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


                       
                    
                  
 







                                                                      


















                                                              
                                                                     



                       











                                                                        




                                                                 
                                    





                                                               
                                            

                    
                                                                       


                                                                         
                                                


                                                           
                                                




                     
                                                             
                                   

                                                               






                                                                            
                                        
                                                           
                                        




             
                                   
                                                            


                                                         

                                                         


        
                                           


                  
                                   


                                                              


                                           


                                              


                                     



                               



                                        
                  
 



                                                            


                                         
                                             



                             
    



                                                              










                                                                       
                                                                    
                                                                          



                              








                                                                    

                                                                       
                                                                     




                                                                           
# $Id$

namespace eval urgent {
    variable options
    variable state

    custom::defgroup Urgent \
	[::msgcat::mc "Urgency hinting.\
	    This plugin provides an ability to set the so called\
	    \"urgency flag\" as a special hint to the window manager\
	    on Tkabber's chat windows when new messages arrive.\
	    ICCCM compliant window managers may use this hint\
	    to somehow draw the user's attention to such a window."] \
	-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::is_delayed {xml} {
    foreach xelem $xml {
	::jlib::wrapper:splitxml $xelem tag vars isempty chdata children
	switch -- [::jlib::wrapper:getattr $vars xmlns] {
	    urn:xmpp:delay -
	    jabber:x:delay {
		return 1
	    }
	}
    }
    return 0
}
proc urgent::chat_message_notify {chatid from type body extras} {
    variable options

    if {!$options(enabled)} return

    set delayed [is_delayed $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_connid $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 {
	    # Handle special tag indicating history messages:
	    foreach xelem $extras {
		::jlib::wrapper:splitxml $xelem tag vars ? ? ?
		set xmlns [::jlib::wrapper:getattr $vars xmlns]
		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} {
    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} {
    set tkwin [chat::winid $chatid]
    tkwait visibility $tkwin ;# seems to be needed by xwininfo
    xclientwinid $tkwin
}

proc urgent::record_xwinid {chatid _type} {
    variable state
    set state(xwinid,$chatid) [xwinid $chatid]
    set state(active,$chatid) false
}

proc urgent::forget_xwinid {chatid} {
    variable state

    unset state(xwinid,$chatid)
    unset state(active,$chatid)
}

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

    if {!$state(active,$chatid)} {
	exec $options(program) -set $state(xwinid,$chatid) &
	set state(active,$chatid) true
    }
}

proc urgent::clear_urgency_hint {winid} {
    set chatid [chat::winid_to_chatid $winid]
    if {$chatid == ""} return

    variable options
    variable state
    
    if {$state(active,$chatid)} {
	set state(active,$chatid) false
	exec $options(program) -clear $state(xwinid,$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