[Tkabber-dev] r1118 - in trunk/tkabber: . examples/xrdb ifacetk

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Wed Apr 18 22:45:35 MSD 2007


Author: sergei
Date: 2007-04-18 22:45:34 +0400 (Wed, 18 Apr 2007)
New Revision: 1118

Added:
   trunk/tkabber/ifacetk/buttonbar.tcl
Modified:
   trunk/tkabber/ChangeLog
   trunk/tkabber/examples/xrdb/badlop-dark.xrdb
   trunk/tkabber/examples/xrdb/black.xrdb
   trunk/tkabber/examples/xrdb/dark.xrdb
   trunk/tkabber/examples/xrdb/dark2.xrdb
   trunk/tkabber/examples/xrdb/green.xrdb
   trunk/tkabber/examples/xrdb/ice.xrdb
   trunk/tkabber/examples/xrdb/light.xrdb
   trunk/tkabber/examples/xrdb/lighthouse.xrdb
   trunk/tkabber/examples/xrdb/ocean-deep.xrdb
   trunk/tkabber/examples/xrdb/teopetuk.xrdb
   trunk/tkabber/examples/xrdb/warm.xrdb
   trunk/tkabber/ifacetk/iface.tcl
   trunk/tkabber/ifacetk/systray.tcl
Log:
	* ifacetk/buttonbar.tcl, ifacetk/iface.tcl, ifacetk/systray.tcl,
	  examples/xrdb/badlop-dark.xrdb, examples/xrdb/black.xrdb,
	  examples/xrdb/dark.xrdb, examples/xrdb/dark2.xrdb,
	  examples/xrdb/green.xrdb, examples/xrdb/ice.xrdb,
	  examples/xrdb/light.xrdb, examples/xrdb/lighthouse.xrdb,
	  examples/xrdb/teopetuk.xrdb, examples/xrdb/warm.xrdb: Merged
	  changes from tkabber-tabbar branch. Changes introduce new user
	  interface in tabbed mode.


Modified: trunk/tkabber/ChangeLog
===================================================================
--- trunk/tkabber/ChangeLog	2007-04-18 18:17:34 UTC (rev 1117)
+++ trunk/tkabber/ChangeLog	2007-04-18 18:45:34 UTC (rev 1118)
@@ -1,6 +1,17 @@
+2007-04-18  Sergei Golovan  <sgolovan at nes.ru>
+
+	* ifacetk/buttonbar.tcl, ifacetk/iface.tcl, ifacetk/systray.tcl,
+	  examples/xrdb/badlop-dark.xrdb, examples/xrdb/black.xrdb,
+	  examples/xrdb/dark.xrdb, examples/xrdb/dark2.xrdb,
+	  examples/xrdb/green.xrdb, examples/xrdb/ice.xrdb,
+	  examples/xrdb/light.xrdb, examples/xrdb/lighthouse.xrdb,
+	  examples/xrdb/teopetuk.xrdb, examples/xrdb/warm.xrdb: Merged
+	  changes from tkabber-tabbar branch. Changes introduce new user
+	  interface in tabbed mode.
+
 2007-04-15  Sergei Golovan  <sgolovan at nes.ru>
 
-	* plugins/chat/logger.tcl: Fixed bug with cinverting chatlogs
+	* plugins/chat/logger.tcl: Fixed bug with converting chatlogs
 	  directory if its definition contains trailing slash.
 
 	* doc/tkabber.xml, doc/tkabber.html, README: Fixed URL of Img

Modified: trunk/tkabber/examples/xrdb/badlop-dark.xrdb
===================================================================
--- trunk/tkabber/examples/xrdb/badlop-dark.xrdb	2007-04-18 18:17:34 UTC (rev 1117)
+++ trunk/tkabber/examples/xrdb/badlop-dark.xrdb	2007-04-18 18:45:34 UTC (rev 1118)
@@ -200,16 +200,16 @@
 
 ! Colors of tab labels (when in tabbed mode)
 ! Usual color
-*NoteBook.alertColor0:              #ffffff
+*alertColor0:			    #ffffff
 
 ! Color when server message is arrived
-*NoteBook.alertColor1:              #ff69b4
+*alertColor1:			    #ff69b4
 
 ! Color when message is arrived
-*NoteBook.alertColor2:              #add8e6
+*alertColor2:			    #add8e6
 
 ! Color when personally addressed message is arrived
-*NoteBook.alertColor3:              #ff7f50
+*alertColor3:			    #ff7f50
 
 ! Colors for browser and discovery service windows
 *JBrowser.fill:			    #ffffff

Modified: trunk/tkabber/examples/xrdb/black.xrdb
===================================================================
--- trunk/tkabber/examples/xrdb/black.xrdb	2007-04-18 18:17:34 UTC (rev 1117)
+++ trunk/tkabber/examples/xrdb/black.xrdb	2007-04-18 18:45:34 UTC (rev 1118)
@@ -76,10 +76,10 @@
 
 *ProgressBar.foreground:	    grey
 
