# gmail.tcl --
#
#       Gmail notifications plugin for Tkabber XMPP client.

package require msgcat

namespace eval gmail {
    ::msgcat::mcload [file join [file dirname [info script]] msgs]

    if {![::plugins::is_registered gmail]} {
        ::plugins::register gmail \
                            -namespace [namespace current] \
                            -source [info script] \
                            -description [::msgcat::mc "Whether the Gmail\
                                                        plugin is loaded."] \
                            -loadcommand [namespace code load] \
                            -unloadcommand [namespace code unload]
        return
    }

    custom::defgroup Plugins \
        [::msgcat::mc "Plugins options."] \
        -group Tkabber

    custom::defgroup {Gmail Notifications} \
        [::msgcat::mc "Google Talk XMPP extensions."] \
        -group Plugins

    custom::defvar options(gmail_notifications) 1 \
        [::msgcat::mc "Request Gmail notifications."] \
        -type boolean -group {Gmail Notifications} \
        -command [namespace current]::request_all_notifications

    custom::defvar options(delete_old_notifications) 1 \
        [::msgcat::mc "Delete Gmail notifications, which are\
                       older than 24 hours."] \
        -type boolean -group {Gmail Notifications} \
        -command [namespace current]::request_all_notifications

    custom::defvar options(timestamp_format) {[%m/%d %R] } \
        [::msgcat::mc "Format of timestamp in Gmail tree view. Set to\
                       empty string if you don't want to see timestamps."] \
        -group {Gmail Notifications} -type string

    custom::defvar last_mail_time {} \
        [::msgcat::mc "Last Gmail message time."] \
        -type string -group Hidden
}

package require md5

proc gmail::load {} {
    hook::add connected_hook [namespace current]::request_notifications
    hook::add finload_hook [namespace current]::create_menu
    hook::add save_session_hook [namespace current]::save_session

    create_menu
    request_all_notifications
}

proc gmail::unload {} {
    hook::remove connected_hook [namespace current]::request_notifications
    hook::remove finload_hook [namespace current]::create_menu
    hook::remove save_session_hook [namespace current]::save_session

    catch {
        set menu [.mainframe getmenu plugins]
        set idx [$menu index [::msgcat::mc "Open Gmail notifications"]]
        $menu delete $idx
    }

    destroy_win .gmail_messages
}

############################################################################

proc gmail::request_all_notifications {args} {
    variable options

    if {$options(gmail_notifications)} {
        foreach xlib [connections] {
            request_notifications $xlib
        }
    }
}

############################################################################

proc gmail::request_notifications {xlib} {
    variable options
    variable last_mail_time

    set jid [connection_bare_jid $xlib]
    catch {array set tmp $last_mail_time}

    if {[info exists tmp($jid)]} {
        set time $tmp($jid)
    } else {
        set time 0
    }

    if {$options(gmail_notifications)} {
        ::xmpp::sendIQ $xlib get \
            -query [::xmpp::xml::create query \
                            -xmlns google:mail:notify \
                            -attrs [list  newer-than-time $time]] \
            -command [list [namespace current]::receive_notifications $jid]
    }
}

############################################################################

proc gmail::receive_notifications {jid status xml} {
    variable last_mail_time

    if {$status != "ok"} {
        return
    }

    ::xmpp::xml::split $xml tag xmlns attrs cdata subels

    if {[::xmpp::xml::isAttr $attrs result-time]} {
        catch {array set tmp $last_mail_time}
        set tmp($jid) [::xmpp::xml::getAttr $attrs result-time]
        set last_mail_time [array get tmp]
    }

    fill_tree $jid $subels
}

#############################################################################

proc gmail::create_menu {} {
    catch {
        set menu [.mainframe getmenu plugins]
        $menu add command \
              -label [::msgcat::mc "Open Gmail notifications"] \
              -command [list [namespace current]::open_window -raise 1]
    }
}

#############################################################################

