diff options
| author | Ian Roxborough <irox@redhat.com> | 2001-09-09 19:49:03 +0000 |
|---|---|---|
| committer | Ian Roxborough <irox@redhat.com> | 2001-09-09 19:49:03 +0000 |
| commit | 57e8350a3895a1579b77cc134d6d7d49b056678e (patch) | |
| tree | 7584c16f5407dd1371b8290109b3b822067afd5a /itcl/iwidgets3.0.0/generic | |
| parent | 7467241ff2a5cd6da7bbecb7111fc0dc3211c7de (diff) | |
| download | gdb-57e8350a3895a1579b77cc134d6d7d49b056678e.tar.gz | |
Itcl import for Tcl/Tk8.3 upgradeITCL_TCL_8_3
Diffstat (limited to 'itcl/iwidgets3.0.0/generic')
31 files changed, 759 insertions, 248 deletions
diff --git a/itcl/iwidgets3.0.0/generic/calendar.itk b/itcl/iwidgets3.0.0/generic/calendar.itk index 7c35487fbd1..a7b0363a7a8 100644 --- a/itcl/iwidgets3.0.0/generic/calendar.itk +++ b/itcl/iwidgets3.0.0/generic/calendar.itk @@ -378,7 +378,7 @@ configbody iwidgets::Calendar::buttonforeground { -foreground $itk_option(-buttonforeground) } } else { - $itk_option(-forwardimage) configure \ + $itk_component(forward) configure \ -foreground $itk_option(-buttonforeground) } @@ -388,7 +388,7 @@ configbody iwidgets::Calendar::buttonforeground { -foreground $itk_option(-buttonforeground) } } else { - $itk_option(-backwardimage) configure \ + $itk_component(-backward) configure \ -foreground $itk_option(-buttonforeground) } } @@ -890,7 +890,7 @@ body iwidgets::Calendar::_select {date_} { -width $itk_option(-selectthickness) $itk_component(page) raise $date-sensor } else { - set $_time $time + set _time $time _redraw } } diff --git a/itcl/iwidgets3.0.0/generic/canvasprintbox.itk b/itcl/iwidgets3.0.0/generic/canvasprintbox.itk index 20a566a5fab..64ced049bf4 100644 --- a/itcl/iwidgets3.0.0/generic/canvasprintbox.itk +++ b/itcl/iwidgets3.0.0/generic/canvasprintbox.itk @@ -239,6 +239,7 @@ configbody iwidgets::Canvasprintbox::pagesize { if {[lsearch $lst $opt] == -1} { error "bad option \"pagesize\": should be one of: [ezPaperInfo types]" } + $itk_component(paperom) select "*[string range $opt 1 end]" _update_canvas } diff --git a/itcl/iwidgets3.0.0/generic/checkbox.itk b/itcl/iwidgets3.0.0/generic/checkbox.itk index 30fa700321f..d1498d15667 100755 --- a/itcl/iwidgets3.0.0/generic/checkbox.itk +++ b/itcl/iwidgets3.0.0/generic/checkbox.itk @@ -46,8 +46,7 @@ option add *Checkbox.relief groove widgetDefault # Usual options. # itk::usual Checkbox { - keep -background -borderwidth -cursor -disabledforeground \ - -foreground -labelfont -selectcolor + keep -background -borderwidth -cursor -foreground -labelfont } # ------------------------------------------------------------------ @@ -58,10 +57,7 @@ class iwidgets::Checkbox { constructor {args} {} - itk_option define -disabledforeground \ - disabledForeground DisabledForeground {} - itk_option define -selectcolor selectColor Background {} - itk_option define -command command Command {} + itk_option define -orient orient Orient vertical public { method add {tag args} @@ -107,11 +103,26 @@ body iwidgets::Checkbox::constructor {args} { # ------------------------------------------------------------------ # ------------------------------------------------------------------ -# OPTION: -command +# OPTION: -orient # -# Specifies a command to be evaluated upon change in the checkbox +# Allows the user to orient the checkbuttons either horizontally +# or vertically. Added by Chad Smith (csmith@adc.com) 3/10/00. # ------------------------------------------------------------------ -configbody iwidgets::Checkbox::command {} +configbody iwidgets::Checkbox::orient { + if {$itk_option(-orient) == "horizontal"} { + foreach tag $_buttons { + pack $itk_component($tag) -side left -anchor nw -padx 4 -expand 1 + } + } elseif {$itk_option(-orient) == "vertical"} { + foreach tag $_buttons { + pack $itk_component($tag) -side top -anchor w -padx 4 -expand 0 + } + } else { + error "Bad orientation: $itk_option(-orient). Should be\ + \"horizontal\" or \"vertical\"." + } +} + # ------------------------------------------------------------------ # METHODS @@ -168,10 +179,17 @@ body iwidgets::Checkbox::add {tag args} { $args } { usual + keep -command -disabledforeground -selectcolor -state ignore -highlightthickness -highlightcolor rename -font -labelfont labelFont Font } - pack $itk_component($tag) -anchor w -padx 4 + + # Redraw the buttons with the proper orientation. + if {$itk_option(-orient) == "vertical"} { + pack $itk_component($tag) -side top -anchor w -padx 4 -expand 0 + } else { + pack $itk_component($tag) -side left -anchor nw -expand 1 + } lappend _buttons $tag @@ -233,6 +251,17 @@ body iwidgets::Checkbox::delete {index} { # ------------------------------------------------------------------ body iwidgets::Checkbox::select {index} { set tag [gettag $index] + #----------------------------------------------------------- + # BUG FIX: csmith (Chad Smith: csmith@adc.com), 3/30/99 + #----------------------------------------------------------- + # This method should only invoke the checkbutton if it's not + # already selected. Check its associated variable, and if + # it's set, then just ignore and return. + #----------------------------------------------------------- + if {[set [scope buttonVar($this,$tag)]] == + [[component $tag] cget -onvalue]} { + return + } $itk_component($tag) invoke } @@ -310,4 +339,3 @@ body iwidgets::Checkbox::buttonconfigure {index args} { body iwidgets::Checkbox::gettag {index} { return [lindex $_buttons [index $index]] } - diff --git a/itcl/iwidgets3.0.0/generic/combobox.itk b/itcl/iwidgets3.0.0/generic/combobox.itk index 45b79b037b6..ab70ba98956 100644 --- a/itcl/iwidgets3.0.0/generic/combobox.itk +++ b/itcl/iwidgets3.0.0/generic/combobox.itk @@ -360,7 +360,7 @@ configbody iwidgets::Combobox::state { must be normal or disabled" } } - if {[info exists itk_component(arrowBtn)]} { + if {[winfo exists itk_component(arrowBtn)]} { $itk_component(arrowBtn) configure -state $itk_option(-state) } } @@ -435,6 +435,9 @@ body iwidgets::Combobox::curselection {} { body iwidgets::Combobox::delete {component first {last {}}} { switch -- $component { entry { + if {$last == {}} { + set last [expr $first + 1] + } iwidgets::Entryfield::delete $first $last } list { @@ -656,7 +659,25 @@ body iwidgets::Combobox::_createComponents {} { # --- build a dropdown combobox --- # make the arrow childsite be on the right hand side - configure -childsitepos e -command [code $this _addToList] + + #------------------------------------------------------------- + # BUG FIX: csmith (Chad Smith: csmith@adc.com), 3/4/99 + #------------------------------------------------------------- + # The following commented line of code overwrites the -command + # option when passed into the constructor. The order of calls + # in the constructor is: + # 1) eval itk_initalize $args (initializes -command) + # 2) _doLayout + # 3) _createComponents (overwrites -command) + # The solution is to only set the -command option if it hasn't + # already been set. The following 4 lines of code do this. + #------------------------------------------------------------- + # ** configure -childsitepos e -command [code $this _addToList] + #------------------------------------------------------------- + configure -childsitepos e + if ![llength [cget -command]] { + configure -command [code $this _addToList] + } # arrow button to popup the list itk_component add arrowBtn { diff --git a/itcl/iwidgets3.0.0/generic/dateentry.itk b/itcl/iwidgets3.0.0/generic/dateentry.itk index a6dff9eae03..5cf648c03b1 100644 --- a/itcl/iwidgets3.0.0/generic/dateentry.itk +++ b/itcl/iwidgets3.0.0/generic/dateentry.itk @@ -403,6 +403,5 @@ body iwidgets::Dateentry::_releaseGrab {} { grab release $itk_component(popup) $itk_component(iconbutton) configure -relief raised destroy $itk_component(popup) - unset itk_component(popup) bind $itk_component(iconbutton) <Button-1> [code $this _popup] } diff --git a/itcl/iwidgets3.0.0/generic/disjointlistbox.itk b/itcl/iwidgets3.0.0/generic/disjointlistbox.itk index 5f40399fa8e..1234eae70e6 100755 --- a/itcl/iwidgets3.0.0/generic/disjointlistbox.itk +++ b/itcl/iwidgets3.0.0/generic/disjointlistbox.itk @@ -50,9 +50,6 @@ # # Default resources. # - -set tk_strictMotif 1 - option add *Disjointlistbox.lhsLabelText Available widgetDefault option add *Disjointlistbox.rhsLabelText Current widgetDefault option add *Disjointlistbox.lhsButtonLabel {Insert >>} widgetDefault diff --git a/itcl/iwidgets3.0.0/generic/entryfield.itk b/itcl/iwidgets3.0.0/generic/entryfield.itk index 065e6a56e16..bf3880086cf 100644 --- a/itcl/iwidgets3.0.0/generic/entryfield.itk +++ b/itcl/iwidgets3.0.0/generic/entryfield.itk @@ -56,6 +56,7 @@ class iwidgets::Entryfield { itk_option define -fixed fixed Fixed 0 itk_option define -focuscommand focusCommand Command {} itk_option define -invalid invalid Command {bell} + itk_option define -pasting pasting Behavior 1 itk_option define -validate validate Command {} public { @@ -192,6 +193,40 @@ configbody iwidgets::Entryfield::validate { configbody iwidgets::Entryfield::invalid {} # ------------------------------------------------------------------ +# OPTION: -pasting +# +# Allows the developer to enable and disable pasting into the entry +# component of the entryfield. This is done to avoid potential stack +# dumps when using the -validate configuration option. Plus, it's just +# a good idea to have complete control over what you allow the user +# to enter into the entryfield. +# ------------------------------------------------------------------ +configbody iwidgets::Entryfield::pasting { + set oldtags [bindtags $itk_component(entry)] + set firsttag [lindex $oldtags 0] + + if ($itk_option(-pasting)) { + if {$firsttag == "pastetag"} { + bindtags $itk_component(entry) [lreplace $oldtags 0 0] + } + + } else { + if {$firsttag == "pastetag"} { + # Ignore this if it's already set. + return + } + bindtags $itk_component(entry) [linsert $oldtags 0 pastetag] + bind pastetag <ButtonRelease-2> {break} + bind pastetag <KeyPress> { + # Disable function keys > F9 and the 'Insert' key. + if {[regexp {^F[1,2][0-9]+$} "%K"] || "%K" == "Insert"} { + break + } + } + } +} + +# ------------------------------------------------------------------ # OPTION: -fixed # # Restrict entry to 0 (unlimited) chars. The value is the maximum @@ -475,10 +510,31 @@ body iwidgets::Entryfield::_keyPress {char sym state} { # means a modifier was used such as a control, meta key, or control # or meta key with numlock down. # - if {($char == "") || \ - ($state == 4) || ($state == 8) || \ - ($state == 36) || ($state == 40)} { - return -code continue 1 + #----------------------------------------------------------- + # BUG FIX: csmith (Chad Smith: csmith@adc.com), 3/15/99 + #----------------------------------------------------------- + # The following conditional used to hardcode specific state values, such + # as "4" and "8". These values are used to detect <Ctrl>, <Shift>, etc. + # key combinations. On the windows platform, the <Alt> key is state + # 16, and on the unix platform, the <Alt> key is state 8. All <Ctrl> + # and <Alt> combinations should be masked out, regardless of the + # <NumLock> or <CapsLock> status, and regardless of platform. + #----------------------------------------------------------- + set CTRL 4 + global tcl_platform + if {$tcl_platform(platform) == "unix"} { + set ALT 8 + } elseif {$tcl_platform(platform) == "windows"} { + set ALT 16 + } else { + # This is something other than UNIX or WINDOWS. Default to the + # old behavior (UNIX). + set ALT 8 + } + # Thanks to Rolf Schroedter for the following elegant conditional. This + # masks out all <Ctrl> and <Alt> key combinations. + if {($char == "") || ($state & ($CTRL | $ALT))} { + return -code continue 1 } # diff --git a/itcl/iwidgets3.0.0/generic/extfileselectionbox.itk b/itcl/iwidgets3.0.0/generic/extfileselectionbox.itk index 34c9ddbaec7..0b04fcf26d4 100644 --- a/itcl/iwidgets3.0.0/generic/extfileselectionbox.itk +++ b/itcl/iwidgets3.0.0/generic/extfileselectionbox.itk @@ -81,20 +81,17 @@ class iwidgets::Extfileselectionbox { method filter {} } - public { - method _selectDir {} - method _dblSelectDir {} - method _selectFile {} - method _selectSelection {} - method _selectFilter {} - } - protected { method _packComponents {{when later}} method _updateLists {{when later}} } private { + method _selectDir {} + method _dblSelectDir {} + method _selectFile {} + method _selectSelection {} + method _selectFilter {} method _setFilter {} method _setSelection {} method _setDirList {} @@ -716,6 +713,8 @@ body iwidgets::Extfileselectionbox::_setSelection {} { } else { set selection [file join $_pwd ..] } + } else { + set selection [file join $_pwd $selection] } # diff --git a/itcl/iwidgets3.0.0/generic/feedback.itk b/itcl/iwidgets3.0.0/generic/feedback.itk index 54c1f7b4d26..3e765bec3f8 100644 --- a/itcl/iwidgets3.0.0/generic/feedback.itk +++ b/itcl/iwidgets3.0.0/generic/feedback.itk @@ -109,7 +109,7 @@ proc ::iwidgets::feedback {pathName args} { # ------------------------------------------------------------------ # CONSTRUCTOR # ------------------------------------------------------------------ -body iwidgets::Feedback::constructor {args} { +itcl::body iwidgets::Feedback::constructor {args} { itk_component add trough { frame $itk_interior.trough -relief sunken } { @@ -138,13 +138,15 @@ body iwidgets::Feedback::constructor {args} { grid rowconfigure $itk_interior 1 -weight 1 grid columnconfigure $itk_interior 0 -weight 1 + bind $itk_component(hull) <Configure> [itcl::code $this _display] + eval itk_initialize $args } # ------------------------------------------------------------------ # DESTRUCTOR # ------------------------------------------------------------------ -body iwidgets::Feedback::destructor {} { +itcl::body iwidgets::Feedback::destructor {} { } # ------------------------------------------------------------------ @@ -156,7 +158,7 @@ body iwidgets::Feedback::destructor {} { # # Set the total number of steps. # ------------------------------------------------------------------ -configbody iwidgets::Feedback::steps { +itcl::configbody iwidgets::Feedback::steps { step 0 } @@ -170,9 +172,12 @@ configbody iwidgets::Feedback::steps { # Displays the bar in the trough with the width set using the current number # of steps. # ----------------------------------------------------------------------------- -body iwidgets::Feedback::_display {} { +itcl::body iwidgets::Feedback::_display {} { + update idletasks set troughwidth [winfo width $itk_component(trough)] - set _barwidth [expr $troughwidth.0/$itk_option(-steps)] + set _barwidth [expr \ + (1.0*$troughwidth-(2.0*[$itk_component(trough) cget -borderwidth])) / \ + $itk_option(-steps)] set fraction [expr int((1.0*$_stepval)/$itk_option(-steps)*100.0)] $itk_component(percentage) config -text "$fraction%" @@ -186,7 +191,7 @@ body iwidgets::Feedback::_display {} { # # Resets the status bar to 0 # ------------------------------------------------------------------ -body iwidgets::Feedback::reset {} { +itcl::body iwidgets::Feedback::reset {} { set _stepval 0 _display } @@ -196,7 +201,7 @@ body iwidgets::Feedback::reset {} { # # Increase the value of the status bar by inc. Default to 1 # ------------------------------------------------------------------ -body iwidgets::Feedback::step {{inc 1}} { +itcl::body iwidgets::Feedback::step {{inc 1}} { if {$_stepval >= $itk_option(-steps)} { return diff --git a/itcl/iwidgets3.0.0/generic/fileselectionbox.itk b/itcl/iwidgets3.0.0/generic/fileselectionbox.itk index b41b29cdcdf..b164afbfd49 100644 --- a/itcl/iwidgets3.0.0/generic/fileselectionbox.itk +++ b/itcl/iwidgets3.0.0/generic/fileselectionbox.itk @@ -674,6 +674,8 @@ body iwidgets::Fileselectionbox::_setSelection {} { } else { set selection [file join $_pwd ..] } + } else { + set selection [file join $_pwd $selection] } # @@ -683,6 +685,7 @@ body iwidgets::Fileselectionbox::_setSelection {} { regsub {^/(tmp_mnt|export)} $selection {} selection; } + $itk_component(selection) delete 0 end $itk_component(selection) insert 0 $selection } diff --git a/itcl/iwidgets3.0.0/generic/finddialog.itk b/itcl/iwidgets3.0.0/generic/finddialog.itk index b237153ac32..894d0db4fff 100755 --- a/itcl/iwidgets3.0.0/generic/finddialog.itk +++ b/itcl/iwidgets3.0.0/generic/finddialog.itk @@ -251,7 +251,7 @@ body ::iwidgets::Finddialog::clear {} { } if {$itk_option(-clearcommand) != {}} { - $itk_option(-clearcommand) + eval $itk_option(-clearcommand) } } @@ -423,7 +423,7 @@ body ::iwidgets::Finddialog::find {} { # If a match command is defined, then call it with the match point. # if {$itk_option(-matchcommand) != {}} { - $itk_option(-matchcommand) $matchPoint + [subst $itk_option(-matchcommand)] $matchPoint } # diff --git a/itcl/iwidgets3.0.0/generic/hierarchy.itk b/itcl/iwidgets3.0.0/generic/hierarchy.itk index 79bad190b50..f315fd07b8a 100644 --- a/itcl/iwidgets3.0.0/generic/hierarchy.itk +++ b/itcl/iwidgets3.0.0/generic/hierarchy.itk @@ -80,12 +80,17 @@ class iwidgets::Hierarchy { itk_option define -alwaysquery alwaysQuery AlwaysQuery 0 itk_option define -closedicon closedIcon Icon {} + itk_option define -dblclickcommand dblClickCommand Command {} itk_option define -expanded expanded Expanded 0 itk_option define -filter filter Filter 0 itk_option define -font font Font \ -*-Courier-Medium-R-Normal--*-120-*-*-*-*-*-* itk_option define -height height Height 0 itk_option define -iconcommand iconCommand Command {} + itk_option define -icondblcommand iconDblCommand Command {} + itk_option define -imagecommand imageCommand Command {} + itk_option define -imagedblcommand imageDblCommand Command {} + itk_option define -imagemenuloadcommand imageMenuLoadCommand Command {} itk_option define -markbackground markBackground Foreground #a0a0a0 itk_option define -markforeground markForeground Background Black itk_option define -nodeicon nodeIcon Icon {} @@ -94,63 +99,77 @@ class iwidgets::Hierarchy { itk_option define -selectcommand selectCommand Command {} itk_option define -selectbackground selectBackground Foreground #c3c3c3 itk_option define -selectforeground selectForeground Background Black + itk_option define -textmenuloadcommand textMenuLoadCommand Command {} itk_option define -visibleitems visibleItems VisibleItems 80x24 itk_option define -width width Width 0 - public method clear {} - public method collapse {node} - public method current {} - public method draw {{when -now}} - public method expand {node} - public method mark {op args} - public method prune {node} - public method refresh {node} - public method selection {op args} - public method toggle {node} - - public method bbox {index} - public method compare {index1 op index2} - public method debug {args} {eval $args} - public method delete {first {last {}}} - public method dlineinfo {index} - public method dump {args} - public method get {index1 {index2 {}}} - public method index {index} - public method insert {args} - public method scan {option args} - public method search {args} - public method see {index} - public method tag {op args} - public method window {option args} - public method xview {args} - public method yview {args} - - protected method _contents {uid} - protected method _iconSelect {node icon} - protected method _post {x y} - protected method _drawLevel {node indent} - protected method _select {x y} - protected method _deselectSubNodes {uid} - protected method _deleteNodeInfo {uid} - protected method _getParent {uid} - protected method _getHeritage {uid} - protected method _isInternalTag {tag} - - private variable _filterCode "" ;# Compact view flag. - private variable _hcounter 0 ;# Counter for hierarchy icons - private variable _icons ;# Array of user icons by uid - private variable _images ;# Array of our icons by uid - private variable _indents ;# Array of indentation by uid - private variable _marked ;# Array of marked nodes by uid - private variable _markers "" ;# List of markers for level being drawn - private variable _nodes ;# List of subnodes by uid - private variable _pending "" ;# Pending draw flag - private variable _posted "" ;# List of tags at posted menu position - private variable _selected ;# Array of selected nodes by uid - private variable _tags ;# Array of user tags by uid - private variable _text ;# Array of displayed text by uid - private variable _states ;# Array of selection state by uid - private variable _ucounter 0 ;# Counter for user icons + public { + method clear {} + method collapse {node} + method current {} + method draw {{when -now}} + method expand {node} + method expanded {node} + method expState { } + method mark {op args} + method prune {node} + method refresh {node} + method selection {op args} + method toggle {node} + + method bbox {index} + method compare {index1 op index2} + method debug {args} {eval $args} + method delete {first {last {}}} + method dlineinfo {index} + method dump {args} + method get {index1 {index2 {}}} + method index {index} + method insert {args} + method scan {option args} + method search {args} + method see {index} + method tag {op args} + method window {option args} + method xview {args} + method yview {args} + } + + protected { + method _contents {uid} + method _post {x y} + method _drawLevel {node indent} + method _select {x y} + method _deselectSubNodes {uid} + method _deleteNodeInfo {uid} + method _getParent {uid} + method _getHeritage {uid} + method _isInternalTag {tag} + method _iconSelect {node icon} + method _iconDblSelect {node icon} + method _imageSelect {node} + method _imageDblClick {node} + method _imagePost {node image type x y} + method _double {x y} + } + + private { + variable _filterCode "" ;# Compact view flag. + variable _hcounter 0 ;# Counter for hierarchy icons + variable _icons ;# Array of user icons by uid + variable _images ;# Array of our icons by uid + variable _indents ;# Array of indentation by uid + variable _marked ;# Array of marked nodes by uid + variable _markers "" ;# List of markers for level being drawn + variable _nodes ;# List of subnodes by uid + variable _pending "" ;# Pending draw flag + variable _posted "" ;# List of tags at posted menu position + variable _selected ;# Array of selected nodes by uid + variable _tags ;# Array of user tags by uid + variable _text ;# Array of displayed text by uid + variable _states ;# Array of selection state by uid + variable _ucounter 0 ;# Counter for user icons + } } # @@ -275,6 +294,9 @@ body iwidgets::Hierarchy::constructor {args} { bind $itk_component(list) <ButtonPress-1> \ [code $this _select %x %y] + bind $itk_component(list) <Double-1> \ + [code $this _double %x %y] + bind $itk_component(list) <ButtonPress-3> \ [code $this _post %x %y] @@ -407,6 +429,20 @@ configbody iwidgets::Hierarchy::selectcommand { } # ------------------------------------------------------------------ +# OPTION: -dblclickcommand +# +# Command executed to double click an item in the list. If this command +# contains "%n", it is replaced with the name of the selected node. +# If it contains a "%s", it is replaced with a boolean indicator of +# the node's current selection status, where a value of 1 denotes +# that the node is currently selected and 0 that it is not. +# +# Douglas R. Howard, Jr. +# ------------------------------------------------------------------ +configbody iwidgets::Hierarchy::dblclickcommand { +} + +# ------------------------------------------------------------------ # OPTION: -iconcommand # # Command executed upon selection of user icons. If this command @@ -418,6 +454,44 @@ configbody iwidgets::Hierarchy::iconcommand { } # ------------------------------------------------------------------ +# OPTION: -icondblcommand +# +# Command executed upon double selection of user icons. If this command +# contains "%n", it is replaced with the name of the node the icon +# belongs to. Should it contain "%i" then the icon name is +# substituted. +# +# Douglas R. Howard, Jr. +# ------------------------------------------------------------------ +configbody iwidgets::Hierarchy::icondblcommand { +} + +# ------------------------------------------------------------------ +# OPTION: -imagecommand +# +# Command executed upon selection of image icons. If this command +# contains "%n", it is replaced with the name of the node the icon +# belongs to. Should it contain "%i" then the icon name is +# substituted. +# +# Douglas R. Howard, Jr. +# ------------------------------------------------------------------ +configbody iwidgets::Hierarchy::imagecommand { +} + +# ------------------------------------------------------------------ +# OPTION: -imagedblcommand +# +# Command executed upon double selection of user icons. If this command +# contains "%n", it is replaced with the name of the node the icon +# belongs to. +# +# Douglas R. Howard, Jr. +# ------------------------------------------------------------------ +configbody iwidgets::Hierarchy::imagedblcommand { +} + +# ------------------------------------------------------------------ # OPTION: -alwaysquery # # Boolean flag which tells the hierarchy widget weather or not @@ -524,10 +598,8 @@ configbody iwidgets::Hierarchy::openicon { 0xff, 0x1f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; } } - - set itk_option(-openicon) openFolder } - + set itk_option(-openicon) openFolder } else { if {[lsearch [image names] $itk_option(-openicon)] == -1} { error "bad openicon option \"$itk_option(-openicon)\":\ @@ -582,10 +654,8 @@ configbody iwidgets::Hierarchy::closedicon { 0xfe, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; } } - - set itk_option(-closedicon) closedFolder } - + set itk_option(-closedicon) closedFolder } else { if {[lsearch [image names] $itk_option(-closedicon)] == -1} { error "bad closedicon option \"$itk_option(-closedicon)\":\ @@ -640,10 +710,8 @@ configbody iwidgets::Hierarchy::nodeicon { 0xfe, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; } } - - set itk_option(-nodeicon) nodeFolder } - + set itk_option(-nodeicon) nodeFolder } else { if {[lsearch [image names] $itk_option(-nodeicon)] == -1} { error "bad nodeicon option \"$itk_option(-nodeicon)\":\ @@ -761,6 +829,25 @@ configbody iwidgets::Hierarchy::visibleitems { } # ------------------------------------------------------------------ +# OPTION: -textmenuloadcommand +# +# Dynamically loads the popup menu based on what was selected. +# +# Douglas R. Howard, Jr. +# ------------------------------------------------------------------ +configbody iwidgets::Hierarchy::textmenuloadcommand {} + +# ------------------------------------------------------------------ +# OPTION: -imagemenuloadcommand +# +# Dynamically loads the popup menu based on what was selected. +# +# Douglas R. Howard, Jr. +# ------------------------------------------------------------------ +configbody iwidgets::Hierarchy::imagemenuloadcommand {} + + +# ------------------------------------------------------------------ # PUBLIC METHODS # ------------------------------------------------------------------ @@ -1255,6 +1342,47 @@ body iwidgets::Hierarchy::yview {args} { return [eval $itk_component(list) yview $args] } +# ---------------------------------------------------------------------- +# PUBLIC METHOD: expanded node +# +# Tells if a node is expanded or collapsed +# +# Douglas R. Howard, Jr. +# ---------------------------------------------------------------------- +body iwidgets::Hierarchy::expanded {node} { + if {! [info exists _states($node)]} { + error "bad collapse node argument: \"$node\", the node doesn't exist" + } + + return $_states($node) +} + +# ---------------------------------------------------------------------- +# PUBLIC METHOD: expState +# +# Returns a list of all expanded nodes +# +# Douglas R. Howard, Jr. +# ---------------------------------------------------------------------- +body iwidgets::Hierarchy::expState {} { + set nodes [_contents ""] + set open "" + set i 0 + while {1} { + if {[info exists _states([lindex $nodes $i])] && + $_states([lindex $nodes $i])} { + lappend open [lindex $nodes $i] + foreach child [_contents [lindex $nodes $i]] { + lappend nodes $child + } + } + incr i + if {$i >= [llength $nodes]} {break} + } + + return $open +} + # ------------------------------------------------------------------ # PROTECTED METHODS # ------------------------------------------------------------------ @@ -1331,7 +1459,13 @@ body iwidgets::Hierarchy::_drawLevel {node indent} { # its expanded/collapsed state. # label $_images($child) -image $icon -background $bg - bind $_images($child) <ButtonPress-1> [code $this toggle $child] + # DRH - enhanced and added features that handle image clicking, + # double clicking, and right clicking behavior + bind $_images($child) <ButtonPress-1> \ + "[code $this toggle $child]; [code $this _imageSelect $child]" + bind $_images($child) <Double-1> [code $this _imageDblClick $child] + bind $_images($child) <ButtonPress-3> \ + [code $this _imagePost $child $_images($child) $type %x %y] $itk_component(list) window create insert -window $_images($child) # @@ -1351,8 +1485,14 @@ body iwidgets::Hierarchy::_drawLevel {node indent} { label $wid -image $image -background $bg } + # DRH - this will bind events to the icons to allow + # clicking, double clicking, and right clicking actions. bind $wid <ButtonPress-1> \ - [code $this _iconSelect $child $image] + [code $this _iconSelect $child $image] + bind $wid <Double-1> \ + [code $this _iconDblSelect $child $image] + bind $wid <ButtonPress-3> \ + [code $this _imagePost $child $wid $type %x %y] $itk_component(list) window create insert -window $wid } } @@ -1508,6 +1648,12 @@ body iwidgets::Hierarchy::_post {x y} { # If we have tags then do the popup at this position. # if {$_posted != {}} { + # DRH - here is where the user's function for dynamic popup + # menu loading is done, if the user has specified to do so with the + # "-textmenuloadcommand" + if {$itk_option(-textmenuloadcommand) != {}} { + eval $itk_option(-textmenuloadcommand) + } tk_popup $itk_component(itemMenu) $rx $ry } else { tk_popup $itk_component(bgMenu) $rx $ry @@ -1515,6 +1661,38 @@ body iwidgets::Hierarchy::_post {x y} { } # ---------------------------------------------------------------------- +# PROTECTED METHOD: _imagePost node image type x y +# +# Used internally to post the popup menu at the coordinate (x,y) +# relative to the widget. If (x,y) is on an image, then the itemMenu +# component is posted. +# +# Douglas R. Howard, Jr. +# ---------------------------------------------------------------------- +body iwidgets::Hierarchy::_imagePost {node image type x y} { + set rx [expr [winfo rootx $image]+$x] + set ry [expr [winfo rooty $image]+$y] + + # + # The posted variable will hold the list of tags which exist at + # this x,y position that will be passed back to the user. They + # don't need to know about our internal tags, info, hilite, and + # lowlite, so remove them from the list. + # + set _posted {} + + lappend _posted $node $type + + # + # If we have tags then do the popup at this position. + # + if {$itk_option(-imagemenuloadcommand) != {}} { + eval $itk_option(-imagemenuloadcommand) + } + tk_popup $itk_component(itemMenu) $rx $ry +} + +# ---------------------------------------------------------------------- # PROTECTED METHOD: _select x y # # Used internally to select an item at the coordinate (x,y) relative @@ -1551,10 +1729,50 @@ body iwidgets::Hierarchy::_select {x y} { } # ---------------------------------------------------------------------- +# PROTECTED METHOD: _double x y +# +# Used internally to double click an item at the coordinate (x,y) relative +# to the widget. The command associated with the -dblclickcommand +# option is execute following % character substitutions. If %n +# appears in the command, the selected node is substituted. If %s +# appears, a boolean value representing the current selection state +# will be substituted. +# +# Douglas R. Howard, Jr. +# ---------------------------------------------------------------------- +body iwidgets::Hierarchy::_double {x y} { + if {$itk_option(-dblclickcommand) != {}} { + if {[set seltags [$itk_component(list) tag names @$x,$y]] != {}} { + foreach tag $seltags { + if {![_isInternalTag $tag]} { + lappend node $tag + } + } + + if {[lsearch $seltags "hilite"] == -1} { + set selectstatus 0 + } else { + set selectstatus 1 + } + + set cmd $itk_option(-dblclickcommand) + regsub -all {%n} $cmd [list $node] cmd + regsub -all {%s} $cmd [list $selectstatus] cmd + + uplevel #0 $cmd + } + } + + return +} + +# ---------------------------------------------------------------------- # PROTECTED METHOD: _iconSelect node icon # # Used internally to upon selection of user icons. The -iconcommand # is executed after substitution of the node for %n and icon for %i. +# +# Douglas R. Howard, Jr. # ---------------------------------------------------------------------- body iwidgets::Hierarchy::_iconSelect {node icon} { set cmd $itk_option(-iconcommand) @@ -1567,6 +1785,62 @@ body iwidgets::Hierarchy::_iconSelect {node icon} { } # ---------------------------------------------------------------------- +# PROTECTED METHOD: _iconDblSelect node icon +# +# Used internally to upon double selection of user icons. The +# -icondblcommand is executed after substitution of the node for %n and +# icon for %i. +# +# Douglas R. Howard, Jr. +# ---------------------------------------------------------------------- +body iwidgets::Hierarchy::_iconDblSelect {node icon} { + if {$itk_option(-icondblcommand) != {}} { + set cmd $itk_option(-icondblcommand) + regsub -all {%n} $cmd [list $node] cmd + regsub -all {%i} $cmd [list $icon] cmd + + uplevel \#0 $cmd + } + return {} +} + +# ---------------------------------------------------------------------- +# PROTECTED METHOD: _imageSelect node icon +# +# Used internally to upon selection of user icons. The -imagecommand +# is executed after substitution of the node for %n. +# +# Douglas R. Howard, Jr. +# ---------------------------------------------------------------------- +body iwidgets::Hierarchy::_imageSelect {node} { + if {$itk_option(-imagecommand) != {}} { + set cmd $itk_option(-imagecommand) + regsub -all {%n} $cmd [list $node] cmd + + uplevel \#0 $cmd + } + return {} +} + +# ---------------------------------------------------------------------- +# PROTECTED METHOD: _imageDblClick node +# +# Used internally to upon double selection of images. The +# -imagedblcommand is executed. +# +# Douglas R. Howard, Jr. +# ---------------------------------------------------------------------- +body iwidgets::Hierarchy::_imageDblClick {node} { + if {$itk_option(-imagedblcommand) != {}} { + set cmd $itk_option(-imagedblcommand) + regsub -all {%n} $cmd [list $node] cmd + + uplevel \#0 $cmd + } + return {} +} + +# ---------------------------------------------------------------------- # PROTECTED METHOD: _deselectSubNodes uid # # Used internally to recursively deselect all the nodes beneath a diff --git a/itcl/iwidgets3.0.0/generic/hyperhelp.itk b/itcl/iwidgets3.0.0/generic/hyperhelp.itk index e3f4a05bd83..8eb5e80be44 100644 --- a/itcl/iwidgets3.0.0/generic/hyperhelp.itk +++ b/itcl/iwidgets3.0.0/generic/hyperhelp.itk @@ -261,9 +261,8 @@ configbody iwidgets::Hyperhelp::title { # Set location of help files # ------------------------------------------------------------------ configbody iwidgets::Hyperhelp::helpdir { - if {[string index [file dirname $itk_option(-helpdir)] 0] != "/" && \ - [string index [file dirname $itk_option(-helpdir)] 0] != "~"} { - configure -helpdir [pwd]/$itk_option(-helpdir) + if {[file pathtype $itk_option(-helpdir)] == "relative"} { + configure -helpdir [file join [pwd] $itk_option(-helpdir)] } else { set _history {} set _history_len 0 diff --git a/itcl/iwidgets3.0.0/generic/labeledframe.itk b/itcl/iwidgets3.0.0/generic/labeledframe.itk index 19b8540f70b..0291c2053d2 100644 --- a/itcl/iwidgets3.0.0/generic/labeledframe.itk +++ b/itcl/iwidgets3.0.0/generic/labeledframe.itk @@ -105,14 +105,20 @@ class iwidgets::Labeledframe { public method clientHandlesConfigure {{yes 1}} # - # Private methods + # Protected methods # - private { - method smt {value} { _setMarginThickness $value } + + protected { method _positionLabel {{when later}} method _collapseMargin {} method _setMarginThickness {value} + method smt {value} { _setMarginThickness $value } + } + # + # Private methods/data + # + private { proc _initTable {} variable _reposition "" ;# non-null => _positionLabel pending diff --git a/itcl/iwidgets3.0.0/generic/menubar.itk b/itcl/iwidgets3.0.0/generic/menubar.itk index 35f1a669374..1b6e0b25329 100644 --- a/itcl/iwidgets3.0.0/generic/menubar.itk +++ b/itcl/iwidgets3.0.0/generic/menubar.itk @@ -109,8 +109,6 @@ class iwidgets::Menubar { method path { args } { } method type { path } { } method yposition { entryPath } { } - - method _helpHandler { menuPath } { } } private { @@ -121,6 +119,7 @@ class iwidgets::Menubar { method radiobutton { radName args } { } method separator { sepName args } { } method cascade { casName args } { } + method _helpHandler { menuPath } { } method _addMenuButton { buttonName args} { } method _insertMenuButton { beforeMenuPath buttonName args} { } method _makeMenuButton {buttonName args} { } @@ -2114,7 +2113,7 @@ body iwidgets::Menubar::_getSymbolicPath { parent segment } { # ------------------------------------------------------------- # -# PROTECTED METHOD: _helpHandler +# PRIVATE METHOD: _helpHandler # # Bound to the <Motion> event on a menu pane. This puts the # help string associated with the menu entry into the @@ -2207,7 +2206,12 @@ body iwidgets::Menubar::_getCallerLevel { } { # in frames. Since our menubuttons are within the Menubar class, the # default proc won't find them during menu traversal. This proc # redefines the default proc to remedy the problem. -# +#----------------------------------------------------------- +# BUG FIX: csmith (Chad Smith: csmith@adc.com), 3/30/99 +#----------------------------------------------------------- +# The line, "set qchild ..." below had a typo. It should be +# "info command $child" instead of "winfo command $child". +#----------------------------------------------------------- proc tkMenuFind {w char} { global tkPriv set char [string tolower $char] @@ -2215,7 +2219,7 @@ proc tkMenuFind {w char} { foreach child [winfo child $w] { switch [winfo class $child] { Menubutton { - set qchild [winfo command $child] + set qchild [info command $child] set char2 [string index [$qchild cget -text] \ [$qchild cget -underline]] if {([string compare $char [string tolower $char2]] == 0) diff --git a/itcl/iwidgets3.0.0/generic/messagedialog.itk b/itcl/iwidgets3.0.0/generic/messagedialog.itk index 072f4d34068..ba1927a194f 100644 --- a/itcl/iwidgets3.0.0/generic/messagedialog.itk +++ b/itcl/iwidgets3.0.0/generic/messagedialog.itk @@ -39,6 +39,7 @@ # itk::usual Messagedialog { keep -background -cursor -font -foreground -modality + keep -wraplength -justify } # ------------------------------------------------------------------ @@ -88,6 +89,7 @@ body iwidgets::Messagedialog::constructor {args} { label $itk_interior.message } { keep -background -cursor -font -foreground -text + keep -wraplength -justify rename -padx -textpadx textPadX Pad rename -pady -textpady textPadY Pad diff --git a/itcl/iwidgets3.0.0/generic/notebook.itk b/itcl/iwidgets3.0.0/generic/notebook.itk index 78a470c44e8..a83a7984933 100644 --- a/itcl/iwidgets3.0.0/generic/notebook.itk +++ b/itcl/iwidgets3.0.0/generic/notebook.itk @@ -764,7 +764,7 @@ body iwidgets::Notebook::_deletePages { fromPage toPage } { # If we deleted a selected page set our selection to none if { $_currPage >= $fromPage && $_currPage <= $toPage } { - set $_currPage -1 + set _currPage -1 } # make sure _currPage stays in sync with new numbering... diff --git a/itcl/iwidgets3.0.0/generic/optionmenu.itk b/itcl/iwidgets3.0.0/generic/optionmenu.itk index cfc700f3033..f0fd8b998cd 100644 --- a/itcl/iwidgets3.0.0/generic/optionmenu.itk +++ b/itcl/iwidgets3.0.0/generic/optionmenu.itk @@ -123,7 +123,7 @@ body iwidgets::Optionmenu::constructor {args} { component hull configure -highlightthickness 0 itk_component add menuBtn { - menubutton $itk_interior.menuBtn -relief raised -indicator on \ + menubutton $itk_interior.menuBtn -relief raised -indicatoron on \ -textvariable [scope _currentItem] -takefocus 1 \ -menu $itk_interior.menuBtn.menu } { @@ -411,6 +411,9 @@ body iwidgets::Optionmenu::insert {index string args} { # ------------------------------------------------------------------ body iwidgets::Optionmenu::select {index} { set index [index $index] + if {$index > [expr $_numitems - 1]} { + incr index -1 + } _setItem [lindex $_items $index] } @@ -601,7 +604,24 @@ body iwidgets::Optionmenu::_setitems {items_} { # if {$first != ""} { set i [lsearch -exact $_items $savedCurrentItem] - select [expr {$i != -1 ? $savedCurrentItem : $first}] + #------------------------------------------------------------- + # BEGIN BUG FIX: csmith (Chad Smith: csmith@adc.com), 11/18/99 + #------------------------------------------------------------- + # The previous code fragment: + # <select [expr {$i != -1 ? $savedCurrentItem : $first}]> + # is faulty because of exponential numbers. For example, + # 2e-4 is numerically equal to 2e-04, but the string representation + # is of course different. As a result, the select invocation + # fails, and an error message is printed. + #------------------------------------------------------------- + if {$i != -1} { + select $savedCurrentItem + } else { + select $first + } + #------------------------------------------------------------- + # END BUG FIX + #------------------------------------------------------------- } else { _setItem "" } diff --git a/itcl/iwidgets3.0.0/generic/pane.itk b/itcl/iwidgets3.0.0/generic/pane.itk index dd1baa28182..b7260f3815c 100644 --- a/itcl/iwidgets3.0.0/generic/pane.itk +++ b/itcl/iwidgets3.0.0/generic/pane.itk @@ -97,7 +97,7 @@ configbody iwidgets::Pane::minimum { set pixels \ [winfo pixels $itk_component(hull) $itk_option(-minimum)] - set $itk_option(-minimum) $pixels + set itk_option(-minimum) $pixels } # ------------------------------------------------------------------ diff --git a/itcl/iwidgets3.0.0/generic/panedwindow.itk b/itcl/iwidgets3.0.0/generic/panedwindow.itk index 6ed1165919b..644d1d6c8f7 100644 --- a/itcl/iwidgets3.0.0/generic/panedwindow.itk +++ b/itcl/iwidgets3.0.0/generic/panedwindow.itk @@ -151,7 +151,7 @@ configbody iwidgets::Panedwindow::orient { if {$_initialized} { switch $itk_option(-orient) { vertical { - for {set i 1} {$i < [llength $_panes]} {incr i} { + for {set i 1} {$i < [llength $_activePanes]} {incr i} { bind $itk_component(sash$i) <Button-1> \ [code $this _startGrip %x $i] bind $itk_component(sash$i) <B1-Motion> \ @@ -168,7 +168,7 @@ configbody iwidgets::Panedwindow::orient { } horizontal { - for {set i 1} {$i < [llength $_panes]} {incr i} { + for {set i 1} {$i < [llength $_activePanes]} {incr i} { bind $itk_component(sash$i) <Button-1> \ [code $this _startGrip %y $i] bind $itk_component(sash$i) <B1-Motion> \ @@ -204,7 +204,7 @@ configbody iwidgets::Panedwindow::sashborderwidth { set itk_option(-sashborderwidth) $pixels if {$_initialized} { - for {set i 1} {$i < [llength $_panes]} {incr i} { + for {set i 1} {$i < [llength $_activePanes]} {incr i} { $itk_component(sash$i) configure \ -borderwidth $itk_option(-sashborderwidth) } @@ -218,9 +218,8 @@ configbody iwidgets::Panedwindow::sashborderwidth { # ------------------------------------------------------------------ configbody iwidgets::Panedwindow::sashcursor { if {$_initialized} { - for {set i 1} {$i < [llength $_panes]} {incr i} { - $itk_component(sash$i) configure \ - -cursor $itk_option(-sashcursor) + for {set i 1} {$i < [llength $_activePanes]} {incr i} { + $itk_component(sash$i) configure -cursor $itk_option(-sashcursor) } } } @@ -236,7 +235,7 @@ configbody iwidgets::Panedwindow::sashwidth { set itk_option(-sashwidth) $pixels if {$_initialized} { - for {set i 1} {$i < [llength $_panes]} {incr i} { + for {set i 1} {$i < [llength $_activePanes]} {incr i} { $itk_component(sash$i) configure \ -width $itk_option(-sashwidth) } @@ -254,7 +253,7 @@ configbody iwidgets::Panedwindow::sashheight { set itk_option(-sashheight) $pixels if {$_initialized} { - for {set i 1} {$i < [llength $_panes]} {incr i} { + for {set i 1} {$i < [llength $_activePanes]} {incr i} { $itk_component(sash$i) configure \ -height $itk_option(-sashheight) } @@ -274,7 +273,7 @@ configbody iwidgets::Panedwindow::thickness { set itk_option(-thickness) $pixels if {$_initialized} { - for {set i 1} {$i < [llength $_panes]} {incr i} { + for {set i 1} {$i < [llength $_activePanes]} {incr i} { $itk_component(separator$i) configure \ -height $itk_option(-thickness) $itk_component(separator$i) configure \ @@ -283,7 +282,7 @@ configbody iwidgets::Panedwindow::thickness { -borderwidth [expr $itk_option(-thickness) / 2] } - for {set i 1} {$i < [llength $_panes]} {incr i} { + for {set i 1} {$i < [llength $_activePanes]} {incr i} { _placeSash $i } } @@ -304,7 +303,7 @@ configbody iwidgets::Panedwindow::sashindent { set itk_option(-sashindent) $pixels if {$_initialized} { - for {set i 1} {$i < [llength $_panes]} {incr i} { + for {set i 1} {$i < [llength $_activePanes]} {incr i} { _placeSash $i } } diff --git a/itcl/iwidgets3.0.0/generic/radiobox.itk b/itcl/iwidgets3.0.0/generic/radiobox.itk index 797dc5960f3..7ec9a31da5d 100644 --- a/itcl/iwidgets3.0.0/generic/radiobox.itk +++ b/itcl/iwidgets3.0.0/generic/radiobox.itk @@ -53,6 +53,7 @@ class iwidgets::Radiobox { disabledForeground DisabledForeground {} itk_option define -selectcolor selectColor Background {} itk_option define -command command Command {} + itk_option define -orient orient Orient vertical public { method add {tag args} @@ -119,6 +120,22 @@ body iwidgets::Radiobox::constructor {args} { configbody iwidgets::Radiobox::command {} # ------------------------------------------------------------------ +# OPTION: -orient +# +# Allows the user to orient the radiobuttons either horizontally +# or vertically. +# ------------------------------------------------------------------ +configbody iwidgets::Radiobox::orient { + if {$itk_option(-orient) == "horizontal" || + $itk_option(-orient) == "vertical"} { + _rearrange + } else { + error "Bad orientation: $itk_option(-orient). Should be\ + \"horizontal\" or \"vertical\"." + } +} + +# ------------------------------------------------------------------ # METHODS # ------------------------------------------------------------------ @@ -216,20 +233,29 @@ body iwidgets::Radiobox::insert {index tag args} { # ------------------------------------------------------------------ # METHOD: _rearrange # -# Rearrange the buttons in the childsite frame using -# the grid geometry manager. +# Rearrange the buttons in the childsite frame using the grid +# geometry manager. This method was modified by Chad Smith on 3/9/00 +# to take into consideration the newly added -orient config option. # ------------------------------------------------------------------ body iwidgets::Radiobox::_rearrange {} { - set index 0 - set master $itk_component(childsite) - if {[set count [llength $_buttons]] > 0} { - foreach tag $_buttons { - grid configure $itk_component($tag) -row $index -sticky nw - grid rowconfigure $master $index -weight 0 - incr index + if {$itk_option(-orient) == "vertical"} { + set row 0 + foreach tag $_buttons { + grid configure $itk_component($tag) -col 0 -row $row -sticky nw + grid rowconfigure $itk_component(childsite) $row -weight 0 + incr row + } + grid rowconfigure $itk_component(childsite) [expr $count-1] \ + -weight 1 + } else { + set col 0 + foreach tag $_buttons { + grid configure $itk_component($tag) -col $col -row 0 -sticky nw + grid columnconfigure $itk_component(childsite) $col -weight 1 + incr col + } } - grid rowconfigure $master [expr $count-1] -weight 1 } } diff --git a/itcl/iwidgets3.0.0/generic/scrolledhtml.itk b/itcl/iwidgets3.0.0/generic/scrolledhtml.itk index 71cee27b14f..66c0e3d42e6 100644 --- a/itcl/iwidgets3.0.0/generic/scrolledhtml.itk +++ b/itcl/iwidgets3.0.0/generic/scrolledhtml.itk @@ -141,6 +141,7 @@ class iwidgets::Scrolledhtml { itk_option define -unknownimage unknownimage File {} itk_option define -textbackground textBackground Background {} itk_option define -update update Update 1 + itk_option define -debug debug Debug 0 public method import {args} public method clear {} @@ -544,7 +545,7 @@ body iwidgets::Scrolledhtml::import {args} { append _cwd [file dirname $filename] } else { set f [open $filename r] -g set _cwd [file dirname $filename] + set _cwd [file dirname $filename] } } } @@ -611,7 +612,12 @@ body iwidgets::Scrolledhtml::render {html {wd .}} { [lindex $entity 1]] "" entity set cmd [string tolower [lindex $entity 0]] if {[info command _entity_$cmd]!=""} { - catch {eval _entity_$cmd [lrange $entity 1 end]} + if {[catch {eval _entity_$cmd [lrange $entity 1 end]} bad]} { + if {$itk_option(-debug)} { + global errorInfo + puts stderr "render: _entity_$cmd [lrange $entity 1 end] = Error:$bad\n$errorInfo" + } + } } set html \ [string range $html [expr [lindex $match 1]+1] end] @@ -728,16 +734,24 @@ body iwidgets::Scrolledhtml::_append_text {text} { if ![string length $text] return } if {!$_pre && !$_intitle} { - set p [$_hottext get "end - 2c"] + if {[catch {$_hottext get "end - 2c"} p]} { + set p "" + } set n [string index $text 0] if {$n == " " && $p == " "} { set text [string range $text 1 end] } - $_hottext insert end $text $_tag + if {[catch {$_hottext insert end $text $_tag}]} { + set pht [winfo parent $_hottext] + catch {$pht insert end $text $_tag} + } return } if {$_pre && !$_intitle} { - $_hottext insert end $text $_tag + if {[catch {$_hottext insert end $text $_tag}]} { + set pht [winfo parent $_hottext] + catch {$pht insert end $text $_tag} + } return } append _title $text @@ -807,7 +821,7 @@ body iwidgets::Scrolledhtml::_set_tag {} { if {![info exists _tagl($_tag)]} { set _tagfont($_tag) 1 eval $_hottext tag configure $_tag \ - -foreground $_color \ + -foreground ${_color} \ -lmargin1 ${_left}m \ -lmargin2 ${_left2}m $args if [catch {eval $_hottext tag configure $_tag \ @@ -2062,8 +2076,10 @@ body iwidgets::Scrolledhtml::_entity_table {{args {}}} { _push link $_link _push alink $_alink # push fake first row to avoid using optional /tr tag - _push color {} - _push bgcolor {} + # (This needs to set a real color - not the empty string + # becaule later code will try to use those values.) + _push color $_color + _push bgcolor $_bgcolor _push link {} _push alink {} @@ -2125,7 +2141,7 @@ body iwidgets::Scrolledhtml::_entity_table {{args {}}} { # end table # ------------------------------------------------------------------ body iwidgets::Scrolledhtml::_entity_/table {} { - if $_intable { + if {$_intable} { _pop tableborder set table [[_pop table] childsite] _pop row @@ -2147,11 +2163,23 @@ body iwidgets::Scrolledhtml::_entity_/table {} { set _bgcolor [_pop bgcolor] set _link [_pop link] set _alink [_pop alink] - foreach x [grid slaves $table] { - if {[$x cget -height] == 1} { - $x configure -height [lindex [split [$x index "end - 1 chars"] "."] 0] - } - } + foreach x [grid slaves $table] { + set text [$x get 1.0 end] + set tl [split $text \n] + set max 0 + foreach l $tl { + set len [string length $l] + if {$len > $max} { + set max $len + } + } + if {$max > [$x cget -width]} { + $x configure -width $max + } + if {[$x cget -height] == 1} { + $x configure -height [lindex [split [$x index "end - 1 chars"] "."] 0] + } + } $_hottext configure -state disabled set _hottext [_pop hottext] $_hottext configure -state normal @@ -2217,17 +2245,29 @@ body iwidgets::Scrolledhtml::_entity_td {{args {}}} { set cellspacing [_peek cellspacing] set _hottext $table.cell[incr _counter] text $_hottext -relief flat -width $ar(width) -height $ar(height) \ - -foreground $_color -background $_bgcolor -highlightthickness 0 \ + -highlightthickness 0 -wrap word -cursor $itk_option(-cursor) \ -wrap word -cursor $itk_option(-cursor) \ -padx $cellpadding -pady $cellpadding - if [info exists ar(nowrap)] { - $_hottext configure -wrap none - } + if {$_color != ""} { + $_hottext config -foreground $_color + } + if {$_bgcolor != ""} { + $_hottext config -background $_bgcolor + } + if [info exists ar(nowrap)] { + $_hottext configure -wrap none + } if [_peek tableborder] { $_hottext configure -relief sunken } set row [_peek row] + if {$row < 0} { + set row 0 + } set column [_pop column] + if {$column < 0} { + set column 0 + } while {[grid slaves $table -row $row -column $column] != ""} { incr column } diff --git a/itcl/iwidgets3.0.0/generic/scrolledlistbox.itk b/itcl/iwidgets3.0.0/generic/scrolledlistbox.itk index c8222b96de4..87f371a2e58 100644 --- a/itcl/iwidgets3.0.0/generic/scrolledlistbox.itk +++ b/itcl/iwidgets3.0.0/generic/scrolledlistbox.itk @@ -79,6 +79,7 @@ class iwidgets::Scrolledlistbox { public method sort {{mode ascending}} public method xview {args} public method yview {args} + public method itemconfigure {args} protected method _makeSelection {} protected method _dblclick {} @@ -154,6 +155,9 @@ body iwidgets::Scrolledlistbox::constructor {args} { usual keep -borderwidth -exportselection -relief -selectmode + + # This option was added in Tk 8.3 + catch {keep -listvariable} rename -font -textfont textFont Font rename -background -textbackground textBackground Background @@ -700,6 +704,16 @@ body iwidgets::Scrolledlistbox::yview {args} { } # ------------------------------------------------------------------ +# METHOD: itemconfigure args +# +# This is a wrapper method around the new tk8.3 itemconfigure command +# for the listbox. +# ------------------------------------------------------------------ +body iwidgets::Scrolledlistbox::itemconfigure {args} { + return [eval $itk_component(listbox) itemconfigure $args] +} + +# ------------------------------------------------------------------ # PROTECTED METHOD: _makeSelection # # Evaluate the selection command. diff --git a/itcl/iwidgets3.0.0/generic/scrolledtext.itk b/itcl/iwidgets3.0.0/generic/scrolledtext.itk index f595aa1c3bb..86fc7f362d4 100644 --- a/itcl/iwidgets3.0.0/generic/scrolledtext.itk +++ b/itcl/iwidgets3.0.0/generic/scrolledtext.itk @@ -81,6 +81,7 @@ class iwidgets::Scrolledtext { public method delete {first {last {}}} public method dlineinfo {index} public method get {index1 {index2 {}}} + public method image {option args} public method index {index} public method insert {args} public method mark {option args} @@ -392,6 +393,17 @@ body iwidgets::Scrolledtext::get {index1 {index2 {}}} { } # ------------------------------------------------------------------ +# METHOD image option ?arg arg ...? +# +# Manipulate images dependent on options. +# +# ------------------------------------------------------------------ +body iwidgets::Scrolledtext::image {option args} { + return [eval $itk_component(text) image $option $args] +} + + +# ------------------------------------------------------------------ # METHOD index index # # Return position corresponding to index. @@ -433,7 +445,14 @@ body iwidgets::Scrolledtext::scan {option args} { # Searches the text for characters matching a pattern. # ------------------------------------------------------------------ body iwidgets::Scrolledtext::search {args} { - return [eval $itk_component(text) search $args] + #----------------------------------------------------------- + # BUG FIX: csmith (Chad Smith: csmith@adc.com), 11/18/99 + #----------------------------------------------------------- + # Need to run this command up one level on the stack since + # the text widget may modify one of the arguments, which is + # the case when -count is specified. + #----------------------------------------------------------- + return [uplevel eval $itk_component(text) search $args] } # ------------------------------------------------------------------ diff --git a/itcl/iwidgets3.0.0/generic/shell.itk b/itcl/iwidgets3.0.0/generic/shell.itk index 05a91e4f079..78ef19c53f9 100644 --- a/itcl/iwidgets3.0.0/generic/shell.itk +++ b/itcl/iwidgets3.0.0/generic/shell.itk @@ -240,8 +240,8 @@ body iwidgets::Shell::activate {} { } set _wait($this) 0 - wm deiconify $itk_component(hull) raise $itk_component(hull) + wm deiconify $itk_component(hull) tkwait visibility $itk_component(hull) if {$itk_option(-modality) == "application"} { diff --git a/itcl/iwidgets3.0.0/generic/spindate.itk b/itcl/iwidgets3.0.0/generic/spindate.itk index 0d9cda138ac..215c031b0b8 100644 --- a/itcl/iwidgets3.0.0/generic/spindate.itk +++ b/itcl/iwidgets3.0.0/generic/spindate.itk @@ -572,14 +572,6 @@ body iwidgets::Spindate::_packDate {{when later}} { grid columnconfigure $_interior $i -minsize 0 } - # - # Get some boolean 1/0 values for the -monthon and -dayon options. - # We need this later so that Tcl doesn't complain about operands - # of || being strings. - # - set monthon [expr {$itk_option(-monthon) == "1"}] - set dayon [expr {$itk_option(-dayon) == "1"}] - set _repack "" # @@ -610,7 +602,7 @@ body iwidgets::Spindate::_packDate {{when later}} { } if {$itk_option(-yearon)} { - if {$monthon || $dayon} { + if {$itk_option(-monthon) || $itk_option(-dayon)} { grid rowconfigure $_interior [incr row] \ -minsize $itk_option(-datemargin) } @@ -650,7 +642,7 @@ body iwidgets::Spindate::_packDate {{when later}} { } if {$itk_option(-yearon)} { - if {$monthon || $dayon} { + if {$itk_option(-monthon) || $itk_option(-dayon)} { grid columnconfigure $_interior [incr column] \ -minsize $itk_option(-datemargin) } diff --git a/itcl/iwidgets3.0.0/generic/spinint.itk b/itcl/iwidgets3.0.0/generic/spinint.itk index 2c3310394da..9dc819ce999 100644 --- a/itcl/iwidgets3.0.0/generic/spinint.itk +++ b/itcl/iwidgets3.0.0/generic/spinint.itk @@ -163,33 +163,14 @@ body iwidgets::Spinint::up {} { # if {$val >= $min_range && $val < $max_range} { incr val $itk_option(-step) - - # - # Re-check boundaries. - # - if {$val >= $min_range && $val <= $max_range} { - $itk_component(entry) delete 0 end - $itk_component(entry) insert 0 $val - } else { - - # - # This is wrap when -step > 1. - # - if {$itk_option(-wrap)} { - if {$val > $max_range} { - $itk_component(entry) delete 0 end - $itk_component(entry) insert 0 $min_range - } else { - uplevel #0 $itk_option(-invalid) - } - } else { - uplevel #0 $itk_option(-invalid) - } - } - + $itk_component(entry) delete 0 end + $itk_component(entry) insert 0 $val } else { if {$itk_option(-wrap)} { - if {$val == $max_range} { + if {$val >= $max_range} { + $itk_component(entry) delete 0 end + $itk_component(entry) insert 0 $min_range + } elseif {$val < $min_range} { $itk_component(entry) delete 0 end $itk_component(entry) insert 0 $min_range } else { @@ -227,33 +208,14 @@ body iwidgets::Spinint::down {} { # if {$val > $min_range && $val <= $max_range} { incr val -$itk_option(-step) - - # - # Re-check boundaries. - # - if {$val >= $min_range && $val <= $max_range} { - $itk_component(entry) delete 0 end - $itk_component(entry) insert 0 $val - } else { - - # - # This is wrap when -step > 1. - # - if {$itk_option(-wrap)} { - if {$val < $min_range} { - $itk_component(entry) delete 0 end - $itk_component(entry) insert 0 $max_range - } else { - uplevel #0 $itk_option(-invalid) - } - } else { - uplevel #0 $itk_option(-invalid) - } - } - + $itk_component(entry) delete 0 end + $itk_component(entry) insert 0 $val } else { if {$itk_option(-wrap)} { - if {$val == $min_range} { + if {$val <= $min_range} { + $itk_component(entry) delete 0 end + $itk_component(entry) insert 0 $max_range + } elseif {$val > $max_range} { $itk_component(entry) delete 0 end $itk_component(entry) insert 0 $max_range } else { diff --git a/itcl/iwidgets3.0.0/generic/timeentry.itk b/itcl/iwidgets3.0.0/generic/timeentry.itk index 20fb4c7d65f..8366e524f7e 100644 --- a/itcl/iwidgets3.0.0/generic/timeentry.itk +++ b/itcl/iwidgets3.0.0/generic/timeentry.itk @@ -394,6 +394,5 @@ body iwidgets::Timeentry::_releaseGrab {} { grab release $itk_component(popup) $itk_component(iconbutton) configure -relief raised destroy $itk_component(popup) - unset itk_component(popup) bind $itk_component(iconbutton) <Button-1> [code $this _popup] } diff --git a/itcl/iwidgets3.0.0/generic/timefield.itk b/itcl/iwidgets3.0.0/generic/timefield.itk index a30ffc35385..c9b8c54c437 100644 --- a/itcl/iwidgets3.0.0/generic/timefield.itk +++ b/itcl/iwidgets3.0.0/generic/timefield.itk @@ -59,6 +59,8 @@ class iwidgets::Timefield { itk_option define -seconds seconds Seconds on itk_option define -format format Format civilian itk_option define -iq iq Iq high + itk_option define -gmt gmt GMT no + itk_option define -state state State normal public { method get {{format "-string"}} @@ -84,11 +86,10 @@ class iwidgets::Timefield { variable _numFields 4 variable _forward {} variable _backward {} + variable _timeVar "" common _militaryFields {hour minute second} common _civilianFields {hour minute second ampm} - - common _timeVar } } @@ -105,18 +106,15 @@ proc iwidgets::timefield {pathName args} { body iwidgets::Timefield::constructor {args} { component hull configure -borderwidth 0 - set _timeVar($this) "" - # # Create an entry field for entering the time. # itk_component add time { - entry $itk_interior.time \ - -textvariable [scope _timeVar($this)] + entry $itk_interior.time } { keep -borderwidth -cursor -exportselection \ -foreground -highlightcolor -highlightthickness \ - -insertbackground -justify -relief + -insertbackground -justify -relief -textvariable rename -font -textfont textFont Font rename -highlightbackground -background background Background @@ -136,6 +134,7 @@ body iwidgets::Timefield::constructor {args} { # bind $itk_component(time) <FocusIn> [code $this _focusIn] bind $itk_component(time) <KeyPress> [code $this _keyPress %A %K %s] + bind $itk_component(time) <1> "focus $itk_component(time); break" # # Disable some mouse button event bindings: @@ -291,10 +290,47 @@ configbody iwidgets::Timefield::format { # Update the current contents of the entry field to reflect # the configured format. # - show $_timeVar($this) + show $_timeVar } # ------------------------------------------------------------------ +# OPTION: -gmt +# +# This option is used for GMT time. Must be a boolean value. +# ------------------------------------------------------------------ +configbody iwidgets::Timefield::gmt { + switch $itk_option(-gmt) { + 0 - no - false - off { } + 1 - yes - true - on { } + default { + error "bad gmt option \"$itk_option(-gmt)\": should be boolean" + } + } +} + +# ------------------------------------------------------------------ +# OPTION: -state +# +# Disable the +# ------------------------------------------------------------------ +configbody iwidgets::Timefield::state { + switch -- $itk_option(-state) { + normal { + $itk_component(time) configure -state normal + } + disabled { + focus $itk_component(hull) + $itk_component(time) configure -state disabled + } + default { + error "Invalid value for -state: $itk_option(-state). Should be\ + \"normal\" or \"disabled\"." + } + } +} + + +# ------------------------------------------------------------------ # METHODS # ------------------------------------------------------------------ @@ -308,13 +344,14 @@ configbody iwidgets::Timefield::format { # formats. # ------------------------------------------------------------------ body iwidgets::Timefield::get {{format "-string"}} { + set _timeVar [$itk_component(time) get] switch -- $format { "-string" { - return $_timeVar($this) + return $_timeVar } "-clicks" { - return [::clock scan $_timeVar($this)] + return [::clock scan $_timeVar -gmt $itk_option(-gmt)] } default { error "bad format option \"$format\":\ @@ -332,6 +369,7 @@ body iwidgets::Timefield::get {{format "-string"}} { # information on obtaining times and their formats. # ------------------------------------------------------------------ body iwidgets::Timefield::show {{time "now"}} { + set icursor [$itk_component(time) index insert] if {$time == {}} { set time "now" @@ -344,7 +382,7 @@ body iwidgets::Timefield::show {{time "now"}} { } {^[0-9]+$} { - if { [catch {::clock format $time}] } { + if { [catch {::clock format $time -gmt $itk_option(-gmt)}] } { error "bad time: \"$time\", must be a valid time \ string, clock clicks value or the keyword now" } @@ -352,14 +390,21 @@ body iwidgets::Timefield::show {{time "now"}} { } default { - if {[catch {set seconds [::clock scan $time]}]} { + if {[catch {set seconds [::clock scan $time -gmt $itk_option(-gmt)]}]} { error "bad time: \"$time\", must be a valid time \ string, clock clicks value or the keyword now" } } } - set _timeVar($this) [::clock format $seconds -format $_formatString] + set _timeVar [::clock format $seconds -format $_formatString \ + -gmt $itk_option(-gmt)] + + $itk_component(time) delete 0 end + $itk_component(time) insert end $_timeVar + $itk_component(time) icursor $icursor + + return $_timeVar } # ------------------------------------------------------------------ @@ -370,8 +415,8 @@ body iwidgets::Timefield::show {{time "now"}} { # 26:59:59 is invalid. # ------------------------------------------------------------------ body iwidgets::Timefield::isvalid {} { - - return [expr ([catch {::clock scan $_timeVar($this)}] == 0)] + set _timeVar [$itk_component(time) get] + return [expr ([catch {::clock scan $_timeVar -gmt $itk_option(-gmt)}] == 0)] } # ------------------------------------------------------------------ @@ -410,9 +455,9 @@ body iwidgets::Timefield::_keyPress {char sym state} { set icursor [$itk_component(time) index insert] set lastField [lindex $_fields end] - set prevtime $_timeVar($this) + set prevtime $_timeVar regexp {^([0-9])([0-9]):([0-9])([0-9]):([0-9])([0-9]).*$} \ - $_timeVar($this) dummy \ + $_timeVar dummy \ hour1 hour2 minute1 minute2 second1 second2 set hour "$hour1$hour2" set minute "$minute1$minute2" @@ -592,6 +637,7 @@ body iwidgets::Timefield::_keyPress {char sym state} { } } + set _timeVar [$itk_component(time) get] return -code break } @@ -621,10 +667,8 @@ body iwidgets::Timefield::_keyPress {char sym state} { _toggleAmPm } else { set newclicks [::clock scan "$prevtime 1 $_cfield"] - set newtime [::clock format $newclicks -format $_formatString] - set _timeVar($this) $newtime + show [::clock format $newclicks -format $_formatString] } - return -code continue } minus - Down { @@ -636,10 +680,8 @@ body iwidgets::Timefield::_keyPress {char sym state} { _toggleAmPm } else { set newclicks [::clock scan "$prevtime 1 $_cfield ago"] - set newtime [::clock format $newclicks -format $_formatString] - set _timeVar($this) $newtime + show [::clock format $newclicks -format $_formatString] } - return -code continue } Tab { @@ -709,10 +751,11 @@ body iwidgets::Timefield::_keyPress {char sym state} { # between "AM" and "PM" when format is "civilian". # ------------------------------------------------------------------ body iwidgets::Timefield::_toggleAmPm {} { - set firstChar [string index $_timeVar($this) 9] + set firstChar [string index $_timeVar 9] $itk_component(time) delete 9 10 $itk_component(time) insert 9 [expr {($firstChar == "A") ? "P" : "A"}] $itk_component(time) icursor 9 + set _timeVar [$itk_component(time) get] } # ------------------------------------------------------------------ diff --git a/itcl/iwidgets3.0.0/generic/toolbar.itk b/itcl/iwidgets3.0.0/generic/toolbar.itk index 22d6cd7ec7b..c9e2be2d463 100644 --- a/itcl/iwidgets3.0.0/generic/toolbar.itk +++ b/itcl/iwidgets3.0.0/generic/toolbar.itk @@ -578,6 +578,9 @@ body iwidgets::Toolbar::_resetBalloonTimer {} { # # ------------------------------------------------------------- body iwidgets::Toolbar::_startBalloonDelay {window} { + if {$_balloonAfterID != 0} { + after cancel $_balloonAfterID + } set _balloonAfterID [after $_balloonTimer [code $this showBalloon $window]] } diff --git a/itcl/iwidgets3.0.0/generic/watch.itk b/itcl/iwidgets3.0.0/generic/watch.itk index afd90a3ee91..bfe662ea2b9 100755 --- a/itcl/iwidgets3.0.0/generic/watch.itk +++ b/itcl/iwidgets3.0.0/generic/watch.itk @@ -594,7 +594,7 @@ configbody ::iwidgets::Watch::secondcolor { # Configure the color of the ticks. # configbody ::iwidgets::Watch::tickcolor { - watch itemconfigure tick -fill $itk_option(-tickcolor) + watch itemconfigure tick -outline $itk_option(-tickcolor) } # ------------------------------------------------------------------ |