-*NoteBook.alertColor0:		    Grey
-*NoteBook.alertColor1:		    mediumorchid3
-*NoteBook.alertColor2:		    cornflowerblue
-*NoteBook.alertColor3:		    coral3
+*alertColor0:			    Grey
+*alertColor1:			    mediumorchid3
+*alertColor2:			    cornflowerblue
+*alertColor3:			    coral3
 
 *NoteBook*Entry.background:	    #000000
 *NoteBook*Entry.disabledBackground: #000000

Modified: trunk/tkabber/examples/xrdb/dark.xrdb
===================================================================
--- trunk/tkabber/examples/xrdb/dark.xrdb	2007-04-18 18:17:34 UTC (rev 1117)
+++ trunk/tkabber/examples/xrdb/dark.xrdb	2007-04-18 18:45:34 UTC (rev 1118)
@@ -163,16 +163,16 @@
 
 ! Colors of tab labels (when in tabbed mode)
 ! Usual color
-*NoteBook.alertColor0: white
+*alertColor0: white
 
 ! Color when server message is arrived
-*NoteBook.alertColor1: hotpink
+*alertColor1: hotpink
 
 ! Color when message is arrived
-*NoteBook.alertColor2: lightblue
+*alertColor2: lightblue
 
 ! Color when personally addressed message is arrived
-*NoteBook.alertColor3: coral
+*alertColor3: coral
 
 ! Colors for browser and discovery service windows
 *JBrowser.fill:			    #ffffff

Modified: trunk/tkabber/examples/xrdb/dark2.xrdb
===================================================================
--- trunk/tkabber/examples/xrdb/dark2.xrdb	2007-04-18 18:17:34 UTC (rev 1117)
+++ trunk/tkabber/examples/xrdb/dark2.xrdb	2007-04-18 18:45:34 UTC (rev 1118)
@@ -165,16 +165,16 @@
 
 ! Colors of tab labels (when in tabbed mode)
 ! Usual color
-*NoteBook.alertColor0: #bfbfae
+*alertColor0: #bfbfae
 
 ! Color when server message is arrived
-*NoteBook.alertColor1: #e899b5
+*alertColor1: #e899b5
 
 ! Color when message is arrived
-*NoteBook.alertColor2: #add8cc
+*alertColor2: #add8cc
 
 ! Color when personally addressed message is arrived
-*NoteBook.alertColor3: #f99393
+*alertColor3: #f99393
 
 ! Colors for Raw XML window
 *RawXML.inforeground:		    #f99393

Modified: trunk/tkabber/examples/xrdb/green.xrdb
===================================================================
--- trunk/tkabber/examples/xrdb/green.xrdb	2007-04-18 18:17:34 UTC (rev 1117)
+++ trunk/tkabber/examples/xrdb/green.xrdb	2007-04-18 18:45:34 UTC (rev 1118)
@@ -89,10 +89,10 @@
 *Text.errorColor:	    orange
 *Text.comboColor:	    Yellow
 
-*NoteBook.alertColor0: PaleGreen3
-*NoteBook.alertColor1: PaleGreen2
-*NoteBook.alertColor2: PaleGreen3
-*NoteBook.alertColor3: LawnGreen
+*alertColor0: PaleGreen3
+*alertColor1: PaleGreen2
+*alertColor2: PaleGreen3
+*alertColor3: LawnGreen
 
 *JBrowser.fill:			    LawnGreen
 *JBrowser.activefill:		    White

Modified: trunk/tkabber/examples/xrdb/ice.xrdb
===================================================================
--- trunk/tkabber/examples/xrdb/ice.xrdb	2007-04-18 18:17:34 UTC (rev 1117)
+++ trunk/tkabber/examples/xrdb/ice.xrdb	2007-04-18 18:45:34 UTC (rev 1118)
@@ -173,16 +173,16 @@
 
 ! Colors of tab labels (when in tabbed mode)
 ! Usual color
-*NoteBook.alertColor0: black
+*alertColor0: black
 
 ! Color when server message is arrived
-*NoteBook.alertColor1: mediumpurple4
+*alertColor1: mediumpurple4
 
 ! Color when message is arrived
-*NoteBook.alertColor2: dodgerblue4
+*alertColor2: dodgerblue4
 
 ! Color when personally addressed message is arrived
-*NoteBook.alertColor3: firebrick4
+*alertColor3: firebrick4
 
 ! Colors for browser and discovery service windows
 *JBrowser.fill:			    #000000

Modified: trunk/tkabber/examples/xrdb/light.xrdb
===================================================================
--- trunk/tkabber/examples/xrdb/light.xrdb	2007-04-18 18:17:34 UTC (rev 1117)
+++ trunk/tkabber/examples/xrdb/light.xrdb	2007-04-18 18:45:34 UTC (rev 1118)
@@ -173,16 +173,16 @@
 
 ! Colors of tab labels (when in tabbed mode)
 ! Usual color
-*NoteBook.alertColor0: black
+*alertColor0: black
 
 ! Color when server message is arrived
-*NoteBook.alertColor1: mediumpurple4
+*alertColor1: mediumpurple4
 
 ! Color when message is arrived
