1# Gmail notifications support.
2
3package require msgcat
4
5namespace eval gmail {
6    ::msgcat::mcload [file join [file dirname [info script]] msgs]
7
8    if {![::plugins::is_registered gmail]} {
9	::plugins::register gmail \
10			    -namespace [namespace current] \
11			    -source [info script] \
12			    -description [::msgcat::mc "Whether the Gmail plugin is loaded."] \
13			    -loadcommand [namespace code load] \
14			    -unloadcommand [namespace code unload]
15	return
16    }
17
18    custom::defgroup Plugins \
19	[::msgcat::mc "Plugins options."] \
20	-group Tkabber
21
22    custom::defgroup {Gmail Notifications} \
23	[::msgcat::mc "Google Talk XMPP extensions."] \
24	-group Plugins
25
26    custom::defvar options(gmail_notifications) 1 \
27	[::msgcat::mc "Request Gmail notifications."] \
28	-type boolean -group {Gmail Notifications} \
29	-command [namespace current]::request_all_notifications
30
31    custom::defvar options(delete_old_notifications) 1 \
32	[::msgcat::mc "Delete Gmail notifications, which are older than 24 hours."] \
33	-type boolean -group {Gmail Notifications} \
34	-command [namespace current]::request_all_notifications
35
36    custom::defvar options(timestamp_format) {[%m/%d %R] } \
37	[::msgcat::mc "Format of timestamp in Gmail tree view. Set to\
38		       empty string if you don't want to see timestamps."] \
39	-group {Gmail Notifications} -type string
40
41    custom::defvar last_mail_time {} \
42	[::msgcat::mc "Last Gmail message time."] \
43	-type string -group Hidden
44}
45
46package require md5
47
48proc gmail::load {} {
49    hook::add connected_hook [namespace current]::request_notifications
50    hook::add finload_hook [namespace current]::create_menu
51    hook::add save_session_hook [namespace current]::save_session
52
53    create_menu
54    request_all_notifications
55}
56
57proc gmail::unload {} {
58    hook::remove connected_hook [namespace current]::request_notifications
59    hook::remove finload_hook [namespace current]::create_menu
60    hook::remove save_session_hook [namespace current]::save_session
61
62    catch {
63	set menu [.mainframe getmenu plugins]
64	set idx [$menu index [::msgcat::mc "Open Gmail notifications"]]
65	$menu delete $idx
66    }
67
68    destroy_win .gmail_messages
69}
70
71############################################################################
72
73proc gmail::request_all_notifications {args} {
74    variable options
75
76    if {$options(gmail_notifications)} {
77	foreach xlib [connections] {
78	    request_notifications $xlib
79	}
80    }
81}
82
83############################################################################
84
85proc gmail::request_notifications {xlib} {
86    variable options
87    variable last_mail_time
88
89    set jid [connection_bare_jid $xlib]
90    catch {array set tmp $last_mail_time}
91
92    if {[info exists tmp($jid)]} {
93	set time $tmp($jid)
94    } else {
95	set time 0
96    }
97
98    if {$options(gmail_notifications)} {
99	::xmpp::sendIQ $xlib get \
100	    -query [::xmpp::xml::create query \
101			    -xmlns google:mail:notify \
102			    -attrs [list  newer-than-time $time]] \
103	    -command [list [namespace current]::receive_notifications $jid]
104    }
105}
106
107############################################################################
108
109proc gmail::receive_notifications {jid status xml} {
110    variable last_mail_time
111
112    if {$status != "ok"} {
113	return
114    }
115
116    ::xmpp::xml::split $xml tag xmlns attrs cdata subels
117
118    if {[::xmpp::xml::isAttr $attrs result-time]} {
119	catch {array set tmp $last_mail_time}
120	set tmp($jid) [::xmpp::xml::getAttr $attrs result-time]
121	set last_mail_time [array get tmp]
122    }
123
124    fill_tree $jid $subels
125}
126
127#############################################################################
128
129proc gmail::create_menu {} {
130    catch {
131	set menu [.mainframe getmenu plugins]
132	$menu add command \
133	      -label [::msgcat::mc "Open Gmail notifications"] \
134	      -command [list [namespace current]::open_window -raise 1]
135    }
136}
137
138#############################################################################
139
140proc gmail::open_window {args} {
141    global tcl_platform
142    variable options
143
144    set raise 0
145    foreach {key val} $args {
146	switch -- $key {
147	    -raise { set raise $val }
148	}
149    }
150
151    set w .gmail_messages
152
153    if {[winfo exists $w]} {
154	if {$raise} {
155	    raise_win $w
156	}
157	return
158    }
159
160    add_win $w -title [::msgcat::mc "Gmail notifications"] \
161	-tabtitle [::msgcat::mc "Gmail"] \
162	-raisecmd [list focus $w.tree] \
163	-class JDisco \
164	-raise $raise
165
166    if {![info exists options(seencolor)]} {
167	if {[cequal $tcl_platform(platform) unix] && \
168		![string equal [option get $w disabledForeground JDisco] ""]} {
169	    set options(seencolor) [option get $w disabledForeground JDisco]
170	} else {
171	    set options(seencolor) [option get $w featurecolor JDisco]
172	}
173    }
174    if {![info exists options(unseencolor)]} {
175	set options(unseencolor) [option get $w fill JDisco]
176    }
177
178    set sw [ScrolledWindow $w.sw]
179    set tw [Tree $w.tree -dragenabled 0]
180    $sw setwidget $tw
181
182    pack $sw -side top -expand yes -fill both
183
184    $tw bindText <<ContextMenu>> \
185	    [list [namespace current]::message_popup $tw]
186    $tw bindText <Double-ButtonPress-1> \
187	    [list [namespace current]::message_action browse $tw]
188
189    # HACK
190    bind $tw.c <Return> \
191         "[namespace current]::message_action browse $tw \[$tw selection get\]"
192    bindscroll $tw.c
193
194    messages_restore
195}
196
197#############################################################################
198
199proc gmail::fill_tree {jid xmlList} {
200    variable options
201
202    if {[llength $xmlList] == 0} {
203	return
204    }
205
206    open_window
207
208    foreach xml $xmlList {
209	::xmpp::xml::split $xml tag xmlns attrs cdata subels
210
211	switch -- $tag {
212	    mail-thread-info {
213		set tid [::xmpp::xml::getAttr $attrs tid]
214		set messages [::xmpp::xml::getAttr $attrs messages]
215		set date [::xmpp::xml::getAttr $attrs date]
216		set url [::xmpp::xml::getAttr $attrs url]
217		add_thread $jid $tid $messages $date $url $subels 1
218	    }
219	}
220    }
221}
222
223proc gmail::add_thread {jid tid messages date url xmlList unseen} {
224    variable options
225
226    set w .gmail_messages
227    set tw $w.tree
228
229    set fnode [str2node $jid]
230    if {![$tw exists $fnode]} {
231	$tw insert end root $fnode -text $jid -open 1 \
232	    -fill $options(unseencolor) -image browser/user \
233	    -data [list type jid jid $jid unseen $unseen]
234    }
235
236    set senders [list]
237    set subject ""
238    foreach xml $xmlList {
239	::xmpp::xml::split $xml tag xmlns attrs cdata subels
240
241	switch -- $tag {
242	    senders {
243		foreach subel $subels {
244		    ::xmpp::xml::split $subel stag sxmlns sattrs scdata ssubels
245		    if {$stag == "sender"} {
246			lappend senders [::xmpp::xml::getAttr $sattrs name]
247		    }
248		}
249	    }
250	    subject {
251		set subject $cdata
252	    }
253	}
254    }
255
256    set snode [str2node "$tid $jid"]
257    if {[$tw exists $snode]} {
258	$tw delete $snode
259    }
260
261    set timestamp [clock format [string range $date 0 end-3] -format $options(timestamp_format)]
262    set names [senders2names $senders]
263    $tw insert end $fnode $snode \
264	-text "$timestamp$names ($messages) $subject" -open 1 \
265	-fill $options(unseencolor) \
266	-data [list type thread jid $jid tid $tid \
267		    messages $messages date $date url $url \
268		    xml $xmlList unseen $unseen]
269
270    if {$options(delete_old_notifications)} {
271	message_action deleteold $tw $fnode
272    } else {
273	messages_store $tw
274    }
275    message_update $tw $snode
276    sort_nodes $tw $fnode -date
277    tab_set_updated $w 1 message
278}
279
280proc gmail::senders2names {senders} {
281    if {[llength $senders] <= 1} {
282	return [lindex $senders 0]
283    } else {
284	set names {}
285	foreach s $senders {
286	    lappend names [lindex [split [string trim $s]] 0]
287	}
288	if {[llength $names] <= 3} {
289	    return [join $names ", "]
290	} else {
291	    return "[lindex $names 0] .. [join [lrange $names end-1 end] {, }]"
292	}
293    }
294}
295
296proc gmail::str2node {string} {
297    set utf8str [encoding convertto utf-8 $string]
298    if {[catch { ::md5::md5 -hex $utf8str } ret]} {
299	return [::md5::md5 $utf8str]
300    } else {
301	return $ret
302    }
303}
304
305proc gmail::message_popup {tw node} {
306    $tw selection set $node
307
308    if {[catch { array set props [$tw itemcget $node -data] }]} {
309	return
310    }
311
312    set m .gmail_popup_menu
313
314    if {[winfo exists $m]} {
315	destroy $m
316    }
317
318    menu $m -tearoff 0
319
320    switch -- $props(type) {
321	jid {
322	#    $m add command -label [::msgcat::mc "Mark all seen"] \
323	#	-command [list [namespace current]::message_action markseen $tw $node]
324	#    $m add command -label [::msgcat::mc "Mark all unseen"] \
325	#	-command [list [namespace current]::message_action markunseen $tw $node]
326	    $m add command -label [::msgcat::mc "Delete messages older than 24 hours"] \
327		-command [list [namespace current]::message_action deleteold $tw $node]
328	#    $m add command -label [::msgcat::mc "Delete seen messages"] \
329	#	-command [list [namespace current]::message_action deleteseen $tw $node]
330	    $m add command -label [::msgcat::mc "Delete all messages"] \
331		-command [list [namespace current]::message_action delete $tw $node]
332	}
333	thread {
334	    $m add command -label [::msgcat::mc "Browse"] \
335		-command [list [namespace current]::message_action browse $tw $node]
336	#    $m add command -label [::msgcat::mc "Mark seen"] \
337	#	-command [list [namespace current]::message_action markseen $tw $node]
338	#    $m add command -label [::msgcat::mc "Mark unseen"] \
339	#	-command [list [namespace current]::message_action markunseen $tw $node]
340	    $m add command -label [::msgcat::mc "Delete"] \
341		-command [list [namespace current]::message_action delete $tw $node]
342	}
343	default {
344	    return
345	}
346    }
347
348    tk_popup $m [winfo pointerx .] [winfo pointery .]
349}
350
351proc gmail::message_action {action tw node} {
352    message_action_aux $action $tw $node
353    messages_store $tw
354}
355
356proc gmail::message_action_aux {action tw node} {
357    variable options
358
359    if {[catch { array set props [$tw itemcget $node -data] }]} {
360        return
361    }
362
363    switch -glob -- $props(type)/$action {
364	jid/markseen {
365            foreach child [$tw nodes $node] {
366		message_action_aux markseen $tw $child
367            }
368	}
369	jid/markunseen {
370            foreach child [$tw nodes $node] {
371		message_action_aux markunseen $tw $child
372            }
373	}
374	jid/deleteold {
375	    foreach child [$tw nodes $node] {
376		message_action_aux deleteold $tw $child
377	    }
378	}
379	jid/deleteseen {
380	    foreach child [$tw nodes $node] {
381		message_action_aux deleteseen $tw $child
382	    }
383	}
384	jid/delete {
385	    foreach child [$tw nodes $node] {
386		message_action_aux delete $tw $child
387	    }
388	}
389	thread/browse {
390	    if {$props(url) != ""} {
391		browseurl $props(url)
392	    }
393	}
394	thread/markseen {
395            set props(unseen) 0
396	}
397	thread/markunseen {
398            set props(unseen) 1
399	}
400	thread/deleteold {
401	    set datediff [expr {[clock seconds] - [string range $props(date) 0 end-3]}]
402	    if {$datediff > 86400} {
403		message_action_aux delete $tw $node
404	    }
405	}
406	thread/deleteseen {
407	    if {!$props(unseen)} {
408		message_action_aux delete $tw $node
409	    }
410	}
411	thread/delete {
412            set props(unseen) 0
413            $tw itemconfigure $node -data [array get props]
414            message_update $tw $node
415
416	    # Deduce the node to select after $node is deleted:
417	    # Next sibling is tried first, then previous, then parent node.
418	    set p [$tw parent $node]
419	    set end [expr {[llength [$tw nodes $p]] - 1}]
420	    set ix [$tw index $node]
421	    if {$ix < $end} {
422		set next [$tw nodes $p [incr ix]]
423	    } elseif {$ix > 0} {
424		set next [$tw nodes $p [incr ix -1]]
425	    } else {
426		set next $p
427	    }
428
429            $tw delete $node
430
431	    if {![string equal $next root]} {
432		$tw selection set $next
433	    }
434	}
435	default {
436	    return
437	}
438    }
439}
440
441proc gmail::sort_nodes {tw node type} {
442    if {[string range $type 0 0] == "-"} {
443	set order -decreasing
444	set type [string range $type 1 end]
445    } elseif {[string range $type 0 0] == "+"} {
446	set order -increasing
447	set type [string range $type 1 end]
448    } else {
449	set order -increasing
450    }
451
452    set children {}
453    foreach child [$tw nodes $node] {
454        catch { unset props }
455        array set props [$tw itemcget $child -data]
456
457	lappend children [list $child $props($type)]
458    }
459    set neworder {}
460    foreach child [lsort $order -index 1 $children] {
461        lappend neworder [lindex $child 0]
462    }
463    $tw reorder $node $neworder
464}
465
466proc gmail::message_update {tw node} {
467    variable options
468
469    for {set parent [$tw parent $node]} \
470            {![cequal $parent root]} \
471            {set parent [$tw parent $parent]} {
472        set unseen 0
473
474        foreach child [$tw nodes $parent] {
475            catch { unset props }
476            array set props [$tw itemcget $child -data]
477
478            incr unseen $props(unseen)
479        }
480
481        catch { unset props }
482        array set props [$tw itemcget $parent -data]
483        set props(unseen) $unseen
484
485        set text $props(jid)
486        set myfill $options(seencolor)
487        if {$unseen > 0} {
488            append text " ($unseen)"
489            set myfill $options(unseencolor)
490        }
491        $tw itemconfigure $parent -text $text -fill $myfill \
492                -data [array get props]
493    }
494}
495
496#############################################################################
497
498proc gmail::messages_store {tw} {
499    set file [file join $::configdir gmail-notifications.tcl]
500    set file0 [file join $::configdir gmail-notifications0.tcl]
501    set file1 [file join $::configdir gmail-notifications1.tcl]
502
503    if {[catch {open $file1 {WRONLY CREAT TRUNC}} fd]} {
504        debugmsg plugins "unable to open $file1: $fd"
505        return
506    }
507    fconfigure $fd -encoding utf-8
508
509    set code [catch {messages_store_aux $tw root $fd} result]
510
511    catch {close $fd}
512
513    if {$code} {
514        debugmsg plugins $result
515        catch {file delete $file1}
516        return
517    }
518
519    set renameP 0
520    if {![file exists $file]} {
521    } elseif {[file size $file] == 0} {
522        catch {file delete -force $file}
523    } else {
524        set renameP 1
525        catch {file rename -force $file $file0}
526    }
527
528    if {![catch {file rename $file1 $file} result]} {
529        return
530    }
531    debugmsg plugins "unable to rename $file1 to $file: $result"
532
533    if {($renameP) && ([catch {file rename -force $file0 $file} result])} {
534        debugmsg plugins "unable to rename $file0 back to $file: $result"
535    }
536    catch {file delete $file1}
537
538    return
539}
540
541#############################################################################
542
543proc gmail::messages_store_aux {tw node fd} {
544    if {![winfo exists $tw]} {
545        return
546    }
547
548    if {[llength [set children [$tw nodes $node]]] > 0} {
549        foreach child $children {
550            messages_store_aux $tw $child $fd
551        }
552    } elseif {![catch {array set props [$tw itemcget $node -data]}]} {
553        puts $fd [list [namespace current]::add_thread \
554		       $props(jid) $props(tid) $props(messages) \
555		       $props(date) $props(url) $props(xml) \
556		       $props(unseen)]
557    }
558}
559
560#############################################################################
561
562proc gmail::messages_restore {} {
563    set file [file join $::configdir gmail-notifications.tcl]
564    if {[file exists $file]} {
565	catch {
566	    set fd [open $file "r"]
567	    fconfigure $fd -encoding utf-8
568	    uplevel #0 [read $fd]
569	    close $fd
570	}
571    }
572
573    return ""
574}
575
576#############################################################################
577
578proc gmail::notify_response {xlib from xml args} {
579    variable options
580
581    if {$from != "" && \
582	    $from != [connection_bare_jid $xlib] && \
583	    $from != [connection_jid $xlib]} {
584	return {error cancel not-allowed}
585    }
586
587    ::xmpp::xml::split $xml tag xmlns attrs cdata subels
588
589    if {$tag != "new-mail"} {
590	return {error modify bad-request}
591    }
592
593    request_notifications $xlib
594
595    return [list result ""]
596}
597
598::xmpp::iq::register set * google:mail:notify \
599		     [namespace current]::gmail::notify_response
600
601#############################################################################
602
603proc gmail::restore_window {from xlib jid} {
604    open_window -raise 1
605}
606
607#############################################################################
608
609proc gmail::save_session {vsession} {
610    upvar 2 $vsession session
611    global usetabbar
612
613    # We don't need JID at all, so make it empty (special case)
614    set user     ""
615    set server   ""
616    set resource ""
617
618    # TODO
619    if {!$usetabbar} return
620
621    set prio 0
622    foreach page [.nb pages] {
623	set path [ifacetk::nbpath $page]
624
625	if {[string equal $path .gmail_messages]} {
626	    lappend session \
627		    [list $prio $user $server $resource \
628			  [list [namespace current]::restore_window ""]]
629	}
630	incr prio
631    }
632}
633
634#############################################################################
635
636