proc gmail::open_window {args} {
    global tcl_platform

    set raise 0
    foreach {key val} $args {
        switch -- $key {
            -raise { set raise $val }
        }
    }

    set w .gmail_messages

    if {[winfo exists $w]} {
        if {$raise} {
            raise_win $w
        }
        return
    }

    add_win $w -title [::msgcat::mc "Gmail notifications"] \
        -tabtitle [::msgcat::mc "Gmail"] \
        -raisecmd [list focus $w.tree] \
        -class JDisco \
        -raise $raise

    if {$tcl_platform(platform) eq "unix" && \
            ![string equal [option get $w disabledForeground JDisco] ""]} {
        set config(seencolor) [option get $w disabledForeground JDisco]
    } else {
        set config(seencolor) [option get $w featurecolor JDisco]
    }
    set config(unseencolor) [option get $w fill JDisco]

    set sw [ScrolledWindow $w.sw]
    set tw [MyTree $w.tree]
    $sw setwidget $tw

    $tw tag configure seen -foreground $config(seencolor)
    $tw tag configure unseen -foreground $config(unseencolor)

    pack $sw -side top -expand yes -fill both

    $tw tag bind Text <<ContextMenu>> \
            [list [namespace current]::message_popup [double% $tw] %x %y]
    $tw tag bind Text <Double-ButtonPress-1> \
            [list [namespace current]::message_browse [double% $tw]]
    # Override the default action which toggles the non-leaf nodes
    bind $tw <Double-ButtonPress-1> break

    if {[winfo exists $tw.c]} {
        # HACK
        bind $tw.c <Return> \
             [list [namespace current]::message_browse [double% $tw]]
    } else {
        $tw tag bind Text <Return> \
             [list [namespace current]::message_browse [double% $tw]]
        # Override the default action which toggles the non-leaf nodes
        bind $tw <Return> break
    }

    messages_restore
}

#############################################################################

proc gmail::fill_tree {jid xmlList} {
    if {[llength $xmlList] == 0} {
        return
    }

    open_window

    foreach xml $xmlList {
        ::xmpp::xml::split $xml tag xmlns attrs cdata subels

        switch -- $tag {
            mail-thread-info {
                set tid [::xmpp::xml::getAttr $attrs tid]
                set messages [::xmpp::xml::getAttr $attrs messages]
                set date [::xmpp::xml::getAttr $attrs date]
                set url [::xmpp::xml::getAttr $attrs url]
                add_thread $jid $tid $messages $date $url $subels 1
            }
        }
    }
}

proc gmail::add_thread {jid tid messages date url xmlList unseen} {
    variable options

    set w .gmail_messages
    set tw $w.tree

    set fnode [str2node $jid]
    if {![$tw exists $fnode]} {
        $tw insert {} end \
            -id $fnode \
            -text $jid \
            -open 1 \
            -tags {Text unseen} \
            -image browser/user \
            -values [list type jid jid $jid unseen $unseen]
    }

    set senders [list]
    set subject ""
    foreach xml $xmlList {
        ::xmpp::xml::split $xml tag xmlns attrs cdata subels

        switch -- $tag {
            senders {
                foreach subel $subels {
                    ::xmpp::xml::split $subel stag sxmlns sattrs scdata ssubels
                    if {$stag == "sender"} {
                        lappend senders [::xmpp::xml::getAttr $sattrs name]
                    }
                }
            }
            subject {
                set subject $cdata
            }
        }
    }

    set snode [str2node "$tid $jid"]
    if {[$tw exists $snode]} {
        $tw delete [list $snode]
    }

    set timestamp [clock format [string range $date 0 end-3] \
                                -format $options(timestamp_format)]
    set names [senders2names $senders]
    $tw insert $fnode end \
        -id $snode \
        -text "$timestamp$names ($messages) $subject" \
        -open 1 \
        -tags {Text unseen} \
        -values [list type thread jid $jid tid $tid \
                    messages $messages date $date url $url \
                    xml $xmlList unseen $unseen]

    if {$options(delete_old_notifications)} {
        message_action deleteold $tw $fnode
    } else {
        messages_store $tw
    }
    message_update $tw $snode
    sort_nodes $tw $fnode -date
    tab_set_updated $w 1 message
}

proc gmail::senders2names {senders} {
    if {[llength $senders] <= 1} {
        return [lindex $senders 0]
    } else {
        set names {}
        foreach s $senders {
            lappend names [lindex [split [string trim $s]] 0]
        }
        if {[llength $names] <= 3} {
            return [join $names ", "]
        } else {
            return "[lindex $names 0] .. [join [lrange $names end-1 end] {, }]"
        }
    }
}

proc gmail::str2node {string} {
    set utf8str [encoding convertto utf-8 $string]
    if {[catch { ::md5::md5 -hex $utf8str } ret]} {
        return [::md5::md5 $utf8str]
    } else {
        return $ret
    }
}