-*NoteBook.alertColor2: dodgerblue4
+*alertColor2: dodgerblue4
 
 ! Color when personally addressed message is arrived
-*NoteBook.alertColor3: firebrick4
+*alertColor3: firebrick4
 
 ! Colors for browser and discovery service windows
 *JBrowser.fill:			    #000000

Modified: trunk/tkabber/examples/xrdb/lighthouse.xrdb
===================================================================
--- trunk/tkabber/examples/xrdb/lighthouse.xrdb	2007-04-18 18:17:34 UTC (rev 1117)
+++ trunk/tkabber/examples/xrdb/lighthouse.xrdb	2007-04-18 18:45:34 UTC (rev 1118)
@@ -161,16 +161,16 @@
 
 ! Colors of tab labels (when in tabbed mode)
 ! Usual color
-*NoteBook.alertColor0: black
+*alertColor0: black
 
 ! Color when server message is arrived
-*NoteBook.alertColor1: mediumpurple4
+*alertColor1: mediumpurple4
 
 ! Color when message is arrived
-*NoteBook.alertColor2: dodgerblue4
+*alertColor2: dodgerblue4
 
 ! Color when personally addressed message is arrived
-*NoteBook.alertColor3: firebrick4
+*alertColor3: firebrick4
 
 ! Colors for browser and discovery service windows
 *JBrowser.fill:			    #000000

Modified: trunk/tkabber/examples/xrdb/ocean-deep.xrdb
===================================================================
--- trunk/tkabber/examples/xrdb/ocean-deep.xrdb	2007-04-18 18:17:34 UTC (rev 1117)
+++ trunk/tkabber/examples/xrdb/ocean-deep.xrdb	2007-04-18 18:45:34 UTC (rev 1118)
@@ -255,16 +255,16 @@
 ! Colors of tab labels font (when in tabbed mode)
 *NoteBook*Entry.readonlyBackground: #1e3837
 ! Usual color
-*NoteBook.alertColor0:            #ffffff
+*alertColor0:            #ffffff
 
 ! Color when server message is arrived
-*NoteBook.alertColor1:            #ff69b4
+*alertColor1:            #ff69b4
 
 ! Color when message is arrived
-*NoteBook.alertColor2:            #add8e6
+*alertColor2:            #add8e6
 
 ! Color when personally addressed message is arrived
-*NoteBook.alertColor3:            #ff7f50
+*alertColor3:            #ff7f50
 
 ! ------------------------------------------------------------------- CHAT ----
 

Modified: trunk/tkabber/examples/xrdb/teopetuk.xrdb
===================================================================
--- trunk/tkabber/examples/xrdb/teopetuk.xrdb	2007-04-18 18:17:34 UTC (rev 1117)
+++ trunk/tkabber/examples/xrdb/teopetuk.xrdb	2007-04-18 18:45:34 UTC (rev 1118)
@@ -170,16 +170,16 @@
 
 ! Colors of tab labels (when in tabbed mode)
 ! Usual color
-*NoteBook.alertColor0:		    black
+*alertColor0:			    black
 
 ! Color when server message is arrived
-*NoteBook.alertColor1:		    DarkGreen
+*alertColor1:			    DarkViolet
 
 ! Color when message is arrived
-*NoteBook.alertColor2:		    dodgerblue4
+*alertColor2:			    dodgerblue4
 
 ! Color when personally addressed message is arrived
-*NoteBook.alertColor3:		    firebrick4
+*alertColor3:			    firebrick4
 
 ! Colors for browser and discovery service windows
 *JBrowser.fill:			    #000000

Modified: trunk/tkabber/examples/xrdb/warm.xrdb
===================================================================
--- trunk/tkabber/examples/xrdb/warm.xrdb	2007-04-18 18:17:34 UTC (rev 1117)
+++ trunk/tkabber/examples/xrdb/warm.xrdb	2007-04-18 18:45:34 UTC (rev 1118)
@@ -198,16 +198,16 @@
 
 ! Colors of tab labels (when in tabbed mode)
 ! Usual color
-*NoteBook.alertColor0: black
+*alertColor0: black
 
 ! Color when server message is arrived
-*NoteBook.alertColor1: mediumpurple4
+*alertColor1: mediumpurple4
 
 ! Color when message is arrived
-*NoteBook.alertColor2: dodgerblue4
+*alertColor2: dodgerblue4
 
 ! Color when personally addressed message is arrived
-*NoteBook.alertColor3: firebrick4
+*alertColor3: firebrick4
 
 ! Colors for browser and discovery service windows
 *JBrowser.fill:			    #000000

