[Tkabber-dev] r515 - in branches/plugins-0.11.1/juick: . msgs

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Tue Apr 10 01:18:44 MSK 2012


Author: Totktonada
Date: 2012-04-10 01:18:44 +0400 (Tue, 10 Apr 2012)
New Revision: 515

Added:
   branches/plugins-0.11.1/juick/tkabber-0.11.1-compatibility.tcl
Modified:
   branches/plugins-0.11.1/juick/BUGS
   branches/plugins-0.11.1/juick/TODO
   branches/plugins-0.11.1/juick/juick.tcl
   branches/plugins-0.11.1/juick/msgs/ru.msg
Log:
Juick plugin (tkabber-0.11.1 branch):
* Both support Tkabber-0.11.1 and Tkabber-svn.
* Fix aligning.
* Replace tabs with spaces.


Modified: branches/plugins-0.11.1/juick/BUGS
===================================================================
--- branches/plugins-0.11.1/juick/BUGS	2012-04-09 21:05:52 UTC (rev 514)
+++ branches/plugins-0.11.1/juick/BUGS	2012-04-09 21:18:44 UTC (rev 515)
@@ -2,4 +2,5 @@
 # Mathed: "-". Fixed: "+".
 
 - Citate with smile in middle.
-- Random order of sending cached messages and PM.
+- Iq with your nick received after offline messages => personal messages indicated as common.
+- On opening chat plugin send several iq-requests to Juick JID.

Modified: branches/plugins-0.11.1/juick/TODO
===================================================================
--- branches/plugins-0.11.1/juick/TODO	2012-04-09 21:05:52 UTC (rev 514)
+++ branches/plugins-0.11.1/juick/TODO	2012-04-09 21:18:44 UTC (rev 515)
@@ -8,6 +8,7 @@
 - Command validation (necessary?)
 + Colored citation
 + Copy nicks/nums/tag to clipboard (Tkabber-way)
++ Dynamic load/unload.
 + Open things in browser.
 + Colored PM.
 - Colored post in some threads.

Modified: branches/plugins-0.11.1/juick/juick.tcl
===================================================================
--- branches/plugins-0.11.1/juick/juick.tcl	2012-04-09 21:05:52 UTC (rev 514)
+++ branches/plugins-0.11.1/juick/juick.tcl	2012-04-09 21:18:44 UTC (rev 515)
@@ -1,52 +1,203 @@
 package require msgcat
 
-option add *juick.nick			red		widgetDefault
-option add *juick.tag			ForestGreen	widgetDefault
-option add *juick.my			gray		widgetDefault
-option add *juick.number		blue		widgetDefault
-option add *juick.private_foreground	blue		widgetDefault
-option add *juick.private_background	#FF9A15		widgetDefault
-option add *juick.citing		gray35		widgetDefault
+option add *juick.nick                  red            widgetDefault
+option add *juick.tag                   ForestGreen    widgetDefault
+option add *juick.my                    gray           widgetDefault
+option add *juick.number                blue           widgetDefault
+option add *juick.private_foreground    blue           widgetDefault
+option add *juick.private_background    #FF9A15        widgetDefault
+option add *juick.citing                gray35         widgetDefault
 
