tidy vfs src/vfs/_vfscommon.vfs

src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/SelectColor.html

@@ -125,7 +125,7 @@ Title of the Dialog toplevel.
 
 </DD>
 </DL>
-<DL><DT><A NAME="-type"><B>-type (read-only)</B></A></DT>
+<DL><DT><A NAME="-type"><B>-type (only on widget creation)</B></A></DT>
 <DD>
 
 Specifies the type of the SelectColor widget. Must be <B>dialog</B> or
@@ -135,7 +135,8 @@ return an empty string if cancel button is pressed or if dialog is destroyed,
 and the selected color if ok button is pressed. In all cases, dialog is
 destroyed.  <BR>If <B>type</B> option is <I>popup</I>,
 SelectColor::<B>create</B> creates a small, popup dialog with a small set of
-predefined colors and a button to activate a full color dialog.
+predefined colors and a button to activate a full color dialog.<BR>
+The widget commands <B>dialog</B> and <B>menu</B> below are synonymes for those operation modes.
 
 </DD>
 </DL>

src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/Tree.html

@@ -486,9 +486,14 @@ Specifies the desired width for the tree in units of 8 pixels.
 <B><A NAME="nodes">NODE NAMES</A></B><BR>
 <p>
 Certain special characters in node names are automatically substituted
-by the tree during operation.  These characters are <b>&amp; | ^ !</b>.
+by the tree during operation.  These characters are <b>&amp; | ^ ! :</b>.
-They are all substituted with a <b>_</b> character.  This is only to
+They are internally substituted by non printable characters \1 to \5.
-avoid errors because the characters are special to the tree widget.
+This is only to avoid errors because the characters are special to the tree widget.
+In consequence, the characters \1 to \5 are not unique in node names and should be avoided.
+</p>
+<p>Note: until BWidget 1.9.16, a double colon ("::") was substituded by \5 and the
+single colon (":") lead to an error. This change is incompatible in the sense, that
+the generated node name changed between the versions.
 </p>
 
 <B><A NAME="wc">WIDGET COMMAND</A></B><BR>

src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/ChangeLog

@@ -1,3 +1,44 @@
+2024-10-27 Harald Oehlmann <oehhar@users.sourceforge.net>
+
+	**** BWidget 1.10.1 tagged ****
+
+2024-10-15 Harald Oehlmann <oehhar@users.sourceforge.net>
+	* Fix Tk9 compatibilty of statusbar.tcl.
+	Thanks to Paul Obermeier.
+	Ticket [7eb06c3a3a] 
+
+2024-10-15 Harald Oehlmann <oehhar@users.sourceforge.net>
+
+	**** BWidget 1.10.0 tagged ****
+
+2024-10-14 Harald Oehlmann <oehhar@users.sourceforge.net>
+	* TCL/Tk 9 patch provided by Emiliano. Ticket [b78ac94ee6]
+
+2023-05-22 Harald Oehlmann <oehhar@users.sourceforge.net>
+	* color.tcl: Bugfix in color chooser.
+	Displayed color box got gray (instead yellow) after the
+	following action: manually enter #ff0, click on far right
+	pannel for intensity.
+	In addition, add limited support for manual entry of named
+	colors.
+	Thanks to Steve from https://sourceforge.net/projects/scidvspc/
+	for bug report and contribution. Ticket [4f9a4205f0]
+
+2023-05-22 Harald Oehlmann <oehhar@users.sourceforge.net>
+	TCL9.0/Tk8.7 compatibility issues found by Paul Obermeier.
+	https://wiki.tcl-lang.org/page/Porting+extensions+to+Tcl+9
+	* dropsite.tcl: Replaced "$tcl_platform" with "$::tcl_platform"
+	  in namespaces.
+	* widget.tcl: Replaced "package require Tcl 8.1.1" with
+	  "package require Tcl 8.1.1-".
+	Ticket [1bee17b353] 
+
+2023-05-22 Harald Oehlmann <oehhar@users.sourceforge.net>
+	tree.tcl: Bug: node names with leading colons gave error.
+	The node name solution was changed, that ":" is now
+	substituded by "\5", and not "::". Ticket [d075175ade].
+	Thanks to Rolf Ade for the ticket.
+
 2022-12-25 Harald Oehlmann <oehhar@users.sourceforge.net>
 
 	**** BWidget 1.9.16 tagged ****

src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/button.tcl

