# Alarm plugin
# Protocol is decribed in the file proto.ru_koi8_r (russian)
#

set ::NS(plugins_alarm) "plugins:alarm"

namespace eval alarm {
    
    # load translated msgs
    variable scriptdir [file dirname [info script]]
    
    set sysenc [encoding system]
    encoding system utf-8
    ::msgcat::mcload [file join $scriptdir msgs]
    encoding system $sysenc
    unset sysenc
    
    image create photo plugins/alarm -file [file join $scriptdir pixmaps alarm.gif]
    array set timers {}

					
    # Setup plugins options. 
    set policy [list \
		    allow_all [::msgcat::mc "Allow to all"] \
		    only_registered [::msgcat::mc "Allow to subscribed only"] \
		    deny_to_all [::msgcat::mc "Deny to all" ]]

    set type_names [list \
			[::msgcat::mc "Play sound" ] \
			[::msgcat::mc "Show message box" ] \
			[::msgcat::mc "Show message in the chat" ]]

    
           
    custom::defgroup Plugins [::msgcat::mc "Plugins options."] -group Tkabber
    
    custom::defgroup Alarm [::msgcat::mc "Alarm options."] -group Plugins

    custom::defvar options(enabled) 1 \
        [::msgcat::mc "Enable alarms"] \
        -type boolean -group Alarm

    custom::defvar options(denied_jids) "" \
	[::msgcat::mc "Deny alarms from these JIDs"] \
	-type string -group Alarm 
    custom::defvar options(allowed_jids) "" \
	[::msgcat::mc "Allow alarms from these JIDs"] \
	-type string -group Alarm 
   
    custom::defvar options(denied_groups) "" \
	[::msgcat::mc "Deny alarms from these groups in roster"] \
	-type string -group Alarm 
    custom::defvar options(allowed_groups) "" \
	[::msgcat::mc "Allow alarms from these groups in roster"] \
	-type string -group Alarm 

    custom::defvar options(default_rule) only_registered \
        [::msgcat::mc "Default rule for incoming alarms."] \
        -type radio -group Alarm -layout vertical -values $policy

    custom::defvar options(type) {0 2} \
        [::msgcat::mc "How to show you that somebody alarms you."] \
        -type list -group Alarm -values $type_names

    custom::defvar options(antiflood_interval) 30 \
	[::msgcat::mc "Wait for this interval in seconds between two alarms from one JID"] \
	-type integer -group Alarm

    custom::defvar options(ding_support_in) 1 \
	[::msgcat::mc "Enable alarm on keyword <ding>. JAJC and yahoo seems use it for their alarms."] \
	-type boolean -group Alarm

    custom::defvar options(ding_support_out) 0 \
	[::msgcat::mc "Enable smart alarm sending. It is when plugin sends ibb alarms only to clients which supports them and standart <ding> message to others."] \
	-type boolean -group Alarm

    custom::defvar options(keymessage) "^alarm!"  \
	[::msgcat::mc "Regexp for message-based alarms. If empty then message-based alarms will be disabled."] \
	-type string -group Alarm

   
}


# ####################################
# Sound value
namespace eval ::sound {
   
    # This item stores value in ::sound namespace becouse the proc load_sound_file is there.
    # There was two ways: copy the proc here or put the var there :) I prefered the first
    custom::defvar options(plugin_alarm_sound) \
	[file join [file dirname [info script]] sounds alarm.wav] \
	[::msgcat::mc "Play this sound file"] \
	-command [list [namespace current]::load_sound_file plugin_alarm] \
	-type file -group Alarm

    hook::add postload_hook [list [namespace current]::load_sound_file plugin_alarm ] 100
}



# ##################################
# Base functions

proc alarm::send_alarm0 {xlib jid} {
    debugmsg plugins "alarm: send alarm to $jid using $xlib"

    xmpp::sendIQ $xlib set \
        -query [xmpp::xml::create alarm -xmlns $::NS(plugins_alarm)] \
        -to $jid \
        -command [list [namespace current]::get_response $jid]
}

proc alarm::get_response {jid res child} {
    debugmsg plugins "alarm: response from $jid res: $res child: $child"


    if { [cequal $res OK] } {
	::set_status [format [::msgcat::mc "%s was alarmed"] $jid]
    } else {
	lassign [error_type_condition $child] type condition
	set reason [format [::msgcat::mc "%s rejects your alarm: "] $jid]
	     
	switch -- $condition {
	    not-acceptable { append reason [::msgcat::mc "antiflood"] }
	    service-unavailable { append reason [::msgcat::mc "alarms are disabled"] }
	    feature-not-implemented { append reason [::msgcat::mc "alarms are not supported"] }
	    default { append reason [error_to_string $child] }
	}
	
	::set_status $reason
    }     
}



proc alarm::show_alarm {xlib from} {
    variable options
    debugmsg plugins "alarm: alarm from $from xlib: $xlib"
    
    foreach type $options(type) {
	switch -- $type {
	    0 { # Play sound
		::sound::play $::sound::options(plugin_alarm_sound)
	    }
	    1 { # Show message box

		set nick [::chat::get_nick $xlib $from chat]
		set tag [::jid_to_tag $from]
		
		if {![winfo exists .alarm$tag]} {
		    NonmodalMessageDlg .alarm$tag \
			-aspect 50000 -icon info \
			-message [format [::msgcat::mc "%s alarms you."] $nick]
		}
		
	    }
	    2 { # Show message in chat window
		set nick [::chat::get_nick $xlib $from chat]

		set group [::xmpp::jid::stripResource $from]
		set chatid [::chat::chatid $xlib $group]
		set type groupchat
		if { ![::chat::is_groupchat $chatid] } {
		    set chatid [::chat::chatid $xlib $from]		    
		    set type chat
		}
		
		if {![info exists ::chat::opened($chatid)]} {
		    chat::open_window $chatid $type 
		}

		::chat::add_message $chatid $from info \
		    [format [::msgcat::mc "%s alarms you."] $nick] {}		
	    }
	}
    }

}

