diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/ArrowButton.html b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/ArrowButton.html similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/ArrowButton.html rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/ArrowButton.html diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/BWidget.html b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/BWidget.html similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/BWidget.html rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/BWidget.html diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/Button.html b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/Button.html similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/Button.html rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/Button.html diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/ButtonBox.html b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/ButtonBox.html similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/ButtonBox.html rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/ButtonBox.html diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/ComboBox.html b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/ComboBox.html similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/ComboBox.html rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/ComboBox.html diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/Dialog.html b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/Dialog.html similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/Dialog.html rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/Dialog.html diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/DragSite.html b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/DragSite.html similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/DragSite.html rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/DragSite.html diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/DropSite.html b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/DropSite.html similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/DropSite.html rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/DropSite.html diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/DynamicHelp.html b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/DynamicHelp.html similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/DynamicHelp.html rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/DynamicHelp.html diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/Entry.html b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/Entry.html similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/Entry.html rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/Entry.html diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/Label.html b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/Label.html similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/Label.html rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/Label.html diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/LabelEntry.html b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/LabelEntry.html similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/LabelEntry.html rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/LabelEntry.html diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/LabelFrame.html b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/LabelFrame.html similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/LabelFrame.html rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/LabelFrame.html diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/ListBox.html b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/ListBox.html similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/ListBox.html rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/ListBox.html diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/MainFrame.html b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/MainFrame.html similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/MainFrame.html rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/MainFrame.html diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/MessageDlg.html b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/MessageDlg.html similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/MessageDlg.html rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/MessageDlg.html diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/NoteBook.html b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/NoteBook.html similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/NoteBook.html rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/NoteBook.html diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/PagesManager.html b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/PagesManager.html similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/PagesManager.html rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/PagesManager.html diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/PanedWindow.html b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/PanedWindow.html similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/PanedWindow.html rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/PanedWindow.html diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/PanelFrame.html b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/PanelFrame.html similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/PanelFrame.html rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/PanelFrame.html diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/PasswdDlg.html b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/PasswdDlg.html similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/PasswdDlg.html rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/PasswdDlg.html diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/ProgressBar.html b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/ProgressBar.html similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/ProgressBar.html rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/ProgressBar.html diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/ProgressDlg.html b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/ProgressDlg.html similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/ProgressDlg.html rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/ProgressDlg.html diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/ScrollView.html b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/ScrollView.html similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/ScrollView.html rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/ScrollView.html diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/ScrollableFrame.html b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/ScrollableFrame.html similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/ScrollableFrame.html rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/ScrollableFrame.html diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/ScrolledWindow.html b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/ScrolledWindow.html similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/ScrolledWindow.html rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/ScrolledWindow.html diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/SelectColor.html b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/SelectColor.html similarity index 96% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/SelectColor.html rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/SelectColor.html index e61044d1..87bf7529 100644 --- a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/SelectColor.html +++ b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/SelectColor.html @@ -125,7 +125,7 @@ Title of the Dialog toplevel. -
-type (read-only)
+
-type (only on widget creation)
Specifies the type of the SelectColor widget. Must be dialog 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.
If type option is popup, SelectColor::create 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.
+The widget commands dialog and menu below are synonymes for those operation modes.
diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/SelectFont.html b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/SelectFont.html similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/SelectFont.html rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/SelectFont.html diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/Separator.html b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/Separator.html similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/Separator.html rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/Separator.html diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/SpinBox.html b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/SpinBox.html similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/SpinBox.html rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/SpinBox.html diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/StatusBar.html b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/StatusBar.html similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/StatusBar.html rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/StatusBar.html diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/TitleFrame.html b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/TitleFrame.html similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/TitleFrame.html rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/TitleFrame.html diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/Tree.html b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/Tree.html similarity index 98% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/Tree.html rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/Tree.html index 7b547edd..4da88748 100644 --- a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/Tree.html +++ b/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. NODE NAMES

Certain special characters in node names are automatically substituted -by the tree during operation. These characters are & | ^ !. -They are all substituted with a _ character. This is only to -avoid errors because the characters are special to the tree widget. +by the tree during operation. These characters are & | ^ ! :. +They are internally substituted by non printable characters \1 to \5. +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. +

+

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.

