2 ## Copyright 1997 Jeffrey Hobbs, CADIX International
5 ##------------------------------------------------------------------------
10 ## Implements a Tabbed Notebook megawidget
13 ## tabnote <window pathname> <options>
16 ## (Any entry widget option may be used in addition to these)
18 ## -activebackground color DEFAULT: {}
19 ## The background color given to the active tab. A value of {}
20 ## means these items will pick up the widget's background color.
22 ## -background color DEFAULT: DEFAULT
23 ## The background color for the container subwidgets.
25 ## -browsecmd script DEFAULT: {}
26 ## A script that is executed each time a tab changes. It appends
27 ## the old tab and the new tab to the script. An empty string ({})
28 ## represents the blank (empty) tab.
30 ## -disabledbackground color DEFAULT: #c0c0c0 (dark gray)
31 ## The background color given to disabled tabs.
33 ## -justify justification DEFAULT: center
34 ## The justification applied to the text in multi-line tabs.
35 ## Must be one of: left, right, center.
37 ## -linewidth pixels DEFAULT: 1
38 ## The width of the line surrounding the tabs. Must be at least 1.
40 ## -linecolor color DEFAULT: black
41 ## The color of the line surrounding the tabs.
43 ## -normalbackground DEFAULT: {}
44 ## The background color of items with normal state. A value of {}
45 ## means these items will pick up the widget's background color.
47 ## -padx pixels DEFAULT: 4
48 ## The X padding for folder tabs around the items.
50 ## -pady pixels DEFAULT: 2
51 ## The Y padding for folder tabs around the items.
53 ## RETURNS: the window pathname
55 ## BINDINGS (in addition to default widget bindings)
57 ## <1> in a tabs activates that tab.
60 ## These are the methods that the Tabnote widget recognizes. Aside from
61 ## these, it accepts methods that are valid for entry widgets.
63 ## configure ?option? ?value option value ...?
65 ## Standard tk widget routines.
68 ## Activates the tab specified by id. id may either by the unique id
69 ## returned by the add command or the string used in the add command.
71 ## add string ?-window widget? ?-state state?
72 ## Adds a tab to the tab notebook with the specified string, unless
73 ## the string is the name of an image, in which case the image is used.
74 ## Each string must be unique. The widget specifies a widget to show
75 ## when that tab is pressed. It must be a child of the tab notebook
76 ## (required for grid management) and exist prior to the 'add' command
77 ## being called. The optional state can be normal (default), active or
78 ## or disabled. If active is given, then this tab becomes the active
79 ## tab. A unique tab id is returned.
82 ## Deletes the tab specified by id. id may either by the unique id
83 ## returned by the add command or the string used in the add command.
85 ## itemconfigure ?option? ?value option value ...?
87 ## Configure or retrieve the option of a tab notebook item.
90 ## Returns the text name for a given tabId.
93 ## Returns the true widget path of the specified widget. Valid
94 ## widgets are hold (a frame), tabs (a canvas), blank (a frame).
97 ## The megawidget creates a global array with the classname, and a
98 ## global array which is the name of each megawidget created. The latter
99 ## array is deleted when the megawidget is destroyed.
100 ## Public procs of $CLASSNAME and [string tolower $CLASSNAME] are used.
101 ## Other procs that begin with $CLASSNAME are private. For each widget,
102 ## commands named .$widgetname and $CLASSNAME$widgetname are created.
107 ##------------------------------------------------------------------------
109 #package require Widget 1.0
110 package provide Tabnotebook 1.3
112 array set Tabnotebook {
116 {frame hold hold {-relief raised -bd 1}}
119 {-background $data(-background) -height 1 -width 40}}
120 {canvas tabs tabs {-bg $data(-background) \
121 -highlightthickness 0 -takefocus 0}}
124 -activebackground {activeBackground ActiveBackground {}}
126 -background {ALIAS frame -background}
128 -borderwidth {ALIAS frame -borderwidth}
129 -browsecmd {browseCmd BrowseCommand {}}
130 -disabledbackground {disabledBackground DisabledBackground #a3a3a3}
131 -normalbackground {normalBackground normalBackground #c3c3c3}
132 -justify {justify Justify center}
133 -minwidth {minWidth Width -1}
134 -minheight {minHeight Height -1}
137 -relief {ALIAS frame -relief}
138 -linewidth {lineWidth LineWidth 1}
139 -linecolor {lineColor LineColor black}
141 # Create this to make sure there are registered in auto_mkindex
142 # these must come before the [widget create ...]
143 proc Tabnotebook args {}
144 proc tabnotebook args {}
145 widget create Tabnotebook
147 ;proc Tabnotebook:construct {w args} {
159 $data(tabs) yview moveto 0
160 $data(tabs) xview moveto 0
162 grid $data(tabs) -sticky ew
163 grid $data(hold) -sticky news
164 grid $data(blank) -in $data(hold) -row 0 -column 0 -sticky nsew
165 grid columnconfig $w 0 -weight 1
166 grid rowconfig $w 1 -weight 1
167 grid columnconfig $data(hold) 0 -weight 1
168 grid rowconfig $data(hold) 0 -weight 1
170 bind $data(tabs) <Configure> "
171 if {\[string compare $data(tabs) %W\]} return
172 Tabnotebook:resize [list $w] %w
174 bind $data(tabs) <2> { %W scan mark %x 0 }
175 bind $data(tabs) <B2-Motion> {
177 Tabnotebook:resize [winfo parent %W] [winfo width %W]
181 ;proc Tabnotebook:configure { w args } {
184 set truth {^(1|yes|true|on)$}
186 foreach {key val} $args {
189 if {[string compare $data(curtab) {}]} {
190 $data(tabs) itemconfig POLY:$data(curtab) -fill $val
192 if {[string compare $val {}]} {
193 $data(hide) config -bg $val
195 lappend post {$data(hide) config -bg $data(-background)}
199 $data(tabs) config -bg $val
200 $data(hold) config -bg $val
201 $data(blank) config -bg $val
204 $data(hold) config -bd $val
205 $data(hide) config -height $val
207 -disabledbackground {
208 foreach i $data(ids) {
209 if {[string match disabled $data(:$i:-state)]} {
210 $data(tabs) itemconfig POLY:$i -fill $val
214 -justify { $data(tabs) itemconfig TEXT -justify $val }
216 $data(tabs) itemconfigure LINE -width $val
219 $data(tabs) itemconfigure LINE -fill $val
222 if {$val >= 0} { grid columnconfig $w 0 -minsize $val }
225 if {$val >= 0} { grid rowconfig $w 1 -minsize $val }
228 foreach i $data(ids) {
229 if {[string match normal $data(:$i:-state)]} {
230 $data(tabs) itemconfig POLY:$i -fill $val
235 if {$val <= 0} { set val 1 }
238 $data(hold) config -relief $val
243 if {[string compare $post {}]} {
248 ;proc Tabnotebook_add { w text args } {
252 if {[string match {} $text]} {
253 return -code error "non-empty text required for noteboook label"
254 } elseif {[string compare {} [$c find withtag ID:$text]]} {
255 return -code error "tab \"$text\" already exists"
261 foreach {key val} $args {
262 switch -glob -- $key {
264 if {[string compare $val {}]} {
265 if {![winfo exist $val]} {
266 return -code error "window \"$val\" does not exist"
267 } elseif {[string comp $w [winfo parent $val]] && \
268 [string comp $data(hold) [winfo parent $val]]} {
269 return -code error "window \"$val\" must be a\
270 child of the tab notebook ($w)"
276 if {![regexp {^(normal|disabled|active)$} $val]} {
277 return -code error "unknown state \"$val\", must be:\
278 normal, disabled or active"
283 return -code error "unknown option '$key', must be:\
284 [join [array names s] {, }]"
288 set tabnum [incr data(numtabs)]
291 if {[lsearch -exact [image names] $text] != -1} {
292 set i [$c create image $px $py -image $text -anchor nw \
293 -tags [list IMG ID:$text TAB:$tabnum]]
295 set i [$c create text [expr {$px+1}] $py -text $text -anchor nw \
296 -tags [list TEXT ID:$text TAB:$tabnum] \
297 -justify $data(-justify)]
299 foreach {x1 y1 x2 y2} [$c bbox $i] {
300 set W [expr {$x2-$x1+$px}]
301 set FW [expr {$W+$px}]
302 set FH [expr {$y2-$y1+3*$py}]
304 set diff [expr {$FH-$data(height)}]
310 $c create poly 0 $FH $px $py $W $py $FW $FH -fill {} \
311 -tags [list POLY POLY:$tabnum TAB:$tabnum]
312 $c create line 0 $FH $px $py $W $py $FW $FH \
313 -tags [list LINE LINE:$tabnum TAB:$tabnum] \
314 -width $data(-linewidth) -fill $data(-linecolor)
315 $c move TAB:$tabnum $data(width) [expr {($diff<0)?-$diff:0}]
317 $c raise LINE:$tabnum
319 $c config -width $data(width) -height $data(height) \
320 -scrollregion "0 0 $data(width) $data(height)"
321 $c bind TAB:$tabnum <1> [list Tabnotebook_activate $w $tabnum]
322 array set data [list :$tabnum:-window $s(-window) \
323 :$tabnum:-state $s(-state)]
324 if {[string compare $s(-window) {}]} {
325 grid $s(-window) -in $data(hold) -row 0 -column 0 -sticky nsew
329 active { Tabnotebook_activate $w $tabnum }
330 disabled {$c itemconfig POLY:$tabnum -fill $data(-disabledbackground)}
331 normal {$c itemconfig POLY:$tabnum -fill $data(-normalbackground)}
333 lappend data(ids) $tabnum
337 ;proc Tabnotebook_activate { w id } {
340 if {[string compare $id {}]} {
341 set tab [Tabnotebook:verify $w $id]
342 if {[string match disabled $data(:$tab:-state)]} return
346 if {[string match $data(curtab) $tab]} return
348 set oldtab $data(curtab)
349 if {[string compare $oldtab {}]} {
350 $c itemconfig POLY:$oldtab -fill $data(-normalbackground)
351 set data(:$oldtab:-state) normal
353 set data(curtab) $tab
354 if {[string compare $tab {}]} {
355 set data(:$tab:-state) active
356 $c itemconfig POLY:$tab -fill $data(-activebackground)
358 if {[info exists data(:$tab:-window)] && \
359 [winfo exists $data(:$tab:-window)]} {
360 raise $data(:$tab:-window)
364 Tabnotebook:resize $w [winfo width $w]
365 if {[string comp $data(-browsecmd) {}]} {
366 uplevel \#0 $data(-browsecmd) \
367 [list [Tabnotebook_name $w $oldtab] [Tabnotebook_name $w $tab]]
371 ;proc Tabnotebook_delete { w id } {
374 set tab [Tabnotebook:verify $w $id]
376 foreach {x1 y1 x2 y2} [$c bbox TAB:$tab] { set W [expr {$x2-$x1-3}] }
378 for { set i [expr {$tab+1}] } { $i <= $data(numtabs) } { incr i } {
381 foreach {x1 y1 x2 y2} [$c bbox all] { set H [expr {$y2-$y1-3}] }
382 if {$H<$data(height)} {
383 $c move all 0 [expr {$H-$data(height)}]
387 $c config -width $data(width) -height $data(height) \
388 -scrollregion "0 0 $data(width) $data(height)"
389 set i [lsearch $data(ids) $tab]
390 set data(ids) [lreplace $data(ids) $i $i]
391 catch {grid forget $data(:$tab:-window)}
392 unset data(:$tab:-state) data(:$tab:-window)
393 if {[string match $tab $data(curtab)]} {
399 ;proc Tabnotebook_itemcget { w id key } {
402 set tab [Tabnotebook:verify $w $id]
403 set opt [array names data :$tab:$key*]
404 set len [llength $opt]
407 } elseif {$len == 0} {
408 set all [array names data :$tab:-*]
409 foreach o $all { lappend opts [lindex [split $o :] end] }
410 return -code error "unknown option \"$key\", must be one of:\
413 foreach o $opt { lappend opts [lindex [split $o :] end] }
414 return -code error "ambiguous option \"$key\", must be one of:\
419 ;proc Tabnotebook_itemconfigure { w id args } {
422 set tab [Tabnotebook:verify $w $id]
423 set len [llength $args]
425 return [uplevel Tabnotebook_itemcget $w $tab $args]
427 return -code error "uneven set of key/value pairs in \"$args\""
429 if {[string match {} $args]} {
430 set all [array names data :$tab:-*]
431 foreach o $all { lappend res [lindex [split $o :] end] $data($o) }
434 foreach {key val} $args {
435 switch -glob -- $key {
437 if {[string comp $val {}]} {
438 if {![winfo exist $val]} {
439 return -code error "window \"$val\" does not exist"
440 } elseif {[string comp $w [winfo parent $val]] && \
441 [string comp $data(hold) [winfo parent $val]]} {
442 return -code error "window \"$val\" must be a\
443 child of the tab notebook ($w)"
446 set old $data(:$tab:-window)
447 if {[winfo exists $old]} { grid forget $old }
448 set data(:$tab:-window) $val
449 if {[string comp $val {}]} {
450 grid $val -in $data(hold) -row 0 -column 0 \
454 if {[string match active $data(:$tab:-state)]} {
455 if {[string comp $val {}]} {
463 if {![regexp {^(normal|disabled|active)$} $val]} {
464 return -code error "unknown state \"$val\", must be:\
465 normal, disabled or active"
467 if {[string match $val $data(:$tab:-state)]} return
468 set old $data(:$tab:-state)
471 set data(:$tab:-state) $val
472 Tabnotebook_activate $w $tab
475 if {[string match active $old]} {
476 Tabnotebook_activate $w {}
478 $data(tabs) itemconfig POLY:$tab \
479 -fill $data(-disabledbackground)
480 set data(:$tab:-state) $val
483 if {[string match active $old]} {
484 Tabnotebook_activate $w {}
486 $data(tabs) itemconfig POLY:$tab -fill {}
487 set data(:$tab:-state) $val
492 return -code error "unknown option '$key', must be:\
493 [join [array names s] {, }]"
499 ## given a tab number, return the text
500 ;proc Tabnotebook_name { w id } {
503 if {[string match {} $id]} return
505 foreach item [$data(tabs) find withtag TAB:$id] {
506 set tags [$data(tabs) gettags $item]
507 if {[set i [lsearch -glob $tags {ID:*}]] != -1} {
508 set text [string range [lindex $tags $i] 3 end]
515 ;proc Tabnotebook:resize { w x } {
518 if {[string compare $data(curtab) {}]} {
519 set x [expr {round(-[$data(tabs) canvasx 0])}]
520 foreach {x1 y1 x2 y2} [$data(tabs) bbox TAB:$data(curtab)] {
521 place $data(hide) -y [winfo y $data(hold)] -x [expr {$x1+$x+3}]
522 $data(hide) config -width [expr {$x2-$x1-5}]
525 place forget $data(hide)
529 ;proc Tabnotebook:see { w id } {
533 set box [$c bbox $id]
534 if {[string match {} $box]} return
535 foreach {x y x1 y1} $box {left right} [$c xview] \
536 {p q xmax ymax} [$c cget -scrollregion] {
537 set xpos [expr (($x1+$x)/2.0)/$xmax - ($right-$left)/2.0]
539 $c xview moveto $xpos
542 ;proc Tabnotebook:verify { w id } {
546 if {[string comp {} [set i [$c find withtag ID:$id]]]} {
547 if {[regexp {TAB:([0-9]+)} [$c gettags [lindex $i 0]] junk id]} {
550 } elseif {[string comp {} [$c find withtag TAB:$id]]} {
553 return -code error "unrecognized tab \"$id\""