Bwidget Source Code
Artifact [1d6262e6e6]
Not logged in

Artifact 1d6262e6e63f28beaf3d0fdd26afef3ed96ce850fa5f6d5830e1e4b46e8c570f:

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>&nbsp;&nbsp;<A HREF="#-arcradius">-arcradius</A></TD>
 <TD>&nbsp;&nbsp;<A HREF="#-height">-height</A></TD>
 </TR>
 <TR>
 <TD>&nbsp;&nbsp;<A HREF="#-homogeneous">-homogeneous</A></TD>
-<TD>&nbsp;&nbsp;<A HREF="#-side">-side</A></TD>
+<TD>&nbsp;&nbsp;<A HREF="#-internalborderwidth">-internalborderwidth or -ibd</A></TD>
 </TR>
 <TR>
+<TD>&nbsp;&nbsp;<A HREF="#-side">-side</A></TD>
 <TD>&nbsp;&nbsp;<A HREF="#-tabbevelsize">-tabbevelsize</A></TD>
-<TD>&nbsp;&nbsp;<A HREF="#-tabpady">-tabpady</A></TD>
 </TR>
 <TR>
+<TD>&nbsp;&nbsp;<A HREF="#-tabpady">-tabpady</A></TD>
 <TD>&nbsp;&nbsp;<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) == "" } {