Index: BWman/NoteBook.html ================================================================== --- BWman/NoteBook.html +++ BWman/NoteBook.html @@ -44,17 +44,18 @@   -arcradius   -height   -homogeneous -  -side +  -internalborderwidth or -ibd +  -side   -tabbevelsize -  -tabpady +  -tabpady   -width
@@ -115,11 +116,15 @@


DESCRIPTION

-NoteBook widget manage a set of pages and displays one of them. +The NoteBook widget manages a set of pages and displays one of them. A page +is a frame or ttk::frame that is included in the NoteBook by its +insert command. Each page is associated with a tab; +the tabs are displayed in a band either above or below the pages, depending on +the value of the option -side.



WIDGET-SPECIFIC OPTIONS
-arcradius
@@ -140,14 +145,24 @@
-homogeneous
-Specifies wether or not the label of the pages must have the same width. +Specifies whether or not the label of the pages must have the same width. + +
+
+ +
-internalborderwidth or -ibd
+
+ +Value that is applied to each page in the NoteBook as its -borderwidth or -bd.
+ +
-side
Specifies the side where to place the label of the pages. Must be one of top or bottom. @@ -249,19 +264,90 @@ index page ?option value...?
-Insert a new page idendified by page at position index in the pages list. +Insert a new page identified by page at position index in the pages list. index must be numeric or end. The pathname of the new page is returned. +Dynamic help, if it is specified by the options, is +displayed when the pointer hovers over the tab that belongs to the page.

+

