[Tkabber-dev] r834 - in trunk/tkabber: . ifacetk jabberlib-tclxml plugins/general

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Sun Dec 24 19:30:47 MSK 2006


Author: sergei
Date: 2006-12-24 19:30:40 +0300 (Sun, 24 Dec 2006)
New Revision: 834

Added:
   trunk/tkabber/plugins/general/session.tcl
Modified:
   trunk/tkabber/ChangeLog
   trunk/tkabber/chats.tcl
   trunk/tkabber/ifacetk/idefault.tcl
   trunk/tkabber/ifacetk/iface.tcl
   trunk/tkabber/jabberlib-tclxml/jabberlib.tcl
   trunk/tkabber/joingrdialog.tcl
   trunk/tkabber/plugins/general/headlines.tcl
Log:
	* ifacetk/idefault.tcl, ifacetk/iface.tcl: Use named font instead
	  of XLFD when XFT fonts rendering is used.

	* jabberlib-tclxml/jabberlib.tcl: Added connection_resource function.

	* joingrdialog.tcl: Removed two useless debug messages.

	* plugins/general/session.tcl: Added preliminary session support. Now
	  it is possible to save some tabs at Tkabber exit and restore them on
	  Tkabber start.

	* chats.tcl, plugins/general/headlines.tcl: Added functions which save
	  chats and headlines during Tkabber exit. Separated opening headlines
	  window from putting messages to it.


Modified: trunk/tkabber/ChangeLog
===================================================================
--- trunk/tkabber/ChangeLog	2006-12-22 10:10:14 UTC (rev 833)
+++ trunk/tkabber/ChangeLog	2006-12-24 16:30:40 UTC (rev 834)
@@ -1,3 +1,20 @@
+2006-12-24  Sergei Golovan  <sgolovan at nes.ru>
+
+	* ifacetk/idefault.tcl, ifacetk/iface.tcl: Use named font instead
+	  of XLFD when XFT fonts rendering is used.
+
+	* jabberlib-tclxml/jabberlib.tcl: Added connection_resource function.
+
+	* joingrdialog.tcl: Removed two useless debug messages.
+
+	* plugins/general/session.tcl: Added preliminary session support. Now
+	  it is possible to save some tabs at Tkabber exit and restore them on
+	  Tkabber start.
+
+	* chats.tcl, plugins/general/headlines.tcl: Added functions which save
+	  chats and headlines during Tkabber exit. Separated opening headlines
+	  window from putting messages to it.
+
 2006-12-22  Sergei Golovan  <sgolovan at nes.ru>
 
 	* plugins/roster/fetch_nicknames.tcl: Added plugin, which

Modified: trunk/tkabber/chats.tcl
===================================================================
--- trunk/tkabber/chats.tcl	2006-12-22 10:10:14 UTC (rev 833)
+++ trunk/tkabber/chats.tcl	2006-12-24 16:30:40 UTC (rev 834)
@@ -394,7 +394,6 @@
 	set chats(status,$chatid) connected
     }
     set chats(exit_status,$chatid) ""
-    debugmsg chat "OURJID: [our_jid $chatid]"
     lappend chats(opened) $chatid
     
     set opened($chatid) $cw
@@ -1293,3 +1292,60 @@
     }
 }
 
+#############################################################################
+
+proc chat::restore_window {cjid type nick connid jid} {
+    set chatid [chatid $connid $cjid]
+
+    if {$type == "groupchat"} {
+	set_our_groupchat_nick $chatid $nick
+    }
+
+    # TODO: Password?
+    open_window $chatid $type
+}
+
+#############################################################################
+
+proc chat::save_session {vsession} {
+    upvar 2 $vsession session
+    global usetabbar
+    variable chats
+    variable chat_id
+
+    # TODO
+    if {!$usetabbar} return
+
+    set prio 0
+    foreach page [.nb pages] {
+	set path [ifacetk::nbpath $page]
+
+	if {[info exists chat_id($path)]} {
+	    set chatid $chat_id($path)
+
+	    set connid [get_connid $chatid]
+	    set jid [get_jid $chatid]
+	    set type $chats(type,$chatid)
+
+	    if {$type == "groupchat"} {
+		set nick [get_our_groupchat_nick $chatid]
+	    } else {
+		set nick ""
+	    }
+
+	    set user [jlib::connection_user $connid]
+	    set server [jlib::connection_server $connid]
+	    set resource [jlib::connection_resource $connid]
+
+	    lappend session [list $prio $user $server $resource \
+		[list [namespace current]::restore_window $jid $type $nick] \
+	    ]
+	}
+	incr prio
+    }
+}
+
+hook::add save_session_hook [namespace current]::chat::save_session
+
+#############################################################################
+

