Attachment "NoteBookRightImage.patch" to
ticket [15e19fe9ec]
added by
kjnash
2017-11-02 15:50:32.
Index: BWman/NoteBook.html
==================================================================
--- BWman/NoteBook.html
+++ BWman/NoteBook.html
@@ -44,17 +44,18 @@
<TD> <A HREF="#-arcradius">-arcradius</A></TD>
<TD> <A HREF="#-height">-height</A></TD>
</TR>
<TR>
<TD> <A HREF="#-homogeneous">-homogeneous</A></TD>
-<TD> <A HREF="#-side">-side</A></TD>
+<TD> <A HREF="#-internalborderwidth">-internalborderwidth or -ibd</A></TD>
</TR>
<TR>
+<TD> <A HREF="#-side">-side</A></TD>
<TD> <A HREF="#-tabbevelsize">-tabbevelsize</A></TD>
-<TD> <A HREF="#-tabpady">-tabpady</A></TD>
</TR>
<TR>
+<TD> <A HREF="#-tabpady">-tabpady</A></TD>
<TD> <A HREF="#-width">-width</A></TD>
</TR>
</TABLE></DD>
</DL>
<DL>
@@ -115,11 +116,15 @@
</DL>
<BR><HR WIDTH="100%"><BR>
<B><A NAME="descr"></A>DESCRIPTION</B><BR>
<P>
-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 <B>frame</B> or <B>ttk::frame</B> that is included in the NoteBook by its
+<A HREF="#insert"><B>insert</B></A> 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 <A HREF="#-side">-side</A>.
</P>
<BR><HR WIDTH="50%"><BR>
<B><A NAME="wso">WIDGET-SPECIFIC OPTIONS</A></B><BR>
<DL><DT><A NAME="-arcradius"><B>-arcradius</B></A></DT>
@@ -140,14 +145,24 @@
</DD>
</DL>
<DL><DT><A NAME="-homogeneous"><B>-homogeneous</B></A></DT>
<DD>
-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.
</DD>
</DL>
+
+<DL><DT><A NAME="-internalborderwidth"><B>-internalborderwidth</B> or <B>-ibd</B></A></DT>
+<DD>
+
+Value that is applied to each page in the NoteBook as its <B>-borderwidth</B> or <B>-bd</B>.
+
+</DD>
+</DL>
+
+
<DL><DT><A NAME="-side"><B>-side</B></A></DT>
<DD>
Specifies the side where to place the label of the pages. Must be one
of <B>top</B> or <B>bottom</B>.
@@ -249,19 +264,90 @@
<I>index</I>
<I>page</I>
?<I>option value...</I>?
</DT><DD>
-Insert a new page idendified by <I>page</I> at position <I>index</I> in the pages list.
+Insert a new page identified by <I>page</I> at position <I>index</I> in the pages list.
<I>index</I> must be numeric or <B>end</B>. 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.
<P>
+<DL><DT><A NAME="Page-activebackground"><B>-activebackground</B></A></DT>
+<DD>
+
+Background color for the tab when it is active.
+
+</DD>
+</DL>
+<DL><DT><A NAME="Page-activeforeground"><B>-activeforeground</B></A></DT>
+<DD>
+
+Color used for the tab's text when the tab is active.
+
+</DD>
+</DL>
+<DL><DT><A NAME="Page-background"><B>-background</B></A></DT>
+<DD>
+
+Background color for the tab when it is not active.
+
+</DD>
+</DL>
<DL><DT><A NAME="Page-createcmd"><B>-createcmd</B></A></DT>
<DD>
Specifies a command to be called the first time the page is raised.
+</DD>
+</DL>
+<DL><DT><A NAME="Page-disabledforeground"><B>-disabledforeground</B></A></DT>
+<DD>
+
+Color used for the tab's text when the tab is disabled.
+
+</DD>
+</DL>
+
+<DL><DT><A NAME="Page-foreground"><B>-foreground</B></A></DT>
+<DD>
+
+Color used for the tab's text when the tab is neither active nor disabled.
+
+</DD>
+</DL>
+<DL><DT><A NAME="Page-helpcmd"><B>-helpcmd</B></A></DT>
+<DD>
+
+Has no effect.
+See also <A HREF="DynamicHelp.html">DynamicHelp</A>.
+
+</DD>
+</DL>
+<DL><DT><A NAME="Page-helptext"><B>-helptext</B></A></DT>
+<DD>
+
+Text for dynamic help. If empty, no help is available for this page.
+See also <A HREF="DynamicHelp.html">DynamicHelp</A>.
+
+</DD>
+</DL>
+<DL><DT><A NAME="Page-helptype"><B>-helptype</B></A></DT>
+<DD>
+
+Type of dynamic help. Use <I>balloon</I> (the default for a NoteBook
+page) or <I>variable</I>.
+See also <A HREF="DynamicHelp.html">DynamicHelp</A>.
+
+</DD>
+</DL>
+<DL><DT><A NAME="Page-helpvar"><B>-helpvar</B></A></DT>
+<DD>
+
+Variable to use when <B>-helptype</B> option is <I>variable</I>.
+See also <A HREF="DynamicHelp.html">DynamicHelp</A>.
+
</DD>
</DL>
<DL><DT><A NAME="Page-image"><B>-image</B></A></DT>
<DD>
@@ -273,17 +359,40 @@
<DD>
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.
+</DD>
+</DL>
+<DL><DT><A NAME="Page-ractiveimage"><B>-ractiveimage</B></A></DT>
+<DD>
+
+Image to show on the right of the tab when the tab is active.
+
</DD>
</DL>
<DL><DT><A NAME="Page-raisecmd"><B>-raisecmd</B></A></DT>
<DD>
Specifies a command to be called each time the page is raised.
+</DD>
+</DL>
+<DL><DT><A NAME="Page-rimage"><B>-rimage</B></A></DT>
+<DD>
+
+Image to show on the right of the tab when the tab is not active.
+
+</DD>
+</DL>
+<DL><DT><A NAME="Page-rimagecmd"><B>-rimagecmd</B></A></DT>
+<DD>
+
+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.
+
</DD>
</DL>
<DL><DT><A NAME="Page-state"><B>-state</B></A></DT>
<DD>
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 $tabIndex+1]
+ } else {
+ # This tab is furthest to the right. Raise the tab to the left.
+ set raiseTabName [lindex $tabList $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 <Leave> 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 [list {*}$cmd $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 <Enter> \
+ [list NoteBook::_rightImage on $path $page]
+ $path.c bind $page:jmg <Leave> \
+ [list NoteBook::_rightImage off $path $page]
+ $path.c bind $page:jmg <ButtonRelease-1> \
+ [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) == "" } {