can't read "pu": no such variable
while executing
"list $name-creationCmd "$name %W -padx 2 -pady 2 -wrap none" $name-putValueCmd "%W delete 1.0 end; %W insert 1.0 %T" $name-getValueCmd "%W get 1.0 ..."
(procedure "addTkCoreWidgets" line 9)
invoked from within
"addTkCoreWidgets "
(in namespace eval "::request::tablelist" script line 31)
invoked from within
"namespace eval tablelist {
#
# Register the Tk core widgets entry, text, checkbutton,
# menubutton, and spinbox for interactive cell editi..."
(in namespace eval "::request" script line 18)
invoked from within
"namespace eval ::request $script"
("::try" body line 12)
OUTPUT BUFFER:
#==============================================================================
# Contains the implementation of interactive cell editing in tablelist widgets.
#
# Structure of the module:
# - Namespace initialization
# - Public procedures related to interactive cell editing
# - Private procedures implementing the interactive cell editing
# - Private procedures used in bindings related to interactive cell editing
#
# Copyright (c) 2003-2020 Csaba Nemethi (E-mail: csaba.nemethi@t-online.de)
#==============================================================================
#
# Namespace initialization
# ========================
#
namespace eval tablelist {
#
# Register the Tk core widgets entry, text, checkbutton,
# menubutton, and spinbox for interactive cell editing
#
proc addTkCoreWidgets {} {
variable editWin
variable pu
set name entry
array set editWin [list \
$name-creationCmd "$name %W -width 0" \
$name-putValueCmd "%W delete 0 end; %W insert 0 %T" \
$name-getValueCmd "%W get" \
$name-putTextCmd "%W delete 0 end; %W insert 0 %T" \
$name-getTextCmd "%W get" \
$name-putListCmd "" \
$name-getListCmd "" \
$name-selectCmd "" \
$name-invokeCmd "" \
$name-fontOpt -font \
$name-useFormat 1 \
$name-useReqWidth 0 \
$name-usePadX 0 \
$name-isEntryLike 1 \
$name-focusWin %W \
$name-reservedKeys {Left Right} \
]
set name text
array set editWin [list \
$name-creationCmd "$name %W -padx 2 -pady 2 -wrap none" \
$name-putValueCmd "%W delete 1.0 end; %W insert 1.0 %T" \
$name-getValueCmd "%W get 1.0 end-1$pu" \
$name-putTextCmd "%W delete 1.0 end; %W insert 1.0 %T" \
$name-getTextCmd "%W get 1.0 end-1$pu" \
$name-putListCmd "" \
$name-getListCmd "" \
$name-selectCmd "" \
$name-invokeCmd "" \
$name-fontOpt -font \
$name-useFormat 1 \
$name-useReqWidth 0 \
$name-usePadX 0 \
$name-isEntryLike 1 \
$name-focusWin %W \
$name-reservedKeys {Left Right Up Down Prior Next
Control-Home Control-End Meta-b Meta-f
Control-p Control-n Meta-less Meta-greater} \
]
set name checkbutton
array set editWin [list \
$name-creationCmd "createCheckbutton %W" \
$name-putValueCmd {set [%W cget -variable] %T} \
$name-getValueCmd {set [%W cget -variable]} \
$name-putTextCmd {set [%W cget -variable] %T} \
$name-getTextCmd {set [%W cget -variable]} \
$name-putListCmd "" \
$name-getListCmd "" \
$name-selectCmd "" \
$name-invokeCmd "%W invoke" \
$name-fontOpt "" \
$name-useFormat 0 \
$name-useReqWidth 1 \
$name-usePadX 0 \
$name-isEntryLike 0 \
$name-focusWin %W \
$name-reservedKeys {} \
]
set name menubutton
array set editWin [list \
$name-creationCmd "createMenubutton %W" \
$name-putValueCmd {set [%W cget -textvariable] %T} \
$name-getValueCmd "%W cget -text" \
$name-putTextCmd {set [%W cget -textvariable] %T} \
$name-getTextCmd "%W cget -text" \
$name-putListCmd "" \
$name-getListCmd "" \
$name-selectCmd "" \
$name-invokeCmd "event generate %W " \
$name-fontOpt -font \
$name-useFormat 1 \
$name-useReqWidth 0 \
$name-usePadX 1 \
$name-isEntryLike 0 \
$name-focusWin %W \
$name-reservedKeys {} \
]
if {$::tk_version < 8.4} {
return ""
}
set name spinbox
array set editWin [list \
$name-creationCmd "$name %W -width 0" \
$name-putValueCmd "%W delete 0 end; %W insert 0 %T" \
$name-getValueCmd "%W get" \
$name-putTextCmd "%W delete 0 end; %W insert 0 %T" \
$name-getTextCmd "%W get" \
$name-putListCmd "" \
$name-getListCmd "" \
$name-selectCmd "" \
$name-invokeCmd "" \
$name-fontOpt -font \
$name-useFormat 1 \
$name-useReqWidth 0 \
$name-usePadX 1 \
$name-isEntryLike 1 \
$name-focusWin %W \
$name-reservedKeys {Left Right Up Down} \
]
}
addTkCoreWidgets
#
# Register the tile widgets ttk::entry, ttk::spinbox, ttk::combobox,
# ttk::checkbutton, and ttk::menubutton for interactive cell editing
#
proc addTileWidgets {} {
variable editWin
set name ttk::entry
array set editWin [list \
$name-creationCmd "createTileEntry %W" \
$name-putValueCmd "%W delete 0 end; %W insert 0 %T" \
$name-getValueCmd "%W get" \
$name-putTextCmd "%W delete 0 end; %W insert 0 %T" \
$name-getTextCmd "%W get" \
$name-putListCmd "" \
$name-getListCmd "" \
$name-selectCmd "" \
$name-invokeCmd "" \
$name-fontOpt -font \
$name-useFormat 1 \
$name-useReqWidth 0 \
$name-usePadX 0 \
$name-isEntryLike 1 \
$name-focusWin %W \
$name-reservedKeys {Left Right} \
]
set name ttk::spinbox
array set editWin [list \
$name-creationCmd "createTileSpinbox %W" \
$name-putValueCmd "%W delete 0 end; %W insert 0 %T" \
$name-getValueCmd "%W get" \
$name-putTextCmd "%W delete 0 end; %W insert 0 %T" \
$name-getTextCmd "%W get" \
$name-putListCmd "" \
$name-getListCmd "" \
$name-selectCmd "" \
$name-invokeCmd "" \
$name-fontOpt -font \
$name-useFormat 1 \
$name-useReqWidth 0 \
$name-usePadX 1 \
$name-isEntryLike 1 \
$name-focusWin %W \
$name-reservedKeys {Left Right Up Down} \
]
set name ttk::combobox
array set editWin [list \
$name-creationCmd "createTileCombobox %W" \
$name-putValueCmd "%W set %T" \
$name-getValueCmd "%W get" \
$name-putTextCmd "%W set %T" \
$name-getTextCmd "%W get" \
$name-putListCmd "" \
$name-getListCmd "" \
$name-selectCmd "" \
$name-invokeCmd "event generate %W " \
$name-fontOpt -font \
$name-useFormat 1 \
$name-useReqWidth 0 \
$name-usePadX 1 \
$name-isEntryLike 1 \
$name-focusWin %W \
$name-reservedKeys {Left Right Up Down} \
]
set name ttk::checkbutton
array set editWin [list \
$name-creationCmd "createTileCheckbutton %W" \
$name-putValueCmd {set [%W cget -variable] %T} \
$name-getValueCmd {set [%W cget -variable]} \
$name-putTextCmd {set [%W cget -variable] %T} \
$name-getTextCmd {set [%W cget -variable]} \
$name-putListCmd "" \
$name-getListCmd "" \
$name-selectCmd "" \
$name-invokeCmd {%W instate !pressed {%W invoke}} \
$name-fontOpt "" \
$name-useFormat 0 \
$name-useReqWidth 1 \
$name-usePadX 0 \
$name-isEntryLike 0 \
$name-focusWin %W \
$name-reservedKeys {} \
]
set name ttk::menubutton
array set editWin [list \
$name-creationCmd "createTileMenubutton %W" \
$name-putValueCmd {set [%W cget -textvariable] %T} \
$name-getValueCmd "%W cget -text" \
$name-putTextCmd {set [%W cget -textvariable] %T} \
$name-getTextCmd "%W cget -text" \
$name-putListCmd "" \
$name-getListCmd "" \
$name-selectCmd "" \
$name-invokeCmd "event generate %W " \
$name-fontOpt "" \
$name-useFormat 1 \
$name-useReqWidth 0 \
$name-usePadX 1 \
$name-isEntryLike 0 \
$name-focusWin %W \
$name-reservedKeys {} \
]
foreach {name value} [array get editWin ttk::*-creationCmd] {
set editWin(::$name) $value
}
}
if {$::tk_version >= 8.4 && [llength [package versions tile]] > 0} {
addTileWidgets
}
}
#
# Public procedures related to interactive cell editing
# =====================================================
#
#------------------------------------------------------------------------------
# tablelist::addBWidgetEntry
#
# Registers the Entry widget from the BWidget package for interactive cell
# editing.
#------------------------------------------------------------------------------
proc tablelist::addBWidgetEntry {{name Entry}} {
checkEditWinName $name
variable editWin
array set editWin [list \
$name-creationCmd "Entry %W -width 0" \
$name-putValueCmd "%W delete 0 end; %W insert 0 %T" \
$name-getValueCmd "%W get" \
$name-putTextCmd "%W delete 0 end; %W insert 0 %T" \
$name-getTextCmd "%W get" \
$name-putListCmd "" \
$name-getListCmd "" \
$name-selectCmd "" \
$name-invokeCmd "" \
$name-fontOpt -font \
$name-useFormat 1 \
$name-useReqWidth 0 \
$name-usePadX 0 \
$name-isEntryLike 1 \
$name-focusWin %W \
$name-reservedKeys {Left Right} \
]
return $name
}
#------------------------------------------------------------------------------
# tablelist::addBWidgetSpinBox
#
# Registers the SpinBox widget from the BWidget package for interactive cell
# editing.
#------------------------------------------------------------------------------
proc tablelist::addBWidgetSpinBox {{name SpinBox}} {
checkEditWinName $name
variable editWin
array set editWin [list \
$name-creationCmd "createBWidgetSpinBox %W" \
$name-putValueCmd "%W configure -text %T" \
$name-getValueCmd "%W cget -text" \
$name-putTextCmd "%W configure -text %T" \
$name-getTextCmd "%W cget -text" \
$name-putListCmd "" \
$name-getListCmd "" \
$name-selectCmd "" \
$name-invokeCmd "" \
$name-fontOpt -font \
$name-useFormat 1 \
$name-useReqWidth 0 \
$name-usePadX 1 \
$name-isEntryLike 1 \
$name-focusWin %W.e \
$name-reservedKeys {Left Right Up Down Prior Next} \
]
return $name
}
#------------------------------------------------------------------------------
# tablelist::addBWidgetComboBox
#
# Registers the ComboBox widget from the BWidget package for interactive cell
# editing.
#------------------------------------------------------------------------------
proc tablelist::addBWidgetComboBox {{name ComboBox}} {
checkEditWinName $name
variable editWin
array set editWin [list \
$name-creationCmd "createBWidgetComboBox %W" \
$name-putValueCmd "%W configure -text %T" \
$name-getValueCmd "%W cget -text" \
$name-putTextCmd "%W configure -text %T" \
$name-getTextCmd "%W cget -text" \
$name-putListCmd "" \
$name-getListCmd "" \
$name-selectCmd "" \
$name-invokeCmd "%W.a invoke" \
$name-fontOpt -font \
$name-useFormat 1 \
$name-useReqWidth 0 \
$name-usePadX 1 \
$name-isEntryLike 1 \
$name-focusWin %W.e \
$name-reservedKeys {Left Right Up Down} \
]
return $name
}
#------------------------------------------------------------------------------
# tablelist::addIncrEntryfield
#
# Registers the entryfield widget from the Iwidgets package for interactive
# cell editing.
#------------------------------------------------------------------------------
proc tablelist::addIncrEntryfield {{name entryfield}} {
checkEditWinName $name
variable editWin
array set editWin [list \
$name-creationCmd "iwidgets::entryfield %W -width 0" \
$name-putValueCmd "%W clear; %W insert 0 %T" \
$name-getValueCmd "%W get" \
$name-putTextCmd "%W clear; %W insert 0 %T" \
$name-getTextCmd "%W get" \
$name-putListCmd "" \
$name-getListCmd "" \
$name-selectCmd "" \
$name-invokeCmd "" \
$name-fontOpt -textfont \
$name-useFormat 1 \
$name-useReqWidth 0 \
$name-usePadX 0 \
$name-isEntryLike 1 \
$name-focusWin {[%W component entry]} \
$name-reservedKeys {Left Right} \
]
return $name
}
#------------------------------------------------------------------------------
# tablelist::addIncrDateTimeWidget
#
# Registers the datefield, dateentry, timefield, or timeentry widget from the
# Iwidgets package, with or without the -clicks option for its get subcommand,
# for interactive cell editing.
#------------------------------------------------------------------------------
proc tablelist::addIncrDateTimeWidget {widgetType args} {
if {![regexp {^(datefield|dateentry|timefield|timeentry)$} $widgetType]} {
return -code error \
"bad widget type \"$widgetType\": must be\
datefield, dateentry, timefield, or timeentry"
}
switch [llength $args] {
0 {
set useClicks 0
set name $widgetType
}
1 {
set arg [lindex $args 0]
if {[string compare $arg "-seconds"] == 0} {
set useClicks 1
set name $widgetType
} else {
set useClicks 0
set name $arg
}
}
2 {
set arg0 [lindex $args 0]
if {[string compare $arg0 "-seconds"] != 0} {
return -code error "bad option \"$arg0\": must be -seconds"
}
set useClicks 1
set name [lindex $args 1]
}
default {
mwutil::wrongNumArgs "addIncrDateTimeWidget\
datefield|dateentry|timefield|timeentry ?-seconds? ?name?"
}
}
checkEditWinName $name
variable editWin
array set editWin [list \
$name-creationCmd "iwidgets::$widgetType %W" \
$name-putValueCmd "%W show %T" \
$name-getValueCmd "%W get" \
$name-putTextCmd "%W show %T" \
$name-getTextCmd "%W get" \
$name-putListCmd "" \
$name-getListCmd "" \
$name-selectCmd "" \
$name-invokeCmd "" \
$name-fontOpt -textfont \
$name-useReqWidth 1 \
$name-usePadX [string match "*entry" $widgetType] \
$name-useFormat 1 \
$name-isEntryLike 1 \
$name-reservedKeys {Left Right Up Down} \
]
switch $widgetType {
dateentry {
set editWin($name-creationCmd) "createIncrDateentry %W"
}
timeentry {
set editWin($name-creationCmd) "createIncrTimeentry %W"
}
}
if {$useClicks} {
lappend editWin($name-getValueCmd) -clicks
set editWin($name-useFormat) 0
}
if {[string match "date*" $widgetType]} {
set editWin($name-focusWin) {[%W component date]}
} else {
set editWin($name-focusWin) {[%W component time]}
}
return $name
}
#------------------------------------------------------------------------------
# tablelist::addIncrSpinner
#
# Registers the spinner widget from the Iwidgets package for interactive cell
# editing.
#------------------------------------------------------------------------------
proc tablelist::addIncrSpinner {{name spinner}} {
checkEditWinName $name
variable editWin
array set editWin [list \
$name-creationCmd "iwidgets::spinner %W -width 0" \
$name-putValueCmd "%W clear; %W insert 0 %T" \
$name-getValueCmd "%W get" \
$name-putTextCmd "%W clear; %W insert 0 %T" \
$name-getTextCmd "%W get" \
$name-putListCmd "" \
$name-getListCmd "" \
$name-selectCmd "" \
$name-invokeCmd "" \
$name-fontOpt -textfont \
$name-useFormat 1 \
$name-useReqWidth 0 \
$name-usePadX 1 \
$name-isEntryLike 1 \
$name-focusWin {[%W component entry]} \
$name-reservedKeys {Left Right} \
]
return $name
}
#------------------------------------------------------------------------------
# tablelist::addIncrSpinint
#
# Registers the spinint widget from the Iwidgets package for interactive cell
# editing.
#------------------------------------------------------------------------------
proc tablelist::addIncrSpinint {{name spinint}} {
checkEditWinName $name
variable editWin
array set editWin [list \
$name-creationCmd "iwidgets::spinint %W -width 0" \
$name-putValueCmd "%W clear; %W insert 0 %T" \
$name-getValueCmd "%W get" \
$name-putTextCmd "%W clear; %W insert 0 %T" \
$name-getTextCmd "%W get" \
$name-putListCmd "" \
$name-getListCmd "" \
$name-selectCmd "" \
$name-invokeCmd "" \
$name-fontOpt -textfont \
$name-useFormat 1 \
$name-useReqWidth 0 \
$name-usePadX 1 \
$name-isEntryLike 1 \
$name-focusWin {[%W component entry]} \
$name-reservedKeys {Left Right} \
]
return $name
}
#------------------------------------------------------------------------------
# tablelist::addIncrCombobox
#
# Registers the combobox widget from the Iwidgets package for interactive cell
# editing.
#------------------------------------------------------------------------------
proc tablelist::addIncrCombobox {{name combobox}} {
checkEditWinName $name
variable editWin
array set editWin [list \
$name-creationCmd "createIncrCombobox %W" \
$name-putValueCmd "%W clear entry; %W insert entry 0 %T" \
$name-getValueCmd "%W get" \
$name-putTextCmd "%W clear entry; %W insert entry 0 %T" \
$name-getTextCmd "%W get" \
$name-putListCmd {eval [list %W insert list end] %L} \
$name-getListCmd "%W component list get 0 end" \
$name-selectCmd "%W selection set %I" \
$name-invokeCmd "%W invoke" \
$name-fontOpt -textfont \
$name-useFormat 1 \
$name-useReqWidth 0 \
$name-usePadX 1 \
$name-isEntryLike 1 \
$name-focusWin {[%W component entry]} \
$name-reservedKeys {Left Right Up Down Control-p Control-n} \
]
return $name
}
#------------------------------------------------------------------------------
# tablelist::addCtext
#
# Registers the ctext widget for interactive cell editing.
#------------------------------------------------------------------------------
proc tablelist::addCtext {{name ctext}} {
checkEditWinName $name
variable editWin
variable pu
array set editWin [list \
$name-creationCmd "ctext %W -padx 2 -pady 2 -wrap none" \
$name-putValueCmd "%W delete 1.0 end; %W insert 1.0 %T" \
$name-getValueCmd "%W get 1.0 end-1$pu" \
$name-putTextCmd "%W delete 1.0 end; %W insert 1.0 %T" \
$name-getTextCmd "%W get 1.0 end-1$pu" \
$name-putListCmd "" \
$name-getListCmd "" \
$name-selectCmd "" \
$name-invokeCmd "" \
$name-fontOpt -font \
$name-useFormat 1 \
$name-useReqWidth 0 \
$name-usePadX 0 \
$name-isEntryLike 1 \
$name-focusWin %W.t \
$name-reservedKeys {Left Right Up Down Prior Next
Control-Home Control-End Meta-b Meta-f
Control-p Control-n Meta-less Meta-greater} \
]
return $name
}
#------------------------------------------------------------------------------
# tablelist::addOakleyCombobox
#
# Registers Bryan Oakley's combobox widget for interactive cell editing.
#------------------------------------------------------------------------------
proc tablelist::addOakleyCombobox {{name combobox}} {
checkEditWinName $name
variable editWin
array set editWin [list \
$name-creationCmd "createOakleyCombobox %W" \
$name-putValueCmd "%W delete 0 end; %W insert 0 %T" \
$name-getValueCmd "%W get" \
$name-putTextCmd "%W delete 0 end; %W insert 0 %T" \
$name-getTextCmd "%W get" \
$name-putListCmd {eval [list %W list insert end] %L} \
$name-getListCmd "%W list get 0 end" \
$name-selectCmd "%W select %I" \
$name-invokeCmd "%W open" \
$name-fontOpt -font \
$name-useFormat 1 \
$name-useReqWidth 0 \
$name-usePadX 1 \
$name-isEntryLike 1 \
$name-focusWin %W.entry \
$name-reservedKeys {Left Right Up Down Prior Next} \
]
#
# Patch the ::combobox::UpdateVisualAttributes procedure to make sure it
# won't change the background and trough colors of the vertical scrollbar
#
catch {combobox::combobox} ;# enforces the evaluation of "combobox.tcl"
if {[catch {rename ::combobox::UpdateVisualAttributes \
::combobox::_UpdateVisualAttributes}] == 0} {
proc ::combobox::UpdateVisualAttributes w {
set vsbBackground [$w.top.vsb cget -background]
set vsbTroughColor [$w.top.vsb cget -troughcolor]
::combobox::_UpdateVisualAttributes $w
$w.top.vsb configure -background $vsbBackground
$w.top.vsb configure -troughcolor $vsbTroughColor
}
}
return $name
}
#------------------------------------------------------------------------------
# tablelist::addDateMentry
#
# Registers the widget created by the mentry::dateMentry command from the
# Mentry package, with a given format and separator and with or without the
# "-gmt 1" option for the mentry::putClockVal and mentry::getClockVal commands,
# for interactive cell editing.
#------------------------------------------------------------------------------
proc tablelist::addDateMentry {fmt sep args} {
#
# Parse the fmt argument
#
if {![regexp {^([dmyY])([dmyY])([dmyY])$} $fmt dummy \
fields(0) fields(1) fields(2)]} {
return -code error \
"bad format \"$fmt\": must be a string of length 3,\
consisting of the letters d, m, and y or Y"
}
#
# Check whether all the three date components are represented in fmt
#
for {set n 0} {$n < 3} {incr n} {
set lfields($n) [string tolower $fields($n)]
}
if {[string compare $lfields(0) $lfields(1)] == 0 ||
[string compare $lfields(0) $lfields(2)] == 0 ||
[string compare $lfields(1) $lfields(2)] == 0} {
return -code error \
"bad format \"$fmt\": must have unique components for the\
day, month, and year"
}
#
# Parse the remaining arguments (if any)
#
switch [llength $args] {
0 {
set useGMT 0
set name dateMentry
}
1 {
set arg [lindex $args 0]
if {[string compare $arg "-gmt"] == 0} {
set useGMT 1
set name dateMentry
} else {
set useGMT 0
set name $arg
}
}
2 {
set arg0 [lindex $args 0]
if {[string compare $arg0 "-gmt"] != 0} {
return -code error "bad option \"$arg0\": must be -gmt"
}
set useGMT 1
set name [lindex $args 1]
}
default {
mwutil::wrongNumArgs "addDateMentry format separator ?-gmt? ?name?"
}
}
checkEditWinName $name
variable editWin
array set editWin [list \
$name-creationCmd [list mentry::dateMentry %W $fmt $sep] \
$name-putValueCmd "mentry::putClockVal %T %W -gmt $useGMT" \
$name-getValueCmd "mentry::getClockVal %W -gmt $useGMT" \
$name-putTextCmd "" \
$name-getTextCmd "%W getstring" \
$name-putListCmd {eval [list %W put 0] %L} \
$name-getListCmd "%W getlist" \
$name-selectCmd "" \
$name-invokeCmd "" \
$name-fontOpt -font \
$name-useFormat 0 \
$name-useReqWidth 1 \
$name-usePadX 1 \
$name-isEntryLike 1 \
$name-focusWin "" \
$name-reservedKeys {Left Right Up Down Prior Next} \
]
return $name
}
#------------------------------------------------------------------------------
# tablelist::addTimeMentry
#
# Registers the widget created by the mentry::timeMentry command from the
# Mentry package, with a given format and separator and with or without the
# "-gmt 1" option for the mentry::putClockVal and mentry::getClockVal commands,
# for interactive cell editing.
#------------------------------------------------------------------------------
proc tablelist::addTimeMentry {fmt sep args} {
#
# Parse the fmt argument
#
if {![regexp {^(H|I)(M)(S?)$} $fmt dummy fields(0) fields(1) fields(2)]} {
return -code error \
"bad format \"$fmt\": must be a string of length 2 or 3\
starting with H or I, followed by M and optionally by S"
}
#
# Parse the remaining arguments (if any)
#
switch [llength $args] {
0 {
set useGMT 0
set name timeMentry
}
1 {
set arg [lindex $args 0]
if {[string compare $arg "-gmt"] == 0} {
set useGMT 1
set name timeMentry
} else {
set useGMT 0
set name $arg
}
}
2 {
set arg0 [lindex $args 0]
if {[string compare $arg0 "-gmt"] != 0} {
return -code error "bad option \"$arg0\": must be -gmt"
}
set useGMT 1
set name [lindex $args 1]
}
default {
mwutil::wrongNumArgs "addTimeMentry format separator ?-gmt? ?name?"
}
}
checkEditWinName $name
variable editWin
array set editWin [list \
$name-creationCmd [list mentry::timeMentry %W $fmt $sep] \
$name-putValueCmd "mentry::putClockVal %T %W -gmt $useGMT" \
$name-getValueCmd "mentry::getClockVal %W -gmt $useGMT" \
$name-putTextCmd "" \
$name-getTextCmd "%W getstring" \
$name-putListCmd {eval [list %W put 0] %L} \
$name-getListCmd "%W getlist" \
$name-selectCmd "" \
$name-invokeCmd "" \
$name-fontOpt -font \
$name-useFormat 0 \
$name-useReqWidth 1 \
$name-usePadX 1 \
$name-isEntryLike 1 \
$name-focusWin "" \
$name-reservedKeys {Left Right Up Down Prior Next} \
]
return $name
}
#------------------------------------------------------------------------------
# tablelist::addDateTimeMentry
#
# Registers the widget created by the mentry::dateTimeMentry command from the
# Mentry package, with a given format and given separators and with or without
# the "-gmt 1" option for the mentry::putClockVal and mentry::getClockVal
# commands, for interactive cell editing.
#------------------------------------------------------------------------------
proc tablelist::addDateTimeMentry {fmt dateSep timeSep args} {
#
# Parse the fmt argument
#
if {![regexp {^([dmyY])([dmyY])([dmyY])(H|I)(M)(S?)$} $fmt dummy \
fields(0) fields(1) fields(2) fields(3) fields(4) fields(5)]} {
return -code error \
"bad format \"$fmt\": must be a string of length 5 or 6,\
with the first 3 characters consisting of the letters d, m,\
and y or Y, followed by H or I, then M, and optionally by S"
}
#
# Check whether all the three date components are represented in fmt
#
for {set n 0} {$n < 3} {incr n} {
set lfields($n) [string tolower $fields($n)]
}
if {[string compare $lfields(0) $lfields(1)] == 0 ||
[string compare $lfields(0) $lfields(2)] == 0 ||
[string compare $lfields(1) $lfields(2)] == 0} {
return -code error \
"bad format \"$fmt\": must have unique components for the\
day, month, and year"
}
#
# Parse the remaining arguments (if any)
#
switch [llength $args] {
0 {
set useGMT 0
set name dateTimeMentry
}
1 {
set arg [lindex $args 0]
if {[string compare $arg "-gmt"] == 0} {
set useGMT 1
set name dateTimeMentry
} else {
set useGMT 0
set name $arg
}
}
2 {
set arg0 [lindex $args 0]
if {[string compare $arg0 "-gmt"] != 0} {
return -code error "bad option \"$arg0\": must be -gmt"
}
set useGMT 1
set name [lindex $args 1]
}
default {
mwutil::wrongNumArgs "addDateTimeMentry format dateSeparator\
timeSeparator ?-gmt? ?name?"
}
}
checkEditWinName $name
variable editWin
array set editWin [list \
$name-creationCmd [list mentry::dateTimeMentry %W $fmt \
$dateSep $timeSep] \
$name-putValueCmd "mentry::putClockVal %T %W -gmt $useGMT" \
$name-getValueCmd "mentry::getClockVal %W -gmt $useGMT" \
$name-putTextCmd "" \
$name-getTextCmd "%W getstring" \
$name-putListCmd {eval [list %W put 0] %L} \
$name-getListCmd "%W getlist" \
$name-selectCmd "" \
$name-invokeCmd "" \
$name-fontOpt -font \
$name-useFormat 0 \
$name-useReqWidth 1 \
$name-usePadX 1 \
$name-isEntryLike 1 \
$name-focusWin "" \
$name-reservedKeys {Left Right Up Down Prior Next} \
]
return $name
}
#------------------------------------------------------------------------------
# tablelist::addFixedPointMentry
#
# Registers the widget created by the mentry::fixedPointMentry command from the
# Mentry package, with a given number of characters before and a given number
# of digits after the decimal point, with or without the -comma option, for
# interactive cell editing.
#------------------------------------------------------------------------------
proc tablelist::addFixedPointMentry {cnt1 cnt2 args} {
#
# Check the arguments cnt1 and cnt2
#
if {![isInteger $cnt1] || $cnt1 <= 0} {
return -code error "expected positive integer but got \"$cnt1\""
}
if {![isInteger $cnt2] || $cnt2 <= 0} {
return -code error "expected positive integer but got \"$cnt2\""
}
#
# Parse the remaining arguments (if any)
#
switch [llength $args] {
0 {
set useComma 0
set name fixedPointMentry_$cnt1.$cnt2
}
1 {
set arg [lindex $args 0]
if {[string compare $arg "-comma"] == 0} {
set useComma 1
set name fixedPointMentry_$cnt1,$cnt2
} else {
set useComma 0
set name $arg
}
}
2 {
set arg0 [lindex $args 0]
if {[string compare $arg0 "-comma"] != 0} {
return -code error "bad option \"$arg0\": must be -comma"
}
set useComma 1
set name [lindex $args 1]
}
default {
mwutil::wrongNumArgs "addFixedPointMentry count1 count2\
?-comma? ?name?"
}
}
checkEditWinName $name
variable editWin
array set editWin [list \
$name-creationCmd [list mentry::fixedPointMentry %W $cnt1 $cnt2] \
$name-putValueCmd "mentry::putReal %T %W" \
$name-getValueCmd "mentry::getReal %W" \
$name-putTextCmd "" \
$name-getTextCmd "%W getstring" \
$name-putListCmd {eval [list %W put 0] %L} \
$name-getListCmd "%W getlist" \
$name-selectCmd "" \
$name-invokeCmd "" \
$name-fontOpt -font \
$name-useFormat 0 \
$name-useReqWidth 1 \
$name-usePadX 1 \
$name-isEntryLike 1 \
$name-focusWin "" \
$name-reservedKeys {Left Right} \
]
if {$useComma} {
lappend editWin($name-creationCmd) -comma
}
return $name
}
#------------------------------------------------------------------------------
# tablelist::addIPAddrMentry
#
# Registers the widget created by the mentry::ipAddrMentry command from the
# Mentry package for interactive cell editing.
#------------------------------------------------------------------------------
proc tablelist::addIPAddrMentry {{name ipAddrMentry}} {
checkEditWinName $name
variable editWin
array set editWin [list \
$name-creationCmd "mentry::ipAddrMentry %W" \
$name-putValueCmd "mentry::putIPAddr %T %W" \
$name-getValueCmd "mentry::getIPAddr %W" \
$name-putTextCmd "" \
$name-getTextCmd "%W getstring" \
$name-putListCmd {eval [list %W put 0] %L} \
$name-getListCmd "%W getlist" \
$name-selectCmd "" \
$name-invokeCmd "" \
$name-fontOpt -font \
$name-useFormat 0 \
$name-useReqWidth 1 \
$name-usePadX 1 \
$name-isEntryLike 1 \
$name-focusWin "" \
$name-reservedKeys {Left Right Up Down Prior Next} \
]
return $name
}
#------------------------------------------------------------------------------
# tablelist::addIPv6AddrMentry
#
# Registers the widget created by the mentry::ipv6AddrMentry command from the
# Mentry package for interactive cell editing.
#------------------------------------------------------------------------------
proc tablelist::addIPv6AddrMentry {{name ipv6AddrMentry}} {
checkEditWinName $name
variable editWin
array set editWin [list \
$name-creationCmd "mentry::ipv6AddrMentry %W" \
$name-putValueCmd "mentry::putIPv6Addr %T %W" \
$name-getValueCmd "mentry::getIPv6Addr %W" \
$name-putTextCmd "" \
$name-getTextCmd "%W getstring" \
$name-putListCmd {eval [list %W put 0] %L} \
$name-getListCmd "%W getlist" \
$name-selectCmd "" \
$name-invokeCmd "" \
$name-fontOpt -font \
$name-useFormat 0 \
$name-useReqWidth 1 \
$name-usePadX 1 \
$name-isEntryLike 1 \
$name-focusWin "" \
$name-reservedKeys {Left Right Up Down Prior Next} \
]
return $name
}
#
# Private procedures implementing the interactive cell editing
# ============================================================
#
#------------------------------------------------------------------------------
# tablelist::checkEditWinName
#
# Generates an error if the given edit window name is one of "entry", "text",
# "spinbox", "checkbutton", "menubutton", "ttk::entry", "ttk::spinbox",
# "ttk::combobox", "ttk::checkbutton", or "ttk::menubutton".
#------------------------------------------------------------------------------
proc tablelist::checkEditWinName name {
if {[regexp {^(entry|text|spinbox|checkbutton|menubutton)$} $name]} {
return -code error \
"edit window name \"$name\" is reserved for Tk $name widgets"
}
if {[regexp {^(::)?ttk::(entry|spinbox|combobox|checkbutton|menubutton)$} \
$name]} {
return -code error \
"edit window name \"$name\" is reserved for tile $name widgets"
}
}
#------------------------------------------------------------------------------
# tablelist::createCheckbutton
#
# Creates a checkbutton widget of the given path name for interactive cell
# editing in a tablelist widget.
#------------------------------------------------------------------------------
proc tablelist::createCheckbutton {w args} {
makeCheckbutton $w
foreach {opt val} $args {
switch -- $opt {
-state { $w configure $opt $val }
default {}
}
}
set win [getTablelistPath $w]
$w configure -variable ::tablelist::ns${win}::data(editText)
}
#------------------------------------------------------------------------------
# tablelist::createMenubutton
#
# Creates a menubutton widget of the given path name for interactive cell
# editing in a tablelist widget.
#------------------------------------------------------------------------------
proc tablelist::createMenubutton {w args} {
set win [getTablelistPath $w]
menubutton $w -anchor w -indicatoron 1 -justify left -padx 2 -pady 2 \
-relief raised -textvariable ::tablelist::ns${win}::data(editText)
foreach {opt val} $args {
$w configure $opt $val
}
variable winSys
upvar ::tablelist::ns${win}::data data
if {[string compare $winSys "aqua"] == 0} {
catch {
set data(useCustomMDEFSav) $::tk::mac::useCustomMDEF
set ::tk::mac::useCustomMDEF 1
}
}
set menu $w.menu
menu $menu -tearoff 0 -postcommand [list tablelist::postMenuCmd $w]
foreach event {