# mute.tcl --
#
#       This file implements MUTE plugin for the Tkabber XMPP client.
#       MUTE stands for the Multi-User Text Editor.
#
# Requirements:
#       The following text utilities have to be present on your system
#       and in the PATH environment variable:
#       diff:   utility to compare two files (apt-get install diffutils
#               in Debian, but it has priority required, so it's always
#               present in the system)
#       patch:  applies a diff output to an original file (apt-get install
#               patch in Debian)
#       merge:  three-way file merger (apt-get install rcs in Debian)

package require msgcat

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

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

}

proc mute::load {} {
    set ::NS(mute_ancestor) "http://jabber.org/protocol/mute#ancestor"
    set ::NS(mute_editor) "http://jabber.org/protocol/mute#editor"

    hook::add roster_create_groupchat_user_menu_hook \
              [namespace current]::editor::add_user_menu_item 49
    hook::add chat_create_user_menu_hook \
              [namespace current]::editor::add_user_menu_item 49
    hook::add roster_jid_popup_menu_hook \
              [namespace current]::editor::add_user_menu_item 49

    ::xmpp::iq::register set * $::NS(mute_editor) \
                         [namespace current]::editor::recv_set_iq
    ::xmpp::iq::register get * $::NS(mute_ancestor) \
                         [namespace current]::ancestor::recv_get_iq
    ::xmpp::iq::register set * $::NS(mute_ancestor) \
                         [namespace current]::ancestor::recv_set_iq
}

proc mute::unload {} {
    hook::remove roster_create_groupchat_user_menu_hook \
                 [namespace current]::editor::add_user_menu_item 49
    hook::remove chat_create_user_menu_hook \
                 [namespace current]::editor::add_user_menu_item 49
    hook::remove roster_jid_popup_menu_hook \
                 [namespace current]::editor::add_user_menu_item 49

    ::xmpp::iq::unregister set * $::NS(mute_editor)
    ::xmpp::iq::unregister get * $::NS(mute_ancestor)
    ::xmpp::iq::unregister set * $::NS(mute_ancestor)

    catch {unset ::NS(mute_ancestor)}
    catch {unset ::NS(mute_editor)}

    namespace delete [namespace current]::editor
    namespace delete [namespace current]::ancestor
}

namespace eval mute::editor {}

