# $Id$
# XChat Festival Plugin
# Copyright (C) 2008 
# by Zygo Blaxell <zblaxell@feedme.hungrycats.org>
# Released under the GNU GPL.

# Connect to festival server.
# Does nothing if we believe we are already connected.
proc festival_connect {host {port 1314}} {
	set host_port [list $host $port]
	if {![catch {set ::festival_fd($host_port)}]} {
		return
	}
	puts "festival_connect $host_port"
	set ::festival_fd($host_port) [socket -async $host $port]
	fconfigure $::festival_fd($host_port) -blocking 0 -buffering none -translation binary
	puts "festival_connect $host_port open in $::festival_fd($host_port)"
}

# Disconnect from festival server.
# Does nothing if we believe we are already disconnected.
proc festival_disconnect {host {port 1314}} {
	set host_port [list $host $port]
	puts "festival_disconnect $host_port"
	catch {close $::festival_fd($host_port)}
	catch {unset ::festival_fd($host_port)}
}

# Disconnect, then connect.
# This guarantees that we will attempt to make a new connection to the server,
# disconnecting an existing connection in the process if one exists.
proc festival_reconnect {host {port 1314}} {
	festival_disconnect $host $port
	festival_connect $host $port
}

proc festival_servers {} {
	puts "Connected festival servers:"
	foreach {host_port fd} [array get ::festival_fd] {
		foreach {host port} $host_port break
		puts "Host $host Port $port"
	}
}