+if {[string equal $::tkabber_version "0.11.1"]} {
+    set scriptdir [file dirname [info script]]
+
+    catch {source [file join $scriptdir \
+        tkabber-0.11.1-compatibility.tcl]} \
+        source_compatibility_file_result
+}
+
 namespace eval juick {
+variable options
+variable juick_nicknames
+variable chat_things
+
 ::msgcat::mcload [file join [file dirname [info script]] msgs]
 
-hook::add draw_message_hook        [namespace current]::ignore_server_messages 0
-hook::add draw_message_hook        [namespace current]::handle_message 21
-hook::add chat_window_click_hook   [namespace current]::insert_from_window
-hook::add chat_win_popup_menu_hook [namespace current]::add_juick_things_menu 20
-hook::add chat_send_message_hook   [namespace current]::rewrite_send_juick_message 19
+if {![::plugins::is_registered juick]} {
+    ::plugins::register juick \
+              -namespace [namespace current] \
+              -source [info script] \
+              -description [::msgcat::mc "Whether the Juick plugin is loaded."] \
+              -loadcommand [namespace code load] \
+              -unloadcommand [namespace code unload]
+    return
+}
 
-hook::add draw_message_hook [namespace current]::update_juick_tab 8
-hook::remove draw_message_hook ::plugins::update_tab::update 8
+custom::defgroup Plugins [::msgcat::mc "Plugins options."] -group Tkabber
 
-hook::add draw_message_hook [namespace current]::add_number_of_messages_from_juick_to_title 18
-hook::remove draw_message_hook ::::ifacetk::add_number_of_messages_to_title 18
+set group "Juick"
+custom::defgroup $group \
+        [::msgcat::mc "Juick settings."] \
+        -group Plugins
 
+custom::defvar options(main_jid) "juick at juick.com/Juick" \
+        [::msgcat::mc "Main Juick JID. This used for forwarding things from other chats."] \
+        -group $group \
+        -type string
+custom::defvar options(special_update_juick_tab) 1 \
+        [::msgcat::mc "Only private messages and replies to your comments is personal message."] \
+        -group $group \
+        -type boolean
+
+proc load {} {
+    ::richtext::entity_state juick_numbers 1
+    ::richtext::entity_state citing 1
+    ::richtext::entity_state juick 1
+    ::richtext::entity_state juick_ligth 1
+
+    hook::add draw_message_hook        [namespace current]::ignore_server_messages 0
+    hook::add draw_message_hook        [namespace current]::handle_message 21
+    hook::add chat_window_click_hook   [namespace current]::insert_from_window
+    hook::add chat_win_popup_menu_hook [namespace current]::add_juick_things_menu 20
+    hook::add rewrite_message_hook     [namespace current]::rewrite_juick_message 20
+    hook::add chat_send_message_hook   [namespace current]::rewrite_send_juick_message 19
+
+    hook::add draw_message_hook [namespace current]::update_juick_tab 8
+    hook::remove draw_message_hook ::plugins::update_tab::update 8
+
+    hook::add draw_message_hook [namespace current]::add_number_of_messages_from_juick_to_title 18
+    hook::remove draw_message_hook ::::ifacetk::add_number_of_messages_to_title 18
+
+    hook::add roster_push_hook [namespace current]::request_juick_nick 99
+    hook::add generate_completions_hook [namespace current]::juick_commands_comps 99
+}
+
+proc unload {} {
+    hook::remove draw_message_hook        [namespace current]::ignore_server_messages 0
+    hook::remove draw_message_hook        [namespace current]::handle_message 21
+    hook::remove chat_window_click_hook   [namespace current]::insert_from_window
+    hook::remove chat_win_popup_menu_hook [namespace current]::add_juick_things_menu 20
+    hook::remove rewrite_message_hook     [namespace current]::rewrite_juick_message 20
+    hook::remove chat_send_message_hook   [namespace current]::rewrite_send_juick_message 19
+
+    hook::remove draw_message_hook [namespace current]::update_juick_tab 8
+    hook::add draw_message_hook ::plugins::update_tab::update 8
+
+    hook::remove draw_message_hook [namespace current]::add_number_of_messages_from_juick_to_title 18
+    hook::add draw_message_hook ::::ifacetk::add_number_of_messages_to_title 18
+
+    hook::remove roster_push_hook [namespace current]::request_juick_nick 99
+    hook::remove generate_completions_hook [namespace current]::juick_commands_comps 99
+
+    ::richtext::entity_state juick_numbers 0
+    ::richtext::entity_state citing 0
+    ::richtext::entity_state juick 0
+    ::richtext::entity_state juick_ligth 0
+}
+
+proc is_juick_jid {jid} {
+    set jid [::xmpp::jid::removeResource $jid]
+    set node [::xmpp::jid::node $jid]
+    return [expr [cequal $jid "juick at juick.com"] || [cequal $node "juick%juick.com"]]
+
+#    if {$without_resource} { \
+#        return [expr [cequal $jid "juick at juick.com"] || [regexp "juick%juick.com at .+" $jid]] \
+#    } else { \
+#       return [expr [cequal $jid "juick at juick.com/Juick"] || [regexp "juick%juick.com at .+/Juick" $jid]] \
+#    }
+}
+
 # Determines whether given chatid correspond to Juick
 proc is_juick {chatid} {
     set jid [chat::get_jid $chatid]
-    return [expr [cequal $jid "juick at juick.com/Juick"] || [regexp "juick%juick.com at .+/Juick" $jid]]
+    return [is_juick_jid $jid]
 }
 
+proc request_juick_nick {xlib jid name groups subsc ask} {
+    variable juick_nicknames
+
+    if {![is_juick_jid $jid] || [info exists juick_nicknames($jid)]} {
+        return
+    }
+
+    ::xmpp::sendIQ $xlib get \
+        -query [::xmpp::xml::create query \
+            -xmlns "http://juick.com/query#users"] \
+        -to $jid \
+        -command [list [namespace current]::receive_juick_nick $jid]
+}
+
+proc receive_juick_nick {jid res child} {
+    variable juick_nicknames
+
+    if {![string equal $res ok]} return
+
+    ::xmpp::xml::split $child tag xmlns attrs cdata subels
+
+    if {![cequal $xmlns "http://juick.com/query#users"]} return
+
+    set ch [lindex $subels 0]
+    ::xmpp::xml::split $ch stag sxmlns sattrs scdata ssubels
+
+    if {![cequal $sxmlns "http://juick.com/user"]} return
+
+    set uname [::xmpp::xml::getAttr $sattrs uname]
+    set juick_nicknames($jid) $uname
+
+#    puts "For $jid: uname is \"$uname\""
+
+    return
+}
+
 proc handle_message {chatid from type body x} {
-    if {[is_juick $chatid]} {
-        ::richtext::property_add {JUICK} {}
-        set chatw [chat::chat_win $chatid]
-        set jid [chat::get_jid $chatid]
+    variable juick_nicknames
 
-        set tags {}
-        if {![cequal $jid $from]} {
-            lappend tags JMY
-        }
+    if {![is_juick $chatid]} return
 
-        ::richtext::render_message $chatw $body $tags
-        return stop
+    ::richtext::property_add {JUICK} {}
+
+    set chatw [chat::chat_win $chatid]
+    set jid [chat::get_jid $chatid]
+
+    set tags {}
+    if {![cequal $jid $from]} {
+        lappend tags JMY
     }
+
+    ::richtext::render_message $chatw $body $tags
+    return stop
 }
 
+proc get_juick_nickname {jid} {
+    variable juick_nicknames
+
+    set uname ""
+    set jid [::xmpp::jid::removeResource $jid]
+
+    if {[info exists juick_nicknames($jid)]} {
+        set uname $juick_nicknames($jid)
+    }
+
+    return $uname
+}
+
+proc is_personal_juick_message {from body} {
+    variable juick_nicknames
+    set reply_to_my_comment 0
+
+    set private_msg [regexp {^Private message from @.+:\n} $body]
+    set reply_to_comment [regexp {Reply by @[^\n ]+:\n>.+\n\n@([^\n ]+) .+\n\n#\d+/\d+ http://juick.com/\d+#\d+$} $body -> reply_to_nick]
+
+    if {$reply_to_comment} {
+        set reply_to_my_comment [cequal [get_juick_nickname $from] $reply_to_nick]
+    }
+
+    return [expr $private_msg || $reply_to_my_comment]
+}
+
 proc update_juick_tab {chatid from type body x} {
-    if {![is_juick $chatid] || ![cequal $type "chat"]} {
+    variable options
+    if {![expr [is_juick_jid $from] && [cequal $type "chat"] && $options(special_update_juick_tab)]} {
         ::plugins::update_tab::update $chatid $from $type $body $x
         return
     }
@@ -61,7 +212,7 @@
 
     set cw [chat::winid $chatid]
 
-    if {[regexp {^Private message from @.+:\n} $body]} {
+    if {[is_personal_juick_message $from $body]} {
         tab_set_updated $cw 1 mesg_to_user
     } else {
         tab_set_updated $cw 1 message
@@ -75,7 +226,8 @@
 }
 
 proc add_number_of_messages_from_juick_to_title {chatid from type body x} {
-    if {![is_juick $chatid] || ![cequal $type "chat"]} {
+    variable options
+    if {![expr [is_juick_jid $from] && [cequal $type "chat"] && $options(special_update_juick_tab)]} {
         ::ifacetk::add_number_of_messages_to_title $chatid $from $type $body $x
         return
     }
@@ -96,7 +248,7 @@
 
     incr number_msg($chatid)
 
-    if {[regexp {^Private message from @.+:\n} $body]} {
+    if {[is_personal_juick_message $from $body]} {
         incr personal_msg($chatid)
     }
 
@@ -104,6 +256,47 @@
     ::ifacetk::update_main_window_title
 }
 
+proc rewrite_juick_message \
+     {vxlib vfrom vid vtype vis_subject vsubject \
+      vbody verr vthread vpriority vx} {
+    upvar 2 $vfrom from
+    upvar 2 $vtype type
+    upvar 2 $vbody body
+    upvar 2 $vx x
+
+    if {![is_juick_jid $from] || ![cequal $type "chat"]} {
+        return
+    }
+
+#############################
+# Remove jabber:x:oob element
+    set newx {}
+
+    foreach xe $x {
+        ::xmpp::xml::split $xe tag xmlns attrs cdata subels
+
+        if {![cequal $xmlns "jabber:x:oob"]} {
+            lappend newx $xe
+        }
+    }
+
+    set x $newx
+
+#############################
+# Add GMT time
+    foreach xe $x {
+        ::xmpp::xml::split $xe tag xmlns attrs cdata subels
+
+        if {[cequal $xmlns "http://juick.com/message"]} {
+            foreach {key val} $attrs {
+                if {[cequal $key "ts"]} {
+                    set body "$val GMT\n$body"
+                }
+            }
+        }
+    }
+}
+
 proc rewrite_send_juick_message {chatid user body type} {
     if {![is_juick $chatid] || ![cequal $type "chat"]} {
         return
@@ -122,9 +315,13 @@
 }
 
 proc insert_from_window {chatid w x y} {
+    variable options
     set thing ""
     set cw [chat::chat_win $chatid]
     set ci [chat::input_win $chatid]
+    set jid [::xmpp::jid::removeResource [chat::get_jid $chatid]]
+
+
     set tags [$cw tag names "@$x,$y"]
 
     if {[set idx [lsearch -glob $tags JUICK-*]] >= 0} {
@@ -133,6 +330,19 @@
 
     if {$thing == ""} return
 
+    if {![is_juick_jid $jid]} {
+        set xlib [chat::get_xlib $chatid]
+        set mainchat [chat::chatid $xlib $options(main_jid)]
+
+        if {[chat::is_opened $mainchat]} {
+            chat::activate $mainchat
+        } else {
+            chat::open_to_user $xlib $options(main_jid)
+        }
+
+        set ci [chat::input_win $mainchat]
+    }
+
     $ci insert insert "$thing "
     focus -force $ci
     return stop
@@ -154,19 +364,67 @@
     if {[regexp {#\d+$} $thing]} {
         $m add command -label [::msgcat::mc "\[J\] Subscribe to $thing replies."] \
               -command [list [namespace current]::subscribe_to $chatwin $thing]
+        $m add command -label [::msgcat::mc "\[J\] Open thread in new tab."] \
+              -command [list [namespace current]::get_juick_thread $chatwin $thing]
     }
 }
 
 proc subscribe_to {w thing} {
-     set cw [join [lrange [split $w .] 0 end-1] .]
-     set chatid [chat::winid_to_chatid $cw]
-     set xlib [chat::get_xlib $chatid]
-     set jid [chat::get_jid $chatid]
-     set body "S $thing"
+    set cw [join [lrange [split $w .] 0 end-1] .]
+    set chatid [chat::winid_to_chatid $cw]
+    set xlib [chat::get_xlib $chatid]
+    set jid [chat::get_jid $chatid]
+    set body "S $thing"
 
-     message::send_msg $xlib $jid -type chat -body $body
+    message::send_msg $xlib $jid -type chat -body $body
 }
 
+proc get_juick_thread {w thing} {
+    set cw [join [lrange [split $w .] 0 end-1] .]
+    set chatid [chat::winid_to_chatid $cw]
+    set xlib [chat::get_xlib $chatid]
+    set jid [chat::get_jid $chatid]
+    set mid [string range $thing 1 end]
+
+    ::xmpp::sendIQ $xlib get \
+        -query [::xmpp::xml::create query \
+            -xmlns "http://juick.com/query#messages" \
+            -attrs [list mid $mid]] \
+        -to $jid \
+        -command [list [namespace current]::receive_juick_thread $jid]
+}
+
+proc receive_juick_thread {jid res child0} {
+    if {![string equal $res ok]} return
+
+    ::xmpp::xml::split $child0 tag0 xmlns0 attrs0 cdata0 subels0
+
+    if {![cequal $xmlns0 "http://juick.com/query#messages"]} return
+
+    set child1 [lindex $subels0 0]
+    ::xmpp::xml::split $child1 tag1 xmlns1 attrs1 cdata1 subels1
+
+    if {![cequal $xmlns1 "http://juick.com/message"]} return
+
+    set msg ""
+
+    foreach child2 $subels1 {
+        ::xmpp::xml::split $child2 tag2 xmlns2 attrs2 cdata2 subels2
+        switch -- $tag2 {
+            body {
+                set msg $cdata2
+            }
+        }
+    }
+
+    puts "Get message from $jid: \"$msg\""
+
+    # open new tab
+    
+
+    return
+}
+
 proc copy_thing {w thing} {
     clipboard clear -displayof $w
     clipboard append -displayof $w $thing
@@ -187,11 +445,44 @@
     }
 }
 
-variable commands {HELP NICK LOGIN S U ON OFF D BL WL PM VCARD PING INVITE}
+# See commented code in juick_commands_comps.
+#variable commands {HELP NICK LOGIN "S " "U " ON OFF "D " "BL " "WL " "PM " VCARD PING INVITE}
+variable commands {HELP NICK LOGIN S U ON OFF D BL WL PM CARD PING INVITE}
 proc correct_command {chatid user body type} {
    # Maybe once I'll get arount to it 
 }
 
+proc juick_commands_comps {chatid compsvar wordstart line} {
+    if {![is_juick $chatid]} return
+
+    upvar 0 $compsvar comps
+    variable chat_things
+    variable commands
+
+    if {!$wordstart} {
+       set comps [concat $commands $comps]
+    } else {
+if {0} {
+        # This code don't work.
+        # See ${PATH_TO_TKABBER}/plugins/chat/completion.tcl at line 94.
+        # Idea: use *rename* for procedure completion::complete.
+        set q 0
+        foreach cmd $commands {
+            if {[string equal -length [string length $cmd] $cmd $line]} {
+                set q 1
+                break
+            }
+        }
+
+        if {!$q} return
+}
+    }
+
+    if {[info exist chat_things($chatid)]} {
+       set comps [concat $chat_things($chatid) $comps]
+    }
+}
+
 # --------------
 # RichText stuff
 
@@ -270,25 +561,30 @@
 }
 
 proc process_juick {atLevel accName} {
-return [process $atLevel $accName juick]
+    if {[::richtext::property_exists {JUICK}]} {
+        return [process $atLevel $accName juick]
+    }
 }
 
 proc process_juick_numbers {atLevel accName} {
-return [process $atLevel $accName juick_numbers]
+    return [process $atLevel $accName juick_numbers]
 }
 
 proc process_citing {atLevel accName} {
-return [process $atLevel $accName citing]
+    if {[::richtext::property_exists {JUICK}]} {
+        return [process $atLevel $accName citing]
+    }
 }
 
 proc process_juick_ligth {atLevel accName} {
-return [process $atLevel $accName juick_ligth]
+    if {[::richtext::property_exists {JUICK}]} {
+       return [process $atLevel $accName juick_ligth]
+    }
 }
 
 proc process {atLevel accName what} {
     upvar #$atLevel $accName chunks
 
-    if {![::richtext::property_exists {JUICK}]} {return}
     set out {}
 
     foreach {s type tags} $chunks {
@@ -348,6 +644,17 @@
            }
     }
 
+#################
+            variable chat_things
+            set cw [join [lrange [split $w .] 0 end-1] .]
+            set chatid [chat::winid_to_chatid $cw]
+            if {![info exist chat_things($chatid)]} {
+                set chat_things($chatid) [list $thing]
+            } else {
+                set chat_things($chatid) [linsert $chat_things($chatid) 0 $thing]
+            }
+#################
+
     set id JUICK-$thing
     $w insert end $thing [lfuse $tags [list $id $type JUICK]]
     return $id
@@ -361,7 +668,7 @@
 
 proc render_juick_ligth {w type thing tags args} {
     set id JLIGTH-$thing
-    $w insert end [append thing \n] [lfuse $tags [list $id $type JLIGTH]]
+    $w insert end $thing [lfuse $tags [list $id $type JLIGTH]]
     return $id
 }
 
@@ -388,10 +695,5 @@
     -parser [namespace current]::process_juick \
     -renderer [namespace current]::render_juick \
     -parser-priority 85
-
-::richtext::entity_state citing 1
-::richtext::entity_state juick 1
-::richtext::entity_state juick_numbers 1
-::richtext::entity_state juick_ligth 1
 }
 # vi:ts=4:et

Modified: branches/plugins-0.11.1/juick/msgs/ru.msg
===================================================================
--- branches/plugins-0.11.1/juick/msgs/ru.msg	2012-04-09 21:05:52 UTC (rev 514)
+++ branches/plugins-0.11.1/juick/msgs/ru.msg	2012-04-09 21:18:44 UTC (rev 515)
@@ -1,2 +1,6 @@
 ::msgcat::mcset ru "\[J\] Copy thing to clipboard." "\[J\] Скопировать сущность в буфер обмена."
+::msgcat::mcset ru "Whether the Juick plugin is loaded." "Загружено ли расширение для удобной работы с Juick."
 ::msgcat::mcset ru "\[J\] Open thing in browser." "\[J\] Открыть сущность в браузере."
+::msgcat::mcset ru "Juick settings." "Параметры расширения для удобной работы с Juick"
+::msgcat::mcset ru "Main Juick JID. This used for forwarding things from other chats." "Главный JID Juick'а. Используется для перенаправления сущностей из других чатов."
+::msgcat::mcset ru "Only private messages and replies to your comments is personal message." "Только приватные сообщения и ответы на ваши комментарии являются персональными сообщениями."

Added: branches/plugins-0.11.1/juick/tkabber-0.11.1-compatibility.tcl
===================================================================
--- branches/plugins-0.11.1/juick/tkabber-0.11.1-compatibility.tcl	                        (rev 0)
+++ branches/plugins-0.11.1/juick/tkabber-0.11.1-compatibility.tcl	2012-04-09 21:18:44 UTC (rev 515)
@@ -0,0 +1,215 @@
+if {[info exist ::tkabber-0.11.1-compatibility-sentry]} {
+    return
+}
+
+set ::tkabber-0.11.1-compatibility-sentry 1
+
+rename ::hook::add ::hook::add_orig
+
+proc ::hook::add {hook func {seq 50}} {
+    if {[string equal $hook roster_push_hook] && \
+        [string equal $func "::plugins::juick::request_juick_nick"] && \
+        [expr $seq == 99]} \
+    {
+        ::hook::add_orig roster_item_hook $func $seq
+    } else {
+        ::hook::add_orig $hook $func $seq
+    }
+}
+
+proc ::hook::remove {hook func {seq 50}} {
+    variable $hook
+
+    set idx [lsearch -exact [set $hook] [list $func $seq]]
+    set $hook [lreplace [set $hook] $idx $idx]
+}
+
+proc ::plugins::is_registered {name} {
+    variable juick_plugin_loaded
+
+    if {![info exists juick_plugin_loaded]} {
+        set juick_plugin_loaded 0
+    }
+
+    return $juick_plugin_loaded
+}
+
+proc ::plugins::register {name args} {
+    variable juick_plugin_loaded
+
+    if {$juick_plugin_loaded} {
+        return
+    }
+
+    set juick_plugin_loaded 1
+
+    foreach {key val} $args {
+        switch -- $key {
+            -source {
+                source $val
+            }
+            -loadcommand {
+                eval $val
+            }
+        }
+    }
+}
+
+proc ::chat::get_xlib {chatid} {
+    ::chat::get_connid $chatid
+}
+
+namespace eval ::xmpp::jid {}
+
+proc ::xmpp::jid::node {jid} {
+    set a [string first @ $jid]
+    if {$a < 0} {
+        return
+    } else {
+        set b [string first / $jid]
+        if {$b >= 0 && $a > $b} {
+            return
+        } else {
+            string range $jid 0 [incr a -1]
+        }
+    }
+}
+
+proc ::xmpp::jid::server {jid} {
+    set a [string first @ $jid]
+    set b [string first / $jid]
+
+    if {$a < 0} {
+        if {$b < 0} {
+            return $jid
+        } else {
+            string range $jid 0 [incr b -1]
+        }
+    } else {
+        if {$b < 0} {
+            string range $jid [incr a] end
+        } elseif {$a >= $b} {
+            string range $jid 0 [incr b -1]
+        } else {
+            string range $jid [incr a] [incr b -1]
+        }
+    }
+}
+
+proc ::xmpp::jid::removeResource {jid} {
+    set node     [node $jid]
+    set server   [server $jid]
+
+    if {[string equal $node ""]} {
+        set jid $server
+    } else {
+        set jid $node@$server
+    }
+
+    return $jid
+}
+
+namespace eval ::xmpp::xml {}
+
+proc ::xmpp::xml::split {xmldata tagVar xmlnsVar attrsVar \
+                        cdataVar subelsVar} {
+    upvar 1 $tagVar tag $xmlnsVar xmlns $attrsVar attrs $cdataVar cdata \
+            $subelsVar subels
+
+    jlib::wrapper:splitxml $xmldata tag attrs isempty cdata subels
+
+    foreach {key val} $attrs {
+        switch -- $key {
+            xmlns {
+                set xmlns $val
+            }
+        }
+    }
+}
+
+
+proc ::xmpp::xml::create {tag args} {
+    set invoke [list jlib::wrapper:createtag $tag -vars]
+
+    foreach {key val} $args {
+        switch -- $key {
+            -xmlns {
+                lappend invoke [list xmlns $val]
+            }
+            -attrs {
+                lappend invoke $val
+            }
+        }
+    }
+
+    eval $invoke
+}
+
+proc ::xmpp::sendIQ {xlib type args} {
+    set invoke [list jlib::send_iq $type]
+    set xmldata {}
+    set newargs {}
+
+    foreach {key val} $args {
+        switch -- $key {
+            -query {
+                set xmldata $val
+            }
+            -to {
+                lappend newargs $key $val
+            }
+            -command {
+                lappend newargs $key \
+                    [list [namespace current]::sendIQAnswer $val]
+            }
+        }
+    }
+
+    lappend invoke $xmldata
+    lappend invoke -connection $xlib
+
+    foreach arg $newargs {
+        lappend invoke $arg
+    }
+
+    eval $invoke
+}
+
+proc ::xmpp::sendIQAnswer {cmd res child} {
+    if {[string equal $res OK]} {
+        set res ok
+    }
+
+    uplevel #0 $cmd [list $res $child]
+}
+
+proc ::xmpp::xml::getAttr {attrList attrName} {
+    ::jlib::wrapper:getattr $attrList $attrName
+}
+
+proc ::chat::activate {chatid} {
+    raise_win [winid $chatid]
+    focus -force [input_win $chatid]
+}
+
+rename ::message::send_msg ::message::send_msg_tkabber_0_11_1
+
+proc ::message::send_msg {xlib args} {
+    set invoke [list ::message::send_msg_tkabber_0_11_1]
+
+    if {[expr [llength $args] % 2] == 0} {
+        # tkabber-0.11.1 invoke
+        set jid $xlib
+        lappend invoke $jid
+    } else {
+        set jid [lindex $args 0]
+        set args [lrange $args 1 end]
+        lappend invoke $jid -connection $xlib
+    }
+
+    foreach {key val} $args {
+        lappend invoke $key $val
+    }
+
+    eval $invoke
+}



More information about the Tkabber-dev mailing list