WIDGET COMMAND
diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/Widget.html b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/Widget.html similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/Widget.html rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/Widget.html diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/contents.html b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/contents.html similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/contents.html rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/contents.html diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/index.html b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/index.html similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/index.html rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/index.html diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/navtree.html b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/navtree.html similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/navtree.html rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/navtree.html diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/options.htm b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/options.htm similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/BWman/options.htm rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/BWman/options.htm diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/CHANGES.txt b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/CHANGES.txt similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/CHANGES.txt rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/CHANGES.txt diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/ChangeLog b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/ChangeLog similarity index 98% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/ChangeLog rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/ChangeLog index 09f8757a..392194a6 100644 --- a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/ChangeLog +++ b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/ChangeLog @@ -1,3 +1,44 @@ +2024-10-27 Harald Oehlmann + + **** BWidget 1.10.1 tagged **** + +2024-10-15 Harald Oehlmann + * Fix Tk9 compatibilty of statusbar.tcl. + Thanks to Paul Obermeier. + Ticket [7eb06c3a3a] + +2024-10-15 Harald Oehlmann + + **** BWidget 1.10.0 tagged **** + +2024-10-14 Harald Oehlmann + * TCL/Tk 9 patch provided by Emiliano. Ticket [b78ac94ee6] + +2023-05-22 Harald Oehlmann + * 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 + 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 + 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 **** BWidget 1.9.16 tagged **** diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/LICENSE.txt b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/LICENSE.txt similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/LICENSE.txt rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/LICENSE.txt diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/README.txt b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/README.txt similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/README.txt rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/README.txt diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/arrow.tcl b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/arrow.tcl similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/arrow.tcl rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/arrow.tcl diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/bitmap.tcl b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/bitmap.tcl similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/bitmap.tcl rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/bitmap.tcl diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/button.tcl b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/button.tcl similarity index 98% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/button.tcl rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/button.tcl index cb365cf8..d6591dde 100644 --- a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/button.tcl +++ b/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 { diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/buttonbox.tcl b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/buttonbox.tcl similarity index 99% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/buttonbox.tcl rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/buttonbox.tcl index 9fefc2a3..b5f36a0e 100644 --- a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/buttonbox.tcl +++ b/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 } diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/color.tcl b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/color.tcl similarity index 92% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/color.tcl rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/color.tcl index bb6dcb60..5489acbd 100644 --- a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/color.tcl +++ b/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,31 +876,46 @@ proc SelectColor::_ValidateColorEntry {percentV percentP} { variable _unsavedSelection set result [regexp -- {^#[0-9a-fA-F]*$} $percentP] - set lenny [string length $percentP] - 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} { - # Not a valid color, which needs 3n+1 characters, n > 0 - } else { - after idle [list SelectColor::_SetWithoutTrace $percentP] - } - } elseif {[string equal $percentV "focusout"]} { - # If the color is valid it will already have been copied to the GUI - # and to _userCommand by the "key" validation above. - # - # The code below only needs to reset the value in the entry widget. - # 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] + # 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] } } - return $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 {!$entryincomplete} { + after idle [list SelectColor::_SetWithoutTrace $percentP] + } + } elseif {[string equal $percentV "focusout"]} { + # If the color is valid it will already have been copied to the GUI + # and to _userCommand by the "key" validation above. + # + # The code below only needs to reset the value in the entry widget. + # 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] + } + + 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 } diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/combobox.tcl b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/combobox.tcl similarity index 99% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/combobox.tcl rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/combobox.tcl index d754e060..88a47a3b 100644 --- a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/combobox.tcl +++ b/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! diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/demo/basic.tcl b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/demo/basic.tcl similarity index 98% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/demo/basic.tcl rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/demo/basic.tcl index cbda19d2..02564d27 100644 --- a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/demo/basic.tcl +++ b/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) ""}] } diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/demo/bwidget.xbm b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/demo/bwidget.xbm similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/demo/bwidget.xbm rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/demo/bwidget.xbm diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/demo/demo.tcl b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/demo/demo.tcl similarity index 98% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/demo/demo.tcl rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/demo/demo.tcl index c242c662..a6e708ad 100644 --- a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/demo/demo.tcl +++ b/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 diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/demo/dnd.tcl b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/demo/dnd.tcl similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/demo/dnd.tcl rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/demo/dnd.tcl diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/demo/manager.tcl b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/demo/manager.tcl similarity index 91% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/demo/manager.tcl rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/demo/manager.tcl index ffddcc3c..2beac26d 100644 --- a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/demo/manager.tcl +++ b/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::prgindic 0 - $Demo::mainframe showstatusbar progression + set ::Demo::status "Compute in progress..." + set ::Demo::prgindic 0 + $::Demo::mainframe showstatusbar progression if { $_afterid == "" } { set _afterid [after 30 DemoManager::_update_progress] } } else { - set Demo::status "" - $Demo::mainframe showstatusbar status + set ::Demo::status "" + $::Demo::mainframe showstatusbar status set _afterid "" } } @@ -125,13 +125,13 @@ proc DemoManager::_update_progress { } { variable _afterid if { $_progress } { - if { $Demo::prgindic < 100 } { - incr Demo::prgindic 5 + if { $::Demo::prgindic < 100 } { + incr ::Demo::prgindic 5 set _afterid [after 30 DemoManager::_update_progress] } else { set _progress 0 - $Demo::mainframe showstatusbar status - set Demo::status "Done" + $::Demo::mainframe showstatusbar status + set ::Demo::status "Done" set _afterid "" after 500 {set Demo::status ""} } diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/demo/select.tcl b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/demo/select.tcl similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/demo/select.tcl rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/demo/select.tcl diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/demo/tmpldlg.tcl b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/demo/tmpldlg.tcl similarity index 97% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/demo/tmpldlg.tcl rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/demo/tmpldlg.tcl index fa005841..203543e0 100644 --- a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/demo/tmpldlg.tcl +++ b/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::progval 0 + set ::DemoDlg::progmsg "Compute in progress..." + 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 } } diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/demo/tree.tcl b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/demo/tree.tcl similarity index 99% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/demo/tree.tcl rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/demo/tree.tcl index 97d8d975..3ec036d2 100644 --- a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/demo/tree.tcl +++ b/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:\\" } diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/demo/x1.xbm b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/demo/x1.xbm similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/demo/x1.xbm rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/demo/x1.xbm diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/dialog.tcl b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/dialog.tcl similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/dialog.tcl rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/dialog.tcl diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/dragsite.tcl b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/dragsite.tcl similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/dragsite.tcl rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/dragsite.tcl diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/dropsite.tcl b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/dropsite.tcl similarity index 99% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/dropsite.tcl rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/dropsite.tcl index 8d4fbf32..39652b13 100644 --- a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/dropsite.tcl +++ b/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 {DropSite::_update_operation [expr %s | 1]} bind DragTop {DropSite::_update_operation [expr %s | 4]} bind DragTop {DropSite::_update_operation [expr %s | 4]} - if { $tcl_platform(platform) == "unix" } { + if { $::tcl_platform(platform) == "unix" } { bind DragTop {DropSite::_update_operation [expr %s | 8]} bind DragTop {DropSite::_update_operation [expr %s | 8]} } else { @@ -85,7 +85,7 @@ namespace eval DropSite { bind DragTop {DropSite::_update_operation [expr %s & ~1]} bind DragTop {DropSite::_update_operation [expr %s & ~4]} bind DragTop {DropSite::_update_operation [expr %s & ~4]} - if { $tcl_platform(platform) == "unix" } { + if { $::tcl_platform(platform) == "unix" } { bind DragTop {DropSite::_update_operation [expr %s & ~8]} bind DragTop {DropSite::_update_operation [expr %s & ~8]} } else { diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/dynhelp.tcl b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/dynhelp.tcl similarity index 99% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/dynhelp.tcl rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/dynhelp.tcl index d7146b66..f1bc68b3 100644 --- a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/dynhelp.tcl +++ b/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 diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/entry.tcl b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/entry.tcl similarity index 98% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/entry.tcl rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/entry.tcl index c874d191..8b133ea8 100644 --- a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/entry.tcl +++ b/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] diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/font.tcl b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/font.tcl similarity index 99% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/font.tcl rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/font.tcl index 97c3c5de..b61a258b 100644 --- a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/font.tcl +++ b/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 \ diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/images/bold.gif b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/images/bold.gif similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/images/bold.gif rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/images/bold.gif diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/images/copy.gif b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/images/copy.gif similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/images/copy.gif rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/images/copy.gif diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/images/cut.gif b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/images/cut.gif similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/images/cut.gif rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/images/cut.gif diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/images/dragfile.gif b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/images/dragfile.gif similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/images/dragfile.gif rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/images/dragfile.gif diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/images/dragicon.gif b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/images/dragicon.gif similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/images/dragicon.gif rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/images/dragicon.gif diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/images/error.gif b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/images/error.gif similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/images/error.gif rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/images/error.gif diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/images/file.gif b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/images/file.gif similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/images/file.gif rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/images/file.gif diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/images/folder.gif b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/images/folder.gif similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/images/folder.gif rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/images/folder.gif diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/images/hourglass.gif b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/images/hourglass.gif similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/images/hourglass.gif rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/images/hourglass.gif diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/images/info.gif b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/images/info.gif similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/images/info.gif rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/images/info.gif diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/images/italic.gif b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/images/italic.gif similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/images/italic.gif rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/images/italic.gif diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/images/minus.xbm b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/images/minus.xbm similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/images/minus.xbm rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/images/minus.xbm diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/images/new.gif b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/images/new.gif similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/images/new.gif rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/images/new.gif diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/images/opcopy.xbm b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/images/opcopy.xbm similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/images/opcopy.xbm rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/images/opcopy.xbm diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/images/open.gif b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/images/open.gif similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/images/open.gif rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/images/open.gif diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/images/openfold.gif b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/images/openfold.gif similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/images/openfold.gif rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/images/openfold.gif diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/images/oplink.xbm b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/images/oplink.xbm similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/images/oplink.xbm rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/images/oplink.xbm diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/images/opmove.xbm b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/images/opmove.xbm similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/images/opmove.xbm rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/images/opmove.xbm diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/images/overstrike.gif b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/images/overstrike.gif similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/images/overstrike.gif rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/images/overstrike.gif diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/images/palette.gif b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/images/palette.gif similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/images/palette.gif rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/images/palette.gif diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/images/passwd.gif b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/images/passwd.gif similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/images/passwd.gif rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/images/passwd.gif diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/images/paste.gif b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/images/paste.gif similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/images/paste.gif rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/images/paste.gif diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/images/plus.xbm b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/images/plus.xbm similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/images/plus.xbm rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/images/plus.xbm diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/images/print.gif b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/images/print.gif similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/images/print.gif rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/images/print.gif diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/images/question.gif b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/images/question.gif similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/images/question.gif rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/images/question.gif diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/images/redo.gif b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/images/redo.gif similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/images/redo.gif rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/images/redo.gif diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/images/save.gif b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/images/save.gif similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/images/save.gif rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/images/save.gif diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/images/target.xbm b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/images/target.xbm similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/images/target.xbm rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/images/target.xbm diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/images/underline.gif b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/images/underline.gif similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/images/underline.gif rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/images/underline.gif diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/images/undo.gif b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/images/undo.gif similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/images/undo.gif rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/images/undo.gif diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/images/warning.gif b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/images/warning.gif similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/images/warning.gif rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/images/warning.gif diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/init.tcl b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/init.tcl similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/init.tcl rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/init.tcl diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/label.tcl b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/label.tcl similarity index 99% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/label.tcl rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/label.tcl index cf5fc0cb..f4407430 100644 --- a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/label.tcl +++ b/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 "" diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/labelentry.tcl b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/labelentry.tcl similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/labelentry.tcl rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/labelentry.tcl diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/labelframe.tcl b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/labelframe.tcl similarity index 98% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/labelframe.tcl rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/labelframe.tcl index 3c816233..4c524748 100644 --- a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/labelframe.tcl +++ b/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 diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/lang/da.rc b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/lang/da.rc similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/lang/da.rc rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/lang/da.rc diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/lang/de.rc b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/lang/de.rc similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/lang/de.rc rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/lang/de.rc diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/lang/en.rc b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/lang/en.rc similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/lang/en.rc rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/lang/en.rc diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/lang/es.rc b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/lang/es.rc similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/lang/es.rc rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/lang/es.rc diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/lang/fr.rc b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/lang/fr.rc similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/lang/fr.rc rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/lang/fr.rc diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/lang/hu.rc b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/lang/hu.rc similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/lang/hu.rc rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/lang/hu.rc diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/lang/nl.rc b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/lang/nl.rc similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/lang/nl.rc rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/lang/nl.rc diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/lang/no.rc b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/lang/no.rc similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/lang/no.rc rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/lang/no.rc diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/lang/pl.rc b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/lang/pl.rc similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/lang/pl.rc rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/lang/pl.rc diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/listbox.tcl b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/listbox.tcl similarity index 99% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/listbox.tcl rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/listbox.tcl index ff63ba30..fc8ac1e4 100644 --- a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/listbox.tcl +++ b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/listbox.tcl @@ -802,11 +802,12 @@ proc ListBox::edit { path item text {verifycmd ""} {clickres 0} {select 1}} { -selectforeground [Widget::getoption $path -selectforeground] \ -selectbackground $sbg \ -font [_getoption $path $item -font] \ - -textvariable ListBox::_edit(text)] + -textvariable ::ListBox::_edit(text)] pack $ent -ipadx 8 -anchor w set idw [$path.c create window $x $y -window $frame -anchor w] - trace variable ListBox::_edit(text) w [list ListBox::_update_edit_size $path $ent $idw $wmax] + trace add variable _edit(text) write \ + [list ::ListBox::_update_edit_size $path $ent $idw $wmax] tkwait visibility $ent grab $frame BWidget::focus set $ent @@ -833,7 +834,8 @@ proc ListBox::edit { path item text {verifycmd ""} {clickres 0} {select 1}} { set ok 1 } } - trace vdelete ListBox::_edit(text) w [list ListBox::_update_edit_size $path $ent $idw $wmax] + trace remove variable _edit(text) write \ + [list ListBox::_update_edit_size $path $ent $idw $wmax] grab release $frame BWidget::focus release $ent destroy $frame @@ -909,6 +911,10 @@ proc ListBox::_destroy { path } { variable $path upvar 0 $path data + if { ![info exists data] && [string match ".#BWidget.#Class*" $path] } { + # this is a proxy win to query xrdb + return + } if { $data(upd,afterid) != "" } { after cancel $data(upd,afterid) } diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/mainframe.tcl b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/mainframe.tcl similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/mainframe.tcl rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/mainframe.tcl diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/messagedlg.tcl b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/messagedlg.tcl similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/messagedlg.tcl rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/messagedlg.tcl diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/notebook.tcl b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/notebook.tcl similarity index 99% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/notebook.tcl rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/notebook.tcl index fec3f297..9ac7a6ef 100644 --- a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/notebook.tcl +++ b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/notebook.tcl @@ -461,11 +461,15 @@ proc NoteBook::_destroy { path } { variable $path upvar 0 $path data + if { ![info exists data] && [string match ".#BWidget.#Class*" $path] } { + # this is a proxy win to query xrdb + return + } foreach page $data(pages) { Widget::destroy $path.f$page } Widget::destroy $path - unset data + unset -nocomplain data } diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/pagesmgr.tcl b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/pagesmgr.tcl similarity index 99% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/pagesmgr.tcl rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/pagesmgr.tcl index 5d328b58..58e0e13f 100644 --- a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/pagesmgr.tcl +++ b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/pagesmgr.tcl @@ -20,7 +20,7 @@ # - PagesManager::_draw_area # - PagesManager::_realize # ------------------------------------------------------------------------------ -package require Tcl 8.1.1 +package require Tcl 8.1.1 9 namespace eval PagesManager { Widget::define PagesManager pagesmgr diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/panedw.tcl b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/panedw.tcl similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/panedw.tcl rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/panedw.tcl diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/panelframe.tcl b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/panelframe.tcl similarity index 95% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/panelframe.tcl rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/panelframe.tcl index fb8bc193..e9f93487 100644 --- a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/panelframe.tcl +++ b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/panelframe.tcl @@ -1,246 +1,246 @@ -# ---------------------------------------------------------------------------- -# panelframe.tcl -# Create PanelFrame widgets. -# A PanelFrame is a boxed frame that allows you to place items -# in the label area (liked combined frame+toolbar). It uses the -# highlight colors the default frame color. -# $Id: panelframe.tcl,v 1.1 2004/09/09 22:17:51 hobbs Exp $ -# ---------------------------------------------------------------------------- -# Index of commands: -# - PanelFrame::create -# - PanelFrame::configure -# - PanelFrame::cget -# - PanelFrame::getframe -# - PanelFrame::add -# - PanelFrame::remove -# - PanelFrame::items -# ---------------------------------------------------------------------------- - -namespace eval PanelFrame { - Widget::define PanelFrame panelframe - - Widget::declare PanelFrame { - {-background TkResource "" 0 frame} - {-borderwidth TkResource 1 0 frame} - {-relief TkResource flat 0 frame} - {-panelbackground TkResource "" 0 {entry -selectbackground}} - {-panelforeground TkResource "" 0 {entry -selectforeground}} - {-width Int 0 0} - {-height Int 0 0} - {-font TkResource "" 0 label} - {-text String "" 0} - {-textvariable String "" 0} - {-ipad String 1 0} - {-bg Synonym -background} - {-bd Synonym -borderwidth} - } - # Should we have automatic state handling? - #{-state TkResource "" 0 label} - - Widget::addmap PanelFrame "" :cmd { - -panelbackground -background - -width {} -height {} -borderwidth {} -relief {} - } - Widget::addmap PanelFrame "" .title { - -panelbackground -background - } - Widget::addmap PanelFrame "" .title.text { - -panelbackground -background - -panelforeground -foreground - -text {} -textvariable {} -font {} - } - Widget::addmap PanelFrame "" .frame { - -background {} - } - - if {0} { - # This would be code to have an automated close button - #{-closebutton Boolean 0 0} - Widget::addmap PanelFrame "" .title.close { - -panelbackground -background - -panelforeground -foreground - } - variable HaveMarlett \ - [expr {[lsearch -exact [font families] "Marlett"] != -1}] - - variable imgdata { - #define close_width 16 - #define close_height 16 - static char close_bits[] = { - 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x10, 0x08, - 0x38, 0x1c, 0x70, 0x0e, - 0xe0, 0x07, 0xc0, 0x03, - 0xc0, 0x03, 0xe0, 0x07, - 0x70, 0x0e, 0x38, 0x1c, - 0x10, 0x08, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00}; - } - # We use the same -foreground as the default -panelbackground - image create bitmap ::PanelFrame::X -data $imgdata \ - -foreground [lindex $Widget::PanelFrame::opt(-panelbackground) 1] - } - - bind PanelFrame [list Widget::destroy %W] -} - - -# ---------------------------------------------------------------------------- -# Command PanelFrame::create -# ---------------------------------------------------------------------------- -proc PanelFrame::create { path args } { - variable HaveMarlett - - Widget::init PanelFrame $path $args - - set lblopts [list -bd 0 -highlightthickness 0] - set outer [eval [list frame $path -class PanelFrame] \ - [Widget::subcget $path :cmd]] - set title [eval [list frame $path.title] \ - [Widget::subcget $path .title]] - set tlbl [eval [list label $path.title.text] $lblopts -anchor w \ - [Widget::subcget $path .title.text]] - set inner [eval [list frame $path.frame] \ - [Widget::subcget $path .frame]] - - foreach {ipadx ipady} [_padval [Widget::cget $path -ipad]] { break } - - if {0} { - set btnopts [list -padx 0 -pady 0 -relief flat -overrelief raised \ - -bd 1 -highlightthickness 0] - set clbl [eval [list button $path.title.close] $btnopts \ - [Widget::subcget $path .title.close]] - set close [Widget::cget $path -closebutton] - if {$HaveMarlett} { - $clbl configure -font "Marlett -14" -text \u0072 - } else { - $clbl configure -image ::PanelFrame::X - } - if {$close} { - pack $path.title.close -side right -padx $ipadx -pady $ipady - } - } - - grid $path.title -row 0 -column 0 -sticky ew - grid $path.frame -row 1 -column 0 -sticky news - grid columnconfigure $path 0 -weight 1 - grid rowconfigure $path 1 -weight 1 - - pack $path.title.text -side left -fill x -anchor w \ - -padx $ipadx -pady $ipady - - return [Widget::create PanelFrame $path] -} - - -# ---------------------------------------------------------------------------- -# Command PanelFrame::configure -# ---------------------------------------------------------------------------- -proc PanelFrame::configure { path args } { - set res [Widget::configure $path $args] - - if {[Widget::hasChanged $path -ipad ipad]} { - } - - return $res -} - - -# ---------------------------------------------------------------------------- -# Command PanelFrame::cget -# ---------------------------------------------------------------------------- -proc PanelFrame::cget { path option } { - return [Widget::cget $path $option] -} - -# ---------------------------------------------------------------------------- -# Command PanelFrame::getframe -# ---------------------------------------------------------------------------- -proc PanelFrame::getframe { path } { - return $path.frame -} - -# ------------------------------------------------------------------------ -# Command PanelFrame::add -# ------------------------------------------------------------------------ -proc PanelFrame::add {path w args} { - variable _widget - - array set opts [list \ - -side right \ - -fill none \ - -expand 0 \ - -pad [Widget::cget $path -ipad] \ - ] - foreach {key val} $args { - if {[info exists opts($key)]} { - set opts($key) $val - } else { - set msg "unknown option \"$key\", must be one of: " - append msg [join [lsort [array names opts]] {, }] - return -code error $msg - } - } - foreach {ipadx ipady} [_padval $opts(-pad)] { break } - - set f $path.title - - lappend _widget($path,items) $w - pack $w -in $f -padx $ipadx -pady $ipady -side $opts(-side) \ - -fill $opts(-fill) -expand $opts(-expand) - - return $w -} - -# ------------------------------------------------------------------------ -# Command PanelFrame::remove -# ------------------------------------------------------------------------ -proc PanelFrame::remove {path args} { - variable _widget - - set destroy [string equal [lindex $args 0] "-destroy"] - if {$destroy} { - set args [lrange $args 1 end] - } - foreach w $args { - set idx [lsearch -exact $_widget($path,items) $w] - if {$idx == -1} { - # ignore unknown - continue - } - if {$destroy} { - destroy $w - } elseif {[winfo exists $w]} { - pack forget $w - } - set _widget($path,items) [lreplace $_widget($path,items) $idx $idx] - } -} - -# ------------------------------------------------------------------------ -# Command PanelFrame::delete -# ------------------------------------------------------------------------ -proc PanelFrame::delete {path args} { - return [PanelFrame::remove $path -destroy $args] -} - -# ------------------------------------------------------------------------ -# Command PanelFrame::items -# ------------------------------------------------------------------------ -proc PanelFrame::items {path} { - variable _widget - return $_widget($path,items) -} - -proc PanelFrame::_padval {padval} { - set len [llength $padval] - foreach {a b} $padval { break } - if {$len == 0 || $len > 2} { - return -code error \ - "invalid pad value \"$padval\", must be 1 or 2 pixel values" - } elseif {$len == 1} { - return [list $a $a] - } elseif {$len == 2} { - return $padval - } -} +# ---------------------------------------------------------------------------- +# panelframe.tcl +# Create PanelFrame widgets. +# A PanelFrame is a boxed frame that allows you to place items +# in the label area (liked combined frame+toolbar). It uses the +# highlight colors the default frame color. +# $Id: panelframe.tcl,v 1.1 2004/09/09 22:17:51 hobbs Exp $ +# ---------------------------------------------------------------------------- +# Index of commands: +# - PanelFrame::create +# - PanelFrame::configure +# - PanelFrame::cget +# - PanelFrame::getframe +# - PanelFrame::add +# - PanelFrame::remove +# - PanelFrame::items +# ---------------------------------------------------------------------------- + +namespace eval PanelFrame { + Widget::define PanelFrame panelframe + + Widget::declare PanelFrame { + {-background TkResource "" 0 frame} + {-borderwidth TkResource 1 0 frame} + {-relief TkResource flat 0 frame} + {-panelbackground TkResource "" 0 {entry -selectbackground}} + {-panelforeground TkResource "" 0 {entry -selectforeground}} + {-width Int 0 0} + {-height Int 0 0} + {-font TkResource "" 0 label} + {-text String "" 0} + {-textvariable String "" 0} + {-ipad String 1 0} + {-bg Synonym -background} + {-bd Synonym -borderwidth} + } + # Should we have automatic state handling? + #{-state TkResource "" 0 label} + + Widget::addmap PanelFrame "" :cmd { + -panelbackground -background + -width {} -height {} -borderwidth {} -relief {} + } + Widget::addmap PanelFrame "" .title { + -panelbackground -background + } + Widget::addmap PanelFrame "" .title.text { + -panelbackground -background + -panelforeground -foreground + -text {} -textvariable {} -font {} + } + Widget::addmap PanelFrame "" .frame { + -background {} + } + + if {0} { + # This would be code to have an automated close button + #{-closebutton Boolean 0 0} + Widget::addmap PanelFrame "" .title.close { + -panelbackground -background + -panelforeground -foreground + } + variable HaveMarlett \ + [expr {[lsearch -exact [font families] "Marlett"] != -1}] + + variable imgdata { + #define close_width 16 + #define close_height 16 + static char close_bits[] = { + 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x10, 0x08, + 0x38, 0x1c, 0x70, 0x0e, + 0xe0, 0x07, 0xc0, 0x03, + 0xc0, 0x03, 0xe0, 0x07, + 0x70, 0x0e, 0x38, 0x1c, + 0x10, 0x08, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00}; + } + # We use the same -foreground as the default -panelbackground + image create bitmap ::PanelFrame::X -data $imgdata \ + -foreground [lindex $::Widget::PanelFrame::opt(-panelbackground) 1] + } + + bind PanelFrame [list Widget::destroy %W] +} + + +# ---------------------------------------------------------------------------- +# Command PanelFrame::create +# ---------------------------------------------------------------------------- +proc PanelFrame::create { path args } { + variable HaveMarlett + + Widget::init PanelFrame $path $args + + set lblopts [list -bd 0 -highlightthickness 0] + set outer [eval [list frame $path -class PanelFrame] \ + [Widget::subcget $path :cmd]] + set title [eval [list frame $path.title] \ + [Widget::subcget $path .title]] + set tlbl [eval [list label $path.title.text] $lblopts -anchor w \ + [Widget::subcget $path .title.text]] + set inner [eval [list frame $path.frame] \ + [Widget::subcget $path .frame]] + + foreach {ipadx ipady} [_padval [Widget::cget $path -ipad]] { break } + + if {0} { + set btnopts [list -padx 0 -pady 0 -relief flat -overrelief raised \ + -bd 1 -highlightthickness 0] + set clbl [eval [list button $path.title.close] $btnopts \ + [Widget::subcget $path .title.close]] + set close [Widget::cget $path -closebutton] + if {$HaveMarlett} { + $clbl configure -font "Marlett -14" -text \u0072 + } else { + $clbl configure -image ::PanelFrame::X + } + if {$close} { + pack $path.title.close -side right -padx $ipadx -pady $ipady + } + } + + grid $path.title -row 0 -column 0 -sticky ew + grid $path.frame -row 1 -column 0 -sticky news + grid columnconfigure $path 0 -weight 1 + grid rowconfigure $path 1 -weight 1 + + pack $path.title.text -side left -fill x -anchor w \ + -padx $ipadx -pady $ipady + + return [Widget::create PanelFrame $path] +} + + +# ---------------------------------------------------------------------------- +# Command PanelFrame::configure +# ---------------------------------------------------------------------------- +proc PanelFrame::configure { path args } { + set res [Widget::configure $path $args] + + if {[Widget::hasChanged $path -ipad ipad]} { + } + + return $res +} + + +# ---------------------------------------------------------------------------- +# Command PanelFrame::cget +# ---------------------------------------------------------------------------- +proc PanelFrame::cget { path option } { + return [Widget::cget $path $option] +} + +# ---------------------------------------------------------------------------- +# Command PanelFrame::getframe +# ---------------------------------------------------------------------------- +proc PanelFrame::getframe { path } { + return $path.frame +} + +# ------------------------------------------------------------------------ +# Command PanelFrame::add +# ------------------------------------------------------------------------ +proc PanelFrame::add {path w args} { + variable _widget + + array set opts [list \ + -side right \ + -fill none \ + -expand 0 \ + -pad [Widget::cget $path -ipad] \ + ] + foreach {key val} $args { + if {[info exists opts($key)]} { + set opts($key) $val + } else { + set msg "unknown option \"$key\", must be one of: " + append msg [join [lsort [array names opts]] {, }] + return -code error $msg + } + } + foreach {ipadx ipady} [_padval $opts(-pad)] { break } + + set f $path.title + + lappend _widget($path,items) $w + pack $w -in $f -padx $ipadx -pady $ipady -side $opts(-side) \ + -fill $opts(-fill) -expand $opts(-expand) + + return $w +} + +# ------------------------------------------------------------------------ +# Command PanelFrame::remove +# ------------------------------------------------------------------------ +proc PanelFrame::remove {path args} { + variable _widget + + set destroy [string equal [lindex $args 0] "-destroy"] + if {$destroy} { + set args [lrange $args 1 end] + } + foreach w $args { + set idx [lsearch -exact $_widget($path,items) $w] + if {$idx == -1} { + # ignore unknown + continue + } + if {$destroy} { + destroy $w + } elseif {[winfo exists $w]} { + pack forget $w + } + set _widget($path,items) [lreplace $_widget($path,items) $idx $idx] + } +} + +# ------------------------------------------------------------------------ +# Command PanelFrame::delete +# ------------------------------------------------------------------------ +proc PanelFrame::delete {path args} { + return [PanelFrame::remove $path -destroy $args] +} + +# ------------------------------------------------------------------------ +# Command PanelFrame::items +# ------------------------------------------------------------------------ +proc PanelFrame::items {path} { + variable _widget + return $_widget($path,items) +} + +proc PanelFrame::_padval {padval} { + set len [llength $padval] + foreach {a b} $padval { break } + if {$len == 0 || $len > 2} { + return -code error \ + "invalid pad value \"$padval\", must be 1 or 2 pixel values" + } elseif {$len == 1} { + return [list $a $a] + } elseif {$len == 2} { + return $padval + } +} diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/passwddlg.tcl b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/passwddlg.tcl similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/passwddlg.tcl rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/passwddlg.tcl diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/pkgIndex.tcl b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/pkgIndex.tcl similarity index 96% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/pkgIndex.tcl rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/pkgIndex.tcl index 0a4703f3..d0717b00 100644 --- a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/pkgIndex.tcl +++ b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/pkgIndex.tcl @@ -1,9 +1,9 @@ if {[catch {package require Tcl}]} return # NOTE: auto_loaded top-level commands shall not be qualified (no leading ::) # but all others should. See auto_qualify for details. -package ifneeded BWidget 1.9.16 "\ - package require Tk 8.1.1-;\ - [list tclPkgSetup $dir BWidget 1.9.16 { +package ifneeded BWidget 1.10.1 "\ + package require Tk 8.1.1 9;\ + [list tclPkgSetup $dir BWidget 1.10.1 { {arrow.tcl source {ArrowButton ::ArrowButton::create ::ArrowButton::use}} {labelframe.tcl source {LabelFrame ::LabelFrame::create ::LabelFrame::use}} {labelentry.tcl source {LabelEntry ::LabelEntry::create ::LabelEntry::use}} diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/progressbar.tcl b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/progressbar.tcl similarity index 96% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/progressbar.tcl rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/progressbar.tcl index 73c48f25..1dc29205 100644 --- a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/progressbar.tcl +++ b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/progressbar.tcl @@ -65,7 +65,7 @@ proc ProgressBar::create { path args } { set _widget($path,dir) 1 set _widget($path,var) [Widget::cget $path -variable] if {$_widget($path,var) != ""} { - GlobalVar::tracevar variable $_widget($path,var) w \ + GlobalVar::tracevar variable $_widget($path,var) write \ [list ProgressBar::_modify $path] set _widget($path,afterid) \ [after idle [list ProgressBar::_modify $path]] @@ -89,12 +89,12 @@ proc ProgressBar::configure { path args } { if { [Widget::hasChangedX $path -variable] } { set newv [Widget::cget $path -variable] if { $_widget($path,var) != "" } { - GlobalVar::tracevar vdelete $_widget($path,var) w \ + GlobalVar::tracevar vdelete $_widget($path,var) write \ [list ProgressBar::_modify $path] } if { $newv != "" } { set _widget($path,var) $newv - GlobalVar::tracevar variable $newv w \ + GlobalVar::tracevar variable $newv write \ [list ProgressBar::_modify $path] if {![info exists _widget($path,afterid)]} { set _widget($path,afterid) \ @@ -198,7 +198,7 @@ proc ProgressBar::_destroy { path } { } if {[info exists _widget($path,var)]} { if {$_widget($path,var) != ""} { - GlobalVar::tracevar vdelete $_widget($path,var) w \ + GlobalVar::tracevar vdelete $_widget($path,var) write \ [list ProgressBar::_modify $path] } unset _widget($path,var) diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/progressdlg.tcl b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/progressdlg.tcl similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/progressdlg.tcl rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/progressdlg.tcl diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/scrollframe.tcl b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/scrollframe.tcl similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/scrollframe.tcl rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/scrollframe.tcl diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/scrollview.tcl b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/scrollview.tcl similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/scrollview.tcl rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/scrollview.tcl diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/scrollw.tcl b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/scrollw.tcl similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/scrollw.tcl rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/scrollw.tcl diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/separator.tcl b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/separator.tcl similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/separator.tcl rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/separator.tcl diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/spinbox.tcl b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/spinbox.tcl similarity index 99% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/spinbox.tcl rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/spinbox.tcl index 5689ba4f..ac4fe99e 100644 --- a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/spinbox.tcl +++ b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/spinbox.tcl @@ -76,7 +76,7 @@ proc SpinBox::create { path args } { [list -highlightthickness 0 -takefocus 0 -class SpinBox] Widget::initFromODB SpinBox $path $maps(SpinBox) - if {$Widget::_theme} { + if {$::Widget::_theme} { set entry [eval [list Entry::create $path.e] $maps(.e)] } else { set entry [eval [list Entry::create $path.e] $maps(.e) -relief flat -bd 0] diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/statusbar.tcl b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/statusbar.tcl similarity index 99% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/statusbar.tcl rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/statusbar.tcl index 568c4acd..932d18d9 100644 --- a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/statusbar.tcl +++ b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/statusbar.tcl @@ -10,7 +10,7 @@ # otherwise the resize behavior may behave oddly. # ------------------------------------------------------------------------ -package require Tk 8.3 +package require Tk 8.3 9 if {0} { proc sample {} { diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/tests/entry.test b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/tests/entry.test similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/tests/entry.test rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/tests/entry.test diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/titleframe.tcl b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/titleframe.tcl similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/titleframe.tcl rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/titleframe.tcl diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/tree.tcl b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/tree.tcl similarity index 98% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/tree.tcl rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/tree.tcl index 55f86a9d..08d6159c 100644 --- a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/tree.tcl +++ b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/tree.tcl @@ -890,16 +890,19 @@ proc Tree::nodes { path node {first ""} {last ""} } { if { ![info exists data($node)] } { return -code error "node \"$node\" does not exist" } - + set nodes {} + set res {} if { ![string length $first] } { - return [lrange $data($node) 1 end] - } - - if { ![string length $last] } { - return [lindex [lrange $data($node) 1 end] $first] + set nodes [lrange $data($node) 1 end] + } elseif { ![string length $last] } { + set nodes [lindex [lrange $data($node) 1 end] $first] } else { - return [lrange [lrange $data($node) 1 end] $first $last] + set nodes [lrange [lrange $data($node) 1 end] $first $last] } + foreach n $nodes { + lappend res [_node_name_rev $path $n] + } + return $res } @@ -1044,11 +1047,11 @@ proc Tree::edit { path node text {verifycmd ""} {clickres 0} {select 1}} { -selectforeground [Widget::getoption $path -selectforeground] \ -selectbackground $sbg \ -font [Widget::getoption $path.$node -font] \ - -textvariable Tree::_edit(text)] + -textvariable ::Tree::_edit(text)] pack $ent -ipadx 8 -anchor w set idw [$path.c create window $x $y -window $frame -anchor w] - trace variable Tree::_edit(text) w \ + trace add variable _edit(text) write \ [list Tree::_update_edit_size $path $ent $idw $wmax] tkwait visibility $ent grab $frame @@ -1071,14 +1074,14 @@ proc Tree::edit { path node text {verifycmd ""} {clickres 0} {select 1}} { set ok 0 while { !$ok } { - tkwait variable Tree::_edit(wait) + tkwait variable ::Tree::_edit(wait) if { !$_edit(wait) || [llength $verifycmd]==0 || [uplevel \#0 $verifycmd [list $_edit(text)]] } { set ok 1 } } - trace vdelete Tree::_edit(text) w \ + trace remove variable _edit(text) write \ [list Tree::_update_edit_size $path $ent $idw $wmax] grab release $frame BWidget::focus release $ent @@ -2054,6 +2057,10 @@ proc Tree::_keynav {which win} { # The current node. proc Tree::_get_current_node {win} { + # TCL9 does not resolve sub-namespaces from parents (root) any more. + # The following sub-namespace ::Tree::selectTree was not observed + # on run-time tests. Nor ::selectTree + # So keep this for TCL 9 if {[info exists selectTree::selectCursor($win)]} { set result $selectTree::selectCursor($win) } elseif {[llength [set selList [$win selection get]]]} { @@ -2215,13 +2222,13 @@ proc Tree::_mouse_select { path cmd args } { proc Tree::_node_name { path node } { # Make sure node names are safe as tags and variable names - set map [list & \1 | \2 ^ \3 ! \4 :: \5] + set map [list & \1 | \2 ^ \3 ! \4 : \5] return [string map $map $node] } proc Tree::_node_name_rev { path node } { # Allow reverse interpretation of node names - set map [list \1 & \2 | \3 ^ \4 ! \5 ::] + set map [list \1 & \2 | \3 ^ \4 ! \5 :] return [string map $map $node] } @@ -2233,6 +2240,10 @@ proc Tree::_destroy { path } { variable $path upvar 0 $path data + if { ![info exists data] && [string match ".#BWidget.#Class*" $path] } { + # this is a proxy win to query xrdb + return + } if { $data(upd,afterid) != "" } { after cancel $data(upd,afterid) } diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/utils.tcl b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/utils.tcl similarity index 99% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/utils.tcl rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/utils.tcl index 16385c25..d05782b2 100644 --- a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/utils.tcl +++ b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/utils.tcl @@ -57,7 +57,11 @@ proc GlobalVar::getvar { varName } { # Command GlobalVar::tracevar # ---------------------------------------------------------------------------- proc GlobalVar::tracevar { cmd varName args } { - return [uplevel \#0 [list trace $cmd $varName] $args] + array set cmdmap { + variable {add variable} + vdelete {remove variable} + } + return [uplevel \#0 trace $cmdmap($cmd) [list $varName] $args] } diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/widget.tcl b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/widget.tcl similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/widget.tcl rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/widget.tcl diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/wizard.tcl b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/wizard.tcl similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/wizard.tcl rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/wizard.tcl diff --git a/src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/xpm2image.tcl b/src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/xpm2image.tcl similarity index 100% rename from src/vfs/_vfscommon.vfs/lib/BWidget1.9.16/xpm2image.tcl rename to src/vfs/_vfscommon.vfs/lib/BWidget1.10.1/xpm2image.tcl diff --git a/src/vfs/_vfscommon.vfs/lib/app-shellspy/shellspy.tcl b/src/vfs/_vfscommon.vfs/lib/app-shellspy/shellspy.tcl index 7c4a3044..6d86b29c 100644 --- a/src/vfs/_vfscommon.vfs/lib/app-shellspy/shellspy.tcl +++ b/src/vfs/_vfscommon.vfs/lib/app-shellspy/shellspy.tcl @@ -808,29 +808,36 @@ set ::argv [list %a%] set ::argc [llength $::argv] set ::argv0 $normscript info script $normscript -source $normscript +source $normscript #restore values -info script $prevscript +info script $prevscript dict with prevglobal {} - }] + }] set repl_lines "" #append repl_lines {puts stderr "starting repl [chan names]"} \n #append repl_lines {puts stderr "stdin [chan configure stdin]"} \n - append repl_lines {package require punk::repl} \n - append repl_lines {repl::init -safe 0} \n - append repl_lines {repl::start stdin} \n - #append repl_lines {puts stdout "shutdown message"} \n + if {$replwhen eq "repl_first"} { #we need to cooperate with the repl to get the script to run on exit namespace eval ::repl {} set ::repl::post_script $script + + append repl_lines {package require punk::repl} \n + append repl_lines {repl::init -safe 0} \n + append repl_lines {repl::start stdin} \n set script "$repl_lines" } elseif {$replwhen eq "repl_last"} { - append script $repl_lines + append repl_lines {package require punk::repl} \n + append repl_lines {repl::init -safe 0} \n + append repl_lines [list repl::submit stdin "eval \{ $script \};\n"] \n + append repl_lines {repl::start stdin} \n + + #append script $repl_lines + set script $repl_lines } else { #just the script } diff --git a/src/vfs/_vfscommon.vfs/modules/punk/args-0.2.1.tm b/src/vfs/_vfscommon.vfs/modules/punk/args-0.2.1.tm index 1a18006b..beb0bc9f 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/args-0.2.1.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/args-0.2.1.tm @@ -8011,7 +8011,7 @@ tcl::namespace::eval punk::args { #valmin, valmax #puts stderr "remaining_rawargs: $remaining_rawargs" #puts stderr "argstate: $argstate" - if {$OPT_MAX ne "0" && [lsearch $remaining_rawargs -*] >= 0} { + if {$OPT_MAX ne "0" && [lsearch $remaining_rawargs -*] > -1} { #contains at least one possible flag set maxidx [expr {[llength $remaining_rawargs] -1}] if {$valmax == -1} { @@ -8966,6 +8966,8 @@ tcl::namespace::eval punk::args { #review - ensure all possible keys present in thisarg_keys + set pkoverride [Dict_getdef $argstate -parsekey ""] + tcl::dict::for {argname_or_ident value_group} $opts_and_values { # #parsekey: key used in resulting leaders opts values dictionaries @@ -8987,7 +8989,7 @@ tcl::namespace::eval punk::args { #get full option name such as -fg|-foreground from non-alias name such as -foreground #if "@opts -any|-arbitrary true" - we may have an option that wasn't defined set argname [dict get $lookup_optset $argname_or_ident] - set pkoverride [Dict_getdef $argstate -parsekey ""] + #set pkoverride [Dict_getdef $argstate -parsekey ""] if {$pkoverride ne ""} { set parsekey $pkoverride } else { @@ -9000,7 +9002,7 @@ tcl::namespace::eval punk::args { } } else { set argname $argname_or_ident - set pkoverride [Dict_getdef $argstate -parsekey ""] + #set pkoverride [Dict_getdef $argstate -parsekey ""] if {$pkoverride ne ""} { set parsekey $pkoverride } else { @@ -9082,7 +9084,7 @@ tcl::namespace::eval punk::args { set vlist_original $vlist ;#retain for possible final strip_ansi #review - validationtransform - if {$is_validate_ansistripped} { + if {[llength $vlist] && $is_validate_ansistripped} { #validate_ansistripped 1 package require punk::ansi set vlist_check [list] @@ -9432,34 +9434,34 @@ tcl::namespace::eval punk::args { } } - #is_allow_ansi doesn't apply to a value matching a supplied -default, or values matching those in -choices/-choicegroups - #assert: our vlist & vlist_check lists have been reduced to remove those - if {!$is_allow_ansi && [llength $vlist]} { - #allow_ansi 0 - package require punk::ansi - #do not run ta::detect on a list - foreach clause_value $vlist { - foreach e $clause_value { - if {[punk::ansi::ta::detect $e]} { - set msg "$argclass '$argname' for %caller% contains ansi - but -allow_ansi is false. character-view: '[punk::ansi::ansistring VIEW $e]'" - return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list contentviolation ansi] -badarg $argname -argspecs $argspecs]] $msg + if {[llength $vlist]} { + #is_allow_ansi doesn't apply to a value matching a supplied -default, or values matching those in -choices/-choicegroups + #assert: our vlist & vlist_check lists have been reduced to remove those + if {!$is_allow_ansi} { + #allow_ansi 0 + package require punk::ansi + #do not run ta::detect on a list + foreach clause_value $vlist { + foreach e $clause_value { + if {[punk::ansi::ta::detect $e]} { + set msg "$argclass '$argname' for %caller% contains ansi - but -allow_ansi is false. character-view: '[punk::ansi::ansistring VIEW $e]'" + return -options [list -code error -errorcode [list PUNKARGS VALIDATION [list contentviolation ansi] -badarg $argname -argspecs $argspecs]] $msg + } } } } - } - #puts "argname:$argname v:$v is_default:$is_default" - #we want defaults to pass through - even if they don't pass the checks that would be required for a specified value - #If the caller manually specified a value that happens to match the default - we don't detect that as any different from an unspecified value - Review. - #arguments that are at their default are not subject to type and other checks + #puts "argname:$argname v:$v is_default:$is_default" + #we want defaults to pass through - even if they don't pass the checks that would be required for a specified value + #If the caller manually specified a value that happens to match the default - we don't detect that as any different from an unspecified value - Review. + #arguments that are at their default are not subject to type and other checks - #don't validate defaults or choices that matched - #puts "---> opts_and_values: $opts_and_values" - #puts "===> argname: $argname is_default: $is_default is_choice: $is_choice" - #if {(!$has_choices && !$is_default) || ($has_choices && (!$is_default && !$choices_all_match))} {} + #don't validate defaults or choices that matched + #puts "---> opts_and_values: $opts_and_values" + #puts "===> argname: $argname is_default: $is_default is_choice: $is_choice" + #if {(!$has_choices && !$is_default) || ($has_choices && (!$is_default && !$choices_all_match))} {} - #our validation-required list could have been reduced to none e.g if match -default or defined -choices/-choicegroups - #assert [llength $vlist] == [llength $vlist_check] - if {[llength $vlist]} { + #our validation-required list could have been reduced to none e.g if match -default or defined -choices/-choicegroups + #assert [llength $vlist] == [llength $vlist_check] #$t = clause column #for {set clausecolumn 0} {$clausecolumn < [llength $typelist]} {incr clausecolumn} {} @@ -9493,37 +9495,37 @@ tcl::namespace::eval punk::args { } - - } - - if {$is_strip_ansi} { - set stripped_list [lmap e $vlist_original {punk::ansi::ansistrip $e}] ;#no faster or slower, but more concise than foreach - if {$is_multiple} { - switch -- [tcl::dict::get $thisarg -ARGTYPE] { - leader { - tcl::dict::set leaders_dict $argname_or_ident $stripped_list - } - option { - tcl::dict::set opts $argname_or_ident $stripped_list - } - value { - tcl::dict::set values_dict $argname_or_ident $stripped_list - } - } - } else { - switch -- [tcl::dict::get $thisarg -ARGTYPE] { - leader { - tcl::dict::set leaders_dict $argname_or_ident [lindex $stripped_list 0] - } - option { - tcl::dict::set opts $argname_or_ident [lindex $stripped_list 0] + if {$is_strip_ansi} { + set stripped_list [lmap e $vlist_original {punk::ansi::ansistrip $e}] ;#no faster or slower, but more concise than foreach + if {$is_multiple} { + switch -- [tcl::dict::get $thisarg -ARGTYPE] { + leader { + tcl::dict::set leaders_dict $argname_or_ident $stripped_list + } + option { + tcl::dict::set opts $argname_or_ident $stripped_list + } + value { + tcl::dict::set values_dict $argname_or_ident $stripped_list + } } - value { - tcl::dict::set values_dict $argname_or_ident [lindex $stripped_list 0] + } else { + switch -- [tcl::dict::get $thisarg -ARGTYPE] { + leader { + tcl::dict::set leaders_dict $argname_or_ident [lindex $stripped_list 0] + } + option { + tcl::dict::set opts $argname_or_ident [lindex $stripped_list 0] + } + value { + tcl::dict::set values_dict $argname_or_ident [lindex $stripped_list 0] + } } } } + } + } set finalopts [dict create] diff --git a/src/vfs/_vfscommon.vfs/modules/punk/repl-0.1.2.tm b/src/vfs/_vfscommon.vfs/modules/punk/repl-0.1.2.tm index 0272500d..486720e8 100644 --- a/src/vfs/_vfscommon.vfs/modules/punk/repl-0.1.2.tm +++ b/src/vfs/_vfscommon.vfs/modules/punk/repl-0.1.2.tm @@ -479,7 +479,13 @@ proc repl::start {inchan args} { puts stderr "-->repl::start active on $inchan $args replthread:[thread::id] codethread:$codethread" set prompt_config [punk::repl::get_prompt_config] doprompt "P% " - chan event $inchan readable [list [namespace current]::repl_handler $inchan $prompt_config] + if {[llength $input_chunks_waiting($inchan)]} { + set readmore 0 + uplevel #0 [list [namespace current]::repl_handler $inchan $readmore $prompt_config] + #after 0 [list [namespace current]::repl_handler $inchan $readmore $prompt_config] + } + set readmore 1 + chan event $inchan readable [list [namespace current]::repl_handler $inchan $readmore $prompt_config] set reading 1 #catch { @@ -530,6 +536,22 @@ proc repl::start {inchan args} { #puts stderr "__> returning 0" return 0 } + +#put a script into the waiting buffer for evaluation +proc repl::submit {inputchan script} { + set prompt_config [punk::repl::get_prompt_config] + upvar ::punk::console::input_chunks_waiting input_chunks_waiting + if {[info exists input_chunks_waiting($inputchan)] && [llength $input_chunks_waiting($inputchan)]} { + set last [lindex $input_chunks_waiting($inputchan) end] + append last $script + lset input_chunks_waiting($inputchan) end $last + } else { + set input_chunks_waiting($inputchan) [list $script] + } + + #set readmore 0 + #after idle [list after 0 [list ::repl::repl_handler $inputchan $readmore $prompt_config]] +} proc repl::post_operations {} { if {[info exists ::repl::post_script] && [string length $::repl::post_script]} { #put aside post_script so the script has the option to add another post_script and restart the repl @@ -1384,7 +1406,10 @@ proc punk::repl::repl_handler_restorechannel_if_not_eof {inputchan previous_inpu } return [chan conf $inputchan] } -proc repl::repl_handler {inputchan prompt_config} { +proc repl::repl_handler {inputchan readmore prompt_config} { + #readmore set to zero used to process input_chunks_waiting without reading inputchan, + # and without rescheduling reader + # -- review variable in_repl_handler set in_repl_handler [list $inputchan $prompt_config] @@ -1451,115 +1476,132 @@ proc repl::repl_handler {inputchan prompt_config} { set waitingchunk [lindex $waitinglines end] # -- #set chunksize [gets $inputchan chunk] - set chunk [read $inputchan] - set chunksize [string length $chunk] - # -- - if {$chunksize > 0} { - if {[string index $chunk end] eq "\n"} { - lappend stdinlines $waitingchunk[string range $chunk 0 end-1] - #punk::console::cursorsave_move_emitblock_return 30 30 "repl_handler num_stdinlines [llength $stdinlines] chunk:$yellow[ansistring VIEW -lf 1 $chunk][a] fblocked:[fblocked $inputchan] pending:[chan pending input stdin]" - - punk::repl::repl_handler_restorechannel_if_not_eof $inputchan $original_input_conf - uplevel #0 [list repl::repl_process_data $inputchan line "" $stdinlines $prompt_config] - } else { - set input_chunks_waiting($inputchan) [list $allwaiting] - lappend input_chunks_waiting($inputchan) $chunk - } + if {!$readmore} { + set chunk "" + set chunksize 0 + uplevel #0 [list repl::repl_process_data $inputchan line "" $stdinlines $prompt_config] + set input_chunks_waiting($inputchan) [list $waitingchunk] } else { - #'chan blocked' docs state: 'Note that this only ever returns 1 when the channel has been configured to be non-blocking..' - if {[chan blocked $inputchan]} { - #REVIEW - - #todo - figure out why we're here. - #can we even put a spinner so we don't keep emitting lines? We probably can't use any ansi functions that need to get a response on stdin..(like get_cursor_pos) - #punk::console::get_size is problematic if -winsize not available on the stdout channel - which is the case for certain 8.6 versions at least.. platform variances? - ## can't do this: set screeninfo [punk::console::get_size]; lassign $screeninfo _c cols _r rows - set outconf [chan configure stdout] - set RED [punk::ansi::a+ red bold]; set RST [punk::ansi::a] - if {"windows" eq $::tcl_platform(platform)} { - set msg "${RED}$inputchan chan blocked is true. (line-length Tcl windows channel bug?)$RST \{$allwaiting\}" + set chunk [read $inputchan] + set chunksize [string length $chunk] + if {$chunksize > 0} { + if {[string index $chunk end] eq "\n"} { + lappend stdinlines $waitingchunk[string range $chunk 0 end-1] + #punk::console::cursorsave_move_emitblock_return 30 30 "repl_handler num_stdinlines [llength $stdinlines] chunk:$yellow[ansistring VIEW -lf 1 $chunk][a] fblocked:[fblocked $inputchan] pending:[chan pending input stdin]" + + punk::repl::repl_handler_restorechannel_if_not_eof $inputchan $original_input_conf + uplevel #0 [list repl::repl_process_data $inputchan line "" $stdinlines $prompt_config] } else { - set msg "${RED}$inputchan chan blocked is true.$RST \{$allwaiting\}" + set input_chunks_waiting($inputchan) [list $allwaiting] + lappend input_chunks_waiting($inputchan) $chunk } - set cols "" - set rows "" - if {[dict exists $outconf -winsize]} { - lassign [dict get $outconf -winsize] cols rows - } else { - #fallback - try external executable. Which is a bit ugly - #tput can't seem to get dimensions (on FreeBSD at least) when not run interactively - ie via exec. (always returns 80x24 no matter if run with <@stdin) - - #bizarrely - tput can work with exec on windows if it's installed e.g from msys2 - #but can be *slow* compared to unix e.g 400ms+ vs <2ms on FreeBSD ! - #stty -a is 400ms+ vs 500us+ on FreeBSD - + } else { + if {[chan blocked $inputchan]} { + #'chan blocked' docs state: 'Note that this only ever returns 1 when the channel has been configured to be non-blocking..' + #REVIEW - + #todo - figure out why we're here. + #can we even put a spinner so we don't keep emitting lines? We probably can't use any ansi functions that need to get a response on stdin..(like get_cursor_pos) + #punk::console::get_size is problematic if -winsize not available on the stdout channel - which is the case for certain 8.6 versions at least.. platform variances? + ## can't do this: set screeninfo [punk::console::get_size]; lassign $screeninfo _c cols _r rows + set outconf [chan configure stdout] + set RED [punk::ansi::a+ red bold]; set RST [punk::ansi::a] if {"windows" eq $::tcl_platform(platform)} { - set tputcmd [auto_execok tput] - if {$tputcmd ne ""} { - if {![catch {exec {*}$tputcmd cols lines} values]} { - lassign $values cols rows - } - } + set msg "${RED}$inputchan chan blocked is true. (line-length Tcl windows channel bug?)$RST \{$allwaiting\}" + } else { + set msg "${RED}$inputchan chan blocked is true.$RST \{$allwaiting\}" } + set cols "" + set rows "" + if {[dict exists $outconf -winsize]} { + lassign [dict get $outconf -winsize] cols rows + } else { + #fallback1 query terminal + if {![catch {punk::console::get_size} sdict]} { + set cols [dict get $sdict columns] + set rows [dict get $sdict rows] + } + + if {![string is integer -strict $cols] || ![string is integer -strict $rows]} { + + #fallback2 - try external executable. Which is a bit ugly + #tput can't seem to get dimensions (on FreeBSD at least) when not run interactively - ie via exec. (always returns 80x24 no matter if run with <@stdin) + + #bizarrely - tput can work with exec on windows if it's installed e.g from msys2 + #but can be *slow* compared to unix e.g 400ms+ vs <2ms on FreeBSD ! + #stty -a is 400ms+ vs 500us+ on FreeBSD - if {![string is integer -strict $cols] || ![string is integer -strict $rows]} { - #same for all platforms? tested on windows, wsl, FreeBSD - #exec stty -a gives a result on the first line like: - #speed xxxx baud; rows rr; columns cc; - #review - more robust parsing - do we know it's first line? - set sttycmd [auto_execok stty] - if {$sttycmd ne ""} { - #the more parseable: stty -g doesn't give rows/columns - if {![catch {exec {*}$sttycmd -a} result]} { - lassign [split $result \n] firstline - set lineparts [split $firstline {;}] ;#we seem to get segments that look well behaved enough to be treated as tcl lists - review - regex? - set rowinfo [lsearch -index end -inline $lineparts rows] - if {[llength $rowinfo] == 2} { - set rows [lindex $rowinfo 0] + if {"windows" eq $::tcl_platform(platform)} { + set tputcmd [auto_execok tput] + if {$tputcmd ne ""} { + if {![catch {exec {*}$tputcmd cols lines} values]} { + lassign $values cols rows + } } - set colinfo [lsearch -index end -inline $lineparts columns] - if {[llength $colinfo] == 2} { - set cols [lindex $colinfo 0] + } + + if {![string is integer -strict $cols] || ![string is integer -strict $rows]} { + #same for all platforms? tested on windows, wsl, FreeBSD + #exec stty -a gives a result on the first line like: + #speed xxxx baud; rows rr; columns cc; + #review - more robust parsing - do we know it's first line? + set sttycmd [auto_execok stty] + if {$sttycmd ne ""} { + #the more parseable: stty -g doesn't give rows/columns + if {![catch {exec {*}$sttycmd -a} result]} { + lassign [split $result \n] firstline + set lineparts [split $firstline {;}] ;#we seem to get segments that look well behaved enough to be treated as tcl lists - review - regex? + set rowinfo [lsearch -index end -inline $lineparts rows] + if {[llength $rowinfo] == 2} { + set rows [lindex $rowinfo 0] + } + set colinfo [lsearch -index end -inline $lineparts columns] + if {[llength $colinfo] == 2} { + set cols [lindex $colinfo 0] + } + } } } } } - } - if {[string is integer -strict $cols] && [string is integer -strict $rows]} { - #got_dimensions - todo - try spinner? - #puts -nonewline stdout [punk::ansi::move $rows 4]$msg - #use cursorsave_ version which avoids get_cursor_pos_list call - set msglen [ansistring length $msg] - punk::console::cursorsave_move_emitblock_return $rows [expr {$cols - $msglen -1}] $msg ;#supports also vt52 - } else { - #no mechanism to get console dimensions - #we are reduced to continuously spewing lines. - puts stderr $msg - } + if {[string is integer -strict $cols] && [string is integer -strict $rows]} { + #got_dimensions - todo - try spinner? + #puts -nonewline stdout [punk::ansi::move $rows 4]$msg + #use cursorsave_ version which avoids get_cursor_pos_list call + set msglen [ansistring length $msg] + punk::console::cursorsave_move_emitblock_return $rows [expr {$cols - $msglen -1}] $msg ;#supports also vt52 + } else { + #no mechanism to get console dimensions + #we are reduced to continuously spewing lines. + puts stderr $msg + } - after 100 + after 100 + } + set input_chunks_waiting($inputchan) [list $allwaiting] } - set input_chunks_waiting($inputchan) [list $allwaiting] } - + # -- } else { - punk::repl::repl_handler_checkchannel $inputchan - punk::repl::repl_handler_checkcontrolsignal_linemode $inputchan - # -- --- --- - #set chunksize [gets $inputchan chunk] - # -- --- --- - set chunk [read $inputchan] - set chunksize [string length $chunk] - # -- --- --- - if {$chunksize > 0} { - #punk::console::cursorsave_move_emitblock_return 35 120 "chunk: [ansistring VIEW -lf 1 "...[string range $chunk end-10 end]"]" - set ln $chunk ;#temp - #punk::console::cursorsave_move_emitblock_return 25 30 [textblock::frame -title line "[a+ green]$waitingchunk[a][a+ red][ansistring VIEW -lf 1 $ln][a+ green]pending:[chan pending input stdin][a]"] - if {[string index $ln end] eq "\n"} { - lappend stdinlines [string range $ln 0 end-1] - punk::repl::repl_handler_restorechannel_if_not_eof $inputchan $original_input_conf - uplevel #0 [list repl::repl_process_data $inputchan line "" $stdinlines $prompt_config] - } else { - lappend input_chunks_waiting($inputchan) $ln + if {$readmore} { + punk::repl::repl_handler_checkchannel $inputchan + punk::repl::repl_handler_checkcontrolsignal_linemode $inputchan + # -- --- --- + #set chunksize [gets $inputchan chunk] + # -- --- --- + set chunk [read $inputchan] + set chunksize [string length $chunk] + # -- --- --- + if {$chunksize > 0} { + #punk::console::cursorsave_move_emitblock_return 35 120 "chunk: [ansistring VIEW -lf 1 "...[string range $chunk end-10 end]"]" + set ln $chunk ;#temp + #punk::console::cursorsave_move_emitblock_return 25 30 [textblock::frame -title line "[a+ green]$waitingchunk[a][a+ red][ansistring VIEW -lf 1 $ln][a+ green]pending:[chan pending input stdin][a]"] + if {[string index $ln end] eq "\n"} { + lappend stdinlines [string range $ln 0 end-1] + punk::repl::repl_handler_restorechannel_if_not_eof $inputchan $original_input_conf + uplevel #0 [list repl::repl_process_data $inputchan line "" $stdinlines $prompt_config] + } else { + lappend input_chunks_waiting($inputchan) $ln + } } } } @@ -1582,19 +1624,21 @@ proc repl::repl_handler {inputchan prompt_config} { } if {$continue} { - if {[dict get $original_input_conf -blocking] ne "0" || [dict get $original_input_conf -translation] ne "lf"} { - chan configure $inputchan -blocking 0 - chan configure $inputchan -translation lf - } - set chunk [read $inputchan] - #we expect a chan configured with -blocking 0 to be blocked immediately after reads - #test - just bug console for now - try to understand when/how/if a non blocking read occurs. - if {![chan blocked $inputchan]} { - puts stderr "repl_handler->$inputchan not blocked after read" - } + if {$readmore} { + if {[dict get $original_input_conf -blocking] ne "0" || [dict get $original_input_conf -translation] ne "lf"} { + chan configure $inputchan -blocking 0 + chan configure $inputchan -translation lf + } + set chunk [read $inputchan] + #we expect a chan configured with -blocking 0 to be blocked immediately after reads + #test - just bug console for now - try to understand when/how/if a non blocking read occurs. + if {![chan blocked $inputchan]} { + puts stderr "repl_handler->$inputchan not blocked after read" + } - punk::repl::repl_handler_restorechannel_if_not_eof $inputchan $original_input_conf - uplevel #0 [list repl::repl_process_data $inputchan raw-read $chunk [list] $prompt_config] + punk::repl::repl_handler_restorechannel_if_not_eof $inputchan $original_input_conf + uplevel #0 [list repl::repl_process_data $inputchan raw-read $chunk [list] $prompt_config] + } while {[llength $input_chunks_waiting($inputchan)]} { set chunkzero [lpop input_chunks_waiting($inputchan) 0] if {$chunkzero eq ""} {continue} ;#why empty waiting - and is there any point passing on? @@ -1604,33 +1648,35 @@ proc repl::repl_handler {inputchan prompt_config} { } } - if {![chan eof $inputchan]} { - ################################################################################## - #Re-enable channel read handler only if no waiting chunks - must process in order - ################################################################################## - if {![llength $input_chunks_waiting($inputchan)]} { - chan event $inputchan readable [list ::repl::repl_handler $inputchan $prompt_config] + if {$readmore} { + if {![chan eof $inputchan]} { + ################################################################################## + #Re-enable channel read handler only if no waiting chunks - must process in order + ################################################################################## + if {![llength $input_chunks_waiting($inputchan)]} { + chan event $inputchan readable [list ::repl::repl_handler $inputchan $readmore $prompt_config] + } else { + #review + #puts stderr "warning: after idle re-enable repl::repl_handler in thread: [thread::id]" + after idle [list ::repl::repl_handler $inputchan $readmore $prompt_config] + } + #################################################### } else { - #review - #puts stderr "warning: after idle re-enable repl::repl_handler in thread: [thread::id]" - after idle [list ::repl::repl_handler $inputchan $prompt_config] - } - #################################################### - } else { - #repl_handler_checkchannel $inputchan - chan event $inputchan readable {} - set reading 0 - #target is the 'main' interp in codethread. - #(note bug where thread::send goes to code interp, but thread::send -async goes to main interp) - # https://core.tcl-lang.org/thread/tktview/0de73f04c7ce188b13a4 - - thread::send -async $::repl::codethread {set ::punk::repl::codethread::is_running 0} ;#to main interp of codethread - if {$::tcl_interactive} { - rputs stderr "\nrepl_handler EOF inputchannel:[chan conf $inputchan]" - #rputs stderr "\n|repl> ctrl-c EOF on $inputchan." + #repl_handler_checkchannel $inputchan + chan event $inputchan readable {} + set reading 0 + #target is the 'main' interp in codethread. + #(note bug where thread::send goes to code interp, but thread::send -async goes to main interp) + # https://core.tcl-lang.org/thread/tktview/0de73f04c7ce188b13a4 + + thread::send -async $::repl::codethread {set ::punk::repl::codethread::is_running 0} ;#to main interp of codethread + if {$::tcl_interactive} { + rputs stderr "\nrepl_handler EOF inputchannel:[chan conf $inputchan]" + #rputs stderr "\n|repl> ctrl-c EOF on $inputchan." + } + set [namespace current]::done 1 + after 1 [list repl::reopen_stdin] } - set [namespace current]::done 1 - after 1 [list repl::reopen_stdin] } set in_repl_handler [list] } diff --git a/src/vfs/_vfscommon.vfs/modules/shellfilter-0.2.1.tm b/src/vfs/_vfscommon.vfs/modules/shellfilter-0.2.1.tm index 8e59cf0b..2eb2f8fa 100644 --- a/src/vfs/_vfscommon.vfs/modules/shellfilter-0.2.1.tm +++ b/src/vfs/_vfscommon.vfs/modules/shellfilter-0.2.1.tm @@ -2472,7 +2472,14 @@ namespace eval shellfilter { set exitinfo [list error "$errMsg" errorCode $::errorCode errorInfo "$::errorInfo"] } } + #puts "shellfilter::run finished call" + #------------------------- + #warning - without flush stdout - we can get hang, but only on some terminals + # - mechanism for this problem not understood! + flush stdout + flush stderr + #------------------------- #the previous redirections on the underlying inchan/outchan/errchan items will be restored from the -aside setting during removal #Remove execution-time Tees from stack @@ -2480,6 +2487,7 @@ namespace eval shellfilter { shellfilter::stack::remove stderr $id_err #shellfilter::stack::remove stderr $id_in + #puts stderr "shellfilter::run complete..." #chan configure stderr -buffering line #flush stdout diff --git a/src/vfs/_vfscommon.vfs/modules/shellrun-0.1.1.tm b/src/vfs/_vfscommon.vfs/modules/shellrun-0.1.1.tm index 478c70fa..c3f7ab10 100644 --- a/src/vfs/_vfscommon.vfs/modules/shellrun-0.1.1.tm +++ b/src/vfs/_vfscommon.vfs/modules/shellrun-0.1.1.tm @@ -187,10 +187,10 @@ namespace eval shellrun { #--------------------------------------------------------------------------------------------- set exitinfo [shellfilter::run $cmdargs {*}$callopts -teehandle punksh -inbuffering none -outbuffering none ] #--------------------------------------------------------------------------------------------- - foreach id $idlist_stderr { shellfilter::stack::remove stderr $id } + #puts stderr "shellrun::run exitinfo: $exitinfo" flush stderr flush stdout diff --git a/src/vfs/_vfscommon.vfs/modules/test/backup.tm b/src/vfs/_vfscommon.vfs/modules/test/backup.tm deleted file mode 100644 index 34f2a73d..00000000 Binary files a/src/vfs/_vfscommon.vfs/modules/test/backup.tm and /dev/null differ diff --git a/src/vfs/_vfscommon.vfs/modules/test/runalltests.tcl b/src/vfs/_vfscommon.vfs/modules/test/runalltests.tcl new file mode 100644 index 00000000..945abba9 --- /dev/null +++ b/src/vfs/_vfscommon.vfs/modules/test/runalltests.tcl @@ -0,0 +1,99 @@ +package require punk +#bogus require to ensure loaded +catch {package require test::bogus666} +set tmlist [tcl::tm::list] +foreach tmfolder $tmlist { + set tfolder [file join $tmfolder test] + if {[file exists $tfolder]} { + puts stdout "checking tm test folder $tfolder" + set subfolders [glob -nocomplain -dir $tfolder -type d -tail *] + foreach sub $subfolders { + if {[string match #* $sub]} { + continue + } + puts stdout "bogus require of test::${sub}::bogus666" + catch {package require test::${sub}::bogus666} + } + } +} +set alltestpkgs [lsearch -all -inline [package names] test::*] +puts "alltestpkgs: $alltestpkgs" +set punktestpkgs [list] +foreach pkg $alltestpkgs { + if {![catch {package require $pkg}]} { + if {[info commands ::${pkg}::RUN] ne ""} { + lappend punktestpkgs $pkg + } + } else { + puts stderr "failed to load test package $pkg" + } +} +set scriptname [file tail [info script]] +set results [dict create] +dict set results total 0 +dict set results passed 0 +dict set results skipped 0 +dict set results failed 0 +set pkgs_with_fails [list] +package require shellrun +puts "running tests in [llength $punktestpkgs] packages $punktestpkgs" +flush stderr +flush stdout +package require punk::ansi +foreach pkg [lrange $punktestpkgs 1 2] { + puts stdout "running test pkg $pkg" + if {[catch { + #set result [shellrun::runout -tcl ${pkg}::RUN] + set result [shellrun::runx -tcl ${pkg}::RUN] + #set result [shellrun::runx ls] + } errM]} { + puts stderr "error calling 'runout -tcl ${pkg}::RUN' $errM"; flush stderr + set result {none ""} + } + puts stdout "executed ${pkg}::RUN" + flush stdout + set i 0 + dict for {what chunk} $result { + set chunk [string map [list \r\n \n] $chunk] + switch -- $what { + stdout { + foreach ln [split $chunk \n] { + incr i + if {[string match "Tests ended at*" $ln]} { + puts stdout " [punk::ansi::ansistring VIEW -lf 2 -cr 1 "$pkg $ln"]" + } elseif {[string match "*:*Total*Passed*Skipped*Failed*" $ln]} { + set fields [lrange $ln 1 end] + dict for {K v} $fields { + set k [string tolower $K] + dict incr results $k $v + if {$k eq "failed" && $v > 0} { + lappend pkgs_with_fails $pkg + } + } + puts stdout "$pkg $ln" + } else { + puts stdout " $ln" + #puts stdout "$i" + } + } + flush stdout + } + stderr { + puts stderr " [punk::ansi::ansistring VIEW -lf 2 -cr 1 $chunk]" + flush stderr + } + default { + puts stderr "<${what}> $chunk" + flush stderr + } + } + } + puts stdout "completed pkg test ${pkg}" +} +puts stdout "results: Total [dict get $results total] Passed [dict get $results passed] Skipped [dict get $results skipped] Failed [dict get $results failed]" +puts stdout "packages with failures: $pkgs_with_fails" +after 5000 {set ::done true} +vwait ::done +puts stdout "DONE" +exit 0 + diff --git a/src/vfs/_vfscommon.vfs/modules/test/tomlish-1.1.1.tm.x b/src/vfs/_vfscommon.vfs/modules/test/tomlish-1.1.1.tm.x deleted file mode 100644 index 8405fae7..00000000 Binary files a/src/vfs/_vfscommon.vfs/modules/test/tomlish-1.1.1.tm.x and /dev/null differ diff --git a/src/vfs/_vfscommon.vfs/modules/test/tomlish-1.1.5.tm.x b/src/vfs/_vfscommon.vfs/modules/test/tomlish-1.1.5.tm.x deleted file mode 100644 index 536e3fa3..00000000 Binary files a/src/vfs/_vfscommon.vfs/modules/test/tomlish-1.1.5.tm.x and /dev/null differ