proc festival_send {the_text} {
	foreach host_port [array names ::festival_fd] {
		set text $the_text
		if {[catch {
			if {$::festival_debug} {
				puts "SPEAKING($host_port on fd $::festival_fd($host_port)):  $text"
			}

			# Quote characters for Scheme interpreter
			regsub -all {\\} $text {\\\\} text
			regsub -all {"} $text {\"} text

			# Send!
			puts $::festival_fd($host_port) "(SayText \"$text\")\n"

			if {$::festival_debug} {
				puts "SPOKE($host_port):  $text"
			}
		} result]} {
			puts "festival_send: error while sending to $host_port on fd $::festival_fd($host_port):  $result"
			eval festival_reconnect [lindex $host_port 0] [lindex $host_port 1]

			# Send (again)!
			puts $::festival_fd($host_port) "(SayText \"$text\")\n"
			puts "RETRY($host_port):  $text"
		}
	}
}

proc festival_input {} {
	festival_user_config
	upvar 1 _src _src
	upvar 1 _private _private
	upvar 1 _raw _raw
	upvar 1 _rest _rest
	upvar 1 _dest _dest
	upvar 1 _cmd _cmd
	set _nick [me]
	splitsrc
	if {$::festival_debug} {
		puts "src=$_src\nprivate=$_private\nraw=$_raw\ndest=$_dest\ncmd=$_cmd\nnick=$_nick\nrest=$_rest"
	}
	set private_condition 0
	set nick_is_me_condition 0
	set chat_condition 0
	switch -exact $::festival_speak_private {
		always { set private_condition $_private }
		never { return }
		default { set private_condition 0 }
	}
	if {![nickcmp $_nick [me]]} {
		switch -exact $::festival_speak_me {
			always { set nick_is_me_condition 1 }
			never { return }
			default { set nick_is_me_condition 0 }
		}
	}
	if {$_cmd == "CHAT"} {
		switch -exact $::festival_speak_chat {
			always { set chat_condition 1 }
			never { return }
			default { set chat_condition 0 }
		}
	}
	if {
		[regexp -nocase $::festival_re_channel $_dest] ||
		[regexp -nocase $::festival_re_nick $_nick] ||
		[regexp -nocase $::festival_re_src $_src] ||
		[regexp -nocase $::festival_re_text $_rest] ||
		[regexp -nocase $::festival_re_raw $_raw] ||
		$nick_is_me_condition || $private_condition || $chat_condition
	} {
		# Flood protection - a TBF
		set now [clock clicks -milliseconds]
		set time_since_last_bucket [expr {$now - $::festival_tbf_bucket_time}]
		if {$time_since_last_bucket > $::festival_tbf_interval_ms || $time_since_last_bucket < 0} {
			# Fill the bucket if the entire interval has gone by, or if time is running backwards
			set ::festival_tbf_bucket_level $::festival_tbf_interval_ms
		} else {
			# Add tokens to bucket at the configured rate
			set ms_per_token [expr {$::festival_tbf_interval_ms / $::festival_tbf_rate}]
			set ::festival_tbf_bucket_level [expr {
				$::festival_tbf_bucket_level - $ms_per_token
				+ ($time_since_last_bucket / $::festival_tbf_rate)
			}]
			if {$::festival_tbf_bucket_level < 0} {
				set ::festival_tbf_bucket_level 0
			}
		}
		set ::festival_tbf_bucket_time $now

		if {$::festival_tbf_bucket_level <= 0} {
			# Bucket empty?  Speak no evil.
			return
		}

		# Pronounce smileys, URLs, and other IRCisms
		regsub {^!} $_rest "Bang " _rest
		# regsub -all {:} $_rest { colon } _rest
		# regsub -all {[-]} $_rest { dash } _rest
		# regsub -all {;} $_rest { semi-colon } _rest
		# regsub -all {\(} $_rest { left-paren } _rest
		# regsub -all {\)} $_rest { right-paren } _rest
		# regsub -all {!} $_rest { bang } _rest
		# regsub -all {[?](\w)} $_rest { question \1} _rest
		# regsub -all {"} $_rest { quote } _rest
		# regsub -all {\.\.\.} $_rest { dot dot dot } _rest

		# FIXME: this has grown into a switch statement...
		if {$_cmd == "ACTION" || $_cmd == "PRIVMSG" || $_cmd == "CHAT"} {
			# If we are following a conversation within a channel, we don't need to introduce
			# the channel every time someone speaks.  We don't need to introduce the speaker
			# if they are speaking (using PRIVMSG not ACTION) and they were the last to speak.
			if {$::festival_last_channel_nick_cmd == [list [server] $_dest $_nick $_cmd]
			    && $_cmd == "PRIVMSG"} {
				set text $_rest
			} else {
				set text {}

				if {$::festival_last_channel != $_dest} {
					if {$_cmd == "CHAT"} {
						set text "in DCC chat, "
					} elseif {[regexp {^#} $_dest]} {
						set text "in $_dest, "
					} else {
						set text "in dialog to $_dest, "
					}
				}

				if {$::festival_last_server != [server]} {
					append text "on [server], "
				}

				if {$_cmd == "ACTION"} {
					append text "$_nick $_rest"
				} else {
					append text "$_nick says $_rest"
				}
			}
		} elseif {$_cmd == "JOIN"} {
			set text "$_nick has joined channel $_dest"
		} elseif {$_cmd == "PART"} {
			set text "$_nick has left channel $_dest"
		} elseif {$_cmd == "NICK"} {
			set text "$_nick is now known as $_dest"
		} elseif {$_cmd == "QUIT"} {
			set text "$_nick has left IRC $_rest"
		} elseif {$_cmd == "TOPIC"} {
			set text "in $_dest, $_nick has changed the topic to: $_rest"
		} elseif {$_cmd == "SNOTICE"} {
			set text "server notice from [server]: $_rest"
		} elseif {$_cmd == "NOTICE"} {
			set text "notice from $_nick: $_rest"
		} elseif {$_cmd == "XC_NOTIFYOFFLINE" || $_cmd == "XC_NOTIFYONLINE"} {
			if {[regexp {^{Notify (On|Off)line} (\S+) (.+)} $_raw -> on_off who where]} {
				set text "Notify:  $who is $on_off line on $where"
			} else {
				set text "Notify:  regexp mismatched, raw text is:  $_raw"
			}
		} else {
			set text "$_cmd from $_nick: $_rest"
		}

		set ::festival_last_channel_nick_cmd [list [server] $_dest $_nick $_cmd]
		set ::festival_last_channel $_dest
		set ::festival_last_server [server]

		festival_send $text
	}

	# Try to have xchat receive join/part messages.
	# Doesn't work though.
	complete EAT_NONE
}

# Standard IRC events 
# (well, ACTION and CHAT aren't, but who's counting...)
on ACTION speak festival_input
on CHAT speak festival_input
on CTCP speak festival_input
on CTCR speak festival_input
on INVITE speak festival_input
on KICK speak festival_input
on KILL speak festival_input
on MODE speak festival_input
on NOTICE speak festival_input
on PART speak festival_input
on PRIVMSG speak festival_input
on SNOTICE speak festival_input
on TOPIC speak festival_input
on WALLOPS speak festival_input
on XC_NOTIFYOFFLINE speak festival_input
on XC_NOTIFYONLINE speak festival_input

# Too noisy - netsplits suck.
# on JOIN speak festival_input

# Too complicated for now:
# These need to look up the user to see if they are on any channels we are listening to.
# on QUIT speak festival_input
# on NICK speak festival_input

# Useless:  doesn't supply the actual message text
# on XC_UCHANMSG speak festival_input

# Initialization (NOT user-serviceable!)
set ::festival_last_channel_nick_cmd {}
set ::festival_last_channel          {}
set ::festival_last_server           {}
set ::festival_tbf_bucket_level      0
set ::festival_tbf_bucket_time       0

if {[llength [info commands festival_user_config]] == 0} {
	proc festival_user_config {} {
		puts "festival_user_config is not defined!"
	}
}

# Note the values here are defaults.
# To set your own values, create a file named ~/.xchat2/festival-config.tcl
# and put the following in it:
# proc festival_user_config {} {
# 	festival_connect localhost
#	set ::festival_debug 1
#       ...
# }
#
# To update the configuration, edit festival-config.tcl, then enter
# "/reload" (or "/source festival-config.tcl") into xchat.
# 
# BEGIN USER-SERVICEABLE PARTS.
# YOU MAY CHANGE ANY VARIABLES DEFINED BELOW THIS LINE.
# (but you should do it in festival-config.tcl!)

# Debugging (can be changed on the fly with xchat:  "/tcl set ::festival_debug 1")
set ::festival_debug	    0

# Nicks matching RE (use '.' for everyone)
# Example:  set ::festival_re_friends {^(john|paul|george|ringo)}  # Prefixes
# Example:  set ::festival_re_friends {^(john|paul|george|ringo)$} # Exact matches
set ::festival_re_nick      {^(.*)}

# Channels matching RE (use '.' for all channels, and don't forget the #)
# Example:  set ::festival_re_channel {^#(xchat|festival|tcl}$}
set ::festival_re_channel   {^#(.*)$}

# Sources (e.g. "Nick!~ident@client-host.bar.com" for PRIVMSG/ACTION)
# This sources the XChat Tcl plugin _src variable and is as useful or useless as that.
# Example:  set ::festival_re_src       {example\.com|my\.employer\.com|my\.isp\.com}
set ::festival_re_src       {.*}

# Text (i.e., the message or chat text)
# Example:  set ::festival_re_text      {kittens|chocolate|kibo}
set ::festival_re_text      {.*}

# Raw input (direct from IRC)
# This matches the raw IRC input line (for IRC and RE experts)
set ::festival_re_raw	    {.*}

# Handling of "private" messages (where "private" is what XChat thinks it is)
# always - always speak private messages, regardless of regexp matches
# never - never speak private messages, regardless of regexp matches
# maybe - private flag means nothing, use regexps to decide to speak or not
set ::festival_speak_private	always

# Handling of "nick_is_me" messages (where _nick is identical to the user's nick).
# always - always speak nick_is_me messages, regardless of regexp matches
# never - never speak nick_is_me messages, regardless of regexp matches
# maybe - nick_is_me means nothing, use regexps to decide to speak or not
set ::festival_speak_me		always

# Handling of DCC CHAT messages.
# always - always speak CHAT messages, regardless of regexp matches
# never - never speak CHAT messages, regardless of regexp matches
# maybe - CHAT means nothing, use regexps to decide to speak or not
set ::festival_speak_chat	always

# TBF:  maximum number of messages per interval.  If exceeded, we stop speaking.
# This prevents a flood of IRC messages from queueing up hours of text.
# Remember, this plugin is a replacement for the "Beep" sound.
# It's not meant to be an accessibility tool.
set ::festival_tbf_rate        5
set ::festival_tbf_interval_ms 1000