proc mute::editor::get_winid {xlib jid id} {
    return [win_id mute [list $xlib $jid]//@mute@//$id]
}

proc mute::editor::add_user_menu_item {m xlib jid} {
    $m add command \
        -label [::msgcat::mc "MUTE"] \
        -command [list [namespace current]::list_request $xlib $jid]
}

proc mute::editor::list_request {xlib jid} {
    ::xmpp::sendIQ $xlib get \
        -query [::xmpp::xml::create list \
                        -xmlns $::NS(mute_ancestor)] \
        -to $jid \
        -command [list [namespace current]::list_recv $xlib $jid]
}

proc mute::editor::list_recv {xlib jid status xml} {
    variable txts

    if {$status != "ok"} {
        after idle [list MessageDlg .mute_list_error -icon error \
                         -message [::msgcat::mc "Error getting list: %s" \
                                                [error_to_string $xml]] \
                         -type ok]
        return ""
    }

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

    set ids {}
    foreach subel $subels {
        ::xmpp::xml::split $subel stag sxmlns sattrs scdata ssubels
        set id [::xmpp::xml::getAttr $sattrs id]
        lappend ids $id
        set desc($id) [::xmpp::xml::getAttr $sattrs desc]
    }

    set w .mute_invite

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

    Dialog $w -title [::msgcat::mc "List of texts from %s" $jid] \
              -anchor e -default 0

    foreach id $ids {
        $w add -text "$id: $desc($id)" \
            -command [list [namespace current]::subscribe_request \
                           $xlib $jid $id]
    }

    $w add -text Cancel -command [list destroy $w]

    $w draw
}

proc mute::editor::subscribe_request {xlib jid id} {
    ::xmpp::sendIQ $xlib set \
        -query [::xmpp::xml::create subscribe \
                        -xmlns $::NS(mute_ancestor) \
                        -subelement [::xmpp::xml::create item \
                                            -attrs [list id $id]]] \
        -to $jid \
        -command [list [namespace current]::subscribe_recv $xlib $jid $id]
}

proc mute::editor::subscribe_recv {xlib jid id status xml} {
    variable txts

    if {$status != "ok"} {
        after idle [list MessageDlg .mute_list_error -icon error \
                         -message [::msgcat::mc "Error getting list: %s" \
                                                [error_to_string $xml]] \
                         -type ok]
        return ""
    }
}

proc mute::editor::open_win {xlib jid id} {
    variable txts

    set w [get_winid $xlib $jid $id]
    if {[winfo exists $w]} {
        return
    }

    add_win $w -title [::msgcat::mc "Edit %s" $id] \
               -tabtitle [::msgcat::mc "Edit %s" $id] \
               -class Mute

    set bbox [ButtonBox $w.bbox -spacing 10 -padx 10]
    pack $bbox -side bottom -anchor e

    $bbox add -text [::msgcat::mc "Commit current version"] \
        -command [list [namespace current]::commit $xlib $jid $id]
    $bbox add -text [::msgcat::mc "Revert to master version"] \
        -command [list [namespace current]::revert $xlib $jid $id]

    set sw [ScrolledWindow $w.sw]
    set text [Text $w.text]
    pack $sw -side top -anchor w -expand yes -fill both -pady 1m
    $sw setwidget $text
}

proc mute::editor::get_textw {xlib jid id} {
    return "[get_winid $xlib $jid $id].text"
}

proc mute::editor::set_text {xlib jid id text} {
    variable txts

    set txts(text,$xlib,$jid,$id) $text
    set t [get_textw $xlib $jid $id]

    $t delete 1.0 end
    $t insert 0.0 $text
}

proc mute::editor::revert {xlib jid id} {
    variable txts

    set text $txts(text,$xlib,$jid,$id)
    set tw [get_textw $xlib $jid $id]

    lassign [split [$tw index insert] .] line pos
    $tw delete 1.0 end
    $tw insert 0.0 $text
    $tw mark set insert "$line.$pos"
}

proc mute::editor::commit {xlib jid id} {
    variable txts

    set orig $txts(text,$xlib,$jid,$id)

    set tw [get_textw $xlib $jid $id]
    set edit [$tw get 1.0 "end -1 chars"]

    if {[string index $edit end] != "\n"} {
        set edit "$edit\n"
    }

    # TODO: check temp files
    set fn "/tmp/mute[rand 1000000]"

    set fd [open $fn.orig w]
    fconfigure $fd -encoding utf-8
    puts -nonewline $fd $orig
    close $fd

    set fd [open $fn.edit w]
    fconfigure $fd -encoding utf-8
    puts -nonewline $fd $edit
    close $fd

    catch { exec diff -u $fn.orig $fn.edit > $fn.diff }

    set fd [open $fn.diff r]
    fconfigure $fd -encoding utf-8
    gets $fd
    gets $fd
    set diff [read $fd]
    close $fd

    file delete $fn.orig $fn.edit $fn.diff

    if {$diff != ""} {
        ::xmpp::sendIQ $xlib set \
            -query [::xmpp::xml::create patch \
                            -xmlns $::NS(mute_ancestor) \
                            -attrs [list id $id] \
                            -cdata $diff] \
            -to $jid \
            -command [list [namespace current]::patch_res $xlib $jid $id]
    }
}

proc mute::editor::patch_res {xlib jid id status xml} {
    variable txts

    if {$status != "ok"} {
        after idle [list MessageDlg .mute_list_error -icon error \
                         -message [::msgcat::mc "Error patching: %s" \
                                                [error_to_string $xml]] \
                         -type ok]
        return ""
    }

    set text $txts(text,$xlib,$jid,$id)

    set tw [get_textw $xlib $jid $id]

    lassign [split [$tw index insert] .] line pos
    $tw delete 1.0 end
    $tw insert 0.0 $text
    $tw mark set insert "$line.$pos"
}

proc mute::editor::patch {xlib jid id patch} {
    variable txts

    set tw [get_textw $xlib $jid $id]

    if {![info exists txts(text,$xlib,$jid,$id)] || ![winfo exists $tw]} {
        return [list error cancel not-allowed]
    }

    set text $txts(text,$xlib,$jid,$id)

    set edit [$tw get 1.0 "end -1 chars"]

    lassign [split [$tw index insert] .] line pos

    # TODO: check temp files
    set fn "/tmp/mute[rand 1000000]"

    set fd [open $fn.old w]
    fconfigure $fd -encoding utf-8
    puts -nonewline $fd $text
    close $fd

    set fd [open $fn.orig w]
    fconfigure $fd -encoding utf-8
    puts -nonewline $fd $text
    close $fd

    set fd [open $fn.patch w]
    fconfigure $fd -encoding utf-8
    puts -nonewline $fd $patch
    close $fd

    set fd [open $fn.edit w]
    fconfigure $fd -encoding utf-8
    puts -nonewline $fd $edit
    close $fd

    if {[catch { exec patch $fn.orig $fn.patch }]} {
        puts "something wrong..."
        return
    }

    set fd [open $fn.orig r]
    fconfigure $fd -encoding utf-8
    set new [read $fd]
    close $fd

    catch { exec merge $fn.edit $fn.old $fn.orig }

    set fd [open $fn.edit r]
    fconfigure $fd -encoding utf-8
    set newedit [read $fd]
    close $fd

    file delete $fn.old $fn.orig $fn.patch $fn.edit

    set txts(text,$xlib,$jid,$id) $new

    $tw delete 1.0 end
    $tw insert 0.0 $newedit

    set lineregexp {@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@}
    set shift 0
    foreach l [split $patch \n] {
        if {[regexp $lineregexp $l temp ol os nl ns]} {
            if {$ol >= $line} break
            set shift [expr {$nl + $ns - $ol - $os}]
        }
    }

    set line [expr {$line + $shift}]
    $tw mark set insert "$line.$pos"

    return [list result ""]
}

proc mute::editor::recv_set_iq {xlib from xml args} {
    ::xmpp::xml::split $xml tag xmlns attrs cdata subels

    switch -- $tag {
        text {
            set id [::xmpp::xml::getAttr $attrs id]
            open_win $xlib $from $id
            set_text $xlib $from $id $cdata
        }
        patch {
            set id [::xmpp::xml::getAttr $attrs id]
            return [patch $xlib $from $id $cdata]
        }
        default {
            return [list error cancel feature-not-implemented]
        }
    }
}

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

namespace eval mute::ancestor {
    set txts(ids) {id1 id2}
    set txts(desc,id1) "Useful text"
    set txts(desc,id2) "Useless text"

    set txts(text,id1) "...
8. Admin Use Cases
   8.1. Banning a User
   8.2. Modifying the Ban List
   8.3. Granting Membership
   8.4. Revoking Membership
   8.5. Modifying the Member List
   8.6. Granting Moderator Privileges
   8.7. Revoking Moderator Privileges
   8.8. Modifying the Moderator List
...
"

    set txts(text,id2) ""
}

proc mute::ancestor::send_text {xlib jid id} {
    variable txts

    ::xmpp::sendIQ $xlib set \
        -query [::xmpp::xml::create text \
                        -xmlns $::NS(mute_editor) \
                        -attrs [list id $id] \
                        -cdata $txts(text,$xlib,$id)] \
        -to $jid
#        -command [list [namespace current]::subscribe_recv $xlib $jid $id]
}

proc mute::ancestor::patch {xlib jid id patch} {
    variable txts

    set text $txts(text,$xlib,$id)

    # TODO: check temp files
    set fn "/tmp/mute[rand 1000000]"

    set fd [open $fn.orig w]
    fconfigure $fd -encoding utf-8
    puts -nonewline $fd $text
    close $fd

    set fd [open $fn.patch w]
    fconfigure $fd -encoding utf-8
    puts -nonewline $fd $patch
    close $fd

    if {[catch { exec patch $fn.orig $fn.patch }]} {
        return [list error cancel not-allowed]
    }

    set fd [open $fn.orig r]
    fconfigure $fd -encoding utf-8
    set new [read $fd]
    close $fd

    file delete $fn.orig $fn.patch

    set txts(text,$xlib,$id) $new
    after idle [list [namespace current]::distribute_patch $xlib $id $patch]

    return [list result ""]
}

proc mute::ancestor::distribute_patch {xlib id patch} {
    variable txts

    foreach subscriber $txts(subscribed,$xlib,$id) {
        ::xmpp::sendIQ $xlib set \
            -query [::xmpp::xml::create patch \
                            -xmlns $::NS(mute_editor) \
                            -attrs [list id $id] \
                            -cdata $patch] \
            -to $subscriber \
            -command [list [namespace current]::unsubscribe_on_error \
                          $xlib $subscriber $id]
    }
}

proc mute::ancestor::unsubscribe_on_error {xlib jid id status xml} {
    variable txts

    if {$status != "ok"} {
        set idx [lsearch -exact $txts(subscribed,$xlib,$id) $jid]
        set txts(subscribed,$xlib,$id) \
            [lreplace $txts(subscribed,$xlib,$id) $idx $idx]
        puts "REMOVE $xlib $jid"
    }
}

proc mute::ancestor::recv_get_iq {xlib from xml args} {
    ::xmpp::xml::split $xml tag xmlns attrs cdata subels

    switch -- $tag {
        list {
            variable txts
            # TODO
            if {![info exists txts(ids,$xlib)]} {
                set txts(ids,$xlib) $txts(ids)
                foreach id $txts(ids) {
                    set txts(desc,$xlib,$id) $txts(desc,$id)
                    set txts(text,$xlib,$id) $txts(text,$id)
                }
            }

            set items {}
            foreach id $txts(ids,$xlib) {
                lappend items [::xmpp::xml::create item \
                                   -attrs [list id $id \
                                                desc $txts(desc,$xlib,$id)]]
            }
            return [list result [::xmpp::xml::create list \
                                     -xmlns $::NS(mute_ancestor) \
                                     -subelements $items]]
        }
        default {
            return [list error cancel feature-not-implemented]
        }
    }
    return ""
}

proc mute::ancestor::recv_set_iq {xlib from xml args} {
    ::xmpp::xml::split $xml tag xmlns attrs cdata subels

    switch -- $tag {
        subscribe {
            variable txts

            foreach subel $subels {
                ::xmpp::xml::split $subel stag sxmlns sattrs scdata ssubels

                set id [::xmpp::xml::getAttr $sattrs id]
                if {[lsearch -exact $txts(ids,$xlib) $id] >= 0} {
                    lappend txts(subscribed,$xlib,$id) $from
                    set txts(subscribed,$xlib,$id) \
                        [lsort -unique $txts(subscribed,$xlib,$id)]
                    after idle [list [namespace current]::send_text \
                                     $xlib $from $id]
                    return [list result ""]
                } else {
                    return [list error modify bad-request]
                }
            }
            return [list error modify bad-request]
        }
        patch {
            set id [::xmpp::xml::getAttr $attrs id]
            return [patch $xlib $from $id $cdata]
        }
        default {
            return [list error cancel feature-not-implemented]
        }
    }
    return ""
}

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