proc gmail::message_popup {tw x y} {
    $tw selection set [list [$tw identify item $x $y]]
    set node [lindex [$tw selection] 0]

    if {[catch {array set props [$tw item $node -values]}]} {
        return
    }

    set m .gmail_popup_menu

    if {[winfo exists $m]} {
        destroy $m
    }

    menu $m -tearoff 0

    switch -- $props(type) {
        jid {
        #    $m add command -label [::msgcat::mc "Mark all seen"] \
        #       -command [list [namespace current]::message_action markseen \
        #                       $tw $node]
        #    $m add command -label [::msgcat::mc "Mark all unseen"] \
        #       -command [list [namespace current]::message_action markunseen \
        #                       $tw $node]
            $m add command -label [::msgcat::mc "Delete messages older than\
                                                 24 hours"] \
                -command [list [namespace current]::message_action deleteold \
                               $tw $node]
        #    $m add command -label [::msgcat::mc "Delete seen messages"] \
        #       -command [list [namespace current]::message_action deleteseen \
        #                       $tw $node]
            $m add command -label [::msgcat::mc "Delete all messages"] \
                -command [list [namespace current]::message_action delete \
                               $tw $node]
        }
        thread {
            $m add command -label [::msgcat::mc "Browse"] \
                -command [list [namespace current]::message_action browse \
                               $tw $node]
        #    $m add command -label [::msgcat::mc "Mark seen"] \
        #       -command [list [namespace current]::message_action markseen \
        #                       $tw $node]
        #    $m add command -label [::msgcat::mc "Mark unseen"] \
        #       -command [list [namespace current]::message_action markunseen \
        #                       $tw $node]
            $m add command -label [::msgcat::mc "Delete"] \
                -command [list [namespace current]::message_action delete \
                $tw $node]
        }
        default {
            return
        }
    }

    tk_popup $m [winfo pointerx .] [winfo pointery .]
}

proc gmail::message_browse {tw} {
    set node [lindex [$tw selection] 0]
    if {$node != ""} {
        message_action browse $tw $node
    }
}

proc gmail::message_action {action tw node} {
    message_action_aux $action $tw $node
    messages_store $tw
}

proc gmail::message_action_aux {action tw node} {
    if {[catch {array set props [$tw item $node -values]}]} {
        return
    }

    switch -glob -- $props(type)/$action {
        jid/markseen {
            foreach child [$tw children $node] {
                message_action_aux markseen $tw $child
            }
        }
        jid/markunseen {
            foreach child [$tw children $node] {
                message_action_aux markunseen $tw $child
            }
        }
        jid/deleteold {
            foreach child [$tw children $node] {
                message_action_aux deleteold $tw $child
            }
        }
        jid/deleteseen {
            foreach child [$tw children $node] {
                message_action_aux deleteseen $tw $child
            }
        }
        jid/delete {
            foreach child [$tw children $node] {
                message_action_aux delete $tw $child
            }
        }
        thread/browse {
            if {$props(url) != ""} {
                browseurl $props(url)
            }
        }
        thread/markseen {
            set props(unseen) 0
        }
        thread/markunseen {
            set props(unseen) 1
        }
        thread/deleteold {
            set datediff \
                [expr {[clock seconds] - [string range $props(date) 0 end-3]}]
            if {$datediff > 86400} {
                message_action_aux delete $tw $node
            }
        }
        thread/deleteseen {
            if {!$props(unseen)} {
                message_action_aux delete $tw $node
            }
        }
        thread/delete {
            set props(unseen) 0
            $tw item $node -values [array get props]
            message_update $tw $node

            # Deduce the node to select after $node is deleted:
            # Next sibling is tried first, then previous, then parent node.
            set p [$tw parent $node]
            set end [expr {[llength [$tw children $p]] - 1}]
            set ix [$tw index $node]
            if {$ix < $end} {
                set next [lindex [$tw children $p] [incr ix]]
            } elseif {$ix > 0} {
                set next [lindex [$tw children $p] [incr ix -1]]
            } else {
                set next $p
            }

            $tw delete [list $node]

            if {![string equal $next {}]} {
                $tw selection set [list $next]
            }
        }
        default {
            return
        }
    }
}

