Attachment "bwidget-tk9.diff" to
ticket [b78ac94ee6]
added by
emiliano
2024-10-07 22:10:26.
Index: button.tcl
==================================================================
--- button.tcl
+++ button.tcl
@@ -127,11 +127,11 @@
# ----------------------------------------------------------------------------
# Command Button::configure
# ----------------------------------------------------------------------------
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 {
set oldaccel1 ""
set oldaccel2 ""
Index: buttonbox.tcl
==================================================================
--- buttonbox.tcl
+++ buttonbox.tcl
@@ -413,7 +413,7 @@
# ----------------------------------------------------------------------------
proc ButtonBox::_destroy { path } {
variable $path
upvar 0 $path data
Widget::destroy $path
- unset data
+ unset -nocomplain data
}
Index: color.tcl
==================================================================
--- color.tcl
+++ color.tcl
@@ -416,11 +416,11 @@
# From now on, this is the only way that:
# (1) ::SelectColor::_SetEntryValue is called
# (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]
# Override background color
@@ -434,11 +434,11 @@
# in the caller.
_userCommand $_oldColor
set color ""
}
- trace remove variable ::SelectColor::_unsavedSelection write ::SelectColor::_SetEntryValue
+ trace remove variable _unsavedSelection write ::SelectColor::_SetEntryValue
destroy $top
return $color
}
@@ -500,11 +500,11 @@
_set_value [lindex $_hsv 2]
$frame.color configure -background $bg
# Display selected color in entry widget (via trace on
# ::SelectColor::_unsavedSelection), and notify caller.
- set ::SelectColor::_unsavedSelection $bg
+ set _unsavedSelection $bg
_userCommand $bg
}
}
@@ -518,11 +518,11 @@
set frame $_widget(fcolor)
$frame.color configure -background $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} {
$frame.color$_selection configure -background $rgb
set _userColors [lreplace $_userColors $user $user $rgb]
@@ -806,23 +806,26 @@
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 {
# Unexpected call
return -code error "Unexpected trace of variable\
\"$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.
}
@@ -905,11 +908,11 @@
#
# 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]
+ after idle [list set SelectColor::_unsavedSelection $color]
}
return 1
}
@@ -922,13 +925,15 @@
# The command is called by SelectColor::_ValidateColorEntry to avoid a loop.
# ------------------------------------------------------------------------------
proc SelectColor::_SetWithoutTrace {value} {
variable _hsv
- trace remove variable ::SelectColor::_unsavedSelection write ::SelectColor::_SetEntryValue
+ 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
}
Index: combobox.tcl
==================================================================
--- combobox.tcl
+++ combobox.tcl
@@ -17,11 +17,11 @@
# - ComboBox::_select
# - ComboBox::_modify_value
# ----------------------------------------------------------------------------
# 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
Widget::tkinclude ComboBox frame :cmd \
@@ -169,11 +169,11 @@
Widget::configure $path [list -bwlistbox 1]
} else {
Widget::configure $path [list -bwlistbox $bw]
}
- set ComboBox::_index($path) -1
+ set ::ComboBox::_index($path) -1
return [Widget::create ComboBox $path]
}
@@ -513,11 +513,11 @@
toplevel $shell -relief solid -bd 1
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 }
}
@@ -701,11 +701,11 @@
if {!$width} { set width [winfo width $path] }
BWidget::place $path.shell $width 0 below $path
wm deiconify $path.shell
raise $path.shell
BWidget::focus set $listb
- if {! $Widget::_aqua } {
+ if {! $::Widget::_aqua } {
BWidget::grab global $path
}
}
@@ -715,11 +715,11 @@
proc ComboBox::_unmapliste { path {refocus 1} } {
# On aqua, state is zoomed, otherwise normal
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!
if {$refocus} {
update
Index: demo/basic.tcl
==================================================================
--- demo/basic.tcl
+++ demo/basic.tcl
@@ -182,18 +182,19 @@
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) ""}]
}
Index: demo/demo.tcl
==================================================================
--- demo/demo.tcl
+++ demo/demo.tcl
@@ -1,8 +1,9 @@
#!/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
variable notebook
@@ -121,11 +122,11 @@
set _wfont [SelectFont $tb2.font -type toolbar \
-command "Demo::update_font \[$tb2.font cget -font\]"]
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
set frame [$mainframe getframe]
set notebook [NoteBook $frame.nb]
@@ -240,11 +241,11 @@
proc Demo::main {} {
variable DEMODIR
lappend ::auto_path [file dirname $DEMODIR]
- package require BWidget
+ package require BWidget 1.9.16
option add *TitleFrame.l.font {helvetica 11 bold italic}
if {$::tk_version < 8.5} {
set helpFont {helvetica 12}
Index: demo/manager.tcl
==================================================================
--- demo/manager.tcl
+++ demo/manager.tcl
@@ -104,19 +104,19 @@
variable _progress
variable _afterid
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 ""
}
}
@@ -123,19 +123,19 @@
proc DemoManager::_update_progress { } {
variable _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 ""}
}
} else {
set _afterid ""
}
}
Index: demo/tmpldlg.tcl
==================================================================
--- demo/tmpldlg.tcl
+++ demo/tmpldlg.tcl
@@ -178,20 +178,20 @@
-buttons $msg(buttons)
}
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
}
}
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 \
-width 20 \
-textvariable DemoDlg::progmsg \
@@ -202,14 +202,14 @@
}
proc DemoDlg::_update_progdlg { } {
if { [winfo exists .progress] } {
- set DemoDlg::progval 2
+ set ::DemoDlg::progval 2
after 20 DemoDlg::_update_progdlg
}
}
proc DemoDlg::_show_passdlg { } {
PasswdDlg .passwd -parent .
}
Index: demo/tree.tcl
==================================================================
--- demo/tree.tcl
+++ demo/tree.tcl
@@ -82,16 +82,16 @@
}
}
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:\\"
}
$tree insert end root home -text $rootdir -data $rootdir -open 1 \
-image [Bitmap::get openfold]
Index: dynhelp.tcl
==================================================================
--- dynhelp.tcl
+++ dynhelp.tcl
@@ -19,11 +19,11 @@
namespace eval DynamicHelp {
Widget::define DynamicHelp dynhelp -classonly
if {$::tcl_version >= 8.5} {
set fontdefault TkTooltipFont
- } elseif {$Widget::_aqua} {
+ } elseif {$::Widget::_aqua} {
set fontdefault {helvetica 11}
} else {
set fontdefault {helvetica 8}
}
@@ -668,11 +668,11 @@
-bg [Widget::getoption $_top -topbackground] \
-bd [Widget::getoption $_top -borderwidth] \
-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
}
Index: entry.tcl
==================================================================
--- entry.tcl
+++ entry.tcl
@@ -177,11 +177,11 @@
# Command Entry::configure
# ------------------------------------------------------------------------------
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]
# Extract the modified bits that we are interested in.
if {[Widget::theme]} {
Index: label.tcl
==================================================================
--- label.tcl
+++ label.tcl
@@ -122,11 +122,11 @@
# ------------------------------------------------------------------------------
# Command Label::configure
# ------------------------------------------------------------------------------
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 ""
}
set res [Widget::configure $path $args]
Index: labelframe.tcl
==================================================================
--- labelframe.tcl
+++ labelframe.tcl
@@ -115,11 +115,11 @@
foreach wl $args {
foreach w $wl {
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
} else {
upvar 0 Widget::${class}::map classmap
Index: listbox.tcl
==================================================================
--- listbox.tcl
+++ listbox.tcl
@@ -804,11 +804,12 @@
-font [_getoption $path $item -font] \
-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
_update_edit_size $path $ent $idw $wmax
update
@@ -831,11 +832,12 @@
if { !$_edit(wait) || [llength $verifycmd]==0 ||
[uplevel \#0 $verifycmd [list $_edit(text)]] } {
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
$path.c delete $idw
$path.c itemconfigure $idn -fill $oldfg
@@ -907,10 +909,14 @@
# ----------------------------------------------------------------------------
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)
}
if { $data(dnd,afterid) != "" } {
after cancel $data(dnd,afterid)
Index: notebook.tcl
==================================================================
--- notebook.tcl
+++ notebook.tcl
@@ -459,15 +459,19 @@
# ---------------------------------------------------------------------------
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
}
# ---------------------------------------------------------------------------
# Command NoteBook::getframe
Index: pagesmgr.tcl
==================================================================
--- pagesmgr.tcl
+++ pagesmgr.tcl
@@ -18,11 +18,11 @@
# - PagesManager::_select
# - PagesManager::_redraw
# - 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
Widget::declare PagesManager {
Index: panelframe.tcl
==================================================================
--- panelframe.tcl
+++ panelframe.tcl
@@ -76,11 +76,11 @@
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]
+ -foreground [lindex $::Widget::PanelFrame::opt(-panelbackground) 1]
}
bind PanelFrame <Destroy> [list Widget::destroy %W]
}
Index: pkgIndex.tcl
==================================================================
--- pkgIndex.tcl
+++ pkgIndex.tcl
@@ -1,10 +1,10 @@
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;\
+ package require Tk 8.1.1 9;\
[list tclPkgSetup $dir BWidget 1.9.16 {
{arrow.tcl source {ArrowButton ::ArrowButton::create ::ArrowButton::use}}
{labelframe.tcl source {LabelFrame ::LabelFrame::create ::LabelFrame::use}}
{labelentry.tcl source {LabelEntry ::LabelEntry::create ::LabelEntry::use}}
{bitmap.tcl source {::Bitmap::get ::Bitmap::use}}
Index: progressbar.tcl
==================================================================
--- progressbar.tcl
+++ progressbar.tcl
@@ -63,11 +63,11 @@
set _widget($path,val) 0
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]]
}
@@ -87,16 +87,16 @@
set res [Widget::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) \
[after idle [list ProgressBar::_modify $path]]
}
@@ -196,13 +196,13 @@
after cancel $_widget($path,afterid)
unset _widget($path,afterid)
}
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)
}
unset _widget($path,dir)
Widget::destroy $path
}
Index: spinbox.tcl
==================================================================
--- spinbox.tcl
+++ spinbox.tcl
@@ -74,11 +74,11 @@
array set maps [Widget::parseArgs SpinBox $args]
eval [list frame $path] $maps(:cmd) \
[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]
}
bindtags $path.e [linsert [bindtags $path.e] 1 SpinBoxEntry]
Index: tree.tcl
==================================================================
--- tree.tcl
+++ tree.tcl
@@ -888,20 +888,23 @@
set node [_node_name $path $node]
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
}
# Tree::visiblenodes --
#
@@ -1046,11 +1049,11 @@
-font [Widget::getoption $path.$node -font] \
-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
BWidget::focus set $ent
@@ -1069,18 +1072,18 @@
bind $frame <Button> [list set Tree::_edit(wait) $clickres]
}
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
destroy $frame
$path.c delete $idw
@@ -2231,10 +2234,14 @@
# ----------------------------------------------------------------------------
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)
}
if { $data(dnd,afterid) != "" } {
after cancel $data(dnd,afterid)
Index: utils.tcl
==================================================================
--- utils.tcl
+++ utils.tcl
@@ -55,11 +55,15 @@
# ----------------------------------------------------------------------------
# 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]
}
# ----------------------------------------------------------------------------