Copied: trunk/tkabber/ifacetk/buttonbar.tcl (from rev 1117, branches/tkabber-tabbar/ifacetk/buttonbar.tcl)
===================================================================
--- trunk/tkabber/ifacetk/buttonbar.tcl	                        (rev 0)
+++ trunk/tkabber/ifacetk/buttonbar.tcl	2007-04-18 18:45:34 UTC (rev 1118)
@@ -0,0 +1,576 @@
+# ----------------------------------------------------------------------------
+#  ButtonBar.tcl
+# ----------------------------------------------------------------------------
+#  Index of commands:
+#     - ButtonBar::create
+#     - ButtonBar::configure
+#     - ButtonBar::cget
+#     - ButtonBar::insert
+#     - ButtonBar::delete
+#     - ButtonBar::move
+#     - ButtonBar::itemconfigure
+#     - ButtonBar::itemcget
+#     - ButtonBar::setfocus
+#     - ButtonBar::index
+# ----------------------------------------------------------------------------
+
+namespace eval ButtonBar {
+    Widget::define ButtonBar ButtonBar Button
+
+    Widget::declare ButtonBar {
+	{-background  TkResource ""	    0 frame}
+	{-orient      Enum	 horizontal 0 {horizontal vertical}}
+	{-minwidth    Int	 0	    0 "%d >= 0"}
+	{-maxwidth    Int	 200	    0 "%d >= 0"}
+	{-padx	      TkResource ""	    0 button}
+	{-pady	      TkResource ""	    0 button}
+	{-command     String     ""         0}
+	{-bg	      Synonym	 -background}
+	{-pages	      String     ""         0}
+    }
+
+    Widget::addmap ButtonBar "" :cmd {-background {}}
+
+    bind ButtonBar <Destroy> [list [namespace current]::_destroy %W]
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command ButtonBar::create
+# ----------------------------------------------------------------------------
+proc ButtonBar::create {path args} {
+    Widget::init ButtonBar $path $args
+
+    variable $path
+    upvar 0  $path data
+
+    eval [list frame $path] [Widget::subcget $path :cmd] \
+	[list -class ButtonBar -takefocus 0 -highlightthickness 0]
+    # For 8.4+ we don't want to inherit the padding
+    catch {$path configure -padx 0 -pady 0}
+
+    frame $path.spacer -width [winfo screenwidth $path]
+
+    bind $path <Configure> [list [namespace current]::_configure $path]
+
+    set data(buttons)  [list]
+    set data(active) ""
+    set data(bindtabs) [list]
+
+    return [Widget::create ButtonBar $path]
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command ButtonBar::configure
+# ----------------------------------------------------------------------------
+proc ButtonBar::configure {path args} {
+    variable $path
+    upvar 0  $path data
+
+    set res [Widget::configure $path $args]
+
+    if {[Widget::hasChanged $path -orient val]} {
+	_redraw $path
+    }
+
+    return $res
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command ButtonBar::cget
+# ----------------------------------------------------------------------------
+proc ButtonBar::cget {path option} {
+    return [Widget::cget $path $option]
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command ButtonBar::_option
+# ----------------------------------------------------------------------------
+proc ButtonBar::_itemoption {path name option} {
+    return [lindex [Button::configure [_but $path $name] $option] 4]
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command ButtonBar::insert
+# ----------------------------------------------------------------------------
+proc ButtonBar::insert {path idx name args} {
+    variable $path
+    upvar 0  $path data
+
+    set but [_but $path $name]
+    set data(buttons) [linsert $data(buttons) $idx $name]
+
+    set newargs {}
+    foreach {key val} $args {
+	switch -- $key {
+	    -raisecmd {
+		set data(raisecmd,$name) $val
+	    }
+	    default { lappend newargs $key $val }
+	}
+    }
+
+    eval [list Button::create $but \
+	      -padx    [Widget::getoption $path -padx] \
+	      -pady    [Widget::getoption $path -pady] \
+	      -anchor  w \
+	      -command [list [namespace current]::activate $path $name]] \
+	      $newargs
+
+    _calc_text $path $name
+
+    bind $but <Configure> [list [namespace current]::_itemconfigure $path $name]
+
+    foreach {event script} $data(bindtabs) {
+	bind $but $event [linsert $script end $name]
+    }
+
+    DragSite::register $but \
+	-draginitcmd [list [namespace current]::_draginitcmd $path $name]
+    DropSite::register $but \
+	-dropcmd [list [namespace current]::_dropcmd $path $name] \
+	-droptypes [list ButtonBar:$path]
+
+    _redraw $path
+
+    if {![string equal [Widget::getoption $path -pages] ""]} {
+	set res [[Widget::getoption $path -pages] add $name]
+    } else {
+	set res $but
+    }
+
+    return $res
+}
+
+proc ButtonBar::_draginitcmd {path name target x y top} {
+    activate $path $name
+    return [list ButtonBar:$path {move} $name]
+}
+
+proc ButtonBar::_dropcmd {path tname target source X Y op type name} {
+    move $path $name [index $path $tname]
+}
+
+# ----------------------------------------------------------------------------
+#  Command ButtonBar::move
+# ----------------------------------------------------------------------------
+proc ButtonBar::move {path name idx} {
+    variable $path
+    upvar 0  $path data
+
+    set i [lsearch -exact $data(buttons) $name]
+    if {$i >= 0} {
+	set data(buttons) [linsert [lreplace $data(buttons) $i $i] $idx $name]
+	_redraw $path
+    }
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command ButtonBar::delete
+# ----------------------------------------------------------------------------
+proc ButtonBar::delete {path name {destroyframe 1}} {
+    variable $path
+    upvar 0  $path data
+
+    set i [lsearch -exact $data(buttons) $name]
+    if {$i >= 0} {
+	set data(buttons) [lreplace $data(buttons) $i $i]
+	destroy [_but $path $name]
+	if {![string equal [Widget::getoption $path -pages] ""]} {
+	    [Widget::getoption $path -pages] delete $name
+	}
+	catch {unset data(raisecmd,$name)}
+	catch {unset data(text,$name)}
+	catch {unset data(width,$name)}
+	catch {unset data(height,$name)}
+	_redraw $path
+    }
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command ButtonBar::activate
+# ----------------------------------------------------------------------------
+proc ButtonBar::activate {path name} {
+    variable $path
+    upvar 0  $path data
+
+    set active ""
+    foreach n $data(buttons) {
+	set but [_but $path $n]
+	if {[string equal $n $name]} {
+	    Button::configure $but -relief sunken -state active
+	    set active $n
+	} else {
+	    Button::configure $but -relief raised -state normal
+	}
+    }
+    if {$active != $data(active)} {
+	set data(active) $active
+	if {![string equal [Widget::getoption $path -pages] ""]} {
+	    [Widget::getoption $path -pages] raise $active
+	}
+	if {[info exists data(raisecmd,$name)]} {
+	    uplevel #0 $data(raisecmd,$name)
+	}
+	set cmd [Widget::getoption $path -command]
+	if {$cmd != ""} {
+	    uplevel #0 $cmd [list $active]
+	}
+    }
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command ButtonBar::itemconfigure
+# ----------------------------------------------------------------------------
+proc ButtonBar::itemconfigure {path name args} {
+    variable $path
+    upvar 0  $path data
+
+    set but [_but $path $name]
+    set res [eval [list Button::configure $but] $args]
+    if {[llength $args] == 1} {
+	switch -- [lindex $args 0] {
+	    -text {
+		set res $data(text,$name)
+	    }
+	}
+    } else {
+	set tf 0
+	foreach {key val} $args {
+	    switch -- $key {
+		-text -
+		-font {
+		    set tf 1
+		}
+	    }
+	}
+	if {$tf} {
+	    _calc_text $path $name
+	    _reconfigure_text $path $name
+	}
+    }
+    return $res
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command ButtonBar::itemcget
+# ----------------------------------------------------------------------------
+proc ButtonBar::itemcget {path name option} {
+    variable $path
+    upvar 0  $path data
+
+    set res [Button::cget [_but $path $name] $option]
+    switch -- $option {
+	-text {
+	    set res $data(text,$name)
+	}
+    }
+    return $res
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command ButtonBar::setfocus
+# ----------------------------------------------------------------------------
+proc ButtonBar::setfocus {path name} {
+    set but [_but $path $name]
+    if { [winfo exists $but] } {
+	focus $but
+    }
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command ButtonBar::index
+# ----------------------------------------------------------------------------
+proc ButtonBar::index {path name} {
+    variable $path
+    upvar 0  $path data
+
+    return [lsearch -exact $data(buttons) $name]
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command ButtonBar::_configure
+# ----------------------------------------------------------------------------
+proc ButtonBar::_configure {path} {
+    variable $path
+    upvar 0  $path data
+
+    set w [winfo width $path]
+    set h [winfo height $path]
+    if {![info exists data(width)] || $data(width) != $w || \
+	![info exists data(height)] || $data(height) != $h} {
+	set data(width) $w
+	set data(height) $h
+	_redraw $path 
+    }
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command ButtonBar::_redraw
+# ----------------------------------------------------------------------------
+proc ButtonBar::_redraw {path} {
+    variable $path
+    upvar 0  $path data
+
+    array unset data configured,*
+
+    set num [llength $data(buttons)]
+
+    if {$num == 0} return
+
+    grid forget $path.spacer
+
+    set cols [lindex [grid size $path] 0]
+    set rows [lindex [grid size $path] 1]
+    for {set c 0} {$c < $cols} {incr c} {
+	grid columnconfigure $path $c -weight 0 -minsize 0
+	catch {grid columnconfigure $path $c -uniform {}}
+    }
+    for {set r 0} {$r < $rows} {incr r} {
+	grid rowconfigure $path $r -weight 0 -minsize 0
+	catch {grid rowconfigure $path $r -uniform {}}
+    }
+
+    set min [Widget::getoption $path -minwidth]
+    set max [Widget::getoption $path -maxwidth]
+    if {$min > $max} {
+	set max $min
+    }
+
+    $path:cmd configure -width $max
+
+    if {[string equal [Widget::getoption $path -orient] "horizontal"]} {
+	set w [winfo width $path]
+
+	if {$min == 0} {
+	    set cols $num
+	} else {
+	    set cols [expr {int($w / $min)}]
+	    if {$cols > $num} {
+		set cols $num
+	    }
+	}
+
+	if {[expr {$max * $cols}] < $w} {
+	    set weight 2
+	    set minsize $max
+	    grid $path.spacer -column $cols -row 0
+	    grid columnconfigure $path $cols -weight 1 -minsize 0
+	} else {
+	    set weight 1
+	    set minsize $min
+	}
+
+	set c 0
+	set r 0
+	foreach name $data(buttons) {
+	    grid [_but $path $name] -column $c -row $r -sticky nsew
+	    grid columnconfigure $path $c -weight $weight -minsize $minsize
+	    catch {grid columnconfigure $path $c -uniform 1}
+	    incr c
+	    if {$c >= $cols} {
+		set c 0
+		incr r
+	    }
+	}
+    } else {
+	set h [winfo height $path]
+
+	set c 0
+	set r 0
+	set th 0
+	set num 0
+	foreach name $data(buttons) {
+	    set but [_but $path $name]
+
+	    if {[info exists data(height,$name)]} {
+		incr th $data(height,$name)
+	    } else {
+		incr th [winfo reqheight $but]
+	    }
+	    if {($c > 0 && $r >= $num) || ($c == 0 && $th > $h)} {
+		set r 0
+		incr c
+	    } elseif {$c == 0} {
+		incr num
+	    }
+	    grid $but -column $c -row $r -sticky nsew
+	    grid rowconfigure $path $r -weight 0 -minsize 0
+	    grid columnconfigure $path $c -weight 0 -minsize $max
+	    incr r
+	}
+	grid rowconfigure $path $num -weight 10000000 -minsize 0
+    }
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command ButtonBar::_destroy
+# ----------------------------------------------------------------------------
+proc ButtonBar::_destroy {path} {
+    variable $path
+    upvar 0  $path data
+    Widget::destroy $path
+    unset data
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command ButtonBar::_but
+# ----------------------------------------------------------------------------
+proc ButtonBar::_but {path name} {
+    return $path.b:$name
+}
+
+# ----------------------------------------------------------------------------
+#  Command ButtonBar::pages
+# ----------------------------------------------------------------------------
+proc ButtonBar::pages {path {first ""} {last ""}} {
+    variable $path
+    upvar 0  $path data
+
+    if {[string equal $first ""]} {
+	return $data(buttons)
+    } elseif {[string equal $last ""]} {
+	return [lindex $data(buttons) $first]
+    } else {
+	return [lrange $data(buttons) $first $last]
+    }
+}
+
+# ----------------------------------------------------------------------------
+#  Command ButtonBar::raise
+# ----------------------------------------------------------------------------
+proc ButtonBar::raise {path {name ""}} {
+    variable $path
+    upvar 0  $path data
+
+    if {[string equal $name ""]} {
+	return $data(active)
+    } else {
+	activate $path $name
+    }
+}
+
+# ----------------------------------------------------------------------------
+#  Command ButtonBar::getframe
+# ----------------------------------------------------------------------------
+proc ButtonBar::getframe {path name} {
+    if {![string equal [Widget::getoption $path -pages] ""]} {
+	return [[Widget::getoption $path -pages] getframe $name]
+    } else {
+	return ""
+    }
+}
+
+# ----------------------------------------------------------------------------
+#  Command ButtonBar::bindtabs
+# ----------------------------------------------------------------------------
+proc ButtonBar::bindtabs {path event script} {
+    variable $path
+    upvar 0  $path data
+
+    lappend data(bindtabs) $event $script
+
+    foreach name $data(buttons) {
+	bind [_but $path $name] $event [linsert $script end $name]
+    }
+}
+
+# ----------------------------------------------------------------------------
+#  Command ButtonBar::see
+# ----------------------------------------------------------------------------
+proc ButtonBar::see {path name} {
+    return ""
+}
+
+# ----------------------------------------------------------------------------
+#  Command ButtonBar::_itemconfigure
+# ----------------------------------------------------------------------------
+proc ButtonBar::_itemconfigure {path name} {
+    variable $path
+    upvar 0  $path data
+
+    if {[info exists data(configured,$name)]} return
+
+    set data(configured,$name) 1
+
+    set but [_but $path $name]
+    set w [winfo width $but]
+
+    if {![info exists data(text,$name)] ||
+	    ![info exists data(width,$name)] || $data(width,$name) != $w} {
+	set data(width,$name) $w
+	_reconfigure_text $path $name
+    }
+    set data(height,$name) [winfo height $but]
+}
+
+
+# ----------------------------------------------------------------------------
+#  Command ButtonBar::_calc_text
+# ----------------------------------------------------------------------------
+proc ButtonBar::_calc_text {path name} {
+    variable $path
+    upvar 0  $path data
+
+    set text [_itemoption $path $name -text]
+    set font [_itemoption $path $name -font]
+
+    set data(text,$name) [list $text [font measure $font $text]]
+
+    set len [string length $text]
+
+    for {set ind 0} {$ind < $len} {incr ind} {
+	lappend data(text,$name) [font measure $font [string range $text 0 $ind]...]
+    }
+}
+
+# ----------------------------------------------------------------------------
+#  Command ButtonBar::_reconfigure_text
+# ----------------------------------------------------------------------------
+proc ButtonBar::_reconfigure_text {path name} {
+    variable $path
+    upvar 0  $path data
+
+    if {![info exists data(text,$name)]} return
+
+    set but [_but $path $name]
+
+    set padx [_itemoption $path $name -padx]
+    set bd   [_itemoption $path $name -bd]
+    set hl   [_itemoption $path $name -highlightthickness]
+
+    set w [winfo width $but]
+
+    set tw [expr {$w - $padx - 2*($bd + $hl)}]
+
+    set text [lindex $data(text,$name) 0]
+    set textw [lindex $data(text,$name) 1]
+
+    Button::configure $but -text $text -helptext ""
+
+    set i -1
+    foreach textw [lrange $data(text,$name) 2 end] {
+	if {$textw > $tw} {
+	    Button::configure $but -text [string range $text 0 $i]... \
+				   -helptext $text
+	    return
+	}
+	incr i
+    }
+}
+
+

Modified: trunk/tkabber/ifacetk/iface.tcl
===================================================================
--- trunk/tkabber/ifacetk/iface.tcl	2007-04-18 18:17:34 UTC (rev 1117)
+++ trunk/tkabber/ifacetk/iface.tcl	2007-04-18 18:45:34 UTC (rev 1118)
@@ -12,11 +12,25 @@
 	     "Use Tabbed Interface (you need to restart)."] \
 	-group IFace -type boolean
 
-    custom::defvar options(tabs_at_bottom) 0 \
-	[::msgcat::mc "Show tabs below the main window."] \
-	-group IFace -type boolean \
+    custom::defvar options(tabs_side) top \
+	[::msgcat::mc "Side where to place tabs in tabbed mode."] \
+	-group IFace -type options \
+	-values [list top    [::msgcat::mc "Top"] \
+		      bottom [::msgcat::mc "Bottom"] \
+		      left   [::msgcat::mc "Left"] \
+		      right  [::msgcat::mc "Right"]] \
 	-command [namespace current]::configure_tabs
 
+    custom::defvar options(tab_minwidth) 90 \
+	[::msgcat::mc "Minimum width of tab buttons in tabbed mode."] \
+	-group IFace -type integer \
+	-command [namespace current]::configure_tabs
+
+    custom::defvar options(tab_maxwidth) 120 \
+	[::msgcat::mc "Maximum width of tab buttons in tabbed mode."] \
+	-group IFace -type integer \
+	-command [namespace current]::configure_tabs
+
     custom::defvar options(show_toolbar) 1 \
 	[::msgcat::mc "Show Toolbar."] \
 	-group IFace -type boolean \
@@ -89,17 +103,56 @@
     namespace export add_win tab_set_updated
 }
 
+source [file join [file dirname [info script]] buttonbar.tcl]
+
 proc ifacetk::configure_tabs {args} {
     variable options
     global usetabbar
+    variable mf
 
     if {$usetabbar} {
-	if {$options(tabs_at_bottom)} {
-	    set side bottom
+	if {[string is integer -strict $options(tab_minwidth)] && \
+		$options(tab_minwidth) >= 0} {
+	    set minwidth $options(tab_minwidth)
 	} else {
-	    set side top
+	    set minwidth 90
 	}
-	.nb configure -side $side
+	if {[string is integer -strict $options(tab_maxwidth)] && \
+		$options(tab_maxwidth) >= 0} {
+	    set maxwidth $options(tab_maxwidth)
+	} else {
+	    set maxwidth 90
+	}
+
+	switch -- $options(tabs_side) {
+	    bottom {
+		set row 2
+		set col 1
+		set rowspan 1
+		set orient horizontal
+	    }
+	    left {
+		set row 1
+		set col 0
+		set rowspan 2
+		set orient vertical
+	    }
+	    right {
+		set row 1
+		set col 2
+		set rowspan 2
+		set orient vertical
+	    }
+	    default {
+		set row 0
+		set col 1
+		set rowspan 1
+		set orient horizontal
+	    }
+	}
+	grid .nb -row $row -rowspan $rowspan -column $col \
+		 -sticky nswe -in [$mf getframe]
+	.nb configure -minwidth $minwidth -maxwidth $maxwidth -orient $orient
     }
 }
 
@@ -742,6 +795,18 @@
 	}
     }
 
+    grid columnconfigure [$mf getframe] 1 -weight 1
+    grid rowconfigure [$mf getframe] 1 -weight 1
+
+    if {$usetabbar} {
+	ButtonBar .nb -orient horizontal \
+		      -pady 1 \
+		      -padx 4 \
+		      -pages .pages
+
+	configure_tabs
+    }
+
     frame .presence
     menubutton .presence.button -menu .presence.button.menu -relief $::tk_relief \
 	-textvariable userstatusdesc -direction above -width $ww
@@ -757,7 +822,7 @@
 	pack .presence.button -side top -anchor w
 	pack .presence.status -side top -fill x -expand yes -anchor w
     }
-    pack .presence -side bottom -anchor w -in [$mf getframe] -fill x
+    grid .presence -row 3 -column 1 -sticky nswe -in [$mf getframe]
 
     if {[winfo exists [set m .presence.button.menu]]} {
 	destroy $m
@@ -785,7 +850,7 @@
 
     if {$usetabbar} {
 	set pw [PanedWin [$mf getframe].pw -side bottom -pad 2 -width 8]
-	pack $pw -fill both -expand yes
+	grid $pw -row 1 -column 1 -sticky nswe
 	set rw [PanedWinAdd $pw -minsize 0 -weight 0]
 	set nw [PanedWinAdd $pw -minsize 32 -weight 1]
 
@@ -798,14 +863,10 @@
 	    -dropcmd [namespace current]::roster::dropcmd
 	pack .roster -expand yes -fill both -side left -in $rw
 
-	if {$options(tabs_at_bottom)} {
-	    set side bottom
-	} else {
-	    set side top
-	}
-
-	NoteBook .nb -width 400 -side $side
-	pack .nb -side right -in $nw -fill both -expand yes
+	frame $nw.fr -relief raised -bd 1
+	pack $nw.fr -side right -fill both -expand yes
+	PagesManager .pages -width 400
+	pack .pages -side right -padx 2m -pady 2m -in $nw.fr -fill both -expand yes
 	PanedWinConf $pw 0 -width $rosterwidth
 
 	event add <<CollapseRoster>> <Control-Key-r>
@@ -864,9 +925,9 @@
 	.nb bindtabs <<ScrollUp>> [list [namespace current]::tab_move .nb -1]
 	.nb bindtabs <<ScrollDown>> [list [namespace current]::tab_move .nb 1]
 
-	DragSite::register .nb.c -draginitcmd [namespace current]::draginitcmd
-	DropSite::register .nb.c -dropovercmd [namespace current]::dropovercmd \
-	    -dropcmd [namespace current]::dropcmd -droptypes {NoteBookPage}
+	#DragSite::register .nb.c -draginitcmd [namespace current]::draginitcmd
+	#DropSite::register .nb.c -dropovercmd [namespace current]::dropovercmd \
+	#    -dropcmd [namespace current]::dropcmd -droptypes {NoteBookPage}
 
 	set geometry [option get . geometry [winfo class .]]
 	if {$geometry == ""} {
@@ -880,7 +941,7 @@
 	    -doubleclick [namespace current]::roster::jid_doubleclick \
 	    -draginitcmd [namespace current]::roster::draginitcmd \
 	    -dropcmd [namespace current]::roster::dropcmd
-	pack .roster -expand yes -fill both -side left -in [$mf getframe]
+	grid .roster -row 1 -column 1 -sticky nswe -in [$mf getframe]
 	set geometry [option get . geometry [winfo class .]]
 	if {$geometry == ""} {
 	    set geometry 200x350
@@ -1331,16 +1392,16 @@
     global alert_colors
 
     if {$usetabbar} {
-	option add *NoteBook.alertColor0 Black widgetDefault
-	option add *NoteBook.alertColor1 DarkBlue widgetDefault
-	option add *NoteBook.alertColor2 Blue widgetDefault
-	option add *NoteBook.alertColor3 Red widgetDefault
+	option add *ButtonBar.alertColor0 Black widgetDefault
+	option add *ButtonBar.alertColor1 DarkBlue widgetDefault
+	option add *ButtonBar.alertColor2 Blue widgetDefault
+	option add *ButtonBar.alertColor3 Red widgetDefault
 
 	set alert_colors [list \
-		[option get .nb alertColor0 NoteBook] \
-		[option get .nb alertColor1 NoteBook] \
-		[option get .nb alertColor2 NoteBook] \
-		[option get .nb alertColor3 NoteBook]]
+		[option get .nb alertColor0 ButtonBar] \
+		[option get .nb alertColor1 ButtonBar] \
+		[option get .nb alertColor2 ButtonBar] \
+		[option get .nb alertColor3 ButtonBar]]
     }
 }
 
@@ -1441,18 +1502,13 @@
 
     if {[winfo exists .presence]} {
 	if {$options(show_presencebar)} {
-	    if {$usetabbar} {
-		set before [.mainframe getframe].pw
-	    } else {
-		set before .roster
-	    }
 	    catch {
-		pack .presence -side bottom -anchor w \
-		    -in [.mainframe getframe] -fill x -before $before
+		grid .presence -row 3 -column 1 \
+		    -sticky nswe -in [.mainframe getframe]
 		.presence.status configure -takefocus 1
 	    }
 	} else {
-	    pack forget .presence
+	    grid forget .presence
 	    .presence.status configure -takefocus 0
 	    if {[focus] == ".presence.status"} {
 	    focus [Widget::focusPrev .presence.status]

Modified: trunk/tkabber/ifacetk/systray.tcl
===================================================================
--- trunk/tkabber/ifacetk/systray.tcl	2007-04-18 18:17:34 UTC (rev 1117)
+++ trunk/tkabber/ifacetk/systray.tcl	2007-04-18 18:45:34 UTC (rev 1118)
@@ -297,7 +297,7 @@
 
     set hitP 0
     foreach {k v} [array get tabcolors] {
-	if {![winfo exists .nb.f$k]} {
+	if {[.nb index $k] < 0} {
 	    continue
 	}
 	if {(![cequal $v ""]) && ($v > $hitP)} {



More information about the Tkabber-dev mailing list