@@ -20,6 +20,8 @@
 namespace eval Button {
     Widget::define Button button DynamicHelp
 
+    # Using namespace variable without variable may set global variables
+    # Fixed in TCL 9, so no correction here
     set remove [list -command -relief -text -textvariable -underline -state]
     if {[info tclversion] > 8.3} {
 	lappend remove -repeatdelay -repeatinterval
@@ -129,7 +131,7 @@ proc Button::create { path args } {
 # ----------------------------------------------------------------------------
 proc Button::configure { path args } {
     set oldunder [$path:cmd cget -underline]
-    if { $oldunder != -1 } {
+    if { $oldunder > -1 } {
         set oldaccel1 [string tolower [string index [$path:cmd cget -text] $oldunder]]
         set oldaccel2 [string toupper $oldaccel1]
     } else {

src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/buttonbox.tcl

@@ -415,5 +415,5 @@ proc ButtonBox::_destroy { path } {
     variable $path
     upvar 0  $path data
     Widget::destroy $path
-    unset data
+    unset -nocomplain data
 }

src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/color.tcl

@@ -23,6 +23,8 @@ namespace eval SelectColor {
         \#ffffff \#ffffff \#ffffff \#ffffff \#ffffff
     }
 
+    # Namespace variables overwrite global variables in TCL8
+    # Not changed here, as fixed in TCL9
     if {[string equal $::tcl_platform(platform) "unix"]} {
         set useTkDialogue 0
     } else {
@@ -418,7 +420,7 @@ proc SelectColor::dialog {path args} {
     # (2) ::SelectColor::_entryColor is modified (except by the user typing in
     #     the entry widget)
 
-    trace add variable ::SelectColor::_unsavedSelection write ::SelectColor::_SetEntryValue
+    trace add variable _unsavedSelection write ::SelectColor::_SetEntryValue
 
     $top add -text [lindex [BWidget::getname ok] 0]
     $top add -text [lindex [BWidget::getname cancel] 0]
@@ -436,7 +438,7 @@ proc SelectColor::dialog {path args} {
         set color ""
     }
 
-    trace remove variable ::SelectColor::_unsavedSelection write ::SelectColor::_SetEntryValue
+    trace remove variable _unsavedSelection write ::SelectColor::_SetEntryValue
 
     destroy $top
     return $color
@@ -502,7 +504,7 @@ proc SelectColor::_select_rgb {count} {
 
         # Display selected color in entry widget (via trace on
         # ::SelectColor::_unsavedSelection), and notify caller.
-        set ::SelectColor::_unsavedSelection $bg
+        set _unsavedSelection $bg
         _userCommand $bg
     }
 }
@@ -520,7 +522,7 @@ proc SelectColor::_set_rgb {rgb} {
 
     # Display selected color in entry widget (via trace on
     # ::SelectColor::_unsavedSelection), and notify caller.
-    set ::SelectColor::_unsavedSelection $rgb
+    set _unsavedSelection $rgb
     _userCommand $rgb
     set user [expr {$_selection-[llength $_baseColors]}]
     if {$user >= 0} {
@@ -808,7 +810,10 @@ proc SelectColor::_SetEntryValue {argVarName var2 op} {
     variable _entryColor
     variable _unsavedSelection
 
-    if {[string equal $argVarName ::SelectColor::_unsavedSelection] &&
+    # get the full qualified name
+    set fqname [uplevel 1 [list namespace which -variable $argVarName]]
+
+    if {[string equal $fqname ::SelectColor::_unsavedSelection] &&
             [string equal $var2 {}] && [string equal $op "write"]} {
         # OK
     } else {
@@ -817,10 +822,10 @@ proc SelectColor::_SetEntryValue {argVarName var2 op} {
                 \"$argVarName\", \"$var2\", \"$op\""
     }
 
-    set col24bit [::SelectColor::_24BitRgb [set $argVarName]]
+    set col24bit [_24BitRgb [set $fqname]]
 
     if {[_ValidateColorEntry forced $col24bit]} {
-        set ::SelectColor::_entryColor $col24bit
+        set _entryColor $col24bit
     } else {
         # Value is invalid, and if written to _entryColor this would disable
         # validation.
@@ -871,16 +876,32 @@ proc SelectColor::_ValidateColorEntry {percentV percentP} {
     variable _unsavedSelection
 
     set result [regexp -- {^#[0-9a-fA-F]*$} $percentP]
+    if {$result} {
+        # Check for a valid rgb color, which needs 3n+1 characters, n > 0
         set lenny  [string length $percentP]
+        set entryincomplete [expr {($lenny - 1) % 3 || $lenny == 1}]
+    } else {
+        # Check for named colors
+        set result [regexp -- {^[a-zA-Z0-9 ]*$} $percentP]
+        # We do not accept the key stroke
+        if {!$result} {
+            return 0
+        }
+        # Check for complete named color
+        set entryincomplete [catch {winfo rgb . $percentP} rgblist]
+        if {!$entryincomplete} {
+            set red [expr {[lindex $rgblist 0]/0x100}]
+            set green [expr {[lindex $rgblist 1]/0x100}]
+            set blue [expr {[lindex $rgblist 2]/0x100}]
+            set percentP [format "#%02X%02X%02X" $red $green $blue]
+        }
+    }
 
-    if {$result} {
     if {[string equal $percentV "forced"]} {
         # Validation only.  Don't want a loop.
     } elseif {[string equal $percentV "key"]} {
         # Copy to GUI if a valid color.
-            if {($lenny - 1) % 3 || $lenny == 1} {
+        if {!$entryincomplete} {
-                # Not a valid color, which needs 3n+1 characters, n > 0
-            } else {
             after idle [list SelectColor::_SetWithoutTrace $percentP]
         }
     } elseif {[string equal $percentV "focusout"]} {
@@ -891,11 +912,10 @@ proc SelectColor::_ValidateColorEntry {percentV percentP} {
         # Remove an invalid value, convert a valid one to 24-bit.
         # Ignore $percentP, just fire the trace on _unsavedSelection.
         set color $_unsavedSelection
-            after idle [list set ::SelectColor::_unsavedSelection $color]
+        after idle [list set SelectColor::_unsavedSelection $color]
-        }
     }
 
-    return $result
+    return 1
 }
 
 
@@ -908,11 +928,14 @@ proc SelectColor::_ValidateColorEntry {percentV percentP} {
 # ------------------------------------------------------------------------------
 
 proc SelectColor::_SetWithoutTrace {value} {
-    trace remove variable ::SelectColor::_unsavedSelection write ::SelectColor::_SetEntryValue
+    variable _hsv
+    variable _unsavedSelection
+
+    trace remove variable _unsavedSelection write ::SelectColor::_SetEntryValue
     _set_rgb $value
     set _hsv [eval rgbToHsv [winfo rgb . $value]]
     _set_hue_sat [lindex $_hsv 0] [lindex $_hsv 1]
     _set_value   [lindex $_hsv 2]
-    trace add variable ::SelectColor::_unsavedSelection write ::SelectColor::_SetEntryValue
+    trace add variable _unsavedSelection write ::SelectColor::_SetEntryValue
     return
 }

src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/combobox.tcl

@@ -19,7 +19,7 @@
 # ----------------------------------------------------------------------------
 
 # ComboBox uses the 8.3 -listvariable listbox option
-package require Tk 8.3
+package require Tk 8.3 9
 
 namespace eval ComboBox {
     Widget::define ComboBox combobox ArrowButton Entry ListBox
@@ -171,7 +171,7 @@ proc ComboBox::create { path args } {
         Widget::configure $path [list -bwlistbox $bw]
     }
 
-    set ComboBox::_index($path) -1
+    set ::ComboBox::_index($path) -1
 
     return [Widget::create ComboBox $path]
 }
@@ -515,7 +515,7 @@ proc ComboBox::_create_popup { path } {
     wm withdraw         $shell
     wm overrideredirect $shell 1
     # these commands cause the combobox to behave strangely on OS X
-    if {! $Widget::_aqua } {
+    if {! $::Widget::_aqua } {
         update idle
         wm transient    $shell [winfo toplevel $path]
         catch { wm attributes $shell -topmost 1 }
@@ -703,7 +703,7 @@ proc ComboBox::_mapliste { path } {
     wm deiconify $path.shell
     raise $path.shell
     BWidget::focus set $listb
-    if {! $Widget::_aqua } {
+    if {! $::Widget::_aqua } {
         BWidget::grab global $path
     }
 }
@@ -717,7 +717,7 @@ proc ComboBox::_unmapliste { path {refocus 1} } {
     if {[winfo exists $path.shell] && \
       ( [string equal [wm state $path.shell] "normal"] ||
 	[string equal [wm state $path.shell] "zoomed"] ) } {
-        if {! $Widget::_aqua } {
+        if {! $::Widget::_aqua } {
             BWidget::grab release $path
             BWidget::focus release $path.shell.listb $refocus
             # Update now because otherwise [focus -force...] makes the app hang!

src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/demo/basic.tcl

@@ -184,14 +184,15 @@ proc DemoBasic::_barmcmd { value but arr1 arr2 } {
 proc DemoBasic::_butcmd { reason } {
     variable count
     variable id
+    variable var
 
     catch {after cancel $id}
     if { $reason == "arm" } {
         incr count
-        set DemoBasic::var(butcmd) "$reason command called ($count)"
+        set var(butcmd) "$reason command called ($count)"
     } else {
         set count 0
-        set DemoBasic::var(butcmd) "$reason command called"
+        set var(butcmd) "$reason command called"
     }
     set id [after 500 {set DemoBasic::var(butcmd) ""}]
 }

src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/demo/demo.tcl

@@ -1,6 +1,7 @@
 #!/bin/sh
 # The next line is executed by /bin/sh, but not tcl \
 exec wish "$0" ${1+"$@"}
+package require Tk
 
 namespace eval Demo {
     variable _wfont
@@ -123,7 +124,7 @@ proc Demo::create { } {
     set font   [$_wfont cget -font]
     pack $_wfont -side left -anchor w
 
-    $mainframe addindicator -text "BWidget [package version BWidget]"
+    $mainframe addindicator -text "BWidget [package provide BWidget]"
     $mainframe addindicator -textvariable tk_patchLevel
 
     # NoteBook creation

src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/demo/manager.tcl

@@ -106,15 +106,15 @@ proc DemoManager::_show_progress { } {
     variable _status
 
     if { $_progress } {
-        set Demo::status   "Compute in progress..."
+        set ::Demo::status   "Compute in progress..."
-        set Demo::prgindic 0
+        set ::Demo::prgindic 0
-        $Demo::mainframe showstatusbar progression
+        $::Demo::mainframe showstatusbar progression
         if { $_afterid == "" } {
             set _afterid [after 30 DemoManager::_update_progress]
         }
     } else {
-        set Demo::status ""
+        set ::Demo::status ""
-        $Demo::mainframe showstatusbar status
+        $::Demo::mainframe showstatusbar status
         set _afterid ""
     }
 }
@@ -125,13 +125,13 @@ proc DemoManager::_update_progress { } {
     variable _afterid
 
     if { $_progress } {
-        if { $Demo::prgindic < 100 } {
+        if { $::Demo::prgindic < 100 } {
-            incr Demo::prgindic 5
+            incr ::Demo::prgindic 5
             set _afterid [after 30 DemoManager::_update_progress]
         } else {
             set _progress 0
-            $Demo::mainframe showstatusbar status
+            $::Demo::mainframe showstatusbar status
-            set Demo::status "Done"
+            set ::Demo::status "Done"
             set _afterid ""
             after 500 {set Demo::status ""}
         }

src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/demo/tmpldlg.tcl

@@ -180,7 +180,7 @@ proc DemoDlg::_show_msgdlg { } {
 
 
 proc DemoDlg::_show_fontdlg { } {
-    set font [SelectFont .fontdlg -parent . -font $Demo::font]
+    set font [SelectFont .fontdlg -parent . -font $::Demo::font]
     if { $font != "" } {
         Demo::update_font $font
     }
@@ -188,8 +188,8 @@ proc DemoDlg::_show_fontdlg { } {
 
 
 proc DemoDlg::_show_progdlg { } {
-    set DemoDlg::progmsg "Compute in progress..."
+    set ::DemoDlg::progmsg "Compute in progress..."
-    set DemoDlg::progval 0
+    set ::DemoDlg::progval 0
 
     ProgressDlg .progress -parent . -title "Wait..." \
         -type         infinite \
@@ -204,7 +204,7 @@ proc DemoDlg::_show_progdlg { } {
 
 proc DemoDlg::_update_progdlg { } {
     if { [winfo exists .progress] } {
-        set DemoDlg::progval 2
+        set ::DemoDlg::progval 2
         after 20 DemoDlg::_update_progdlg
     }
 }

src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/demo/tree.tcl

@@ -84,12 +84,12 @@ proc DemoTree::create { nb } {
 
 
 proc DemoTree::init { tree list args } {
-    global   tcl_platform
+    global   tcl_platform env
     variable count
 
     set count 0
     if { $tcl_platform(platform) == "unix" } {
-        set rootdir [glob "~"]
+        set rootdir [glob $env(HOME)]
     } else {
         set rootdir "c:\\"
     }

src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/dropsite.tcl

@@ -55,7 +55,7 @@ namespace eval DropSite {
         ops,link    1
     }
 
-    if { $tcl_platform(platform) == "unix" } {
+    if { $::tcl_platform(platform) == "unix" } {
         set _tabops(mod,alt) 8
     } else {
         set _tabops(mod,alt) 16
@@ -73,7 +73,7 @@ namespace eval DropSite {
     bind DragTop <KeyPress-Shift_R>     {DropSite::_update_operation [expr %s | 1]}
     bind DragTop <KeyPress-Control_L>   {DropSite::_update_operation [expr %s | 4]}
     bind DragTop <KeyPress-Control_R>   {DropSite::_update_operation [expr %s | 4]}
-    if { $tcl_platform(platform) == "unix" } {
+    if { $::tcl_platform(platform) == "unix" } {
         bind DragTop <KeyPress-Alt_L>       {DropSite::_update_operation [expr %s | 8]}
         bind DragTop <KeyPress-Alt_R>       {DropSite::_update_operation [expr %s | 8]}
     } else {
@@ -85,7 +85,7 @@ namespace eval DropSite {
     bind DragTop <KeyRelease-Shift_R>   {DropSite::_update_operation [expr %s & ~1]}
     bind DragTop <KeyRelease-Control_L> {DropSite::_update_operation [expr %s & ~4]}
     bind DragTop <KeyRelease-Control_R> {DropSite::_update_operation [expr %s & ~4]}
-    if { $tcl_platform(platform) == "unix" } {
+    if { $::tcl_platform(platform) == "unix" } {
         bind DragTop <KeyRelease-Alt_L>     {DropSite::_update_operation [expr %s & ~8]}
         bind DragTop <KeyRelease-Alt_R>     {DropSite::_update_operation [expr %s & ~8]}
     } else {

src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/dynhelp.tcl

@@ -19,9 +19,11 @@
 namespace eval DynamicHelp {
     Widget::define DynamicHelp dynhelp -classonly
 
+    # Namespace variables overwrite global variables in TCL8
+    # Not changed here, as fixed in TCL9
     if {$::tcl_version >= 8.5} {
         set fontdefault TkTooltipFont
-    } elseif {$Widget::_aqua} {
+    } elseif {$::Widget::_aqua} {
         set fontdefault {helvetica 11}
     } else {
         set fontdefault {helvetica 8}
@@ -670,7 +672,7 @@ proc DynamicHelp::_show_help { path w x y } {
             -screen [winfo screen $w]
 
         wm withdraw $_top
-	if { $Widget::_aqua } {
+	if { $::Widget::_aqua } {
 	    ::tk::unsupported::MacWindowStyle style $_top help none
 	} else {
 	    wm overrideredirect $_top 1

src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/entry.tcl

@@ -31,6 +31,8 @@ namespace eval Entry {
 		     -disabledforeground -disabledbackground }
     }
 
+    # Namespace variables overwrite global variables in TCL8
+    # Not changed here, as fixed in TCL9
     set declare [list \
 	    [list -state        Enum        normal 0  [list normal disabled]] \
 	    [list -text         String      ""	   0] \
@@ -72,6 +74,8 @@ namespace eval Entry {
         COLOR   {move {}}
     }
 
+    # Namespace variables overwrite global variables in TCL8
+    # Not changed here, as fixed in TCL9
     if {[Widget::theme]} {
         foreach event [bind TEntry] {
             bind BwEntry $event [bind TEntry $event]
@@ -179,7 +183,7 @@ proc Entry::create { path args } {
 proc Entry::configure { path args } {
     # Cheat by setting the -text value to the current contents of the entry
     # This might be better hidden behind a function in ::Widget.
-    set Widget::Entry::${path}:opt(-text) [$path:cmd get]
+    set ::Widget::Entry::${path}:opt(-text) [$path:cmd get]
 
     set res [Widget::configure $path $args]
 

src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/font.tcl

@@ -42,6 +42,9 @@ namespace eval SelectFont {
     
     # Set up preset lists of fonts, so the user can avoid the painfully slow
     # loadfont process if desired.
+
+    # Namespace variables overwrite global variables in TCL8
+    # Not changed here, as fixed in TCL9
     if { [string equal $::tcl_platform(platform) "windows"] } {
 	set presetVariable [list	\
 		7x14			\

src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/label.tcl

@@ -124,7 +124,7 @@ proc Label::create { path args } {
 # ------------------------------------------------------------------------------
 proc Label::configure { path args } {
     set oldunder [$path.l cget -underline]
-    if { $oldunder != -1 } {
+    if { $oldunder > -1 } {
         set oldaccel [string tolower [string index [$path.l cget -text] $oldunder]]
     } else {
         set oldaccel ""

src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/labelframe.tcl

@@ -114,10 +114,10 @@ proc LabelFrame::align { args } {
     set wlist  {}
     foreach wl $args {
         foreach w $wl {
-            if { ![info exists Widget::_class($w)] } {
+            if { ![info exists ::Widget::_class($w)] } {
                 continue
             }
-            set class $Widget::_class($w)
+            set class $::Widget::_class($w)
             if { [string equal $class "LabelFrame"] } {
                 set textopt  -text
                 set widthopt -width