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