aboutsummaryrefslogtreecommitdiffstats
path: root/urgent.tcl
blob: d7996c16caf2d2a85c35e4b81400e0bb1c0e4d31 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
# $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::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} {
    tkwait visibility $tkwin ;# seems to be needed by xwininfo
    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]
}

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