Modified: trunk/tkabber/ifacetk/idefault.tcl
===================================================================
--- trunk/tkabber/ifacetk/idefault.tcl	2006-12-22 10:10:14 UTC (rev 833)
+++ trunk/tkabber/ifacetk/idefault.tcl	2006-12-24 16:30:40 UTC (rev 834)
@@ -1,27 +1,23 @@
 # $Id$
 
-switch -exact -- $::tcl_platform(platform) {
-    "unix" {
-	# We don't use named font because of insufficient flexibility of font
-	# selection in Tk (for example, you can't select -slant oblique or
-	# -weight semicondensed)
-	# Also font encoding can't be specified
-        set font "fixed"
-    }
-    "windows" {
-        set font [font create font -family "Arial" -size 10]
-    }
-    default {
-        set font [font create font -family "fixed" -size 10]
-    }
+if {$::tcl_platform(platform) == "unix" && \
+	([catch {tk::pkgconfig get fontsystem} fontsystem] || \
+	 ($fontsystem != "xft"))} {
+    set xlfd_fonts 1
+} else {
+    set xlfd_fonts 0
 }
 
-set default_font [list [font actual $font -family] [font actual $font -size]]
+if {$xlfd_fonts} {
+    # We don't use named font because of insufficient flexibility of font
+    # selection in Tk (for example, you can't select -slant oblique or
+    # -weight semicondensed)
+    # Also font encoding can't be specified
+    set font "fixed"
 
-proc define_fonts {args} {
-    global font font_bold font_italic font_bold_italic
+    proc define_fonts {args} {
+	global font font_bold font_italic font_bold_italic
 
-    if {$::tcl_platform(platform) == "unix"} {
 	if {![info exists font_bold]} {
 	    set font_bold [eval font create [font actual $font]]
 	    font configure $font_bold -weight bold
@@ -34,7 +30,24 @@
 	    set font_bold_italic [eval font create [font actual $font]]
 	    font configure $font_bold_italic -weight bold -slant italic
 	}
-    } else {
+    }
+
+    option add *Entry.font $::font widgetDefault
+} else {
+    switch -exact -- $::tcl_platform(platform) {
+	"windows" {
+	    set font [font create font -family "Arial" -size 10]
+	}
+	default {
+	    set font [font create font -family "fixed" -size 10]
+	}
+    }
+
+    set default_font [list [font actual $font -family] [font actual $font -size]]
+
+    proc define_fonts {args} {
+	global font font_bold font_italic font_bold_italic
+
 	if {[catch {
 	    set font_bold \
 		[eval font create font_bold [font actual $font]]
@@ -51,17 +64,7 @@
 	font configure font_bold -weight bold
 	font configure font_bold_italic -weight bold -slant italic
     }
-}
 
-hook::add postload_hook [namespace current]::define_fonts 70
-
-if {![info exists usetabbar]} {
-    set usetabbar 1
-}
-
-if {$::tcl_platform(platform) == "unix"} {
-    option add *Entry.font $::font widgetDefault
-} else {
     #font create menufont -family Helvetica -size 10 \
     # -weight normal -slant roman -underline 0 -overstrike 0
     eval [linsert [font configure $font] 0 font create menufont]
@@ -70,6 +73,12 @@
     option add *Entry.font font widgetDefault
 }
 
+hook::add postload_hook [namespace current]::define_fonts 70
+
+if {![info exists usetabbar]} {
+    set usetabbar 1
+}
+
 if {([catch { tk windowingsystem }] && $::tcl_platform(platform) == "unix") ||
 	(![catch { tk windowingsystem }] && [tk windowingsystem] == "x11")} {
     event add <<ScrollUp>>    <4>
@@ -79,7 +88,6 @@
 }
 
 if {$::tcl_platform(platform) == "windows"} {
-
     # workaround for shortcuts in russian keyboard layout
     event add <<Cut>>   <Control-division>
     event add <<Copy>>  <Control-ntilde>
@@ -89,3 +97,4 @@
     event add <<CollapseRoster>>  <Control-ecircumflex>
     event add <<OpenSearchPanel>> <Control-ucircumflex>
 }
+

Modified: trunk/tkabber/ifacetk/iface.tcl
===================================================================
--- trunk/tkabber/ifacetk/iface.tcl	2006-12-22 10:10:14 UTC (rev 833)
+++ trunk/tkabber/ifacetk/iface.tcl	2006-12-24 16:30:40 UTC (rev 834)
@@ -32,7 +32,7 @@
 	-group IFace -type boolean \
 	-command [namespace current]::switch_statusbar
 
-    if {$::tcl_platform(platform) != "unix"} {
+    if {!$::xlfd_fonts} {
 	custom::defvar options(font) $::default_font \
 	    [::msgcat::mc "Font to use in roster, chat windows etc."] \
 	    -group IFace -type font \
@@ -928,6 +928,10 @@
     return [crange [win_id tab $path] 1 end]
 }
 
+proc ifacetk::nbpath {page} {
+    return [lindex [pack slaves [.nb getframe $page]] 0]
+}
+
 proc ifacetk::update_chat_title {chatid} {
     global usetabbar
     variable options

Modified: trunk/tkabber/jabberlib-tclxml/jabberlib.tcl
===================================================================
--- trunk/tkabber/jabberlib-tclxml/jabberlib.tcl	2006-12-22 10:10:14 UTC (rev 833)
+++ trunk/tkabber/jabberlib-tclxml/jabberlib.tcl	2006-12-24 16:30:40 UTC (rev 834)
@@ -738,13 +738,25 @@
     variable connjid
 
     if {[info exists lib($connid,sasltoken)]} {
-	set server   [$lib($connid,sasltoken) cget -server]
+	set server [$lib($connid,sasltoken) cget -server]
 	return $server
     } else {
 	return $connjid($connid,server)
     }
 }
 
+proc jlib::connection_resource {connid} {
+    variable lib
+    variable connjid
+
+    if {[info exists lib($connid,sasltoken)]} {
+	set resource [$lib($connid,sasltoken) cget -resource]
+	return $resource
+    } else {
+	return $connjid($connid,resource)
+    }
+}
+
 ######################################################################
 
 proc jlib::register_xmlns {connid xmlns callback} {

Modified: trunk/tkabber/joingrdialog.tcl
===================================================================
--- trunk/tkabber/joingrdialog.tcl	2006-12-22 10:10:14 UTC (rev 833)
+++ trunk/tkabber/joingrdialog.tcl	2006-12-24 16:30:40 UTC (rev 834)
@@ -177,13 +177,11 @@
 
     set group [tolower_node_and_domain $group]
     set groupchats(nick,$group) $nick
-    debugmsg conference [array get groupchats]
 }
 
 proc get_our_groupchat_nick {group} {
     global groupchats
     
-    debugmsg conference [array get groupchats]
     debugmsg conference "GET NICK: [list $group]"
     return $groupchats(nick,$group)
 }

Modified: trunk/tkabber/plugins/general/headlines.tcl
===================================================================
--- trunk/tkabber/plugins/general/headlines.tcl	2006-12-22 10:10:14 UTC (rev 833)
+++ trunk/tkabber/plugins/general/headlines.tcl	2006-12-24 16:30:40 UTC (rev 834)
@@ -1,5 +1,7 @@
 # $Id$
 
+#############################################################################
+
 namespace eval headlines {
     variable headid 0
 
@@ -38,8 +40,12 @@
 	-group Messages -type boolean
 }
 
+#############################################################################
+
 package require md5
 
+#############################################################################
+
 proc headlines::process_message {connid from id type is_subject subject body err thread priority x} {
     switch -- $type {
 	headline {
@@ -53,8 +59,142 @@
 hook::add process_message_hook \
     [namespace current]::headlines::process_message
 
+#############################################################################
+
+proc headlines::get_win {connid from} {
+    variable options
+
+    switch -- $options(multiple) {
+        0 { return .headlines }
+        1 { return .headlines_[jid_to_tag [node_and_server_from_jid $from]] }
+        default { return .headlines_[jid_to_tag $from] }
+    }
+}
+
+#############################################################################
+
+proc headlines::get_tree {connid from} {
+    set hw [get_win $connid $from]
+    return $hw.tree
+}
+
+#############################################################################
+
+proc headlines::open_window {connid from} {
+    global tcl_platform
+    global font
+    variable options
+    variable trees
+
+    set hw [get_win $connid $from]
+
+    if {[winfo exists $hw]} return
+
+    switch -- $options(multiple) {
+        0 {
+            set title [::msgcat::mc "Headlines"]
+            set tabtitle [::msgcat::mc "Headlines"]
+        }
+        1 {
+            set user [node_and_server_from_jid $from]
+            set title [format [::msgcat::mc "%s Headlines"] $user]
+            set tabtitle [node_from_jid $from]
+        }
+        default {
+            set title [format [::msgcat::mc "%s Headlines"] $from]
+            set tabtitle [node_from_jid $from]/[resource_from_jid $from]
+        }
+    }
+
+    set tw [get_tree $connid $from]
+
+    if {[lsearch -exact $trees $tw] < 0} {
+        lappend trees $tw
+    }
+
+    add_win $hw -title $title -tabtitle $tabtitle \
+		-raisecmd "focus [list $tw]
+			   tab_set_updated [list $hw]" \
+		-class JBrowser
+
+    PanedWin $hw.pw -side right -pad 0 -width 8
+    pack $hw.pw -fill both -expand yes
+
+    set uw [$hw.pw add -weight 1]
+    set dw [$hw.pw add -weight 1]
+
+    frame $dw.date
+    label $dw.date.label -anchor w -text [::msgcat::mc "Date:"]
+    label $dw.date.ts -font $font -anchor w
+    pack $dw.date -fill x
+    pack $dw.date.label -side left
+    pack $dw.date.ts -side left
+
+    frame $dw.from
+    label $dw.from.label -anchor w -text [::msgcat::mc "From:"]
+    label $dw.from.jid -font $font -anchor w
+    pack $dw.from -fill x
+    pack $dw.from.label -side left
+    pack $dw.from.jid -side left
+
+    frame $dw.subject
+    label $dw.subject.lsubj -anchor w -text [::msgcat::mc "Subject:"]
+    label $dw.subject.subj -font $font -anchor w
+    pack $dw.subject -fill x
+    pack $dw.subject.lsubj -side left
+    pack $dw.subject.subj -side left
+
+    if {![info exists options(seencolor)]} {
+	if {[cequal $tcl_platform(platform) unix]} {
+	    set options(seencolor) [option get $hw disabledForeground JBrowser]
+	} else {
+	    set options(seencolor) [option get $hw nscolor JBrowser]
+	}
+    }
+    if {![info exists options(unseencolor)]} {
+	set options(unseencolor) [option get $hw fill JBrowser]
+    }
+
+    set sw [ScrolledWindow $uw.sw]
+    Tree $tw -deltax 16 -deltay 18 \
+	 -selectcommand [list [namespace current]::update_body \
+			      $dw.date.ts $dw.from.jid $dw.subject.subj $hw.body]
+    $sw setwidget $tw
+    pack $sw -side top -expand yes -fill both
+
+    $tw bindText <ButtonPress-3> [list [namespace current]::select_popup $hw]
+    $tw bindText <Double-ButtonPress-1> \
+		 [list [namespace current]::action browse $hw]
+    balloon::setup $tw -command [list [namespace current]::balloon $hw]
+
+    # HACK
+    bind $tw.c <Return> \
+	 "[namespace current]::action browse $hw \[$tw selection get\]"
+    bind $tw.c <Delete> \
+	 "[namespace current]::action delete $hw \[$tw selection get\]"
+
+    bindscroll $tw.c
+
+    set dsw [ScrolledWindow $dw.sw]
+    text $hw.body -font $font -height 12 -state disabled \
+		  -wrap word -takefocus 1
+    ::richtext::config $hw.body -using url
+    $dsw setwidget $hw.body
+    pack $dsw -expand yes -fill both -anchor nw
+
+    bind $hw.body <ButtonPress-1> [list focus %W]
+
+    bind $hw.body <Key-Up>    [list Tree::_keynav up    $tw]
+    bind $hw.body <Key-Down>  [list Tree::_keynav down  $tw]
+    bind $hw.body <Key-Left>  [list Tree::_keynav left  $tw]
+    bind $hw.body <Key-Right> [list Tree::_keynav right $tw]
+
+    hook::run open_headlines_post_hook $hw
+}
+
+#############################################################################
+
 proc headlines::show {connid from type subject body thread priority x {data {}}} {
-    global tcl_platform
     variable headid
     variable headlines
     variable trees
@@ -102,111 +242,14 @@
 	return
     }
 
-    switch -- $options(multiple) {
-        0 {
-            set hw .headlines
-            set title [::msgcat::mc "Headlines"]
-            set tabtitle [::msgcat::mc "Headlines"]
-        }
+    set hw [get_win $connid $from]
 
-        1 {
-            set user [node_and_server_from_jid $from]
-            set hw .headlines_[jid_to_tag $user]
-            set title [format [::msgcat::mc "%s Headlines"] $user]
-            set tabtitle [node_from_jid $from]
-        }
-
-        default {
-            set hw .headlines_[jid_to_tag $from]
-            set title [format [::msgcat::mc "%s Headlines"] $from]
-            set tabtitle [node_from_jid $from]/[resource_from_jid $from]
-        }
+    if {![winfo exists $hw]} {
+	open_window $connid $from
     }
-    if {[lsearch -exact $trees [set tw $hw.tree]] < 0} {
-        lappend trees $tw
-    }
 
-    if {![winfo exists $hw]} {
-        add_win $hw -title $title -tabtitle $tabtitle \
-            -raisecmd "focus [list $hw.tree]
-                       tab_set_updated [list $hw]" -class JBrowser
+    set tw [get_tree $connid $from]
 
-	PanedWin $hw.pw -side right -pad 0 -width 8
-	pack $hw.pw -fill both -expand yes
-
-	set uw [$hw.pw add -weight 1]
-	set dw [$hw.pw add -weight 1]
-
-	frame $dw.date
-	label $dw.date.label -anchor w -text [::msgcat::mc "Date:"]
-	label $dw.date.ts -font $font -anchor w
-	pack $dw.date -fill x
-	pack $dw.date.label -side left
-	pack $dw.date.ts -side left
-
-	frame $dw.from
-	label $dw.from.label -anchor w -text [::msgcat::mc "From:"]
-	label $dw.from.jid -font $font -anchor w
-	pack $dw.from -fill x
-	pack $dw.from.label -side left
-	pack $dw.from.jid -side left
-
-	frame $dw.subject
-	label $dw.subject.lsubj -anchor w -text [::msgcat::mc "Subject:"]
-	label $dw.subject.subj -font $font -anchor w
-	pack $dw.subject -fill x
-	pack $dw.subject.lsubj -side left
-	pack $dw.subject.subj -side left
-
-	if {![info exists options(seencolor)]} {
-	    if {[cequal $tcl_platform(platform) unix]} {
-		set options(seencolor) [option get $hw disabledForeground JBrowser]
-	    } else {
-		set options(seencolor) [option get $hw nscolor JBrowser]
-	    }
-	}
-	if {![info exists options(unseencolor)]} {
-	    set options(unseencolor) [option get $hw fill JBrowser]
-	}
-
-        set sw [ScrolledWindow $uw.sw]
-	Tree $tw -deltax 16 -deltay 18 \
-	    -selectcommand [list [namespace current]::update_body \
-				 $dw.date.ts $dw.from.jid $dw.subject.subj $hw.body]
-        $sw setwidget $tw
-        pack $sw -side top -expand yes -fill both
-
-        $tw bindText <ButtonPress-3> \
-                [list [namespace current]::select_popup $hw]
-        $tw bindText <Double-ButtonPress-1> \
-                [list [namespace current]::action browse $hw]
-	balloon::setup $tw -command [list [namespace current]::balloon $hw]
-
-        # HACK
-        bind $tw.c <Return> \
-            "[namespace current]::action browse $hw \[$tw selection get\]"
-        bind $tw.c <Delete> \
-            "[namespace current]::action delete $hw \[$tw selection get\]"
-
-        bindscroll $tw.c
-
-	set dsw [ScrolledWindow $dw.sw]
-	text $hw.body -font $font -height 12 -state disabled \
-	     -wrap word -takefocus 1
-	::richtext::config $hw.body -using url
-	$dsw setwidget $hw.body
-	pack $dsw -expand yes -fill both -anchor nw
-
-	bind $hw.body <ButtonPress-1> [list focus %W]
-
-	bind $hw.body <Key-Up>    [list Tree::_keynav up    $tw]
-	bind $hw.body <Key-Down>  [list Tree::_keynav down  $tw]
-	bind $hw.body <Key-Left>  [list Tree::_keynav left  $tw]
-	bind $hw.body <Key-Right> [list Tree::_keynav right $tw]
-
-	hook::run open_headlines_post_hook $hw
-    }
-
     if {$options(multiple) > 1} {
         set text $subject
     } else {
@@ -257,6 +300,8 @@
     tab_set_updated $hw 1 message
 }
 
+#############################################################################
+
 proc headlines::str2node {string} {
     set utf8str [encoding convertto utf-8 $string]
     if {[catch { ::md5::md5 -hex $utf8str } ret]} {
@@ -266,6 +311,8 @@
     }
 }
 
+#############################################################################
+
 proc headlines::update_body {wdate wfrom wsubj wbody tw node} {
     variable headlines
     
@@ -301,6 +348,8 @@
     $wbody configure -state disabled
 }
 
+#############################################################################
+
 proc headlines::update_menu {menu num} {
     variable send_jids
 
@@ -317,6 +366,8 @@
     }
 }
 
+#############################################################################
+
 namespace eval headlines {
     if {[winfo exists [set m .h1popmenu]]} {
 	destroy $m
@@ -368,6 +419,8 @@
 		    \$[namespace current]::headwindow \$[namespace current]::headnode"
 }
 
+#############################################################################
+
 proc headlines::select_popup {hw node} {
     variable headwindow
     variable headnode
@@ -394,6 +447,8 @@
     tk_popup $hm [winfo pointerx .] [winfo pointery .]
 }
 
+#############################################################################
+
 proc headlines::action {action hw node} {
     variable headlines
     variable options
@@ -537,6 +592,8 @@
     }
 }
 
+#############################################################################
+
 proc headlines::update {tw node} {
     variable options
 
@@ -567,6 +624,8 @@
     }
 }
 
+#############################################################################
+
 proc headlines::balloon {hw node} {
     variable options
 
@@ -593,6 +652,8 @@
     return [list $hw:$node ""]
 }
 
+#############################################################################
+
 proc headlines::save {} {
     variable options
     variable trees
@@ -646,6 +707,8 @@
     return
 }
 
+#############################################################################
+
 proc headlines::save_aux {tw node fd} {
     variable headlines
 
@@ -664,6 +727,8 @@
     }
 }
 
+#############################################################################
+
 proc headlines::restore {} {
     variable options
 
@@ -681,6 +746,8 @@
     return ""
 }
 
+#############################################################################
+
 proc headlines::forward3 {menu to tw node} {
     variable send_jids
 
@@ -703,6 +770,8 @@
     update_menu $menu $len
 }
 
+#############################################################################
+
 proc headlines::forward2 {menu tw node} {
     global forward_hl
     variable send_jids
@@ -733,6 +802,8 @@
     update_menu $menu $len
 }
 
+#############################################################################
+
 proc headlines::forward {menu tw node} {
     global forward_hl
 
@@ -757,12 +828,60 @@
     }
 
     CbDialog $gw [::msgcat::mc "Forward headline"] \
-	[list [::msgcat::mc "Send"] "[namespace current]::forward2 [list $menu] [list $tw] [list $node]
+	[list [::msgcat::mc "Send"] "[namespace current]::forward2 [list $menu] \
+								   [list $tw] \
+								   [list $node]
 				     destroy $gw" \
 	      [::msgcat::mc "Cancel"] [list destroy $gw]] \
 	forward_hl $choices $balloons
 }
 
+#############################################################################
+
 hook::add finload_hook [namespace current]::headlines::restore
 hook::add quit_hook    [namespace current]::headlines::save
 
+#############################################################################
+
+proc headlines::restore_window {from connid jid} {
+    open_window $connid $from
+}
+
+#############################################################################
+
+# TODO: Work with changes in options(multiple)
+proc headlines::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 .headlines]} {
+	    lappend session [list $prio $user $server $resource \
+		[list [namespace current]::restore_window ""] \
+	    ]
+	}
+	if {[regexp {^.headlines_(.*)} $path -> tag]} {
+	    set jid [tag_to_jid $tag]
+	    lappend session [list $prio $user $server $resource \
+		[list [namespace current]::restore_window $jid] \
+	    ]
+	}
+	incr prio
+    }
+}
+
+hook::add save_session_hook [namespace current]::headlines::save_session
+
+#############################################################################
+

Added: trunk/tkabber/plugins/general/session.tcl
===================================================================
--- trunk/tkabber/plugins/general/session.tcl	                        (rev 0)
+++ trunk/tkabber/plugins/general/session.tcl	2006-12-24 16:30:40 UTC (rev 834)
@@ -0,0 +1,91 @@
+# $Id$
+# Save, open Tkabber sessions
+#############################################################################
+#
+# Session is a list of {priority user server resource script}
+#
+
+namespace eval session {
+    variable session_file [file join ~ .tkabber session.tcl]
+
+    custom::defgroup Sessions [::msgcat::mc "Tkabber session options."] \
+	-group Tkabber
+    custom::defvar options(save_on_exit) 0 \
+	[::msgcat::mc "Save session on Tkabber exit."] \
+	-type boolean -group Sessions
+    custom::defvar options(open_on_start) 0 \
+	[::msgcat::mc "Open session on Tkabber start."] \
+	-type boolean -group Sessions
+}
+
+#############################################################################
+
+proc session::save_session {} {
+    variable session_file
+
+    hook::run save_session_hook session
+
+    if {![info exists session]} return
+
+    set fd [open $session_file w]
+    fconfigure $fd -encoding utf-8
+    puts $fd $session
+    close $fd
+}
+
+#############################################################################
+
+proc session::save_session_on_exit {} {
+    variable options
+
+    if {$options(save_on_exit)} {
+	save_session
+    }
+}
+
+hook::add quit_hook [namespace current]::session::save_session_on_exit
+
+#############################################################################
+
+proc session::open_session {} {
+    variable session_file
+
+    set session_script_list {}
+    catch {
+	set fd [open $session_file r]
+	fconfigure $fd -encoding utf-8
+	set session_script_list [read $fd]
+	close $fd
+    }
+
+    foreach script [lsort -index 0 $session_script_list] {
+	lassign $script priority user server resource command
+
+	if {($user != "") || ($server != "") || ($resource != "")} {
+	    # HACK. It works if called before any JID is connected
+	    set connid [jlib::new -user $user \
+				  -server $server \
+				  -resource $resource]
+	} else {
+	    set connid ""
+	}
+
+	eval $command [list $connid $user@$server/$resource]
+	update
+    }
+}
+
+#############################################################################
+
+proc session::open_session_on_start {} {
+    variable options
+
+    if {$options(open_on_start)} {
+	open_session
+    }
+}
+
+hook::add finload_hook [namespace current]::session::open_session_on_start 49
+
+#############################################################################
+


Property changes on: trunk/tkabber/plugins/general/session.tcl
___________________________________________________________________
Name: svn:keywords
   + Author Date Id Revision
Name: svn:eol-style
   + native



More information about the Tkabber-dev mailing list