aboutsummaryrefslogblamecommitdiffstats
path: root/urgent.tcl
blob: aecf9d9f978fdd301a5053eb39ab6f29f5122b05 (plain) (tree)
1
2
3
4
5


                       

                    




































                                                                            
                                            





                                                                         
                                                


                                                           
                                                















                                                                               
                                        
                                                           
                                        




             
                                   
                                           
                                                            


                                                         

                                                         


        
                                           


                  


                                       



                                           












                                                 



















                                                                       
                                                                    




                                                                        








                                                                    

                                                                       
                                                                     




                                                                           
# $Id$

namespace eval urgent {
    variable options

    custom::defgroup Urgent [::msgcat::mc "Urgency hinting."] -group Plugins

    custom::defvar options(enabled) 1 \
	[::msgcat::mc "Set the urgency hint on Tkabber's chat\
	    window when a new message is received."] \
	-type boolean \
	-group Urgent

    custom::defvar options(handle_personal_messages) 1 \
	[::msgcat::mc "React on messages addressed to us."] \
	-type boolean \
	-group Urgent

    custom::defvar options(handle_normal_messages) 0 \
	[::msgcat::mc "React on messages in MUC rooms\
	    which are not addressed to us."] \
	-type boolean \
	-group Urgent

    custom::defvar options(handle_server_messages) 0 \
	[::msgcat::mc "React on messages generated by the server"] \
	-type boolean \
	-group Urgent
}

proc urgent::chat_message_notify {chatid from type body extras} {
    variable options

    if {!$options(enabled)} return

    set delayed [::xmpp::delay::exists $extras]
    if {$delayed} return

    switch -- $type {
	groupchat {
	    if {[string equal [chat::get_jid $chatid] $from]} {
		if {$options(handle_server_messages)} {
		    set_urgency_hint $chatid
		}
	    } else {
		set mynick [chat::get_nick [chat::get_xlib $chatid] \
					   [chat::our_jid $chatid] $type]
		if {[check_message $mynick $body]} {
		    if {$options(handle_personal_messages)} {
			set_urgency_hint $chatid
		    }
		} else {
		    if {$options(handle_normal_messages)} {
			set_urgency_hint $chatid
		    }
		}
	    }
	}
	chat {
	    foreach xelem $extras {
		::xmpp::xml::split $xelem tag xmlns attrs cdata subels
		# Don't play sound if this 'empty' tag is present. It indicates
		# messages history in chat window.
		if {[string equal $tag ""] && \
				    [string equal $xmlns tkabber:x:nolog]} {
		    return
		}
	    }

	    if {$from == "" && $options(handle_server_messages)} {
		set_urgency_hint $chatid
	    } elseif {$options(handle_personal_messages)} {
		set_urgency_hint $chatid
	    }
	}
    }
}

proc urgent::xclientwinid {tkwin} {
    # Parent window id: 0x2e0001e "Tkabber"
    set data [exec xwininfo -children -id [winfo id $tkwin]]
    if {[regexp {Parent window id: (\S+)} $data -> id]} {
	return $id
    } else {
	error [format "Failed to parse `xwininfo` output\
	    for Tk window \"%s\"" $tkwin]
    }	
}

proc urgent::root_xwinid {xwinid _chatid} {
    return $xwinid
}

proc urgent::chat_xwinid {chatid} {
    #xclientwinid [chat::winid $chatid]
    winfo id [chat::winid $chatid]
}

proc urgent::record_xwinid {chatid _type} {
    variable xwinids
    set xwinids($chatid) [xwinid $chatid]
}

proc urgent::forget_xwinid {chatid} {
    variable xwinids
    unset xwinids($chatid)
}

proc urgent::set_urgency_hint {chatid} {
    variable options
    variable xwinids

    exec $options(program) -set $xwinids($chatid)
}

proc urgent::clear_urgency_hint {winid} {
    variable options
    variable xwinids

    set chatid [chat::winid_to_chatid $winid]
    
    exec $options(program) -clear $xwinids($chatid)
}

namespace eval urgent {
    variable options

    if {![info exists options(program)]} {
	set options(program) [file join \
	    [file dirname [info script]] urgent]
    }
    if {![file executable $options(program)]} {
	puts stderr [::msgcat::mc "Urgency hint setting program \"%s\"\
	    is not available or not executable by the current user.\
	    The \"urgent\" plugin is disabled. Consult its README file."
	    $options(program)]
	set options(enabled) 0
    }

    hook::add finload_hook [namespace code {
	if {$::ifacetk::options(use_tabbar)} {
	    interp alias {} [namespace current]::xwinid \
		{} [namespace current]::root_xwinid [xclientwinid .]
	} else {
	    interp alias {} [namespace current]::xwinid \
		{} [namespace current]::chat_xwinid
	}
    }]

    hook::add open_chat_post_hook [namespace current]::record_xwinid 40
    hook::add close_chat_post_hook [namespace current]::forget_xwinid
    hook::add draw_message_hook [namespace current]::chat_message_notify 19
    hook::add got_focus_hook [namespace current]::clear_urgency_hint
}

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