proc gmail::sort_nodes {tw node type} {
    if {[string range $type 0 0] == "-"} {
        set order -decreasing
        set type [string range $type 1 end]
    } elseif {[string range $type 0 0] == "+"} {
        set order -increasing
        set type [string range $type 1 end]
    } else {
        set order -increasing
    }

    set children {}
    foreach child [$tw children $node] {
        catch {unset props}
        array set props [$tw item $child -values]

        lappend children [list $child $props($type)]
    }
    set neworder {}
    foreach child [lsort $order -index 1 $children] {
        lappend neworder [lindex $child 0]
    }
    $tw children $node $neworder
}

proc gmail::message_update {tw node} {
    for {set parent [$tw parent $node]} \
            {$parent ne {}} \
            {set parent [$tw parent $parent]} {
        set unseen 0

        foreach child [$tw children $parent] {
            catch {unset props}
            array set props [$tw item $child -values]

            incr unseen $props(unseen)
        }

        catch {unset props}
        array set props [$tw item $parent -values]
        set props(unseen) $unseen

        set text $props(jid)
        set tag seen
        if {$unseen > 0} {
            append text " ($unseen)"
            set tag unseen
        }
        $tw item $parent -text $text -tags [list Text $tag] \
                         -values [array get props]
    }
}

#############################################################################

proc gmail::messages_store {tw} {
    set file [file join $::configdir gmail-notifications.tcl]
    set file0 [file join $::configdir gmail-notifications0.tcl]
    set file1 [file join $::configdir gmail-notifications1.tcl]

    if {[catch {open $file1 {WRONLY CREAT TRUNC}} fd]} {
        debugmsg plugins "unable to open $file1: $fd"
        return
    }
    fconfigure $fd -encoding utf-8

    set code [catch {messages_store_aux $tw root $fd} result]

    catch {close $fd}

    if {$code} {
        debugmsg plugins $result
        catch {file delete $file1}
        return
    }

    set renameP 0
    if {![file exists $file]} {
    } elseif {[file size $file] == 0} {
        catch {file delete -force $file}
    } else {
        set renameP 1
        catch {file rename -force $file $file0}
    }

    if {![catch {file rename $file1 $file} result]} {
        return
    }
    debugmsg plugins "unable to rename $file1 to $file: $result"

    if {($renameP) && ([catch {file rename -force $file0 $file} result])} {
        debugmsg plugins "unable to rename $file0 back to $file: $result"
    }
    catch {file delete $file1}

    return
}

#############################################################################

proc gmail::messages_store_aux {tw node fd} {
    if {![winfo exists $tw]} {
        return
    }

    if {[llength [set children [$tw children $node]]] > 0} {
        foreach child $children {
            messages_store_aux $tw $child $fd
        }
    } elseif {![catch {array set props [$tw item $node -values]}]} {
        puts $fd [list [namespace current]::add_thread \
                       $props(jid) $props(tid) $props(messages) \
                       $props(date) $props(url) $props(xml) \
                       $props(unseen)]
    }
}

#############################################################################

proc gmail::messages_restore {} {
    set file [file join $::configdir gmail-notifications.tcl]
    if {[file exists $file]} {
        catch {
            set fd [open $file "r"]
            fconfigure $fd -encoding utf-8
            uplevel #0 [read $fd]
            close $fd
        }
    }

    return ""
}

#############################################################################

proc gmail::notify_response {xlib from xml args} {
    if {$from != "" && \
            $from != [connection_bare_jid $xlib] && \
            $from != [connection_jid $xlib]} {
        return {error cancel not-allowed}
    }

    ::xmpp::xml::split $xml tag xmlns attrs cdata subels

    if {$tag != "new-mail"} {
        return {error modify bad-request}
    }

    request_notifications $xlib

    return [list result ""]
}

::xmpp::iq::register set * google:mail:notify \
                     [namespace current]::gmail::notify_response

#############################################################################

proc gmail::restore_window {from xlib jid} {
    open_window -raise 1
}

#############################################################################

proc gmail::save_session {vsession} {
    upvar 2 $vsession session
    global usetabbar

    # We don't need JID at all, so make it empty (special case)
    set user     ""
    set server   ""
    set resource ""

    # TODO
    if {!$usetabbar} return

    set prio 0
    foreach page [.nb pages] {
        set path [ifacetk::nbpath $page]

        if {[string equal $path .gmail_messages]} {
            lappend session \
                    [list $prio $user $server $resource \
                          [list [namespace current]::restore_window ""]]
        }
        incr prio
    }
}

# vim:ft=tcl:ts=8:sw=4:sts=4:et