-activebackground
+
+ +Background color for the tab when it is active. + +
+
+
-activeforeground
+
+ +Color used for the tab's text when the tab is active. + +
+
+
-background
+
+ +Background color for the tab when it is not active. + +
+
-createcmd
Specifies a command to be called the first time the page is raised. +
+
+
-disabledforeground
+
+ +Color used for the tab's text when the tab is disabled. + +
+
+ +
-foreground
+
+ +Color used for the tab's text when the tab is neither active nor disabled. + +
+
+
-helpcmd
+
+ +Has no effect. +See also DynamicHelp. + +
+
+
-helptext
+
+ +Text for dynamic help. If empty, no help is available for this page. +See also DynamicHelp. + +
+
+
-helptype
+
+ +Type of dynamic help. Use balloon (the default for a NoteBook +page) or variable. +See also DynamicHelp. + +
+
+
-helpvar
+
+ +Variable to use when -helptype option is variable. +See also DynamicHelp. +
-image
@@ -273,17 +359,40 @@
Specifies a command to be called when a page is about to be leaved. The command must return 0 if the page can not be leaved, or 1 if it can. +
+
+
-ractiveimage
+
+ +Image to show on the right of the tab when the tab is active. +
-raisecmd
Specifies a command to be called each time the page is raised. +
+
+
-rimage
+
+ +Image to show on the right of the tab when the tab is not active. + +
+
+
-rimagecmd
+
+ +Specifies a command to be evaluated, with two arguments appended, when the +image shown on the right of the tab is clicked. The first appended argument +is the Tk window path of the NoteBook, the second is the name of the page. +
-state
Index: ChangeLog ================================================================== --- ChangeLog +++ ChangeLog @@ -1,5 +1,10 @@ +2017-11-03 Harald Oehlmann + notebook.tcl (+man,demo): Add possibility to NoteBook + to add an image at the right of each tab. + Ticket [15e19fe9ec]. Patch by Keith Nash. + 2017-08-25 Harald Oehlmann **** BWidget 1.9.11 tagged **** 2017-05-08 Harald Oehlmann Index: demo/demo.tcl ================================================================== --- demo/demo.tcl +++ demo/demo.tcl @@ -25,10 +25,25 @@ } { namespace inscope :: source $DEMODIR/$script } } +image create photo bwidget16 -data { + R0lGODlhEAAQAOMJABat6IGYffaBCUSku/KCDcCMPomXdgCy//+AANnZ2dnZ2dnZ2dnZ2dnZ2dnZ + 2dnZ2SH5BAEKAA8ALAAAAAAQABAAAAQ58MlJq70U6a0x/9c2iRb5mNmHjmpXuiecIpRA0JWJDEfw + HIffoWU4AIBBYKuABAoxSGEQ6oxins8IADs= +} + +image create photo faded16 -data { + R0lGODlhEAAQAKEDAAAAAICAgKCgoP///yH5BAEKAAMALAAAAAAQABAAAAIjnI+py+1vQEABsDoH + blUI+XyAAImk033Zsmng8hoVRNd2XQAAOw== +} + +image create photo stop16 -data { + R0lGODlhEAAQAMIFAAAAAC8DA3gKCpYMDPAUFP///////////yH5BAEKAAcALAAAAAAQABAAAAMm + SLrc/jDKqYBgAsB8CY/ZMFjTGAzUEACoFI7d83nkUysZpe/8ngAAOw== +} proc Demo::create { } { global tk_patchLevel variable _wfont variable notebook @@ -131,10 +146,18 @@ incr prgindic set f4 [DemoDnd::create $notebook] set prgtext "Creating Tree..." incr prgindic set f5 [DemoTree::create $notebook] + + foreach page [$notebook pages] { + $notebook itemconfigure $page \ + -image bwidget16 \ + -rimage faded16 \ + -ractiveimage stop16 \ + -rimagecmd {::Demo::_close_tab} + } set prgtext "Done" incr prgindic $notebook compute_size pack $notebook -fill both -expand yes -padx 4 -pady 4 @@ -142,10 +165,35 @@ pack $mainframe -fill both -expand yes update idletasks destroy .intro } + +proc Demo::_close_tab { tabSet tabName } { + after idle [list $tabSet delete $tabName] + + set tabIndex [$tabSet index $tabName] + set tabList [$tabSet pages] + set tabTot [llength $tabList] + + # Pick another tab to raise. + if {$tabTot == 1} { + # No other tabs. + exit + } elseif {$tabIndex < $tabTot - 1} { + # Raise the tab to the right. + set raiseTabName [lindex $tabList [expr {$tabIndex + 1}]] + } else { + # This tab is furthest to the right. Raise the tab to the left. + set raiseTabName [lindex $tabList [expr {$tabIndex - 1}]] + } + + $tabSet raise $raiseTabName + $tabSet see $raiseTabName + return +} + proc Demo::update_font { newfont } { variable _wfont variable notebook Index: notebook.tcl ================================================================== --- notebook.tcl +++ notebook.tcl @@ -41,10 +41,13 @@ {-state Enum normal 0 {normal disabled}} {-createcmd String "" 0} {-raisecmd String "" 0} {-leavecmd String "" 0} {-image TkResource "" 0 label} + {-rimage String "" 0} + {-ractiveimage String "" 0} + {-rimagecmd String "" 0} {-text String "" 0} {-foreground String "" 0} {-background String "" 0} {-activeforeground String "" 0} {-activebackground String "" 0} @@ -272,10 +275,11 @@ -relief flat \ -background [Widget::cget $path -background] \ -borderwidth [Widget::cget $path -internalborderwidth] } set data($page,realized) 0 + set data($page,rimage) 0 } else { if { ! $::Widget::_theme} { $f configure -background [Widget::cget $path -background] } $f configure -borderwidth [Widget::cget $path -internalborderwidth] @@ -307,11 +311,11 @@ if { $pos < $data(base) } { incr data(base) -1 } if { $destroyframe } { destroy $path.f$page - unset data($page,width) data($page,realized) + unset data($page,width) data($page,realized) data($page,rimage) } _redraw $path } @@ -504,10 +508,13 @@ if { [Widget::hasChanged $path.f$page -text foo] } { _compute_width $path } elseif { [Widget::hasChanged $path.f$page -image foo] } { _compute_height $path _compute_width $path + } elseif { [Widget::hasChanged $path.f$page -rimage foo] } { + _compute_height $path + _compute_width $path } if { [Widget::hasChanged $path.f$page -state state] && $state == "disabled" && $data(select) == $page } { set data(select) "" } @@ -544,10 +551,17 @@ set wtext [expr {$wtext + [image width $img] + 4}] set himg [expr {[image height $img] + 6}] if { $himg > $hmax } { set hmax $himg } + } + if { [set jmg [Widget::cget $path.f$page -rimage]] != "" } { + set wtext [expr {$wtext + [image width $jmg] + 4}] + set hjmg [expr {[image height $jmg] + 6}] + if { $hjmg > $hmax } { + set hmax $hjmg + } } set wmax [expr {$wtext > $wmax ? $wtext : $wmax}] incr wtot $wtext set data($page,width) $wtext } @@ -572,23 +586,30 @@ set font [Widget::cget $path -font] set pady0 [Widget::_get_padding $path -tabpady 0] set pady1 [Widget::_get_padding $path -tabpady 1] set metrics [font metrics $font -linespace] set imgh 0 + set jmgh 0 set lines 1 foreach page $data(pages) { set img [Widget::cget $path.f$page -image] + set jmg [Widget::cget $path.f$page -rimage] set text [Widget::cget $path.f$page -text] set len [llength [split $text \n]] if {$len > $lines} { set lines $len} if {$img != ""} { set h [image height $img] if {$h > $imgh} { set imgh $h } } + if {$jmg != ""} { + set h [image height $jmg] + if {$h > $jmgh} { set jmgh $h } + } } set height [expr {$metrics * $lines}] if {$imgh > $height} { set height $imgh } + if {$jmgh > $height} { set height $jmgh } set data(hpage) [expr {$height + $pady0 + $pady1}] } # --------------------------------------------------------------------------- @@ -664,10 +685,62 @@ -fill [_getoption $path $page -foreground] } } } + +# --------------------------------------------------------------------------- +# Command NoteBook::_rightImage +# --------------------------------------------------------------------------- +proc NoteBook::_rightImage { type path page } { + variable $path + upvar 0 $path data + + if { [string equal [Widget::cget $path.f$page -state] "disabled"] } { + return + } + + switch -- $type { + on { + set data($page,rimage) 1 + set jmg [Widget::cget $path.f$page -rimage] + set jamg [Widget::cget $path.f$page -ractiveimage] + if { ($jmg ne {}) + && ($jamg ne {}) + && ([image height $jmg] == [image height $jamg]) + && ([image width $jmg] == [image width $jamg]) + } { + $path.c itemconfigure "$page:jmg" \ + -image $jamg + } else { + # Don't replace the -rimage with the -raimage if they are + # different sizes. + } + } + off { + set data($page,rimage) 0 + $path.c itemconfigure "$page:jmg" \ + -image [Widget::cget $path.f$page -rimage] + } + command { + set cmd [Widget::cget $path.f$page -rimagecmd] + if {$cmd ne {}} { + after idle [list uplevel #0 [list NoteBook::_rightImage execute $path $page]] + # Call after idle so that, if the pointer has left the -rimage, + # the event fires and resets data($page,rimage) before + # NoteBook::_rightImage execute is evaluated. + } + } + execute { + set cmd [Widget::cget $path.f$page -rimagecmd] + if {$cmd ne {} && $data($page,rimage)} { + uplevel #0 [concat $cmd [list $path $page]] + } + } + } +} + # --------------------------------------------------------------------------- # Command NoteBook::_select # --------------------------------------------------------------------------- proc NoteBook::_select { path page } { @@ -836,10 +909,11 @@ $rightPlusRadius $h \ ] } set img [Widget::cget $path.f$page -image] + set jmg [Widget::cget $path.f$page -rimage] set ytext $top if { $tabsOnBottom } { # The "+ 2" below moves the text closer to the bottom of the tab, # so it doesn't look so cramped. I should be able to achieve the @@ -855,10 +929,19 @@ if { $img != "" } { # if there's an image, put it on the left and move the text right set ximg $xtext incr xtext [expr {[image width $img] + 2}] } + + if { $jmg != "" } { + # if there's an image, put it on the right and leave the text + set xjmg $xtext + if { $img != "" } { + set xjmg $ximg + } + incr xjmg [expr {$data($page,width) - [image width $jmg] - 10}] + } if { $data(select) == $page } { set bd [Widget::cget $path -borderwidth] if {$bd < 1} { set bd 1 } set fg [_getoption $path $page -foreground] @@ -926,10 +1009,30 @@ $path.c itemconfigure $id -image $img # Sven end } else { $path.c delete $page:img } + + if { $jmg != "" } { + set id [$path.c find withtag $page:jmg] + if { [string equal $id ""] } { + set id [$path.c create image $xjmg $ytext \ + -anchor nw \ + -tags [list page p:$page $page:jmg]] + } + $path.c coords $id $xjmg $ytext + $path.c itemconfigure $id -image $jmg + + $path.c bind $page:jmg \ + [list NoteBook::_rightImage on $path $page] + $path.c bind $page:jmg \ + [list NoteBook::_rightImage off $path $page] + $path.c bind $page:jmg \ + [list NoteBook::_rightImage command $path $page] + } else { + $path.c delete $page:jmg + } if { $data(select) == $page } { $path.c raise p:$page } elseif { $pos == 0 } { if { $data(select) == "" } {