proc alarm::apply_filter {xlib from} {
    variable options
    
    set subsc {}
    set groups {}
    set server [::xmpp::jid::server $from]
    set jid [::xmpp::jid::stripResource $from]
    set full_jid $from
    
    catch {set subsc $::roster::roster(subsc,$xlib,$jid)}
    catch {set groups $::roster::roster(group,$xlib,$jid)}

    # Firstly, check JIDs
    foreach elem $options(denied_jids) {
	if { [cequal $server $elem] || [cequal $jid $elem] || [cequal $full_jid $elem] } {
	    return 0
	}
    }

    foreach elem $options(allowed_jids) {
	if { [cequal $server $elem] || [cequal $jid $elem] || [cequal $full_jid $elem] } {
	    return 1
	}
    } 
    
    # Then groups
    foreach elem $options(denied_groups) {
	foreach group $groups { 
	    if { [cequal $group $elem] } {return 0}
	}
    }

    foreach elem $options(allowed_groups) {
	foreach group $groups { 
	    if { [cequal $group $elem] } {return 1}
	}
    }
    
    # And at the end apply default rule
    switch -- $options(default_rule) {
	deny_to_all { return 0 }
	allow_all { return 1 } 
	only_registered {
	    return [expr [cequal $subsc both] || [cequal $subsc from] || [cequal $subsc to] ]
	}
    }

    return 0;
}

proc alarm::antiflood {xlib from} {
    variable timers
    variable options

    set cur_time [clock seconds]
    set group [::xmpp::jid::stripResource $from]
    if { [info exists timers($group)] && ( $cur_time - $timers($group) < $options(antiflood_interval)) } {
	return 0
    }    
    set timers($group) $cur_time

    return 1
}

# ##################################
# menuitem in the users menu

proc alarm::add_user_menu_item {m xlib jid} {
    $m add command -label [::msgcat::mc "Send alarm"] \
	-command [list [namespace current]::send_alarm $xlib $jid]
}

hook::add roster_create_groupchat_user_menu_hook \
    [namespace current]::alarm::add_user_menu_item 49
hook::add chat_create_user_menu_hook \
    [namespace current]::alarm::add_user_menu_item 49
hook::add roster_jid_popup_menu_hook \
    [namespace current]::alarm::add_user_menu_item 49


# #################################
# button in the chat window

proc alarm::init_chat_dialog {chatid type} {
    variable icon

    if {$type != "chat"} {return}

    set xlib [chat::get_xlib $chatid]
    set jid [chat::get_jid $chatid]
    set cw [chat::winid $chatid]
    
    Button $cw.status.alarm \
	-relief flat \
	-image plugins/alarm \
	-helptype balloon \
	-helptext [::msgcat::mc "Send alarm"] \
	-command [list [namespace current]::send_alarm $xlib $jid]

    pack $cw.status.alarm -side left -before $cw.status.mb

}
hook::add open_chat_post_hook [namespace current]::alarm::init_chat_dialog



# ##################################
# Discovery item

hook::add postload_hook \
    [list disco::browser::register_feature_handler $::NS(plugins_alarm) [namespace current]::alarm::send_alarm \
	 -desc [list * [::msgcat::mc "Send alarm"]]]

# #################################
# incoming IQ handler

proc alarm::iq_proc {xlib from child args} {
    variable options
    
    if { ( !$options(enabled) ) || ( ! [apply_filter $xlib $from] ) } {
	return [list error cancel service-unavailable]  
    } 
    
    if { ![antiflood $xlib $from] } {
	return [list error cancel not-acceptable]  
    }    
    
    show_alarm $xlib $from
    return [list result]
}
::xmpp::iq::register set alarm $::NS(plugins_alarm) [namespace current]::alarm::iq_proc

# #################################
# incoming message handler

proc alarm::message_proc {xlib from id type is_subject subject body err thread priority x} {
    variable options

    set myjid [connection_jid $xlib]

    if {![cequal $type chat] 
	|| (!$options(enabled))
	|| [cequal $from $myjid]
	|| (![apply_filter $xlib $from])
	|| (![antiflood $xlib $from]) } { 
	return 
    }
    
    if {![cequal $options(keymessage) ""]
	&& [regexp $options(keymessage) $body]} {
	after idle [list [namespace current]::show_alarm $xlib $from]	
	return
    }

    if {$options(ding_support_in)
	&& [string match *<ding>* $body]} {
	after idle [list [namespace current]::show_alarm $xlib $from]
	if {[string match <ding> $body]} {
	    return stop
	}
	return
    }

    return    
}
hook::add process_message_hook [namespace current]::alarm::message_proc 90


# ##################################
# Smart alarm sending. 

proc alarm::send_alarm {xlib jid args} {
    variable options
    
    if { ! $options(ding_support_out)} {
	send_alarm0 $xlib $jid 
    } else {
	
	disco::request_info $jid "" \
	    -connection $xlib \
	    -cache yes \
	    -handler [list [namespace current]::disco_info_handler $xlib $jid]
    }
}


proc alarm::disco_info_handler {xlib jid args} {

    lassign $args result identities features extras
    if {![cequal $result OK]} return
    
    foreach feature $features {

	set var [xmpp::xml::getAttr $feature var]
	if {![cequal $var $::NS(plugins_alarm)]} continue
	
	send_alarm0 $xlib $jid
	return
    }
    

    xmpp::sendMessage $xlib $jid -body <ding>

} 

# vim:ts=8:sw=4:sts=4:et
