diff options
Diffstat (limited to 'itcl/iwidgets3.0.0/generic')
58 files changed, 0 insertions, 37774 deletions
diff --git a/itcl/iwidgets3.0.0/generic/buttonbox.itk b/itcl/iwidgets3.0.0/generic/buttonbox.itk deleted file mode 100644 index 20f8b4cb8ce..00000000000 --- a/itcl/iwidgets3.0.0/generic/buttonbox.itk +++ /dev/null @@ -1,571 +0,0 @@ -# -# Buttonbox -# ---------------------------------------------------------------------- -# Manages a framed area with Motif style buttons. The button box can -# be configured either horizontally or vertically. -# -# ---------------------------------------------------------------------- -# AUTHOR: Mark L. Ulferts EMAIL: mulferts@austin.dsccc.com -# Bret A. Schuhmacher EMAIL: bas@wn.com -# -# @(#) $Id$ -# ---------------------------------------------------------------------- -# Copyright (c) 1995 DSC Technologies Corporation -# ====================================================================== -# Permission to use, copy, modify, distribute and license this software -# and its documentation for any purpose, and without fee or written -# agreement with DSC, is hereby granted, provided that the above copyright -# notice appears in all copies and that both the copyright notice and -# warranty disclaimer below appear in supporting documentation, and that -# the names of DSC Technologies Corporation or DSC Communications -# Corporation not be used in advertising or publicity pertaining to the -# software without specific, written prior permission. -# -# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING -# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- -# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE -# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, -# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL -# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR -# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, -# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, -# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS -# SOFTWARE. -# ====================================================================== - -# -# Usual options. -# -itk::usual Buttonbox { - keep -background -cursor -foreground -} - -# ------------------------------------------------------------------ -# BUTTONBOX -# ------------------------------------------------------------------ -class iwidgets::Buttonbox { - inherit itk::Widget - - constructor {args} {} - destructor {} - - itk_option define -pady padY Pad 5 - itk_option define -padx padX Pad 5 - itk_option define -orient orient Orient "horizontal" - itk_option define -foreground foreground Foreground black - - public method index {args} - public method add {args} - public method insert {args} - public method delete {args} - public method default {args} - public method hide {args} - public method show {args} - public method invoke {args} - public method buttonconfigure {args} - public method buttoncget {index option} - - private method _positionButtons {} - private method _setBoxSize {{when later}} - private method _getMaxWidth {} - private method _getMaxHeight {} - - private variable _resizeFlag {} ;# Flag for resize needed. - private variable _buttonList {} ;# List of all buttons in box. - private variable _displayList {} ;# List of displayed buttons. - private variable _unique 0 ;# Counter for button widget ids. -} - -namespace eval iwidgets::Buttonbox { - # - # Set up some class level bindings for map and configure events. - # - bind bbox-map <Map> [code %W _setBoxSize] - bind bbox-config <Configure> [code %W _positionButtons] -} - -# -# Provide a lowercased access method for the Buttonbox class. -# -proc ::iwidgets::buttonbox {pathName args} { - uplevel ::iwidgets::Buttonbox $pathName $args -} - -# ------------------------------------------------------------------ -# CONSTRUCTOR -# ------------------------------------------------------------------ -body iwidgets::Buttonbox::constructor {args} { - # - # Add Configure bindings for geometry management. - # - bindtags $itk_component(hull) \ - [linsert [bindtags $itk_component(hull)] 0 bbox-map] - bindtags $itk_component(hull) \ - [linsert [bindtags $itk_component(hull)] 1 bbox-config] - - pack propagate $itk_component(hull) no - - # - # Initialize the widget based on the command line options. - # - eval itk_initialize $args -} - -# ------------------------------------------------------------------ -# DESTRUCTOR -# ------------------------------------------------------------------ -body iwidgets::Buttonbox::destructor {} { - if {$_resizeFlag != ""} {after cancel $_resizeFlag} -} - -# ------------------------------------------------------------------ -# OPTIONS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# OPTION: -pady -# -# Pad the y space between the button box frame and the hull. -# ------------------------------------------------------------------ -configbody iwidgets::Buttonbox::pady { - _setBoxSize -} - -# ------------------------------------------------------------------ -# OPTION: -padx -# -# Pad the x space between the button box frame and the hull. -# ------------------------------------------------------------------ -configbody iwidgets::Buttonbox::padx { - _setBoxSize -} - -# ------------------------------------------------------------------ -# OPTION: -orient -# -# Position buttons either horizontally or vertically. -# ------------------------------------------------------------------ -configbody iwidgets::Buttonbox::orient { - switch $itk_option(-orient) { - "horizontal" - - "vertical" { - _setBoxSize - } - - default { - error "bad orientation option \"$itk_option(-orient)\",\ - should be either horizontal or vertical" - } - } -} - -# ------------------------------------------------------------------ -# METHODS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# METHOD: index index -# -# Searches the buttons in the box for the one with the requested tag, -# numerical index, keyword "end" or "default". Returns the button's -# tag if found, otherwise error. -# ------------------------------------------------------------------ -body iwidgets::Buttonbox::index {index} { - if {[llength $_buttonList] > 0} { - if {[regexp {(^[0-9]+$)} $index]} { - if {$index < [llength $_buttonList]} { - return $index - } else { - error "Buttonbox index \"$index\" is out of range" - } - - } elseif {$index == "end"} { - return [expr [llength $_buttonList] - 1] - - } elseif {$index == "default"} { - foreach knownButton $_buttonList { - if {[$itk_component($knownButton) cget -defaultring]} { - return [lsearch -exact $_buttonList $knownButton] - } - } - - error "Buttonbox \"$itk_component(hull)\" has no default" - - } else { - if {[set idx [lsearch $_buttonList $index]] != -1} { - return $idx - } - - error "bad Buttonbox index \"$index\": must be number, end,\ - default, or pattern" - } - - } else { - error "Buttonbox \"$itk_component(hull)\" has no buttons" - } -} - -# ------------------------------------------------------------------ -# METHOD: add tag ?option value option value ...? -# -# Add the specified button to the button box. All PushButton options -# are allowed. New buttons are added to the list of buttons and the -# list of displayed buttons. The PushButton path name is returned. -# ------------------------------------------------------------------ -body iwidgets::Buttonbox::add {tag args} { - itk_component add $tag { - iwidgets::Pushbutton $itk_component(hull).[incr _unique] - } { - usual - rename -highlightbackground -background background Background - } - - if {$args != ""} { - uplevel $itk_component($tag) configure $args - } - - lappend _buttonList $tag - lappend _displayList $tag - - _setBoxSize -} - -# ------------------------------------------------------------------ -# METHOD: insert index tag ?option value option value ...? -# -# Insert the specified button in the button box just before the one -# given by index. All PushButton options are allowed. New buttons -# are added to the list of buttons and the list of displayed buttons. -# The PushButton path name is returned. -# ------------------------------------------------------------------ -body iwidgets::Buttonbox::insert {index tag args} { - itk_component add $tag { - iwidgets::Pushbutton $itk_component(hull).[incr _unique] - } { - usual - rename -highlightbackground -background background Background - } - - if {$args != ""} { - uplevel $itk_component($tag) configure $args - } - - set index [index $index] - set _buttonList [linsert $_buttonList $index $tag] - set _displayList [linsert $_displayList $index $tag] - - _setBoxSize -} - -# ------------------------------------------------------------------ -# METHOD: delete index -# -# Delete the specified button from the button box. -# ------------------------------------------------------------------ -body iwidgets::Buttonbox::delete {index} { - set index [index $index] - set tag [lindex $_buttonList $index] - - destroy $itk_component($tag) - - set _buttonList [lreplace $_buttonList $index $index] - - if {[set dind [lsearch $_displayList $tag]] != -1} { - set _displayList [lreplace $_displayList $dind $dind] - } - - _setBoxSize - update idletasks -} - -# ------------------------------------------------------------------ -# METHOD: default index -# -# Sets the default to the push button given by index. -# ------------------------------------------------------------------ -body iwidgets::Buttonbox::default {index} { - set index [index $index] - - set defbtn [lindex $_buttonList $index] - - foreach knownButton $_displayList { - if {$knownButton == $defbtn} { - $itk_component($knownButton) configure -defaultring yes - } else { - $itk_component($knownButton) configure -defaultring no - } - } -} - -# ------------------------------------------------------------------ -# METHOD: hide index -# -# Hide the push button given by index. This doesn't remove the button -# permanently from the display list, just inhibits its display. -# ------------------------------------------------------------------ -body iwidgets::Buttonbox::hide {index} { - set index [index $index] - set tag [lindex $_buttonList $index] - - if {[set dind [lsearch $_displayList $tag]] != -1} { - place forget $itk_component($tag) - set _displayList [lreplace $_displayList $dind $dind] - - _setBoxSize - } -} - -# ------------------------------------------------------------------ -# METHOD: show index -# -# Displays a previously hidden push button given by index. Check if -# the button is already in the display list. If not then add it back -# at it's original location and redisplay. -# ------------------------------------------------------------------ -body iwidgets::Buttonbox::show {index} { - set index [index $index] - set tag [lindex $_buttonList $index] - - if {[lsearch $_displayList $tag] == -1} { - set _displayList [linsert $_displayList $index $tag] - - _setBoxSize - } -} - -# ------------------------------------------------------------------ -# METHOD: invoke ?index? -# -# Invoke the command associated with a push button. If no arguments -# are given then the default button is invoked, otherwise the argument -# is expected to be a button index. -# ------------------------------------------------------------------ -body iwidgets::Buttonbox::invoke {args} { - if {[llength $args] == 0} { - $itk_component([lindex $_buttonList [index default]]) invoke - - } else { - $itk_component([lindex $_buttonList [index [lindex $args 0]]]) \ - invoke - } -} - -# ------------------------------------------------------------------ -# METHOD: buttonconfigure index ?option? ?value option value ...? -# -# Configure a push button given by index. This method allows -# configuration of pushbuttons from the Buttonbox level. The options -# may have any of the values accepted by the add method. -# ------------------------------------------------------------------ -body iwidgets::Buttonbox::buttonconfigure {index args} { - set tag [lindex $_buttonList [index $index]] - - set retstr [uplevel $itk_component($tag) configure $args] - - _setBoxSize - - return $retstr -} - -# ------------------------------------------------------------------ -# METHOD: buttonccget index option -# -# Return value of option for push button given by index. Option may -# have any of the values accepted by the add method. -# ------------------------------------------------------------------ -body iwidgets::Buttonbox::buttoncget {index option} { - set tag [lindex $_buttonList [index $index]] - - set retstr [uplevel $itk_component($tag) cget [list $option]] - - return $retstr -} - -# ----------------------------------------------------------------- -# PRIVATE METHOD: _getMaxWidth -# -# Returns the required width of the largest button. -# ----------------------------------------------------------------- -body iwidgets::Buttonbox::_getMaxWidth {} { - set max 0 - - foreach tag $_displayList { - set w [winfo reqwidth $itk_component($tag)] - - if {$w > $max} { - set max $w - } - } - - return $max -} - -# ----------------------------------------------------------------- -# PRIVATE METHOD: _getMaxHeight -# -# Returns the required height of the largest button. -# ----------------------------------------------------------------- -body iwidgets::Buttonbox::_getMaxHeight {} { - set max 0 - - foreach tag $_displayList { - set h [winfo reqheight $itk_component($tag)] - - if {$h > $max} { - set max $h - } - } - - return $max -} - -# ------------------------------------------------------------------ -# METHOD: _setBoxSize ?when? -# -# Sets the proper size of the frame surrounding all the buttons. -# If "when" is "now", the change is applied immediately. If it is -# "later" or it is not specified, then the change is applied later, -# when the application is idle. -# ------------------------------------------------------------------ -body iwidgets::Buttonbox::_setBoxSize {{when later}} { - if {[winfo ismapped $itk_component(hull)]} { - if {$when == "later"} { - if {$_resizeFlag == ""} { - set _resizeFlag [after idle [code $this _setBoxSize now]] - } - return - } elseif {$when != "now"} { - error "bad option \"$when\": should be now or later" - } - - set _resizeFlag "" - - set numBtns [llength $_displayList] - - if {$itk_option(-orient) == "horizontal"} { - set minw [expr $numBtns * [_getMaxWidth] \ - + ($numBtns+1) * $itk_option(-padx)] - set minh [expr [_getMaxHeight] + 2 * $itk_option(-pady)] - - } else { - set minw [expr [_getMaxWidth] + 2 * $itk_option(-padx)] - set minh [expr $numBtns * [_getMaxHeight] \ - + ($numBtns+1) * $itk_option(-pady)] - } - - # - # Remove the configure event bindings on the hull while we adjust the - # width/height and re-position the buttons. Once we're through, we'll - # update and reinstall them. This prevents double calls to position - # the buttons. - # - set tags [bindtags $itk_component(hull)] - if {[set i [lsearch $tags bbox-config]] != -1} { - set tags [lreplace $tags $i $i] - bindtags $itk_component(hull) $tags - } - - component hull configure -width $minw -height $minh - - update idletasks - - _positionButtons - - bindtags $itk_component(hull) [linsert $tags 0 bbox-config] - } -} - -# ------------------------------------------------------------------ -# METHOD: _positionButtons -# -# This method is responsible setting the width/height of all the -# displayed buttons to the same value and for placing all the buttons -# in equidistant locations. -# ------------------------------------------------------------------ -body iwidgets::Buttonbox::_positionButtons {} { - set bf $itk_component(hull) - set numBtns [llength $_displayList] - - # - # First, determine the common width and height for all the - # displayed buttons. - # - if {$numBtns > 0} { - set bfWidth [winfo width $itk_component(hull)] - set bfHeight [winfo height $itk_component(hull)] - - if {$bfWidth >= [winfo reqwidth $itk_component(hull)]} { - set _btnWidth [_getMaxWidth] - - } else { - if {$itk_option(-orient) == "horizontal"} { - set _btnWidth [expr $bfWidth / $numBtns] - } else { - set _btnWidth $bfWidth - } - } - - if {$bfHeight >= [winfo reqheight $itk_component(hull)]} { - set _btnHeight [_getMaxHeight] - - } else { - if {$itk_option(-orient) == "vertical"} { - set _btnHeight [expr $bfHeight / $numBtns] - } else { - set _btnHeight $bfHeight - } - } - } - - # - # Place the buttons at the proper locations. - # - if {$numBtns > 0} { - if {$itk_option(-orient) == "horizontal"} { - set leftover [expr [winfo width $bf] \ - - 2 * $itk_option(-padx) - $_btnWidth * $numBtns] - - if {$numBtns > 0} { - set offset [expr $leftover / ($numBtns + 1)] - } else { - set offset 0 - } - if {$offset < 0} {set offset 0} - - set xDist [expr $itk_option(-padx) + $offset] - set incrAmount [expr $_btnWidth + $offset] - - foreach button $_displayList { - place $itk_component($button) -anchor w \ - -x $xDist -rely .5 -y 0 -relx 0 \ - -width $_btnWidth -height $_btnHeight - - set xDist [expr $xDist + $incrAmount] - } - - } else { - set leftover [expr [winfo height $bf] \ - - 2 * $itk_option(-pady) - $_btnHeight * $numBtns] - - if {$numBtns > 0} { - set offset [expr $leftover / ($numBtns + 1)] - } else { - set offset 0 - } - if {$offset < 0} {set offset 0} - - set yDist [expr $itk_option(-pady) + $offset] - set incrAmount [expr $_btnHeight + $offset] - - foreach button $_displayList { - place $itk_component($button) -anchor n \ - -y $yDist -relx .5 -x 0 -rely 0 \ - -width $_btnWidth -height $_btnHeight - - set yDist [expr $yDist + $incrAmount] - } - } - } -} - - diff --git a/itcl/iwidgets3.0.0/generic/calendar.itk b/itcl/iwidgets3.0.0/generic/calendar.itk deleted file mode 100644 index a7b0363a7a8..00000000000 --- a/itcl/iwidgets3.0.0/generic/calendar.itk +++ /dev/null @@ -1,938 +0,0 @@ -# -# Calendar -# ---------------------------------------------------------------------- -# Implements a calendar widget for the selection of a date. It displays -# a single month at a time. Buttons exist on the top to change the -# month in effect turning th pages of a calendar. As a page is turned, -# the dates for the month are modified. Selection of a date visually -# marks that date. The selected value can be monitored via the -# -command option or just retrieved using the get method. Methods also -# exist to select a date and show a particular month. The option set -# allows the calendars appearance to take on many forms. -# ---------------------------------------------------------------------- -# AUTHOR: Mark L. Ulferts E-mail: mulferts@austin.dsccc.com -# -# ACKNOWLEDGEMENTS: Michael McLennan E-mail: mmclennan@lucent.com -# -# This code is an [incr Tk] port of the calendar code shown in Michael -# J. McLennan's book "Effective Tcl" from Addison Wesley. Small -# modificiations were made to the logic here and there to make it a -# mega-widget and the command and option interface was expanded to make -# it even more configurable, but the underlying logic is the same. -# -# @(#) $Id$ -# ---------------------------------------------------------------------- -# Copyright (c) 1997 DSC Technologies Corporation -# ====================================================================== -# Permission to use, copy, modify, distribute and license this software -# and its documentation for any purpose, and without fee or written -# agreement with DSC, is hereby granted, provided that the above copyright -# notice appears in all copies and that both the copyright notice and -# warranty disclaimer below appear in supporting documentation, and that -# the names of DSC Technologies Corporation or DSC Communications -# Corporation not be used in advertising or publicity pertaining to the -# software without specific, written prior permission. -# -# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING -# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- -# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE -# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, -# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL -# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR -# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, -# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, -# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS -# SOFTWARE. -# ====================================================================== - -# -# Usual options. -# -itk::usual Calendar { - keep -background -cursor -} - -# ------------------------------------------------------------------ -# CALENDAR -# ------------------------------------------------------------------ -class iwidgets::Calendar { - inherit itk::Widget - - constructor {args} {} - - itk_option define -days days Days {Su Mo Tu We Th Fr Sa} - itk_option define -command command Command {} - itk_option define -forwardimage forwardImage Image {} - itk_option define -backwardimage backwardImage Image {} - itk_option define -weekdaybackground weekdayBackground Background \#d9d9d9 - itk_option define -weekendbackground weekendBackground Background \#d9d9d9 - itk_option define -outline outline Outline \#d9d9d9 - itk_option define -buttonforeground buttonForeground Foreground blue - itk_option define -foreground foreground Foreground black - itk_option define -selectcolor selectColor Foreground red - itk_option define -selectthickness selectThickness SelectThickness 3 - itk_option define -titlefont titleFont Font \ - -*-helvetica-bold-r-normal--*-140-* - itk_option define -dayfont dayFont Font \ - -*-helvetica-medium-r-normal--*-120-* - itk_option define -datefont dateFont Font \ - -*-helvetica-medium-r-normal--*-120-* - itk_option define -currentdatefont currentDateFont Font \ - -*-helvetica-bold-r-normal--*-120-* - itk_option define -startday startDay Day sunday - - public method get {{format "-string"}} ;# Returns the selected date - public method select {{date_ "now"}} ;# Selects date, moving select ring - public method show {{date_ "now"}} ;# Displays a specific date - - protected method _drawtext {canvas_ day_ date_ now_ x0_ y0_ x1_ y1_} - - private method _change {delta_} - private method _configureHandler {} - private method _redraw {} - private method _days {{wmax {}}} - private method _layout {time_} - private method _select {date_} - private method _selectEvent {date_} - private method _adjustday {day_} - private method _percentSubst {pattern_ string_ subst_} - - private variable _time {} - private variable _selected {} - private variable _initialized 0 - private variable _offset 0 -} - -# -# Provide a lowercased access method for the Calendar class. -# -proc ::iwidgets::calendar {pathName args} { - uplevel ::iwidgets::Calendar $pathName $args -} - -# -# Use option database to override default resources of base classes. -# -option add *Calendar.width 200 widgetDefault -option add *Calendar.height 165 widgetDefault - -# ------------------------------------------------------------------ -# CONSTRUCTOR -# ------------------------------------------------------------------ -body iwidgets::Calendar::constructor {args} { - # - # Create the canvas which displays each page of the calendar. - # - itk_component add page { - canvas $itk_interior.page - } { - keep -background -cursor -width -height - } - pack $itk_component(page) -expand yes -fill both - - # - # Create the forward and backward buttons. Rather than pack - # them directly in the hull, we'll waittill later and make - # them canvas window items. - # - itk_component add backward { - button $itk_component(page).backward \ - -command [code $this _change -1] - } { - keep -background -cursor - } - - itk_component add forward { - button $itk_component(page).forward \ - -command [code $this _change +1] - } { - keep -background -cursor - } - - # - # Set the initial time to now. - # - set _time [clock seconds] - - # - # Bind to the configure event which will be used to redraw - # the calendar and display the month. - # - bind $itk_component(page) <Configure> [code $this _configureHandler] - - # - # Evaluate the option arguments. - # - eval itk_initialize $args -} - -# ------------------------------------------------------------------ -# OPTIONS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# OPTION: -command -# -# Sets the selection command for the calendar. When the user -# selects a date on the calendar, the date is substituted in -# place of "%d" in this command, and the command is executed. -# ------------------------------------------------------------------ -configbody iwidgets::Calendar::command {} - -# ------------------------------------------------------------------ -# OPTION: -days -# -# The days option takes a list of values to set the text used to display the -# days of the week header above the dates. The default value is -# {Su Mo Tu We Th Fr Sa}. -# ------------------------------------------------------------------ -configbody iwidgets::Calendar::days { - if {$_initialized} { - if {[$itk_component(page) find withtag days] != {}} { - $itk_component(page) delete days - _days - } - } -} - -# ------------------------------------------------------------------ -# OPTION: -backwardimage -# -# Specifies a image to be displayed on the backwards calendar -# button. If none is specified, a default is provided. -# ------------------------------------------------------------------ -configbody iwidgets::Calendar::backwardimage { - - # - # If no image is given, then we'll use the default image. - # - if {$itk_option(-backwardimage) == {}} { - - # - # If the default image hasn't yet been created, then we - # need to create it. - # - if {[lsearch [image names] $this-backward] == -1} { - image create bitmap $this-backward \ - -foreground $itk_option(-buttonforeground) -data { - #define back_width 16 - #define back_height 16 - static unsigned char back_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0x30, - 0xe0, 0x38, 0xf0, 0x3c, 0xf8, 0x3e, 0xfc, 0x3f, - 0xfc, 0x3f, 0xf8, 0x3e, 0xf0, 0x3c, 0xe0, 0x38, - 0xc0, 0x30, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; - } - } - - # - # Configure the button to use the default image. - # - $itk_component(backward) configure -image $this-backward - - # - # Else, an image has been specified. First, we'll need to make sure - # the image really exists before configuring the button to use it. - # If it doesn't generate an error. - # - } else { - if {[lsearch [image names] $itk_option(-backwardimage)] != -1} { - $itk_component(backward) configure \ - -image $itk_option(-backwardimage) - } else { - error "bad image name \"$itk_option(-backwardimage)\":\ - image does not exist" - } - - # - # If we previously created a default image, we'll just remove it. - # - if {[lsearch [image names] $this-backward] != -1} { - image delete $this-backward - } - } -} - - -# ------------------------------------------------------------------ -# OPTION: -forwardimage -# -# Specifies a image to be displayed on the forwards calendar -# button. If none is specified, a default is provided. -# ------------------------------------------------------------------ -configbody iwidgets::Calendar::forwardimage { - - # - # If no image is given, then we'll use the default image. - # - if {$itk_option(-forwardimage) == {}} { - - # - # If the default image hasn't yet been created, then we - # need to create it. - # - if {[lsearch [image names] $this-forward] == -1} { - image create bitmap $this-forward \ - -foreground $itk_option(-buttonforeground) -data { - #define fwd_width 16 - #define fwd_height 16 - static unsigned char fwd_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x0c, 0x03, - 0x1c, 0x07, 0x3c, 0x0f, 0x7c, 0x1f, 0xfc, 0x3f, - 0xfc, 0x3f, 0x7c, 0x1f, 0x3c, 0x0f, 0x1c, 0x07, - 0x0c, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; - } - } - - # - # Configure the button to use the default image. - # - $itk_component(forward) configure -image $this-forward - - # - # Else, an image has been specified. First, we'll need to make sure - # the image really exists before configuring the button to use it. - # If it doesn't generate an error. - # - } else { - if {[lsearch [image names] $itk_option(-forwardimage)] != -1} { - $itk_component(forward) configure \ - -image $itk_option(-forwardimage) - } else { - error "bad image name \"$itk_option(-forwardimage)\":\ - image does not exist" - } - - # - # If we previously created a default image, we'll just remove it. - # - if {[lsearch [image names] $this-forward] != -1} { - image delete $this-forward - } - } -} - -# ------------------------------------------------------------------ -# OPTION: -weekdaybackground -# -# Specifies the background for the weekdays which allows it to -# be visually distinguished from the weekend. -# ------------------------------------------------------------------ -configbody iwidgets::Calendar::weekdaybackground { - if {$_initialized} { - $itk_component(page) itemconfigure weekday \ - -fill $itk_option(-weekdaybackground) - } -} - -# ------------------------------------------------------------------ -# OPTION: -weekendbackground -# -# Specifies the background for the weekdays which allows it to -# be visually distinguished from the weekdays. -# ------------------------------------------------------------------ -configbody iwidgets::Calendar::weekendbackground { - if {$_initialized} { - $itk_component(page) itemconfigure weekend \ - -fill $itk_option(-weekendbackground) - } -} - -# ------------------------------------------------------------------ -# OPTION: -foreground -# -# Specifies the foreground color for the textual items, buttons, -# and divider on the calendar. -# ------------------------------------------------------------------ -configbody iwidgets::Calendar::foreground { - if {$_initialized} { - $itk_component(page) itemconfigure text \ - -fill $itk_option(-foreground) - $itk_component(page) itemconfigure line \ - -fill $itk_option(-foreground) - } -} - -# ------------------------------------------------------------------ -# OPTION: -outline -# -# Specifies the outline color used to surround the date text. -# ------------------------------------------------------------------ -configbody iwidgets::Calendar::outline { - if {$_initialized} { - $itk_component(page) itemconfigure square \ - -outline $itk_option(-outline) - } -} - -# ------------------------------------------------------------------ -# OPTION: -buttonforeground -# -# Specifies the foreground color of the forward and backward buttons. -# ------------------------------------------------------------------ -configbody iwidgets::Calendar::buttonforeground { - if {$_initialized} { - if {$itk_option(-forwardimage) == {}} { - if {[lsearch [image names] $this-forward] != -1} { - $this-forward configure \ - -foreground $itk_option(-buttonforeground) - } - } else { - $itk_component(forward) configure \ - -foreground $itk_option(-buttonforeground) - } - - if {$itk_option(-backwardimage) == {}} { - if {[lsearch [image names] $this-backward] != -1} { - $this-backward configure \ - -foreground $itk_option(-buttonforeground) - } - } else { - $itk_component(-backward) configure \ - -foreground $itk_option(-buttonforeground) - } - } -} - -# ------------------------------------------------------------------ -# OPTION: -selectcolor -# -# Specifies the color of the ring displayed that distinguishes the -# currently selected date. -# ------------------------------------------------------------------ -configbody iwidgets::Calendar::selectcolor { - if {$_initialized} { - $itk_component(page) itemconfigure $_selected-sensor \ - -outline $itk_option(-selectcolor) - } -} - -# ------------------------------------------------------------------ -# OPTION: -selectthickness -# -# Specifies the thickness of the ring displayed that distinguishes -# the currently selected date. -# ------------------------------------------------------------------ -configbody iwidgets::Calendar::selectthickness { - if {$_initialized} { - $itk_component(page) itemconfigure $_selected-sensor \ - -width $itk_option(-selectthickness) - } -} - -# ------------------------------------------------------------------ -# OPTION: -titlefont -# -# Specifies the font used for the title text that consists of the -# month and year. -# ------------------------------------------------------------------ -configbody iwidgets::Calendar::titlefont { - if {$_initialized} { - $itk_component(page) itemconfigure title \ - -font $itk_option(-titlefont) - } -} - -# ------------------------------------------------------------------ -# OPTION: -datefont -# -# Specifies the font used for the date text that consists of the -# day of the month. -# ------------------------------------------------------------------ -configbody iwidgets::Calendar::datefont { - if {$_initialized} { - $itk_component(page) itemconfigure date \ - -font $itk_option(-datefont) - } -} - -# ------------------------------------------------------------------ -# OPTION: -currentdatefont -# -# Specifies the font used for the current date text. -# ------------------------------------------------------------------ -configbody iwidgets::Calendar::currentdatefont { - if {$_initialized} { - $itk_component(page) itemconfigure now \ - -font $itk_option(-currentdatefont) - } -} - -# ------------------------------------------------------------------ -# OPTION: -dayfont -# -# Specifies the font used for the day of the week text. -# ------------------------------------------------------------------ -configbody iwidgets::Calendar::dayfont { - if {$_initialized} { - $itk_component(page) itemconfigure days \ - -font $itk_option(-dayfont) - } -} - -# ------------------------------------------------------------------ -# OPTION: -startday -# -# Specifies the starting day for the week. The value must be a day of the -# week: sunday, monday, tuesday, wednesday, thursday, friday, or -# saturday. The default is sunday. -# ------------------------------------------------------------------ -configbody iwidgets::Calendar::startday { - set day [string tolower $itk_option(-startday)] - - switch $day { - sunday {set _offset 0} - monday {set _offset 1} - tuesday {set _offset 2} - wednesday {set _offset 3} - thursday {set _offset 4} - friday {set _offset 5} - saturday {set _offset 6} - default { - error "bad startday option \"$itk_option(-startday)\":\ - should be sunday, monday, tuesday, wednesday,\ - thursday, friday, or saturday" - } - } - - if {$_initialized} { - $itk_component(page) delete all-page - _redraw - } -} - -# ------------------------------------------------------------------ -# METHODS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# PUBLIC METHOD: get ?format? -# -# Returns the currently selected date in one of two formats, string -# or as an integer clock value using the -string and -clicks -# options respectively. The default is by string. Reference the -# clock command for more information on obtaining dates and their -# formats. -# ------------------------------------------------------------------ -body iwidgets::Calendar::get {{format "-string"}} { - switch -- $format { - "-string" { - return $_selected - } - "-clicks" { - return [clock scan $_selected] - } - default { - error "bad format option \"$format\":\ - should be -string or -clicks" - } - } -} - -# ------------------------------------------------------------------ -# PUBLIC METHOD: select date_ -# -# Changes the currently selected date to the value specified. -# ------------------------------------------------------------------ -body iwidgets::Calendar::select {{date_ "now"}} { - if {$date_ == "now"} { - set time [clock seconds] - } else { - if {[catch {clock format $date_}] == 0} { - set time $date_ - } elseif {[catch {set time [clock scan $date_]}] != 0} { - error "bad date: \"$date_\", must be a valid date string, clock clicks value or the keyword now" - } - } - - _select [clock format $time -format "%m/%d/%Y"] -} - -# ------------------------------------------------------------------ -# PUBLIC METHOD: show date_ -# -# Changes the currently display month to be that of the specified -# date. -# ------------------------------------------------------------------ -body iwidgets::Calendar::show {{date_ "now"}} { - if {$date_ == "now"} { - set _time [clock seconds] - } else { - if {[catch {clock format $date_}] == 0} { - set _time $date_ - } elseif {[catch {set _time [clock scan $date_]}] != 0} { - error "bad date: \"$date_\", must be a valid date string, clock clicks value or the keyword now" - } - } - - $itk_component(page) delete all-page - _redraw -} - -# ------------------------------------------------------------------ -# PROTECTED METHOD: _drawtext canvas_ day_ date_ now_ -# x0_ y0_ x1_ y1_ -# -# Draws the text in the date square. The method is protected such that -# it can be overridden in derived classes that may wish to add their -# own unique text. The method receives the day to draw along with -# the coordinates of the square. -# ------------------------------------------------------------------ -body iwidgets::Calendar::_drawtext {canvas_ day_ date_ now_ x0_ y0_ x1_ y1_} { - set item [$canvas_ create text \ - [expr (($x1_ - $x0_) / 2) + $x0_] \ - [expr (($y1_ -$y0_) / 2) + $y0_ + 1] \ - -anchor center -text "$day_" \ - -fill $itk_option(-foreground)] - - if {$date_ == $now_} { - $canvas_ itemconfigure $item \ - -font $itk_option(-currentdatefont) \ - -tags [list all-page date text now] - } else { - $canvas_ itemconfigure $item \ - -font $itk_option(-datefont) \ - -tags [list all-page date text] - } -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _configureHandler -# -# Processes a configure event received on the canvas. The method -# deletes all the current canvas items and forces a redraw. -# ------------------------------------------------------------------ -body iwidgets::Calendar::_configureHandler {} { - set _initialized 1 - - $itk_component(page) delete all - _redraw -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _change delta_ -# -# Changes the current month displayed in the calendar, moving -# forward or backward by <delta_> months where <delta_> is +/- -# some number. -# ------------------------------------------------------------------ -body iwidgets::Calendar::_change {delta_} { - set dir [expr ($delta_ > 0) ? 1 : -1] - set month [clock format $_time -format "%m"] - set month [string trimleft $month 0] - set year [clock format $_time -format "%Y"] - - for {set i 0} {$i < abs($delta_)} {incr i} { - incr month $dir - if {$month < 1} { - set month 12 - incr year -1 - } elseif {$month > 12} { - set month 1 - incr year 1 - } - } - if {[catch {set _time [clock scan "$month/1/$year"]}]} { - bell - } else { - _redraw - } -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _redraw -# -# Redraws the calendar. This method is invoked whenever the -# calendar changes size or we need to effect a change such as draw -# it with a new month. -# ------------------------------------------------------------------ -body iwidgets::Calendar::_redraw {} { - # - # Remove all the items that typically change per redraw request - # such as the title and dates. Also, get the maximum width and - # height of the page. - # - $itk_component(page) delete all-page - - set wmax [winfo width $itk_component(page)] - set hmax [winfo height $itk_component(page)] - - # - # If we haven't yet created the forward and backwards buttons, - # then dot it; otherwise, skip it. - # - if {[$itk_component(page) find withtag button] == {}} { - $itk_component(page) create window 3 3 -anchor nw \ - -window $itk_component(backward) -tags button - $itk_component(page) create window [expr $wmax-3] 3 -anchor ne \ - -window $itk_component(forward) -tags button - } - - # - # Create the title centered between the buttons. - # - foreach {x0 y0 x1 y1} [$itk_component(page) bbox button] { - set x [expr (($x1-$x0)/2)+$x0] - set y [expr (($y1-$y0)/2)+$y0] - } - - set title [clock format $_time -format "%B %Y"] - $itk_component(page) create text $x $y -anchor center \ - -text $title -font $itk_option(-titlefont) \ - -fill $itk_option(-foreground) \ - -tags [list title text all-page] - - # - # Add the days of the week labels if they haven't yet been created. - # - if {[$itk_component(page) find withtag days] == {}} { - _days $wmax - } - - # - # Add a line between the calendar header and the dates if needed. - # - set bottom [expr [lindex [$itk_component(page) bbox all] 3] + 3] - - if {[$itk_component(page) find withtag line] == {}} { - $itk_component(page) create line 0 $bottom $wmax $bottom \ - -width 2 -tags line - } - - incr bottom 3 - - # - # Get the layout for the time value and create the date squares. - # This includes the surrounding date rectangle, the date text, - # and the sensor. Bind selection to the sensor. - # - set current "" - set now [clock format [clock seconds] -format "%m/%d/%Y"] - - set layout [_layout $_time] - set weeks [expr [lindex $layout end] + 1] - - foreach {day date kind dcol wrow} $layout { - set x0 [expr $dcol*($wmax-7)/7+3] - set y0 [expr $wrow*($hmax-$bottom-4)/$weeks+$bottom] - set x1 [expr ($dcol+1)*($wmax-7)/7+3] - set y1 [expr ($wrow+1)*($hmax-$bottom-4)/$weeks+$bottom] - - if {$date == $_selected} { - set current $date - } - - # - # Create the rectangle that surrounds the date and configure - # its background based on the wheather it is a weekday or - # a weekend. - # - set item [$itk_component(page) create rectangle $x0 $y0 $x1 $y1 \ - -outline $itk_option(-outline)] - - if {$kind == "weekend"} { - $itk_component(page) itemconfigure $item \ - -fill $itk_option(-weekendbackground) \ - -tags [list all-page square weekend] - } else { - $itk_component(page) itemconfigure $item \ - -fill $itk_option(-weekdaybackground) \ - -tags [list all-page square weekday] - } - - # - # Create the date text and configure its font based on the - # wheather or not it is the current date. - # - _drawtext $itk_component(page) $day $date $now $x0 $y0 $x1 $y1 - - # - # Create a sensor area to detect selections. Bind the - # sensor and pass the date to the bind script. - # - $itk_component(page) create rectangle $x0 $y0 $x1 $y1 \ - -outline "" -fill "" \ - -tags [list $date-sensor all-sensor all-page] - - $itk_component(page) bind $date-sensor <ButtonPress-1> \ - [code $this _selectEvent $date] - } - - # - # Highlight the selected date if it is on this page. - # - if {$current != ""} { - $itk_component(page) itemconfigure $current-sensor \ - -outline $itk_option(-selectcolor) \ - -width $itk_option(-selectthickness) - - $itk_component(page) raise $current-sensor - - } elseif {$_selected == ""} { - set date [clock format $_time -format "%m/%d/%Y"] - _select $date - } -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _days -# -# Used to rewite the days of the week label just below the month -# title string. The days are given in the -days option. -# ------------------------------------------------------------------ -body iwidgets::Calendar::_days {{wmax {}}} { - if {$wmax == {}} { - set wmax [winfo width $itk_component(page)] - } - - set col 0 - set bottom [expr [lindex [$itk_component(page) bbox title buttons] 3] + 7] - - foreach dayoweek $itk_option(-days) { - set x0 [expr $col*($wmax/7)] - set x1 [expr ($col+1)*($wmax/7)] - - $itk_component(page) create text \ - [expr (($x1 - $x0) / 2) + $x0] $bottom \ - -anchor n -text "$dayoweek" \ - -fill $itk_option(-foreground) \ - -font $itk_option(-dayfont) \ - -tags [list days text] - - incr col - } -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _layout time_ -# -# Used whenever the calendar is redrawn. Finds the month containing -# a <time_> in seconds, and returns a list for all of the days in -# that month. The list looks like this: -# -# {day1 date1 kind1 c1 r1 day2 date2 kind2 c2 r2 ...} -# -# where dayN is a day number like 1,2,3,..., dateN is the date for -# dayN, kindN is the day type of weekday or weekend, and cN,rN -# are the column/row indices for the square containing that date. -# ------------------------------------------------------------------ -body iwidgets::Calendar::_layout {time_} { - set month [clock format $time_ -format "%m"] - set year [clock format $time_ -format "%Y"] - - foreach lastday {31 30 29 28} { - if {[catch {clock scan "$month/$lastday/$year"}] == 0} { - break - } - } - set seconds [clock scan "$month/1/$year"] - set firstday [_adjustday [clock format $seconds -format %w]] - - set weeks [expr ceil(double($lastday+$firstday)/7)] - - set rlist "" - for {set day 1} {$day <= $lastday} {incr day} { - set seconds [clock scan "$month/$day/$year"] - set date [clock format $seconds -format "%m/%d/%Y"] - set dayoweek [clock format $seconds -format %w] - - if {$dayoweek == 0 || $dayoweek == 6} { - set kind "weekend" - } else { - set kind "weekday" - } - - set daycol [_adjustday $dayoweek] - - set weekrow [expr ($firstday+$day-1)/7] - lappend rlist $day $date $kind $daycol $weekrow - } - return $rlist -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _adjustday day_ -# -# Modifies the day to be in accordance with the startday option. -# ------------------------------------------------------------------ -body iwidgets::Calendar::_adjustday {day_} { - set retday [expr $day_ - $_offset] - - if {$retday < 0} { - set retday [expr $retday + 7] - } - - return $retday -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _select date_ -# -# Selects the current <date_> on the calendar. Highlights the date -# on the calendar, and executes the command associated with the -# calendar, with the selected date substituted in place of "%d". -# ------------------------------------------------------------------ -body iwidgets::Calendar::_select {date_} { - set time [clock scan $date_] - set date [clock format $time -format "%m/%d/%Y"] - - set _selected $date - - set current [clock format $_time -format "%m %Y"] - set selected [clock format $time -format "%m %Y"] - - if {$current == $selected} { - $itk_component(page) itemconfigure all-sensor \ - -outline "" -width 1 - - $itk_component(page) itemconfigure $date-sensor \ - -outline $itk_option(-selectcolor) \ - -width $itk_option(-selectthickness) - $itk_component(page) raise $date-sensor - } else { - set _time $time - _redraw - } -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _selectEvent date_ -# -# Selects the current <date_> on the calendar. Highlights the date -# on the calendar, and executes the command associated with the -# calendar, with the selected date substituted in place of "%d". -# ------------------------------------------------------------------ -body iwidgets::Calendar::_selectEvent {date_} { - _select $date_ - - if {[string trim $itk_option(-command)] != ""} { - set cmd $itk_option(-command) - set cmd [_percentSubst %d $cmd [get]] - uplevel #0 $cmd - } -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _percentSubst pattern_ string_ subst_ -# -# This command is a "safe" version of regsub, for substituting -# each occurance of <%pattern_> in <string_> with <subst_>. The -# usual Tcl "regsub" command does the same thing, but also -# converts characters like "&" and "\0", "\1", etc. that may -# be present in the <subst_> string. -# -# Returns <string_> with <subst_> substituted in place of each -# <%pattern_>. -# ------------------------------------------------------------------ -body iwidgets::Calendar::_percentSubst {pattern_ string_ subst_} { - if {![string match %* $pattern_]} { - error "bad pattern \"$pattern_\": should be %something" - } - - set rval "" - while {[regexp "(.*)${pattern_}(.*)" $string_ all head tail]} { - set rval "$subst_$tail$rval" - set string_ $head - } - set rval "$string_$rval" -} diff --git a/itcl/iwidgets3.0.0/generic/canvasprintbox.itk b/itcl/iwidgets3.0.0/generic/canvasprintbox.itk deleted file mode 100644 index 64ced049bf4..00000000000 --- a/itcl/iwidgets3.0.0/generic/canvasprintbox.itk +++ /dev/null @@ -1,1111 +0,0 @@ -# -# CanvasPrintBox v1.5 -# ---------------------------------------------------------------------- -# Implements a print box for printing the contents of a canvas widget -# to a printer or a file. It is possible to specify page orientation, the -# number of pages to print the image on and if the output should be -# stretched to fit the page. -# -# CanvasPrintBox is a "super-widget" that can be used as an -# element in ones own GUIs. It is used to print the contents -# of a canvas (called the source hereafter) to a printer or a -# file. Possible settings include: portrait and landscape orientation -# of the output, stretching the output to fit the page while maintaining -# a proper aspect-ratio and posterizing to enlarge the output to fit on -# multiple pages. A stamp-sized copy of the source will be shown (called -# the stamp hereafter) at all times to reflect the effect of changing -# the settings will have on the output. -# -# ---------------------------------------------------------------------- -# AUTHOR: Tako Schotanus EMAIL: Tako.Schotanus@bouw.tno.nl -# ---------------------------------------------------------------------- -# Copyright (c) 1995 Tako Schotanus -# ====================================================================== -# Permission is hereby granted, without written agreement and without -# license or royalty fees, to use, copy, modify, and distribute this -# software and its documentation for any purpose, provided that the -# above copyright notice and the following two paragraphs appear in -# all copies of this software. -# -# IN NO EVENT SHALL THE COPYRIGHT HOLDER BE LIABLE TO ANY PARTY FOR -# DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES -# ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN -# IF THE COPYRIGHT HOLDER HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH -# DAMAGE. -# -# THE COPYRIGHT HOLDER SPECIFICALLY DISCLAIMS ANY WARRANTIES, INCLUDING, -# BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND -# FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS -# ON AN "AS IS" BASIS, AND THE COPYRIGHT HOLDER HAS NO OBLIGATION TO -# PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. -# ====================================================================== - -# -# Default resources. -# -option add *Canvasprintbox.filename "canvas.ps" widgetDefault -option add *Canvasprintbox.hPageCnt 1 widgetDefault -option add *Canvasprintbox.orient landscape widgetDefault -option add *Canvasprintbox.output printer widgetDefault -option add *Canvasprintbox.pageSize A4 widgetDefault -option add *Canvasprintbox.posterize 0 widgetDefault -option add *Canvasprintbox.printCmd lpr widgetDefault -option add *Canvasprintbox.printRegion "" widgetDefault -option add *Canvasprintbox.vPageCnt 1 widgetDefault - -# -# Usual options. -# -itk::usual Canvasprintbox { - keep -background -cursor -textbackground -foreground -} - -#< -# -# CanvasPrintBox is a "super-widget" that can be used as an -# element in ones own GUIs. It is used to print the contents -# of a canvas (called the source hereafter) to a printer or a -# file. Possible settings include: portrait and landscape orientation -# of the output, stretching the output to fit the page while maintaining -# a proper aspect-ratio and posterizing to enlarge the output to fit on -# multiple pages. A stamp-sized copy of the source will be shown (called -# the stamp hereafter) at all times to reflect the effect of changing -# the settings will have on the output. -# -#> -class iwidgets::Canvasprintbox { - inherit itk::Widget - - # - # Holds the current state for all check- and radiobuttons. - # - itk_option define -filename filename FileName "canvas.ps" - itk_option define -hpagecnt hPageCnt PageCnt 1 - itk_option define -orient orient Orient "landscape" - itk_option define -output output Output "printer" - itk_option define -pagesize pageSize PageSize "A4" - itk_option define -posterize posterize Posterize 0 - itk_option define -printcmd printCmd PrintCmd "" - itk_option define -printregion printRegion PrintRegion "" - itk_option define -stretch stretch Stretch 0 - itk_option define -vpagecnt vPageCnt PageCnt 1 - - constructor {args} {} - destructor {} - - # --------------------------------------------------------------- - # PUBLIC - #---------------------------------------------------------------- - public { - method getoutput {} - method print {} - method refresh {} - method setcanvas {canv} - method stop {} - } - - # --------------------------------------------------------------- - # PROTECTED - #---------------------------------------------------------------- - protected { - # - # Just holds the names of some widgets/objects. "win" is used to - # determine if the object is fully constructed and initialized. - # - variable win "" - variable canvw "" - - # - # The canvas we want to print. - # - variable canvas "" - - # - # Boolean indicating if the attribute "orient" is set - # to landscape or not. - # - variable rotate 1 - - # - # Holds the configure options that were used to create this object. - # - variable init_opts "" - - # - # The following attributes hold a list of lines that are - # currently drawn on the "stamp" to show how the page(s) is/are - # oriented. The first holds the vertical dividing lines and the - # second the horizontal ones. - # - variable hlines "" - variable vlines "" - - # - # Updating is set when the thumbnail is being drawn. Settings - # this to 0 while drawing is still busy will terminate the - # proces. - # Restart_update can be set to 1 when the thumbnail is being - # drawn to force a redraw. - # - variable _reposition "" - variable _update_attr_id "" - - method _calc_poster_size {} - method _calc_print_region {} - method _calc_print_scale {} - method _mapEventHandler {} - method _update_attr {{when later}} - method _update_canvas {{when later}} - - common _globVar - - proc ezPaperInfo {size {attr ""} \ - {orient "portrait"} {window ""}} {} - } -} - -# -# Provide a lowercased access method for the Canvasprintbox class. -# -proc ::iwidgets::canvasprintbox {args} { - uplevel ::iwidgets::Canvasprintbox $args -} - -# ------------------------------------------------------------------ -# OPTIONS -# ------------------------------------------------------------------ - -#< -# A list of four coordinates specifying which part of the canvas to print. -# An empty list means that the canvas' entire scrollregion should be -# printed. Any change to this attribute will automatically update the "stamp". -# Defaults to an empty list. -#> -configbody iwidgets::Canvasprintbox::printregion { - if {$itk_option(-printregion) != "" - && [llength $itk_option(-printregion)] != 4} { - error {bad option "printregion": should contain 4 coordinates} - } - _update_canvas -} - -#< -# Specifies where the postscript output should go: to the printer -# or to a file. Can take on the values "printer" or "file". -# The corresponding entry-widget will reflect the contents of -# either the printcmd attribute or the filename attribute. -#> -configbody iwidgets::Canvasprintbox::output { - switch $itk_option(-output) { - file - printer { - set _globVar($this,output) $itk_option(-output) - } - default { - error {bad output option \"$itk_option(-output)\":\ - should be file or printer} - } - } - _update_attr -} - -#< -# The command to execute when printing the postscript output. -# The command will get the postscript directed to its standard -# input. (Only when output is set to "printer") -#> -configbody iwidgets::Canvasprintbox::printcmd { - set _globVar($this,printeref) $itk_option(-printcmd) - _update_attr -} - -#< -# The file to write the postscript output to (Only when output -# is set to "file"). If posterizing is turned on and hpagecnt -# and/or vpagecnt is more than 1, x.y is appended to the filename -# where x is the horizontal page number and y the vertical page number. -#> -configbody iwidgets::Canvasprintbox::filename { - set _globVar($this,fileef) $itk_option(-filename) - _update_attr -} - -#< -# The pagesize the printer supports. Changes to this attribute -# will be reflected immediately in the "stamp". -#> -configbody iwidgets::Canvasprintbox::pagesize { - set opt [string tolower $itk_option(-pagesize)] - set lst [string tolower [ezPaperInfo types]] - 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 -} - -#< -# Determines the orientation of the output to the printer (or file). -# It can take the value "portrait" or "landscape" (default). Changes -# to this attribute will be reflected immediately in the "stamp". -#> -configbody iwidgets::Canvasprintbox::orient { - switch $itk_option(-orient) { - "portrait" - "landscape" { - $itk_component(orientom) select $itk_option(-orient) - _update_canvas - - } - default { - error "bad orient option \"$itk_option(-orient)\":\ - should be portrait or landscape" - } - } -} - -#< -# Determines if the output should be stretched to fill the -# page (as defined by the attribute pagesize) as large as -# possible. The aspect-ratio of the output will be retained -# and the output will never fall outside of the boundaries -# of the page. -#> -configbody iwidgets::Canvasprintbox::stretch { - if {$itk_option(-stretch) != 0 && $itk_option(-stretch) != 1} { - error {bad option "stretch": should be a boolean} - } - set _globVar($this,stretchcb) $itk_option(-stretch) - _update_attr -} - -#< -# Indicates if posterizing is turned on or not. Posterizing -# the output means that it is possible to distribute the -# output over more than one page. This way it is possible to -# print a canvas/region which is larger than the specified -# pagesize without stretching. If used in combination with -# stretching it can be used to "blow up" the contents of a -# canvas to as large as size as you want (See attributes: -# hpagecnt end vpagecnt). Any change to this attribute will -# automatically update the "stamp". -#> -configbody iwidgets::Canvasprintbox::posterize { - if {$itk_option(-posterize) != "0" && $itk_option(-posterize) != "1"} { - error "expected boolean but got \"$itk_option(-posterize)\"" - } - set _globVar($this,postercb) $itk_option(-posterize) - _update_canvas -} - -#< -# Is used in combination with "posterize" to determine over -# how many pages the output should be distributed. This -# attribute specifies how many pages should be used horizontaly. -# Any change to this attribute will automatically update the "stamp". -#> -configbody iwidgets::Canvasprintbox::hpagecnt { - set _globVar($this,hpc) $itk_option(-hpagecnt) - _update_canvas -} - -#< -# Is used in combination with "posterize" to determine over -# how many pages the output should be distributed. This -# attribute specifies how many pages should be used verticaly. -# Any change to this attribute will automatically update the "stamp". -#> -configbody iwidgets::Canvasprintbox::vpagecnt { - set _globVar($this,vpc) $itk_option(-vpagecnt) - _update_canvas -} - -# ------------------------------------------------------------------ -# CONSTRUCTOR -# ------------------------------------------------------------------ -body iwidgets::Canvasprintbox::constructor {args} { - set _globVar($this,output) printer - set _globVar($this,printeref) "" - set _globVar($this,fileef) "canvas.ps" - set _globVar($this,hpc) 1 - set _globVar($this,vpc) 1 - set _globVar($this,postercb) 0 - set _globVar($this,stretchcb) 0 - - itk_component add canvasframe { - frame $itk_interior.f18 -bd 2 - } - - itk_component add canvas { - canvas $itk_component(canvasframe).c1 \ - -bd 2 -relief sunken \ - -scrollregion {0c 0c 10c 10c} \ - -width 250 - } - pack $itk_component(canvas) -expand 1 -fill both - - itk_component add outputom { - iwidgets::Labeledframe $itk_interior.outputom \ - -labelpos nw \ - -labeltext "Output to" - } - set cs [$itk_component(outputom) childsite] - - itk_component add printerrb { - radiobutton $cs.printerrb \ - -text Printer \ - -variable [scope _globVar($this,output)] \ - -anchor w \ - -justify left \ - -value printer \ - -command [code $this _update_attr] - } { - usual - rename -font -labelfont labelFont Font - } - itk_component add printeref { - iwidgets::entryfield $cs.printeref \ - -labeltext "command:" \ - -state normal \ - -labelpos w \ - -textvariable [scope _globVar($this,printeref)] - } - - itk_component add filerb { - radiobutton $cs.filerb \ - -text File \ - -justify left \ - -anchor w \ - -variable [scope _globVar($this,output)] \ - -value file \ - -command [code $this _update_attr] - } { - usual - rename -font -labelfont labelFont Font - } - itk_component add fileef { - iwidgets::entryfield $cs.fileef \ - -labeltext "filename:" \ - -state disabled \ - -labelpos w \ - -textvariable [scope _globVar($this,fileef)] - } - - itk_component add propsframe { - iwidgets::Labeledframe $itk_interior.propsframe \ - -labelpos nw \ - -labeltext "Properties" - } - set cs [$itk_component(propsframe) childsite] - - itk_component add paperom { - iwidgets::optionmenu $cs.paperom \ - -labelpos w -cyclicon 1 \ - -labeltext "Paper size:" \ - -command [code $this refresh] - } { - usual - rename -font -labelfont labelFont Font - } - eval $itk_component(paperom) insert end [ezPaperInfo types] - $itk_component(paperom) select A4 - - itk_component add orientom { - iwidgets::radiobox $itk_interior.orientom \ - -labeltext "Orientation" -command [code $this refresh] - } - $itk_component(orientom) add landscape -text Landscape - $itk_component(orientom) add portrait -text Portrait - $itk_component(orientom) select 0 - - itk_component add stretchcb { - checkbutton $cs.stretchcb \ - -relief flat \ - -text {Stretch to fit} \ - -justify left \ - -anchor w \ - -variable [scope _globVar($this,stretchcb)] \ - -command [code $this refresh] - } { - usual - rename -font -labelfont labelFont Font - } - - itk_component add postercb { - checkbutton $cs.postercb \ - -relief flat \ - -text Posterize \ - -justify left \ - -anchor w \ - -variable [scope _globVar($this,postercb)] \ - -command [code $this refresh] - } { - usual - rename -font -labelfont labelFont Font - } - - itk_component add hpcnt { - iwidgets::entryfield $cs.hpcnt \ - -labeltext on \ - -textvariable [scope _globVar($this,hpc)] \ - -validate integer -width 3 \ - -command [code $this refresh] - } - - itk_component add vpcnt { - iwidgets::entryfield $cs.vpcnt \ - -labeltext by \ - -textvariable [scope _globVar($this,vpc)] \ - -validate integer -width 3 \ - -command [code $this refresh] - } - - itk_component add pages { - label $cs.pages -text pages. - } { - usual - rename -font -labelfont labelFont Font - } - - set init_opts $args - - grid $itk_component(canvasframe) -row 0 -column 0 -rowspan 4 -sticky nsew - grid $itk_component(propsframe) -row 0 -column 1 -sticky nsew - grid $itk_component(outputom) -row 1 -column 1 -sticky nsew - grid $itk_component(orientom) -row 2 -column 1 -sticky nsew - grid columnconfigure $itk_interior 0 -weight 1 - grid rowconfigure $itk_interior 3 -weight 1 - - grid $itk_component(printerrb) -row 0 -column 0 -sticky nsw - grid $itk_component(printeref) -row 0 -column 1 -sticky nsw - grid $itk_component(filerb) -row 1 -column 0 -sticky nsw - grid $itk_component(fileef) -row 1 -column 1 -sticky nsw - iwidgets::Labeledwidget::alignlabels $itk_component(printeref) $itk_component(fileef) - grid columnconfigure $itk_component(outputom) 1 -weight 1 - - grid $itk_component(paperom) -row 0 -column 0 -columnspan 2 -sticky nsw - grid $itk_component(stretchcb) -row 1 -column 0 -sticky nsw - grid $itk_component(postercb) -row 2 -column 0 -sticky nsw - grid $itk_component(hpcnt) -row 2 -column 1 -sticky nsw - grid $itk_component(vpcnt) -row 2 -column 2 -sticky nsw - grid $itk_component(pages) -row 2 -column 3 -sticky nsw - grid columnconfigure $itk_component(propsframe) 3 -weight 1 - - eval itk_initialize $args - - bind $itk_component(pages) <Map> +[code $this _mapEventHandler] - bind $itk_component(canvas) <Configure> +[code $this refresh] -} - - -# --------------------------------------------------------------- -# PUBLIC METHODS -#---------------------------------------------------------------- - -#< -# This is used to set the canvas that has to be printed. -# A stamp-sized copy will automatically be drawn to show how the -# output would look with the current settings. -# -# In: canv - The canvas to be printed -# Out: canvas (attrib) - Holds the canvas to be printed -#> -body iwidgets::Canvasprintbox::setcanvas {canv} { - set canvas $canv - _update_canvas -} - -#< -# Returns the value of the -printercmd or -filename option -# depending on the current setting of -output. -# -# In: itk_option (attrib) -# Out: The value of -printercmd or -filename -#> -body iwidgets::Canvasprintbox::getoutput {} { - switch $_globVar($this,output) { - "file" { - return $_globVar($this,fileef) - } - "printer" { - return $_globVar($this,printeref) - } - } - return "" -} - -#< -# Perfrom the actual printing of the canvas using the current settings of -# all the attributes. -# -# In: itk_option, rotate (attrib) -# Out: A boolean indicating wether printing was successful -#> -body iwidgets::Canvasprintbox::print {} { - - global env tcl_platform - - stop - - if {$itk_option(-output) == "file"} { - set nm $itk_option(-filename) - if {[string range $nm 0 1] == "~/"} { - set nm "$env(HOME)/[string range $nm 2 end]" - } - } else { - set nm "/tmp/xge[winfo id $canvas]" - } - - set pr [_calc_print_region] - set x1 [lindex $pr 0] - set y1 [lindex $pr 1] - set x2 [lindex $pr 2] - set y2 [lindex $pr 3] - set cx [expr int(($x2 + $x1) / 2)] - set cy [expr int(($y2 + $y1) / 2)] - if {!$itk_option(-stretch)} { - set ps [_calc_poster_size] - set pshw [expr int([lindex $ps 0] / 2)] - set pshh [expr int([lindex $ps 1] / 2)] - set x [expr $cx - $pshw] - set y [expr $cy - $pshh] - set w [ezPaperInfo $itk_option(-pagesize) pwidth $itk_option(-orient) $win] - set h [ezPaperInfo $itk_option(-pagesize) pheight $itk_option(-orient) $win] - } else { - set x $x1 - set y $y1 - set w [expr ($x2-$x1) / $_globVar($this,hpc)] - set h [expr ($y2-$y1) / $_globVar($this,vpc)] - } - - set i 0 - set px $x - while {$i < $_globVar($this,hpc)} { - set j 0 - set py $y - while {$j < $_globVar($this,vpc)} { - set nm2 [expr {$_globVar($this,hpc) > 1 || $_globVar($this,vpc) > 1 ? "$nm$i.$j" : $nm}] - - if {$itk_option(-stretch)} { - $canvas postscript \ - -file $nm2 \ - -rotate $rotate \ - -x $px -y $py \ - -width $w \ - -height $h \ - -pagex [ezPaperInfo $itk_option(-pagesize) centerx] \ - -pagey [ezPaperInfo $itk_option(-pagesize) centery] \ - -pagewidth [ezPaperInfo $itk_option(-pagesize) pwidth $itk_option(-orient)] \ - -pageheight [ezPaperInfo $itk_option(-pagesize) pheight $itk_option(-orient)] - } else { - $canvas postscript \ - -file $nm2 \ - -rotate $rotate \ - -x $px -y $py \ - -width $w \ - -height $h \ - -pagex [ezPaperInfo $itk_option(-pagesize) centerx] \ - -pagey [ezPaperInfo $itk_option(-pagesize) centery] - } - - if {$itk_option(-output) == "printer"} { - set cmd "$itk_option(-printcmd) < $nm2" - if {[catch {eval exec $cmd &}]} { - return 0 - } - } - - set py [expr $py + $h] - incr j - } - set px [expr $px + $w] - incr i - } - - return 1 -} - -#< -# Retrieves the current value for all edit fields and updates -# the stamp accordingly. Is useful for Apply-buttons. -#> -body iwidgets::Canvasprintbox::refresh {} { - stop - _update_canvas - return -} - -#< -# Stops the drawing of the "stamp". I'm currently unable to detect -# when a Canvasprintbox gets withdrawn. It's therefore advised -# that you perform a stop before you do something like that. -#> -body iwidgets::Canvasprintbox::stop {} { - - if {$_reposition != ""} { - after cancel $_reposition - set _reposition "" - } - - if {$_update_attr_id != ""} { - after cancel $_update_attr_id - set _update_attr_id "" - } - - return -} - -# --------------------------------------------------------------- -# PROTECTED METHODS -#---------------------------------------------------------------- - -# -# Calculate the total size the output would be with the current -# settings for "pagesize" and "posterize" (and "hpagecnt" and -# "vpagecnt"). This size will be the size of the printable area, -# some space has been substracted to take into account that a -# page should have borders because most printers can't print on -# the very edge of the paper. -# -# In: posterize, hpagecnt, vpagecnt, pagesize, orient (attrib) -# Out: A list of two numbers indicating the width and the height -# of the total paper area which will be used for printing -# in pixels. -# -body iwidgets::Canvasprintbox::_calc_poster_size {} { - set tpw [expr [ezPaperInfo $itk_option(-pagesize) \ - pwidth $itk_option(-orient) $win]*$_globVar($this,hpc)] - set tph [expr [ezPaperInfo $itk_option(-pagesize) \ - pheight $itk_option(-orient) $win]*$_globVar($this,vpc)] - - return "$tpw $tph" -} - -# -# Determine which area of the "source" canvas will be printed. -# If "printregion" was set by the "user" this will be used and -# converted to pixel-coordinates. If the user didn't set it -# the bounding box that contains all canvas-items will be used -# instead. -# -# In: printregion, canvas (attrib) -# Out: Four floats specifying the region to be printed in -# pixel-coordinates (topleft & bottomright). -# -body iwidgets::Canvasprintbox::_calc_print_region {} { - set printreg [expr {$itk_option(-printregion) != "" - ? $itk_option(-printregion) : [$canvas bbox all]}] - - if {$printreg != ""} { - set prx1 [winfo fpixels $canvas [lindex $printreg 0]] - set pry1 [winfo fpixels $canvas [lindex $printreg 1]] - set prx2 [winfo fpixels $canvas [lindex $printreg 2]] - set pry2 [winfo fpixels $canvas [lindex $printreg 3]] - - set res "$prx1 $pry1 $prx2 $pry2" - } else { - set res "0 0 0 0" - } - - return $res -} - -# -# Calculate the scaling factor needed if the output was -# to be stretched to fit exactly on the page (or pages). -# If stretching is turned off this will always return 1.0. -# -# In: stretch (attrib) -# Out: A float specifying the scaling factor. -# -body iwidgets::Canvasprintbox::_calc_print_scale {} { - if {$itk_option(-stretch)} { - set pr [_calc_print_region] - set prw [expr [lindex $pr 2] - [lindex $pr 0]] - set prh [expr [lindex $pr 3] - [lindex $pr 1]] - set ps [_calc_poster_size] - set psw [lindex $ps 0] - set psh [lindex $ps 1] - set sfx [expr $psw / $prw] - set sfy [expr $psh / $prh] - set sf [expr {$sfx < $sfy ? $sfx : $sfy}] - return $sf - } else { - return 1.0 - } -} - -# -# Schedule the thread that makes a copy of the "source" -# canvas to the "stamp". -# -# In: win, canvas (attrib) -# Out: - -# -body iwidgets::Canvasprintbox::_update_canvas {{when later}} { - if {$win == "" || $canvas == "" || [$canvas find all] == ""} { - return - } - if {$when == "later"} { - if {$_reposition == ""} { - set _reposition [after idle [code $this _update_canvas now]] - } - return - } - - _update_attr now - - # - # Make a copy of the "source" canvas to the "stamp". - # - if {$_globVar($this,hpc) == [llength $vlines] && - $_globVar($this,vpc) == [llength $hlines]} { - stop - return - } - - $canvw delete all - - set width [winfo width $canvw] - set height [winfo height $canvw] - set ps [_calc_poster_size] - - # - # Calculate the scaling factor that would be needed to fit the - # whole "source" into the "stamp". This takes into account the - # total amount of "paper" that would be needed to print the - # contents of the "source". - # - set xsf [expr $width/[lindex $ps 0]] - set ysf [expr $height/[lindex $ps 1]] - set sf [expr {$xsf < $ysf ? $xsf : $ysf}] - set w [expr [lindex $ps 0]*$sf] - set h [expr [lindex $ps 1]*$sf] - set x1 [expr ($width-$w)/2] - set y1 [expr ($height-$h)/2] - set x2 [expr $x1+$w] - set y2 [expr $y1+$h] - set cx [expr ($x2+$x1)/ 2] - set cy [expr ($y2+$y1)/ 2] - - set printreg [_calc_print_region] - set prx1 [lindex $printreg 0] - set pry1 [lindex $printreg 1] - set prx2 [lindex $printreg 2] - set pry2 [lindex $printreg 3] - set prcx [expr ($prx2+$prx1)/2] - set prcy [expr ($pry2+$pry1)/2] - - set psf [_calc_print_scale] - - # - # Copy all items from the "real" canvas to the canvas - # showing what we'll send to the printer. Bitmaps and - # texts are not copied because they can't be scaled, - # a rectangle will be created instead. - # - set tsf [expr $sf * $psf] - set dx [expr $cx-($prcx*$tsf)] - set dy [expr $cy-($prcy*$tsf)] - $canvw create rectangle \ - [expr $x1+0] \ - [expr $y1+0] \ - [expr $x2-0] \ - [expr $y2-0] -fill white - set items [eval "$canvas find overlapping $printreg"] - - set itemCount [llength $items] - for {set cnt 0} {$cnt < $itemCount} {incr cnt} { - # - # Determine the item's type and coordinates - # - set i [lindex $items $cnt] - set t [$canvas type $i] - set crds [$canvas coords $i] - - # - # Ask for the item's configuration settings and strip - # it to leave only a list of option names and values. - # - set cfg [$canvas itemconfigure $i] - set cfg2 "" - foreach c $cfg { - if {[llength $c] == 5} { - lappend cfg2 [lindex $c 0] [lindex $c 4] - } - } - - # - # Handle texts and bitmaps differently: they will - # be represented as rectangles. - # - if {$t == "text" || $t == "bitmap" || $t == "window"} { - set t "rectangle" - set crds [$canvas bbox $i] - set cfg2 "-outline {} -fill gray" - } - - # - # Remove the arrows from a line item when the scale - # factor drops below 1/3rd of the original size. - # This to prevent the arrowheads from dominating the - # display. - # - if {$t == "line" && $tsf < 0.33} { - lappend cfg2 -arrow none - } - - # - # Create a copy of the item on the "printing" canvas. - # - set i2 [eval "$canvw create $t $crds $cfg2"] - $canvw scale $i2 0 0 $tsf $tsf - $canvw move $i2 $dx $dy - - if {[expr $cnt%25] == 0} { - update - } - if {$_reposition == ""} { - return - } - } - - set p $x1 - set i 1 - set vlines {} - while {$i < $_globVar($this,hpc)} { - set p [expr $p + ($w/$_globVar($this,hpc))] - set l [$canvw create line $p $y1 $p $y2] - lappend vlines $l - incr i - } - - set p $y1 - set i 1 - set vlines {} - while {$i < $_globVar($this,vpc)} { - set p [expr $p + ($h/$_globVar($this,vpc))] - set l [$canvw create line $x1 $p $x2 $p] - lappend vlines $l - incr i - } - - set _reposition "" -} - -# -# Update the attributes to reflect changes made in the user- -# interface. -# -# In: itk_option (attrib) - the attributes to update -# itk_component (attrib) - the widgets -# _globVar (common) - the global var holding the state -# of all radiobuttons and checkboxes. -# Out: - -# -body iwidgets::Canvasprintbox::_update_attr {{when "later"}} { - if {$when != "now"} { - if {$_update_attr_id == ""} { - set _update_attr_id [after idle [code $this _update_attr now]] - } - return - } - - set itk_option(-printcmd) $_globVar($this,printeref) - set itk_option(-filename) $_globVar($this,fileef) - set itk_option(-output) $_globVar($this,output) - set itk_option(-pagesize) [string tolower [$itk_component(paperom) get]] - set itk_option(-stretch) $_globVar($this,stretchcb) - set itk_option(-posterize) $_globVar($this,postercb) - set itk_option(-vpagecnt) $_globVar($this,vpc) - set itk_option(-hpagecnt) $_globVar($this,hpc) - set itk_option(-orient) [$itk_component(orientom) get] - set rotate [expr {$itk_option(-orient) == "landscape"}] - - if {$_globVar($this,output) == "file"} { - $itk_component(fileef) configure \ - -state normal -foreground $itk_option(-foreground) - $itk_component(printeref) configure \ - -state disabled -foreground $itk_option(-disabledforeground) - } else { - $itk_component(fileef) configure \ - -state disabled -foreground $itk_option(-disabledforeground) - $itk_component(printeref) configure \ - -state normal -foreground $itk_option(-foreground) - } - - set fg [expr {$_globVar($this,postercb) \ - ? $itk_option(-foreground) : $itk_option(-disabledforeground)}] - - $itk_component(vpcnt) configure -foreground $fg - $itk_component(hpcnt) configure -foreground $fg - $itk_component(pages) configure -foreground $fg - - # - # Update dependencies among widgets. (For example: disabling - # an entry-widget when its associated checkbox-button is used - # to turn of the option (the entry's value is not needed - # anymore and this should be reflected in the fact that it - # isn't possible to change it anymore). - # - # former method:_update_widgets/_update_UI - # - set state [expr {$itk_option(-posterize) ? "normal" : "disabled"}] - $itk_component(vpcnt) configure -state $state - $itk_component(hpcnt) configure -state $state - $itk_component(paperom) select "*[string range $itk_option(-pagesize) 1 end]" - - set _update_attr_id "" -} - -# -# Gets called when the CanvasPrintBox-widget gets mapped. -# -body iwidgets::Canvasprintbox::_mapEventHandler {} { - set win $itk_interior - set canvw $itk_component(canvas) - if {$canvas != ""} { - setcanvas $canvas - } - _update_attr -} - -# -# Destroy this object and its associated widgets. -# -body iwidgets::Canvasprintbox::destructor {} { - stop -} - -# -# Hold the information about common paper sizes. A bit of a hack, but it -# should be possible to add your own if you take a look at it. -# -body iwidgets::Canvasprintbox::ezPaperInfo {size {attr ""} \ - {orient "portrait"} {window ""}} { - - set size [string tolower $size] - set attr [string tolower $attr] - set orient [string tolower $orient] - - case $size in { - types { - return "A5 A4 A3 A2 A1 Legal Letter" - } - a5 { - set paper(x1) "1.0c" - set paper(y1) "1.0c" - set paper(x2) "13.85c" - set paper(y2) "20.0c" - set paper(pheight) "19.0c" - set paper(pwidth) "12.85c" - set paper(height) "21.0c" - set paper(width) "14.85c" - set paper(centerx) "7.425c" - set paper(centery) "10.5c" - } - a4 { - set paper(x1) "1.0c" - set paper(y1) "1.0c" - set paper(x2) "20.0c" - set paper(y2) "28.7c" - set paper(pheight) "27.7c" - set paper(pwidth) "19.0c" - set paper(height) "29.7c" - set paper(width) "21.0c" - set paper(centerx) "10.5c" - set paper(centery) "14.85c" - } - a3 { - set paper(x1) "1.0c" - set paper(y1) "1.0c" - set paper(x2) "28.7c" - set paper(y2) "41.0c" - set paper(pheight) "40.0c" - set paper(pwidth) "27.7c" - set paper(height) "42.0c" - set paper(width) "29.7c" - set paper(centerx) "14.85c" - set paper(centery) "21.0c" - } - a2 { - set paper(x1) "1.0c" - set paper(y1) "1.0c" - set paper(x2) "41.0c" - set paper(y2) "58.4c" - set paper(pheight) "57.4c" - set paper(pwidth) "40.0c" - set paper(height) "59.4c" - set paper(width) "42.0c" - set paper(centerx) "21.0c" - set paper(centery) "29.7c" - } - a1 { - set paper(x1) "1.0c" - set paper(y1) "1.0c" - set paper(x2) "58.4c" - set paper(y2) "83.0c" - set paper(pheight) "82.0c" - set paper(pwidth) "57.4c" - set paper(height) "84.0c" - set paper(width) "59.4c" - set paper(centerx) "29.7c" - set paper(centery) "42.0c" - } - legal { - set paper(x1) "0.2i" - set paper(y1) "0.2i" - set paper(x2) "8.3i" - set paper(y2) "13.8i" - set paper(pheight) "13.6i" - set paper(pwidth) "8.1i" - set paper(height) "14.0i" - set paper(width) "8.5i" - set paper(centerx) "4.25i" - set paper(centery) "7.0i" - } - letter { - set paper(x1) "0.2i" - set paper(y1) "0.2i" - set paper(x2) "8.3i" - set paper(y2) "10.8i" - set paper(pheight) "10.6i" - set paper(pwidth) "8.1i" - set paper(height) "11.0i" - set paper(width) "8.5i" - set paper(centerx) "4.25i" - set paper(centery) "5.5i" - } - default { - error "ezPaperInfo: Unknown paper type ($type)" - } - } - - set inv(x1) "y1" - set inv(x2) "y2" - set inv(y1) "x1" - set inv(y2) "x2" - set inv(pwidth) "pheight" - set inv(pheight) "pwidth" - set inv(width) "height" - set inv(height) "width" - set inv(centerx) "centery" - set inv(centery) "centerx" - - case $orient in { - landscape { - set res $paper($inv($attr)) - } - portrait { - set res $paper($attr) - } - default { - error "ezPaperInfo: orientation should be\ - portrait or landscape (not $orient)" - } - } - - if {$window != ""} { - set res [winfo fpixels $window $res] - } - - return $res -} diff --git a/itcl/iwidgets3.0.0/generic/canvasprintdialog.itk b/itcl/iwidgets3.0.0/generic/canvasprintdialog.itk deleted file mode 100644 index d87593947e3..00000000000 --- a/itcl/iwidgets3.0.0/generic/canvasprintdialog.itk +++ /dev/null @@ -1,155 +0,0 @@ -# -# CanvasPrintDialog v1.5 -# ---------------------------------------------------------------------- -# Implements a print dialog for printing the contents of a canvas widget -# to a printer or a file. It is possible to specify page orientation, the -# number of pages to print the image on and if the output should be -# stretched to fit the page. The CanvasPrintDialog is derived from the -# Dialog class and is composed of a CanvasPrintBox with attributes set to -# manipulate the dialog buttons. -# -# ---------------------------------------------------------------------- -# AUTHOR: Tako Schotanus EMAIL: Tako.Schotanus@bouw.tno.nl -# ---------------------------------------------------------------------- -# Copyright (c) 1995 Tako Schotanus -# ====================================================================== -# Permission is hereby granted, without written agreement and without -# license or royalty fees, to use, copy, modify, and distribute this -# software and its documentation for any purpose, provided that the -# above copyright notice and the following two paragraphs appear in -# all copies of this software. -# -# IN NO EVENT SHALL THE COPYRIGHT HOLDER BE LIABLE TO ANY PARTY FOR -# DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES -# ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN -# IF THE COPYRIGHT HOLDER HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH -# DAMAGE. -# -# THE COPYRIGHT HOLDER SPECIFICALLY DISCLAIMS ANY WARRANTIES, INCLUDING, -# BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND -# FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS -# ON AN "AS IS" BASIS, AND THE COPYRIGHT HOLDER HAS NO OBLIGATION TO -# PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. -# ====================================================================== - -# -# Option database default resources: -# -option add *Canvasprintdialog.filename "canvas.ps" widgetDefault -option add *Canvasprintdialog.hPageCnt 1 widgetDefault -option add *Canvasprintdialog.orient landscape widgetDefault -option add *Canvasprintdialog.output printer widgetDefault -option add *Canvasprintdialog.pageSize A4 widgetDefault -option add *Canvasprintdialog.posterize 0 widgetDefault -option add *Canvasprintdialog.printCmd lpr widgetDefault -option add *Canvasprintdialog.printRegion "" widgetDefault -option add *Canvasprintdialog.vPageCnt 1 widgetDefault -option add *Canvasprintdialog.title "Canvas Print Dialog" widgetDefault -option add *Canvasprintdialog.master "." widgetDefault - -# -# Usual options. -# -itk::usual Canvasprintdialog { - keep -background -cursor -foreground -modality -} - -# ------------------------------------------------------------------ -# CANVASPRINTDIALOG -# ------------------------------------------------------------------ -class iwidgets::Canvasprintdialog { - inherit iwidgets::Dialog - - constructor {args} {} - destructor {} - - method deactivate {args} {} - method getoutput {} {} - method setcanvas {canv} {} - method refresh {} {} - method print {} {} -} - -# -# Provide a lowercased access method for the Canvasprintdialog class. -# -proc ::iwidgets::canvasprintdialog {args} { - uplevel ::iwidgets::Canvasprintdialog $args -} - -# ------------------------------------------------------------------ -# CONSTRUCTOR -# -# Create new file selection dialog. -# ------------------------------------------------------------------ -body iwidgets::Canvasprintdialog::constructor {args} { - component hull configure -borderwidth 0 - - # - # Instantiate a file selection box widget. - # - itk_component add cpb { - iwidgets::Canvasprintbox $itk_interior.cpb - } { - usual - keep -printregion -output -printcmd -filename -pagesize \ - -orient -stretch -posterize -hpagecnt -vpagecnt - } - pack $itk_component(cpb) -fill both -expand yes - - # - # Hide the apply and help buttons. - # - buttonconfigure OK -text Print - buttonconfigure Apply -command [code $this refresh] -text Refresh - hide Help - - eval itk_initialize $args -} - -# ------------------------------------------------------------------ -# METHOD: deactivate -# -# Redefines method of dialog shell class. Stops the drawing of the -# thumbnail (when busy) upon deactivation of the dialog. -# ------------------------------------------------------------------ -body iwidgets::Canvasprintdialog::deactivate {args} { - $itk_component(cpb) stop - return [eval Shell::deactivate $args] -} - -# ------------------------------------------------------------------ -# METHOD: getoutput -# -# Thinwrapped method of canvas print box class. -# ------------------------------------------------------------------ -body iwidgets::Canvasprintdialog::getoutput {} { - return [$itk_component(cpb) getoutput] -} - -# ------------------------------------------------------------------ -# METHOD: setcanvas -# -# Thinwrapped method of canvas print box class. -# ------------------------------------------------------------------ -body iwidgets::Canvasprintdialog::setcanvas {canv} { - return [$itk_component(cpb) setcanvas $canv] -} - -# ------------------------------------------------------------------ -# METHOD: refresh -# -# Thinwrapped method of canvas print box class. -# ------------------------------------------------------------------ -body iwidgets::Canvasprintdialog::refresh {} { - return [$itk_component(cpb) refresh] -} - -# ------------------------------------------------------------------ -# METHOD: print -# -# Thinwrapped method of canvas print box class. -# ------------------------------------------------------------------ -body iwidgets::Canvasprintdialog::print {} { - return [$itk_component(cpb) print] -} diff --git a/itcl/iwidgets3.0.0/generic/checkbox.itk b/itcl/iwidgets3.0.0/generic/checkbox.itk deleted file mode 100755 index d1498d15667..00000000000 --- a/itcl/iwidgets3.0.0/generic/checkbox.itk +++ /dev/null @@ -1,341 +0,0 @@ -# -# Checkbox -# ---------------------------------------------------------------------- -# Implements a checkbuttonbox. Supports adding, inserting, deleting, -# selecting, and deselecting of checkbuttons by tag and index. -# -# ---------------------------------------------------------------------- -# AUTHOR: John A. Tucker EMAIL: jatucker@spd.dsccc.com -# -# ---------------------------------------------------------------------- -# Copyright (c) 1997 DSC Technologies Corporation -# ====================================================================== -# Permission to use, copy, modify, distribute and license this software -# and its documentation for any purpose, and without fee or written -# agreement with DSC, is hereby granted, provided that the above copyright -# notice appears in all copies and that both the copyright notice and -# warranty disclaimer below appear in supporting documentation, and that -# the names of DSC Technologies Corporation or DSC Communications -# Corporation not be used in advertising or publicity pertaining to the -# software without specific, written prior permission. -# -# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING -# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- -# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE -# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, -# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL -# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR -# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, -# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, -# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS -# SOFTWARE. -# ====================================================================== - - -# -# Use option database to override default resources of base classes. -# -option add *Checkbox.labelMargin 10 widgetDefault -option add *Checkbox.labelFont \ - "-Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*" widgetDefault -option add *Checkbox.labelPos nw widgetDefault -option add *Checkbox.borderWidth 2 widgetDefault -option add *Checkbox.relief groove widgetDefault - -# -# Usual options. -# -itk::usual Checkbox { - keep -background -borderwidth -cursor -foreground -labelfont -} - -# ------------------------------------------------------------------ -# CHECKBOX -# ------------------------------------------------------------------ -class iwidgets::Checkbox { - inherit iwidgets::Labeledframe - - constructor {args} {} - - itk_option define -orient orient Orient vertical - - public { - method add {tag args} - method insert {index tag args} - method delete {index} - method get {{index ""}} - method index {index} - method select {index} - method deselect {index} - method flash {index} - method toggle {index} - method buttonconfigure {index args} - } - - private { - - method gettag {index} ;# Get the tag of the checkbutton associated - ;# with a numeric index - - variable _unique 0 ;# Unique id for choice creation. - variable _buttons {} ;# List of checkbutton tags. - common buttonVar ;# Array of checkbutton "-variables" - } -} - -# -# Provide a lowercased access method for the Checkbox class. -# -proc ::iwidgets::checkbox {pathName args} { - uplevel ::iwidgets::Checkbox $pathName $args -} - -# ------------------------------------------------------------------ -# CONSTRUCTOR -# ------------------------------------------------------------------ -body iwidgets::Checkbox::constructor {args} { - - eval itk_initialize $args -} - -# ------------------------------------------------------------------ -# OPTIONS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# OPTION: -orient -# -# Allows the user to orient the checkbuttons either horizontally -# or vertically. Added by Chad Smith (csmith@adc.com) 3/10/00. -# ------------------------------------------------------------------ -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 -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# METHOD: index index -# -# Searches the checkbutton tags in the checkbox for the one with the -# requested tag, numerical index, or keyword "end". Returns the -# choices's numerical index if found, otherwise error. -# ------------------------------------------------------------------ -body iwidgets::Checkbox::index {index} { - if {[llength $_buttons] > 0} { - if {[regexp {(^[0-9]+$)} $index]} { - if {$index < [llength $_buttons]} { - return $index - } else { - error "Checkbox index \"$index\" is out of range" - } - - } elseif {$index == "end"} { - return [expr [llength $_buttons] - 1] - - } else { - if {[set idx [lsearch $_buttons $index]] != -1} { - return $idx - } - - error "bad Checkbox index \"$index\": must be number, end,\ - or pattern" - } - - } else { - error "Checkbox \"$itk_component(hull)\" has no checkbuttons" - } -} - -# ------------------------------------------------------------------ -# METHOD: add tag ?option value option value ...? -# -# Add a new tagged checkbutton to the checkbox at the end. The method -# takes additional options which are passed on to the checkbutton -# constructor. These include most of the typical checkbutton -# options. The tag is returned. -# ------------------------------------------------------------------ -body iwidgets::Checkbox::add {tag args} { - itk_component add $tag { - eval checkbutton $itk_component(childsite).cb[incr _unique] \ - -variable [list [scope buttonVar($this,$tag)]] \ - -anchor w \ - -justify left \ - -highlightthickness 0 \ - $args - } { - usual - keep -command -disabledforeground -selectcolor -state - ignore -highlightthickness -highlightcolor - rename -font -labelfont labelFont Font - } - - # 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 - - return $tag -} - -# ------------------------------------------------------------------ -# METHOD: insert index tag ?option value option value ...? -# -# Insert the tagged checkbutton in the checkbox just before the -# one given by index. Any additional options are passed on to the -# checkbutton constructor. These include the typical checkbutton -# options. The tag is returned. -# ------------------------------------------------------------------ -body iwidgets::Checkbox::insert {index tag args} { - itk_component add $tag { - eval checkbutton $itk_component(childsite).cb[incr _unique] \ - -variable [list [scope buttonVar($this,$tag)]] \ - -anchor w \ - -justify left \ - -highlightthickness 0 \ - $args - } { - usual - ignore -highlightthickness -highlightcolor - rename -font -labelfont labelFont Font - } - - set index [index $index] - set before [lindex $_buttons $index] - set _buttons [linsert $_buttons $index $tag] - - pack $itk_component($tag) -anchor w -padx 4 -before $itk_component($before) - - return $tag -} - -# ------------------------------------------------------------------ -# METHOD: delete index -# -# Delete the specified checkbutton. -# ------------------------------------------------------------------ -body iwidgets::Checkbox::delete {index} { - - set tag [gettag $index] - set index [index $index] - destroy $itk_component($tag) - set _buttons [lreplace $_buttons $index $index] - - if { [info exists buttonVar($this,$tag)] == 1 } { - unset buttonVar($this,$tag) - } -} - -# ------------------------------------------------------------------ -# METHOD: select index -# -# Select the specified checkbutton. -# ------------------------------------------------------------------ -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 -} - -# ------------------------------------------------------------------ -# METHOD: toggle index -# -# Toggle a specified checkbutton between selected and unselected -# ------------------------------------------------------------------ -body iwidgets::Checkbox::toggle {index} { - set tag [gettag $index] - $itk_component($tag) toggle -} - -# ------------------------------------------------------------------ -# METHOD: get -# -# Return the value of the checkbutton with the given index, or a -# list of all checkbutton values in increasing order by index. -# ------------------------------------------------------------------ -body iwidgets::Checkbox::get {{index ""}} { - set result {} - - if {$index == ""} { - foreach tag $_buttons { - if {$buttonVar($this,$tag)} { - lappend result $tag - } - } - } else { - set tag [gettag $index] - set result $buttonVar($this,$tag) - } - - return $result -} - -# ------------------------------------------------------------------ -# METHOD: deselect index -# -# Deselect the specified checkbutton. -# ------------------------------------------------------------------ -body iwidgets::Checkbox::deselect {index} { - set tag [gettag $index] - $itk_component($tag) deselect -} - -# ------------------------------------------------------------------ -# METHOD: flash index -# -# Flash the specified checkbutton. -# ------------------------------------------------------------------ -body iwidgets::Checkbox::flash {index} { - set tag [gettag $index] - $itk_component($tag) flash -} - -# ------------------------------------------------------------------ -# METHOD: buttonconfigure index ?option? ?value option value ...? -# -# Configure a specified checkbutton. This method allows configuration -# of checkbuttons from the Checkbox level. The options may have any -# of the values accepted by the add method. -# ------------------------------------------------------------------ -body iwidgets::Checkbox::buttonconfigure {index args} { - set tag [gettag $index] - eval $itk_component($tag) configure $args -} - -# ------------------------------------------------------------------ -# METHOD: gettag index -# -# Return the tag of the checkbutton associated with a specified -# numeric index -# ------------------------------------------------------------------ -body iwidgets::Checkbox::gettag {index} { - return [lindex $_buttons [index $index]] -} diff --git a/itcl/iwidgets3.0.0/generic/colors.itcl b/itcl/iwidgets3.0.0/generic/colors.itcl deleted file mode 100644 index c544c2e2da0..00000000000 --- a/itcl/iwidgets3.0.0/generic/colors.itcl +++ /dev/null @@ -1,209 +0,0 @@ -# -# colors -# ---------------------------------------------------------------------- -# The colors class encapsulates several color related utility functions. -# Class level scope resolution must be used inorder to access the static -# member functions. -# -# USAGE: -# set hsb [colors::rgbToHsb [winfo rgb . bisque]] -# -# ---------------------------------------------------------------------- -# AUTHOR: Mark L. Ulferts EMAIL: mulferts@spd.dsccc.com -# -# @(#) $Id$ -# ---------------------------------------------------------------------- -# Copyright (c) 1995 Mark L. Ulferts -# ====================================================================== -# Permission is hereby granted, without written agreement and without -# license or royalty fees, to use, copy, modify, and distribute this -# software and its documentation for any purpose, provided that the -# above copyright notice and the following two paragraphs appear in -# all copies of this software. -# -# IN NO EVENT SHALL THE COPYRIGHT HOLDER BE LIABLE TO ANY PARTY FOR -# DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES -# ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN -# IF THE COPYRIGHT HOLDER HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH -# DAMAGE. -# -# THE COPYRIGHT HOLDER SPECIFICALLY DISCLAIMS ANY WARRANTIES, INCLUDING, -# BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND -# FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS -# ON AN "AS IS" BASIS, AND THE COPYRIGHT HOLDER HAS NO OBLIGATION TO -# PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. -# ====================================================================== - -namespace eval iwidgets::colors { - - # ------------------------------------------------------------------ - # PROCEDURE: rgbToNumeric - # - # Returns the numeric value for a list of red, green, and blue. - # ------------------------------------------------------------------ - proc rgbToNumeric {rgb} { - if {[llength $rgb] != 3} { - error "bad arg: \"$rgb\", should be list of red, green, and blue" - } - - return [format "#%04x%04x%04x" \ - [lindex $rgb 0] [lindex $rgb 1] [lindex $rgb 2]] - } - - # ------------------------------------------------------------------ - # PROCEDURE: rgbToHsb - # - # The procedure below converts an RGB value to HSB. It takes red, - # green, and blue components (0-65535) as arguments, and returns a - # list containing HSB components (floating-point, 0-1) as result. - # The code here is a copy of the code on page 615 of "Fundamentals - # of Interactive Computer Graphics" by Foley and Van Dam. - # ------------------------------------------------------------------ - proc rgbToHsb {rgb} { - if {[llength $rgb] != 3} { - error "bad arg: \"$rgb\", should be list of red, green, and blue" - } - - set r [expr [lindex $rgb 0]/65535.0] - set g [expr [lindex $rgb 1]/65535.0] - set b [expr [lindex $rgb 2]/65535.0] - - set max 0 - if {$r > $max} {set max $r} - if {$g > $max} {set max $g} - if {$b > $max} {set max $b} - - set min 65535 - if {$r < $min} {set min $r} - if {$g < $min} {set min $g} - if {$b < $min} {set min $b} - - if {$max != 0} { - set sat [expr ($max-$min)/$max] - } else { - set sat 0 - } - if {$sat == 0} { - set hue 0 - } else { - set rc [expr ($max-$r)/($max-$min)] - set gc [expr ($max-$g)/($max-$min)] - set bc [expr ($max-$b)/($max-$min)] - - if {$r == $max} { - set hue [expr $bc-$gc] - } elseif {$g == $max} { - set hue [expr 2+$rc-$bc] - } elseif {$b == $max} { - set hue [expr 4+$gc-$rc] - } - set hue [expr $hue*0.1666667] - if {$hue < 0} {set hue [expr $hue+1.0]} - } - return [list $hue $sat $max] - } - - # ------------------------------------------------------------------ - # PROCEDURE: hsbToRgb - # - # The procedure below converts an HSB value to RGB. It takes hue, - # saturation, and value components (floating-point, 0-1.0) as - # arguments, and returns a list containing RGB components (integers, - # 0-65535) as result. The code here is a copy of the code on page - # 616 of "Fundamentals of Interactive Computer Graphics" by Foley - # and Van Dam. - # ------------------------------------------------------------------ - proc hsbToRgb {hsb} { - - if {[llength $hsb] != 3} { - error "bad arg: \"$hsb\", should be list of hue, saturation, and brightness" - } - - set hue [lindex $hsb 0] - set sat [lindex $hsb 1] - set value [lindex $hsb 2] - - set v [format %.0f [expr 65535.0*$value]] - if {$sat == 0} { - return "$v $v $v" - } else { - set hue [expr $hue*6.0] - if {$hue >= 6.0} { - set hue 0.0 - } - scan $hue. %d i - set f [expr $hue-$i] - set p [format %.0f [expr {65535.0*$value*(1 - $sat)}]] - set q [format %.0f [expr {65535.0*$value*(1 - ($sat*$f))}]] - set t [format %.0f [expr {65535.0*$value*(1 - ($sat*(1 - $f)))}]] - case $i \ - 0 {return "$v $t $p"} \ - 1 {return "$q $v $p"} \ - 2 {return "$p $v $t"} \ - 3 {return "$p $q $v"} \ - 4 {return "$t $p $v"} \ - 5 {return "$v $p $q"} - error "i value $i is out of range" - } - } - - # ------------------------------------------------------------------ - # - # PROCEDURE: topShadow bgColor - # - # This method computes a lighter shadow variant of bgColor. - # It wants to decrease the saturation to 25%. But if there is - # no saturation (as in gray colors) it tries to turn the - # brightness up by 10%. It maxes the brightness at 1.0 to - # avoid bogus colors... - # - # bgColor is converted to HSB where the calculations are - # made. Then converted back to an rgb color number (hex fmt) - # - # ------------------------------------------------------------------ - proc topShadow { bgColor } { - - set hsb [rgbToHsb [winfo rgb . $bgColor]] - - set saturation [lindex $hsb 1] - set brightness [lindex $hsb 2] - - if { $brightness < 0.9 } { - # try turning the brightness up first. - set brightness [expr $brightness * 1.1] - } else { - # otherwise fiddle with saturation - set saturation [expr $saturation * 0.25] - } - - set hsb [lreplace $hsb 1 1 [set saturation]] - set hsb [lreplace $hsb 2 2 [set brightness]] - - set rgb [hsbToRgb $hsb] - set color [rgbToNumeric $rgb] - return $color - } - - - # ------------------------------------------------------------------ - # - # PROC: bottomShadow bgColor - # - # - # This method computes a darker shadow variant of bg color. - # It takes the brightness and decreases it to 80% of its - # original value. - # - # bgColor is converted to HSB where the calculations are - # made. Then converted back to an rgb color number (hex fmt) - # - # ------------------------------------------------------------------ - proc bottomShadow { bgColor } { - - set hsb [rgbToHsb [winfo rgb . $bgColor]] - set hsb [lreplace $hsb 2 2 [expr [lindex $hsb 2] * 0.8]] - set rgb [hsbToRgb $hsb] - set color [rgbToNumeric $rgb] - return $color - } -} diff --git a/itcl/iwidgets3.0.0/generic/combobox.itk b/itcl/iwidgets3.0.0/generic/combobox.itk deleted file mode 100644 index ab70ba98956..00000000000 --- a/itcl/iwidgets3.0.0/generic/combobox.itk +++ /dev/null @@ -1,1360 +0,0 @@ -# Combobox -# ---------------------------------------------------------------------- -# Implements a Combobox widget. A Combobox has 2 basic styles: simple and -# dropdown. Dropdowns display an entry field with an arrow button to the -# right of it. When the arrow button is pressed a selectable list of -# items is popped up. A simple Combobox displays an entry field and a listbox -# just beneath it which is always displayed. In both types, if the user -# selects an item in the listbox, the contents of the entry field are -# replaced with the text from the selected item. If the Combobox is -# editable, the user can type in the entry field and when <Return> is -# pressed the item will be inserted into the list. -# -# WISH LIST: -# This section lists possible future enhancements. -# -# Combobox 1.x: -# - convert bindings to bindtags. -# -# ---------------------------------------------------------------------- -# ORIGINAL AUTHOR: John S. Sigler EMAIL: jsigler@spd.dsccc.com -# sigler@onramp.net -# ---------------------------------------------------------------------- -# CURRENT MAINTAINER: Mitch Gorman EMAIL: logain@erols.com -# Copyright (c) 1995 John S. Sigler -# Copyright (c) 1997 Mitch Gorman -# ====================================================================== -# Permission is hereby granted, without written agreement and without -# license or royalty fees, to use, copy, modify, and distribute this -# software and its documentation for any purpose, provided that the -# above copyright notice and the following two paragraphs appear in -# all copies of this software. -# -# IN NO EVENT SHALL THE COPYRIGHT HOLDER BE LIABLE TO ANY PARTY FOR -# DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES -# ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN -# IF THE COPYRIGHT HOLDER HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH -# DAMAGE. -# -# THE COPYRIGHT HOLDER SPECIFICALLY DISCLAIMS ANY WARRANTIES, INCLUDING, -# BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND -# FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS -# ON AN "AS IS" BASIS, AND THE COPYRIGHT HOLDER HAS NO OBLIGATION TO -# PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. -# ====================================================================== - -# -# Default resources. -# -option add *Combobox.borderWidth 2 widgetDefault -option add *Combobox.labelPos wn widgetDefault -option add *Combobox.listHeight 150 widgetDefault -option add *Combobox.hscrollMode dynamic widgetDefault -option add *Combobox.vscrollMode dynamic widgetDefault - -# -# Usual options. -# -itk::usual Combobox { - keep -background -borderwidth -cursor -foreground -highlightcolor \ - -highlightthickness -insertbackground -insertborderwidth \ - -insertofftime -insertontime -insertwidth -labelfont -popupcursor \ - -selectbackground -selectborderwidth -selectforeground \ - -textbackground -textfont -} - -# ------------------------------------------------------------------ -# COMBOBOX -# ------------------------------------------------------------------ -class iwidgets::Combobox { - inherit iwidgets::Entryfield - - constructor {args} {} - destructor {} - - itk_option define -arrowrelief arrowRelief Relief raised - itk_option define -completion completion Completion true - itk_option define -dropdown dropdown Dropdown true - itk_option define -editable editable Editable true - itk_option define -grab grab Grab local - itk_option define -listheight listHeight Height 150 - itk_option define -margin margin Margin 1 - itk_option define -popupcursor popupCursor Cursor arrow - itk_option define -selectioncommand selectionCommand SelectionCommand {} - itk_option define -state state State normal - itk_option define -unique unique Unique true - - public method clear {{component all}} - public method curselection {} - public method delete {component first {last {}}} - public method get {{index {}}} - public method getcurselection {} - public method insert {component index args} - public method invoke {} - public method justify {direction} - public method see {index} - public method selection {option first {last {}}} - public method size {} - public method sort {{mode ascending}} - public method xview {args} - public method yview {args} - - protected method _addToList {} - protected method _createComponents {} - protected method _deleteList {first {last {}}} - protected method _deleteText {first {last {}}} - protected method _doLayout {{when later}} - protected method _drawArrow {} - protected method _dropdownBtnRelease {{window {}} {x 1} {y 1}} - protected method _ignoreNextBtnRelease {ignore} - protected method _next {} - protected method _packComponents {{when later}} - protected method _positionList {} - protected method _postList {} - protected method _previous {} - protected method _resizeArrow {} - protected method _selectCmd {} - protected method _toggleList {} - protected method _unpostList {} - protected method _commonBindings {} - protected method _dropdownBindings {} - protected method _simpleBindings {} - protected method _listShowing {{val ""}} - - private method _bs {} - private method _lookup {key} - private method _slbListbox {} - private method _stateSelect {} - - private variable _doit 0; - private variable _inbs 0; - private variable _inlookup 0; - private variable _currItem {}; ;# current selected item. - private variable _ignoreRelease false ;# next button release ignored. - private variable _isPosted false; ;# is the dropdown popped up. - private variable _repacking {} ;# non-null => _packComponents pending. - private common _listShowing - private common count 0 -} - -# -# Provide a lowercase access method for the Combobox class. -# -proc ::iwidgets::combobox {pathName args} { - uplevel ::iwidgets::Combobox $pathName $args -} - -# ------------------------------------------------------------------ -# CONSTRUCTOR -# ------------------------------------------------------------------ -body iwidgets::Combobox::constructor {args} { - set _listShowing($this) 0 - - # combobox is different as all components are created - # after determining what the dropdown style is... - - # configure args - eval itk_initialize $args - - # create components that are dependent on options - # (Scrolledlistbox, arrow button) and pack them. - if {$count == 0} { - image create bitmap downarrow -data { - #define down_width 16 - #define down_height 16 - static unsigned char down_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0xfc, 0x7f, 0xf8, 0x3f, - 0xf0, 0x1f, 0xe0, 0x0f, 0xc0, 0x07, 0x80, 0x03, - 0x00, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00 - }; - } - image create bitmap uparrow -data { - #define up_width 16 - #define up_height 16 - static unsigned char up_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x00, - 0xc0, 0x01, 0xe0, 0x03, 0xf0, 0x07, 0xf8, 0x0f, - 0xfc, 0x1f, 0xfe, 0x3f, 0x00, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00 - }; - } - } - incr count - _doLayout -} - -# ------------------------------------------------------------------ -# DESTRUCTOR -# ------------------------------------------------------------------ -body iwidgets::Combobox::destructor {} { - # catch any repacking that may be waiting for idle time - if {$_repacking != ""} { - after cancel $_repacking - } - incr count -1 - if {$count == 0} { - image delete uparrow - image delete downarrow - } -} - -# ================================================================ -# OPTIONS -# ================================================================ - -# -------------------------------------------------------------------- -# OPTION: -arrowrelief -# -# Relief style used on the arrow button. -# -------------------------------------------------------------------- -configbody iwidgets::Combobox::arrowrelief {} - -# -------------------------------------------------------------------- -# OPTION: -completion -# -# Relief style used on the arrow button. -# -------------------------------------------------------------------- -configbody iwidgets::Combobox::completion { - switch -- $itk_option(-completion) { - 0 - no - false - off { } - 1 - yes - true - on { } - default { - error "bad completion option \"$itk_option(-completion)\":\ - should be boolean" - } - } -} - -# -------------------------------------------------------------------- -# OPTION: -dropdown -# -# Boolean which determines the Combobox style: dropdown or simple. -# Because the two style's lists reside in different toplevel widgets -# this is more complicated than it should be. -# -------------------------------------------------------------------- -configbody iwidgets::Combobox::dropdown { - switch -- $itk_option(-dropdown) { - 1 - yes - true - on { - if {[winfo exists $itk_interior.list]} { - set vals [$itk_component(list) get 0 end] - destroy $itk_component(list) - _doLayout - if [llength $vals] { - eval insert list end $vals - } - } - } - 0 - no - false - off { - if {[winfo exists $itk_interior.popup.list]} { - set vals [$itk_component(list) get 0 end] - catch {destroy $itk_component(arrowBtn)} - destroy $itk_component(popup) ;# this deletes the list too - _doLayout - if [llength $vals] { - eval insert list end $vals - } - } - } - default { - error "bad dropdown option \"$itk_option(-dropdown)\":\ - should be boolean" - } - } -} - -# -------------------------------------------------------------------- -# OPTION: -editable -# -# Boolean which allows/disallows user input to the entry field area. -# -------------------------------------------------------------------- -configbody iwidgets::Combobox::editable { - switch -- $itk_option(-editable) { - 1 - true - yes - on { - switch -- $itk_option(-state) { - normal { - $itk_component(entry) configure -state normal - } - } - } - 0 - false - no - off { - $itk_component(entry) configure -state disabled - } - default { - error "bad editable option \"$itk_option(-editable)\":\ - should be boolean" - } - } -} - -# -------------------------------------------------------------------- -# OPTION: -grab -# -# grab-state of megawidget -# -------------------------------------------------------------------- -configbody iwidgets::Combobox::grab { - switch -- $itk_option(-grab) { - local { } - global { } - default { - error "bad grab value \"$itk_option(-grab)\":\ - must be global or local" - } - } -} - -# -------------------------------------------------------------------- -# OPTION: -listheight -# -# Listbox height in pixels. (Need to integrate the scrolledlistbox -# -visibleitems option here - at least for simple listbox.) -# -------------------------------------------------------------------- -configbody iwidgets::Combobox::listheight {} - -# -------------------------------------------------------------------- -# OPTION: -margin -# -# Spacer between the entry field and arrow button of dropdown style -# Comboboxes. -# -------------------------------------------------------------------- -configbody iwidgets::Combobox::margin { - grid columnconfigure $itk_interior 0 -minsize $itk_option(-margin) -} - -# -------------------------------------------------------------------- -# OPTION: -popupcursor -# -# Set the cursor for the popup list. -# -------------------------------------------------------------------- -configbody iwidgets::Combobox::popupcursor {} - -# -------------------------------------------------------------------- -# OPTION: -selectioncommand -# -# Defines the proc to be called when an item is selected in the list. -# -------------------------------------------------------------------- -configbody iwidgets::Combobox::selectioncommand {} - -# -------------------------------------------------------------------- -# OPTION: -state -# -# overall state of megawidget -# -------------------------------------------------------------------- -configbody iwidgets::Combobox::state { - switch -- $itk_option(-state) { - disabled { - $itk_component(entry) configure -state disabled - } - normal { - switch -- $itk_option(-editable) { - 1 - true - yes - on { - $itk_component(entry) configure -state normal - } - 0 - false - no - off { - $itk_component(entry) configure -state disabled - } - } - } - default { - error "bad state value \"$itk_option(-state)\":\ - must be normal or disabled" - } - } - if {[winfo exists itk_component(arrowBtn)]} { - $itk_component(arrowBtn) configure -state $itk_option(-state) - } -} - -# -------------------------------------------------------------------- -# OPTION: -unique -# -# Boolean which disallows/allows adding duplicate items to the listbox. -# -------------------------------------------------------------------- -configbody iwidgets::Combobox::unique { - # boolean error check - switch -- $itk_option(-unique) { - 1 - true - yes - on { } - 0 - false - no - off { } - default { - error "bad unique value \"$itk_option(-unique)\":\ - should be boolean" - } - } -} - -# ================================================================= -# METHODS -# ================================================================= - -# ------------------------------------------------------ -# PUBLIC METHOD: clear ?component? -# -# Remove all elements from the listbox, all contents -# from the entry component, or both (if all). -# -# ------------------------------------------------------ -body iwidgets::Combobox::clear {{component all}} { - switch -- $component { - entry { - iwidgets::Entryfield::clear - } - list { - delete list 0 end - } - all { - delete list 0 end - iwidgets::Entryfield::clear - } - default { - error "bad Combobox component \"$component\":\ - must be entry, list, or all." - } - } - return -} - -# ------------------------------------------------------ -# PUBLIC METHOD: curselection -# -# Return the current selection index. -# -# ------------------------------------------------------ -body iwidgets::Combobox::curselection {} { - return [$itk_component(list) curselection] -} - -# ------------------------------------------------------ -# PUBLIC METHOD: delete component first ?last? -# -# Delete an item or items from the listbox OR delete -# text from the entry field. First argument determines -# which component deletion occurs in - valid values are -# entry or list. -# -# ------------------------------------------------------ -body iwidgets::Combobox::delete {component first {last {}}} { - switch -- $component { - entry { - if {$last == {}} { - set last [expr $first + 1] - } - iwidgets::Entryfield::delete $first $last - } - list { - _deleteList $first $last - } - default { - error "bad Combobox component \"$component\":\ - must be entry or list." - } - } -} - -# ------------------------------------------------------ -# PUBLIC METHOD: get ?index? -# -# -# Retrieve entry contents if no args OR use args as list -# index and retrieve list item at index . -# -# ------------------------------------------------------ -body iwidgets::Combobox::get {{index {}}} { - # no args means to get the current text in the entry field area - if {$index == {}} { - iwidgets::Entryfield::get - } else { - eval $itk_component(list) get $index - } -} - -# ------------------------------------------------------ -# PUBLIC METHOD: getcurselection -# -# Return currently selected item in the listbox. Shortcut -# version of get curselection command combination. -# -# ------------------------------------------------------ -body iwidgets::Combobox::getcurselection {} { - return [$itk_component(list) getcurselection] -} - -# ------------------------------------------------------------------ -# PUBLIC METHOD: ivoke -# -# Pops up or down a dropdown combobox. -# -# ------------------------------------------------------------------ -body iwidgets::Combobox::invoke {} { - if {$itk_option(-dropdown)} { - return [_toggleList] - } - return -} - -# ------------------------------------------------------------ -# PUBLIC METHOD: insert comonent index string ?string ...? -# -# Insert an item into the listbox OR text into the entry area. -# Valid component names are entry or list. -# -# ------------------------------------------------------------ -body iwidgets::Combobox::insert {component index args} { - set nargs [llength $args] - - if {$nargs == 0} { - error "no value given for parameter \"string\" in function\ - \"Combobox::insert\"" - } - - switch -- $component { - entry { - if { $nargs > 1} { - error "called function \"Combobox::insert entry\"\ - with too many arguments" - } else { - if {$itk_option(-state) == "normal"} { - eval iwidgets::Entryfield::insert $index $args - [code $this _lookup ""] - } - } - } - list { - if {$itk_option(-state) == "normal"} { - eval $itk_component(list) insert $index $args - } - } - default { - error "bad Combobox component \"$component\": must\ - be entry or list." - } - } -} - -# ------------------------------------------------------ -# PUBLIC METHOD: justify direction -# -# Wrapper for justifying the listbox items in one of -# 4 directions: top, bottom, left, or right. -# -# ------------------------------------------------------ -body iwidgets::Combobox::justify {direction} { - return [$itk_component(list) justify $direction] -} - -# ------------------------------------------------------------------ -# PUBLIC METHOD: see index -# -# Adjusts the view such that the element given by index is visible. -# ------------------------------------------------------------------ -body iwidgets::Combobox::see {index} { - return [$itk_component(list) see $index] -} - -# ------------------------------------------------------------------ -# PUBLIC METHOD: selection option first ?last? -# -# Adjusts the selection within the listbox and changes the contents -# of the entry component to be the value of the selected list item. -# ------------------------------------------------------------------ -body iwidgets::Combobox::selection {option first {last {}}} { - # thin wrap - if {$option == "set"} { - $itk_component(list) selection clear 0 end - $itk_component(list) selection set $first - set rtn "" - } else { - set rtn [eval $itk_component(list) selection $option $first $last] - } - set _currItem $first - - # combobox additions - set theText [getcurselection] - if {$theText != [$itk_component(entry) get]} { - clear entry - if {$theText != ""} { - insert entry 0 $theText - } - } - return $rtn -} - -# ------------------------------------------------------------------ -# PUBLIC METHOD: size -# -# Returns a decimal string indicating the total number of elements -# in the listbox. -# ------------------------------------------------------------------ -body iwidgets::Combobox::size {} { - return [$itk_component(list) size] -} - -# ------------------------------------------------------ -# PUBLIC METHOD: sort ?mode? -# -# Sort the current list in either "ascending" or "descending" order. -# -# jss: how should i handle selected items? -# -# ------------------------------------------------------ -body iwidgets::Combobox::sort {{mode ascending}} { - $itk_component(list) sort $mode - # return [$itk_component(list) sort $mode] -} - - -# ------------------------------------------------------------------ -# PUBLIC METHOD: xview ?arg arg ...? -# -# Change or query the vertical position of the text in the list box. -# ------------------------------------------------------------------ -body iwidgets::Combobox::xview {args} { - return [eval $itk_component(list) xview $args] -} - -# ------------------------------------------------------------------ -# PUBLIC METHOD: yview ?arg arg ...? -# -# Change or query the horizontal position of the text in the list box. -# ------------------------------------------------------------------ -body iwidgets::Combobox::yview {args} { - return [eval $itk_component(list) yview $args] -} - -# ------------------------------------------------------ -# PROTECTED METHOD: _addToList -# -# Add the current item in the entry to the listbox. -# -# ------------------------------------------------------ -body iwidgets::Combobox::_addToList {} { - set input [get] - if {$input != ""} { - if {$itk_option(-unique)} { - # if item is already in list, select it and exit - set item [lsearch -exact [$itk_component(list) get 0 end] $input] - if {$item != -1} { - selection clear 0 end - if {$item != {}} { - selection set $item $item - set _currItem $item - } - return - } - } - # add the item to end of list - selection clear 0 end - insert list end $input - selection set end end - } -} - -# ------------------------------------------------------ -# PROTECTED METHOD: _createComponents -# -# Create deferred combobox components and add bindings. -# -# ------------------------------------------------------ -body iwidgets::Combobox::_createComponents {} { - if {$itk_option(-dropdown)} { - # --- build a dropdown combobox --- - - # make the arrow childsite be on the right hand side - - #------------------------------------------------------------- - # 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 { - button $itk_interior.arrowBtn -borderwidth 2 \ - -width 15 -height 15 -image downarrow \ - -command [code $this _toggleList] -state $itk_option(-state) - } { - keep -background -borderwidth -cursor -state \ - -highlightcolor -highlightthickness - rename -relief -arrowrelief arrowRelief Relief - rename -highlightbackground -background background Background - } - - # popup list container - itk_component add popup { - toplevel $itk_interior.popup - } { - keep -background -cursor - } - wm withdraw $itk_interior.popup - - # the listbox - itk_component add list { - iwidgets::Scrolledlistbox $itk_interior.popup.list -exportselection no \ - -vscrollmode dynamic -hscrollmode dynamic -selectmode browse - } { - keep -background -borderwidth -cursor -foreground \ - -highlightcolor -highlightthickness \ - -hscrollmode -selectbackground \ - -selectborderwidth -selectforeground -textbackground \ - -textfont -vscrollmode - rename -height -listheight listHeight Height - rename -cursor -popupcursor popupCursor Cursor - } - # mode specific bindings - _dropdownBindings - - # Ugly hack to avoid tk buglet revealed in _dropdownBtnRelease where - # relief is used but not set in scrollbar.tcl. - global tkPriv - set tkPriv(relief) raise - - } else { - # --- build a simple combobox --- - configure -childsitepos s - itk_component add list { - iwidgets::Scrolledlistbox $itk_interior.list -exportselection no \ - -vscrollmode dynamic -hscrollmode dynamic - } { - keep -background -borderwidth -cursor -foreground \ - -highlightcolor -highlightthickness \ - -hscrollmode -selectbackground \ - -selectborderwidth -selectforeground -textbackground \ - -textfont -visibleitems -vscrollmode - rename -height -listheight listHeight Height - } - # add mode specific bindings - _simpleBindings - } - - # popup cursor applies only to the list within the combobox - configure -popupcursor $itk_option(-popupcursor) - - # add mode independent bindings - _commonBindings -} - -# ------------------------------------------------------ -# PROTECTED METHOD: _deleteList first ?last? -# -# Delete an item or items from the listbox. Called via -# "delete list args". -# -# ------------------------------------------------------ -body iwidgets::Combobox::_deleteList {first {last {}}} { - - if {$last == {}} { - set last $first - } - $itk_component(list) delete $first $last - - # remove the item if it is no longer in the list - set text [$this get] - if {$text != ""} { - set index [lsearch -exact [$itk_component(list) get 0 end] $text ] - if {$index == -1} { - clear entry - } - } - return -} - -# ------------------------------------------------------ -# PROTECTED METHOD: _deleteText first ?last? -# -# Renamed Entryfield delete method. Called via "delete entry args". -# -# ------------------------------------------------------ -body iwidgets::Combobox::_deleteText {first {last {}}} { - $itk_component(entry) configure -state normal - set rtrn [delete $first $last] - switch -- $itk_option(-editable) { - 0 - false - no - off { - $itk_component(entry) configure -state disabled - } - } - return $rtrn -} - -# ------------------------------------------------------ -# PROTECTED METHOD: _doLayout ?when? -# -# Call methods to create and pack the Combobox components. -# -# ------------------------------------------------------ -body iwidgets::Combobox::_doLayout {{when later}} { - _createComponents - _packComponents $when -} - - -# ------------------------------------------------------ -# PROTECTED METHOD: _drawArrow -# -# Draw the arrow button. Determines packing according to -# -labelpos. -# -# ------------------------------------------------------ -body iwidgets::Combobox::_drawArrow {} { - set flip false - set relief "" - set fg [cget -foreground] - if {$_isPosted} { - set flip true - set relief "-relief sunken" - } else { - set relief "-relief $itk_option(-arrowrelief)" - } - - if {$flip} { - # - # draw up arrow - # - eval $itk_component(arrowBtn) configure -image uparrow $relief - } else { - # - # draw down arrow - # - eval $itk_component(arrowBtn) configure -image downarrow $relief - } -} - -# ------------------------------------------------------ -# PROTECTED METHOD: _dropdownBtnRelease window x y -# -# Event handler for button releases while a dropdown list -# is posted. -# -# ------------------------------------------------------ -body iwidgets::Combobox::_dropdownBtnRelease {{window {}} {x 1} {y 1}} { - - # if it's a scrollbar then ignore the release - if {($window == [$itk_component(list) component vertsb]) || - ($window == [$itk_component(list) component horizsb])} { - return - } - - # 1st release allows list to stay up unless we are in listbox - if {$_ignoreRelease} { - _ignoreNextBtnRelease false - return - } - - # should I use just the listbox or also include the scrollbars - if { ($x >= 0) && ($x < [winfo width [_slbListbox]]) - && ($y >= 0) && ($y < [winfo height [_slbListbox]])} { - _stateSelect - } - - _unpostList -} - -# ------------------------------------------------------ -# PROTECTED METHOD: _ignoreNextBtnRelease ignore -# -# Set private variable _ignoreRelease. If this variable -# is true then the next button release will not remove -# a dropdown list. -# -# ------------------------------------------------------ -body iwidgets::Combobox::_ignoreNextBtnRelease {ignore} { - set _ignoreRelease $ignore -} - -# ------------------------------------------------------ -# PROTECTED METHOD: _next -# -# Select the next item in the list. -# -# ------------------------------------------------------ -body iwidgets::Combobox::_next {} { - if {[size] <= 1} { - return - } - set i [curselection] - if {($i == {}) || ($i == [expr [size]-1]) } { - set i 0 - } else { - incr i - } - selection clear 0 end - selection set $i $i - see $i - set _currItem $i -} - -# ------------------------------------------------------ -# PROTECTED METHOD: _packComponents ?when? -# -# Pack the components of the combobox and add bindings. -# -# ------------------------------------------------------ -body iwidgets::Combobox::_packComponents {{when later}} { - if {$when == "later"} { - if {$_repacking == ""} { - set _repacking [after idle [code $this _packComponents now]] - return - } - } elseif {$when != "now"} { - error "bad option \"$when\": should be now or later" - } - - if {$itk_option(-dropdown)} { - grid configure $itk_component(list) -row 1 -column 0 -sticky news - _resizeArrow - grid config $itk_component(arrowBtn) -row 0 -column 1 -sticky nsew - } else { - # size and pack list hack - grid configure $itk_component(entry) -row 0 -column 0 -sticky ew - grid configure $itk_component(efchildsite) -row 1 -column 0 -sticky nsew - grid configure $itk_component(list) -row 0 -column 0 -sticky nsew - - grid rowconfigure $itk_component(efchildsite) 1 -weight 1 - grid columnconfigure $itk_component(efchildsite) 0 -weight 1 - } - set _repacking "" -} - -# ------------------------------------------------------ -# PROTECTED METHOD: _positionList -# -# Determine the position (geometry) for the popped up list -# and map it to the screen. -# -# ------------------------------------------------------ -body iwidgets::Combobox::_positionList {} { - - set x [winfo rootx $itk_component(entry) ] - set y [expr [winfo rooty $itk_component(entry) ] + \ - [winfo height $itk_component(entry) ]] - set w [winfo width $itk_component(entry) ] - set h [winfo height [_slbListbox] ] - set sh [winfo screenheight .] - - if {([expr $y+$h] > $sh) && ($y > [expr $sh/2])} { - set y [expr [winfo rooty $itk_component(entry) ] - $h] - } - - $itk_component(list) configure -width $w - wm overrideredirect $itk_component(popup) 0 - wm geometry $itk_component(popup) +$x+$y - wm overrideredirect $itk_component(popup) 1 -} - -# ------------------------------------------------------ -# PROTECTED METHOD: _postList -# -# Pop up the list in a dropdown style Combobox. -# -# ------------------------------------------------------ -body iwidgets::Combobox::_postList {} { - if {[$itk_component(list) size] == ""} { - return - } - - set _isPosted true - _positionList - - # map window and do a grab - wm deiconify $itk_component(popup) - _listShowing -wait - if {$itk_option(-grab) == "global"} { - grab -global $itk_component(popup) - } else { - grab $itk_component(popup) - } - raise $itk_component(popup) - focus $itk_component(popup) - _drawArrow -} - -# ------------------------------------------------------ -# PROTECTED METHOD: _previous -# -# Select the previous item in the list. Wraps at front -# and end of list. -# -# ------------------------------------------------------ -body iwidgets::Combobox::_previous {} { - if {[size] <= 1} { - return - } - set i [curselection] - if {$i == "" || $i == 0} { - set i [expr [size] - 1] - } else { - incr i -1 - } - selection clear 0 end - selection set $i $i - see $i - set _currItem $i -} - -# ------------------------------------------------------ -# PROTECTED METHOD: _resizeArrow -# -# Recalculate the arrow button size and then redraw it. -# -# ------------------------------------------------------ -body iwidgets::Combobox::_resizeArrow {} { - set bw [expr [$itk_component(arrowBtn) cget -borderwidth]+ \ - [$itk_component(arrowBtn) cget -highlightthickness]] - set newHeight [expr [winfo reqheight $itk_component(entry) ]-(2*$bw) - 2] - $itk_component(arrowBtn) configure -width $newHeight -height $newHeight - _drawArrow -} - -# ------------------------------------------------------ -# PROTECTED METHOD: _selectCmd -# -# Called when list item is selected to insert new text -# in entry, and call user -command callback if defined. -# -# ------------------------------------------------------ -body iwidgets::Combobox::_selectCmd {} { - $itk_component(entry) configure -state normal - - set _currItem [$itk_component(list) curselection] - set item [$itk_component(list) getcurselection] - clear entry - $itk_component(entry) insert 0 $item - switch -- $itk_option(-editable) { - 0 - false - no - off { - $itk_component(entry) configure -state disabled - } - } - - # execute user command - if {$itk_option(-selectioncommand) != ""} { - uplevel #0 $itk_option(-selectioncommand) - } -} - -# ------------------------------------------------------ -# PROTECTED METHOD: _toggleList -# -# Post or unpost the dropdown listbox (toggle). -# -# ------------------------------------------------------ -body iwidgets::Combobox::_toggleList {} { - if {[winfo ismapped $itk_component(popup)] } { - _unpostList - } else { - _postList - } -} - -# ------------------------------------------------------ -# PROTECTED METHOD: _unpostList -# -# Unmap the listbox (pop it down). -# -# ------------------------------------------------------ -body iwidgets::Combobox::_unpostList {} { - # Determine if event occured in the scrolledlistbox and, if it did, - # don't unpost it. (A selection in the list unposts it correctly and - # in the scrollbar we don't want to unpost it.) - set x [winfo x $itk_component(list)] - set y [winfo y $itk_component(list)] - set w [winfo width $itk_component(list)] - set h [winfo height $itk_component(list)] - - wm withdraw $itk_component(popup) - grab release $itk_component(popup) - - set _isPosted false - - $itk_component(list) selection clear 0 end - if {$_currItem != {}} { - $itk_component(list) selection set $_currItem $_currItem - $itk_component(list) activate $_currItem - } - - switch -- $itk_option(-editable) { - 1 - true - yes - on { - $itk_component(entry) configure -state normal - } - 0 - false - no - off { - $itk_component(entry) configure -state disabled - } - } - - _drawArrow -} - -# ------------------------------------------------------ -# PROTECTED METHOD: _commonBindings -# -# Bindings that are used by both simple and dropdown -# style Comboboxes. -# -# ------------------------------------------------------ -body iwidgets::Combobox::_commonBindings {} { - bind $itk_component(entry) <KeyPress-BackSpace> [code $this _bs] - bind $itk_component(entry) <KeyRelease> [code $this _lookup %K] - bind $itk_component(entry) <Down> [code $this _next] - bind $itk_component(entry) <Up> [code $this _previous] - bind $itk_component(entry) <Control-n> [code $this _next] - bind $itk_component(entry) <Control-p> [code $this _previous] - bind [_slbListbox] <Control-n> [code $this _next] - bind [_slbListbox] <Control-p> [code $this _previous] -} - - -# ------------------------------------------------------ -# PROTECTED METHOD: _dropdownBindings -# -# Bindings used only by the dropdown type Combobox. -# -# ------------------------------------------------------ -body iwidgets::Combobox::_dropdownBindings {} { - bind $itk_component(popup) <Escape> [code $this _unpostList] - bind $itk_component(popup) <space> \ - "[code $this _stateSelect]; [code $this _unpostList]" - bind $itk_component(popup) <Return> \ - "[code $this _stateSelect]; [code $this _unpostList]" - bind $itk_component(popup) <ButtonRelease-1> \ - [code $this _dropdownBtnRelease %W %x %y] - - bind $itk_component(list) <Map> \ - [code $this _listShowing 1] - bind $itk_component(list) <Unmap> \ - [code $this _listShowing 0] - - # once in the listbox, we drop on the next release (unless in scrollbar) - bind [_slbListbox] <Enter> \ - [code $this _ignoreNextBtnRelease false] - - bind $itk_component(arrowBtn) <3> [code $this _next] - bind $itk_component(arrowBtn) <Shift-3> [code $this _previous] - bind $itk_component(arrowBtn) <Down> [code $this _next] - bind $itk_component(arrowBtn) <Up> [code $this _previous] - bind $itk_component(arrowBtn) <Control-n> [code $this _next] - bind $itk_component(arrowBtn) <Control-p> [code $this _previous] - bind $itk_component(arrowBtn) <Shift-Down> [code $this _toggleList] - bind $itk_component(arrowBtn) <Shift-Up> [code $this _toggleList] - bind $itk_component(arrowBtn) <Return> [code $this _toggleList] - bind $itk_component(arrowBtn) <space> [code $this _toggleList] - - bind $itk_component(entry) <Configure> [code $this _resizeArrow] - bind $itk_component(entry) <Shift-Down> [code $this _toggleList] - bind $itk_component(entry) <Shift-Up> [code $this _toggleList] -} - -# ------------------------------------------------------ -# PROTECTED METHOD: _simpleBindings -# -# Bindings used only by the simple type Comboboxes. -# -# ------------------------------------------------------ -body iwidgets::Combobox::_simpleBindings {} { - bind [_slbListbox] <ButtonRelease-1> [code $this _stateSelect] - # "[code $this _stateselect]; [code $this _selectCmd]" - - - bind [_slbListbox] <space> [code $this _stateSelect] - bind [_slbListbox] <Return> [code $this _stateSelect] - bind $itk_component(entry) <Escape> "" - bind $itk_component(entry) <Shift-Down> "" - bind $itk_component(entry) <Shift-Up> "" - bind $itk_component(entry) <Configure> "" -} - -# ------------------------------------------------------ -# PROTECTED METHOD: _listShowing ?val? -# -# Used instead of "tkwait visibility" to make sure that -# the dropdown list is visible. Whenever the list gets -# mapped or unmapped, this method is called to keep -# track of it. When it is called with the value "-wait", -# it waits for the list to be mapped. -# ------------------------------------------------------ -body iwidgets::Combobox::_listShowing {{val ""}} { - if {$val == ""} { - return $_listShowing($this) - } elseif {$val == "-wait"} { - while {!$_listShowing($this)} { - tkwait variable [scope _listShowing($this)] - } - return - } - set _listShowing($this) $val -} - -# ------------------------------------------------------ -# PRIVATE METHOD: _slbListbox -# -# Access the tk listbox window out of the scrolledlistbox. -# -# ------------------------------------------------------ -body iwidgets::Combobox::_slbListbox {} { - return [$itk_component(list) component listbox] -} - -# ------------------------------------------------------ -# PRIVATE METHOD: _stateSelect -# -# only allows a B1 release in the listbox to have an effect if -state is -# normal. -# -# ------------------------------------------------------ -body iwidgets::Combobox::_stateSelect {} { - switch -- $itk_option(-state) { - normal { - [code $this _selectCmd] - } - } -} - -# ------------------------------------------------------ -# PRIVATE METHOD: _bs -# -# A part of the auto-completion code, this function sets a flag when the -# Backspace key is hit and there is a selection in the entry field. -# Note that it's probably buggy to assume that a selection being present -# means that that selection came from auto-completion. -# -# ------------------------------------------------------ -body iwidgets::Combobox::_bs {} { - # - # exit if completion is turned off - # - switch -- $itk_option(-completion) { - 0 - no - false - off { - return - } - } - # - # critical section flag. it ain't perfect, but for most usage it'll - # keep us from being in this code "twice" at the same time - # (auto-repeated keystrokes are a pain!) - # - if {$_inbs} { - return - } else { - set _inbs 1 - } - - # - # set the _doit flag if there is a selection set in the entry field - # - set _doit 0 - if [$itk_component(entry) selection present] { - set _doit 1 - } - - # - # clear the semaphore and return - # - set _inbs 0 -} - -# ------------------------------------------------------ -# PRIVATE METHOD: _lookup -# -# handles auto-completion of text typed (or insert'd) into the entry field. -# -# ------------------------------------------------------ -body iwidgets::Combobox::_lookup {key} { - # - # exit if completion is turned off - # - switch -- $itk_option(-completion) { - 0 - no - false - off { - return - } - } - - # - # critical section flag. it ain't perfect, but for most usage it'll - # keep us from being in this code "twice" at the same time - # (auto-repeated keystrokes are a pain!) - # - if {$_inlookup} { - return - } else { - set _inlookup 1 - } - - # - # if state of megawidget is disabled, or the entry is not editable, - # clear the semaphore and exit - # - if {$itk_option(-state) == "disabled" \ - || [lsearch {on 1 true yes} $itk_option(-editable)] == -1} { - set _inlookup 0 - return - } - - # - # okay, *now* we can get to work - # the _bs function is called on keyPRESS of BackSpace, and will set - # the _doit flag if there's a selection set in the entryfield. If - # there is, we're assuming that it's generated by completion itself - # (this is probably a Bad Assumption), so we'll want to whack the - # selected text, as well as the character immediately preceding the - # insertion cursor. - # - if {$key == "BackSpace"} { - if {$_doit} { - set first [expr [$itk_component(entry) index insert] -1] - $itk_component(entry) delete $first end - $itk_component(entry) icursor $first - } - } - - # - # get the text left in the entry field, and its length. if - # zero-length, clear the selection in the listbox, clear the - # semaphore, and boogie. - # - set text [get] - set len [string length $text] - if {$len == 0} { - $itk_component(list) selection clear 0 end - set _inlookup 0 - return - } - - # - # okay, so we have to do a lookup. find the first match in the - # listbox to the text we've got in the entry field (glob). - # if one exists, clear the current listbox selection, and set it to - # the one we just found, making that one visible in the listbox. - # then, pick off the text from the listbox entry that hadn't yet been - # entered into the entry field. we need to tack that text onto the - # end of the entry field, select it, and then set the insertion cursor - # back to just before the point where we just added that text. - # if one didn't exist, then just clear the listbox selection - # - set item [lsearch [$itk_component(list) get 0 end] "$text*" ] - if {$item != -1} { - $itk_component(list) selection clear 0 end - $itk_component(list) selection set $item $item - see $item - set remainder [string range [$itk_component(list) get $item] \ - $len end] - $itk_component(entry) insert end $remainder - $itk_component(entry) selection range $len end - $itk_component(entry) icursor $len - } else { - $itk_component(list) selection clear 0 end - } - # - # clear the semaphore and return - # - set _inlookup 0 - return -} diff --git a/itcl/iwidgets3.0.0/generic/dateentry.itk b/itcl/iwidgets3.0.0/generic/dateentry.itk deleted file mode 100644 index 5cf648c03b1..00000000000 --- a/itcl/iwidgets3.0.0/generic/dateentry.itk +++ /dev/null @@ -1,407 +0,0 @@ -# -# Dateentry -# ---------------------------------------------------------------------- -# Implements a quicken style date entry field with a popup calendar -# by combining the datefield and calendar widgets together. This -# allows a user to enter the date via the keyboard or by using the -# mouse by selecting the calendar icon which brings up a popup calendar. -# ---------------------------------------------------------------------- -# AUTHOR: Mark L. Ulferts E-mail: mulferts@austin.dsccc.com -# -# @(#) $Id$ -# ---------------------------------------------------------------------- -# Copyright (c) 1997 DSC Technologies Corporation -# ====================================================================== -# Permission to use, copy, modify, distribute and license this software -# and its documentation for any purpose, and without fee or written -# agreement with DSC, is hereby granted, provided that the above copyright -# notice appears in all copies and that both the copyright notice and -# warranty disclaimer below appear in supporting documentation, and that -# the names of DSC Technologies Corporation or DSC Communications -# Corporation not be used in advertising or publicity pertaining to the -# software without specific, written prior permission. -# -# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING -# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- -# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE -# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, -# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL -# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR -# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, -# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, -# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS -# SOFTWARE. -# ====================================================================== - -# -# Usual options. -# -itk::usual Dateentry { - keep -background -borderwidth -currentdatefont -cursor \ - -datefont -dayfont -foreground -highlightcolor \ - -highlightthickness -labelfont -textbackground -textfont \ - -titlefont -} - -# ------------------------------------------------------------------ -# DATEENTRY -# ------------------------------------------------------------------ -class iwidgets::Dateentry { - inherit iwidgets::Datefield - - constructor {args} {} - - itk_option define -grab grab Grab "global" - itk_option define -icon icon Icon {} - - # - # The calendar widget isn't created until needed, yet we need - # its options to be available upon creation of a dateentry widget. - # So, we'll define them in these class now so they can just be - # propagated onto the calendar later. - # - itk_option define -days days Days {Su Mo Tu We Th Fr Sa} - itk_option define -forwardimage forwardImage Image {} - itk_option define -backwardimage backwardImage Image {} - itk_option define -weekdaybackground weekdayBackground Background \#d9d9d9 - itk_option define -weekendbackground weekendBackground Background \#d9d9d9 - itk_option define -outline outline Outline \#d9d9d9 - itk_option define -buttonforeground buttonForeground Foreground blue - itk_option define -foreground foreground Foreground black - itk_option define -selectcolor selectColor Foreground red - itk_option define -selectthickness selectThickness SelectThickness 3 - itk_option define -titlefont titleFont Font \ - -*-helvetica-bold-r-normal--*-140-* - itk_option define -dayfont dayFont Font \ - -*-helvetica-medium-r-normal--*-120-* - itk_option define -datefont dateFont Font \ - -*-helvetica-medium-r-normal--*-120-* - itk_option define -currentdatefont currentDateFont Font \ - -*-helvetica-bold-r-normal--*-120-* - itk_option define -startday startDay Day sunday - itk_option define -height height Height 165 - itk_option define -width width Width 200 - itk_option define -state state State normal - - protected { - method _getPopupDate {date} - method _releaseGrab {} - method _releaseGrabCheck {rootx rooty} - method _popup {} - method _getDefaultIcon {} - - common _defaultIcon "" - } -} - -# -# Provide a lowercased access method for the dateentry class. -# -proc ::iwidgets::dateentry {pathName args} { - uplevel ::iwidgets::Dateentry $pathName $args -} - -# ------------------------------------------------------------------ -# CONSTRUCTOR -# ------------------------------------------------------------------ -body iwidgets::Dateentry::constructor {args} { - # - # Create an icon label to act as a button to bring up the - # calendar popup. - # - itk_component add iconbutton { - label $itk_interior.iconbutton -relief raised - } { - keep -borderwidth -cursor -foreground - } - grid $itk_component(iconbutton) -row 0 -column 0 -sticky ns - - # - # Initialize the widget based on the command line options. - # - eval itk_initialize $args -} - -# ------------------------------------------------------------------ -# OPTIONS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# OPTION: -icon -# -# Specifies the calendar icon image to be used in the date. -# Should one not be provided, then a default pixmap will be used -# if possible, bitmap otherwise. -# ------------------------------------------------------------------ -configbody iwidgets::Dateentry::icon { - if {$itk_option(-icon) == {}} { - $itk_component(iconbutton) configure -image [_getDefaultIcon] - } else { - if {[lsearch [image names] $itk_option(-icon)] == -1} { - error "bad icon option \"$itk_option(-icon)\":\ - should be an existing image" - } else { - $itk_component(iconbutton) configure -image $itk_option(-icon) - } - } -} - -# ------------------------------------------------------------------ -# OPTION: -grab -# -# Specifies the grab level, local or global, to be obtained when -# bringing up the popup calendar. The default is global. -# ------------------------------------------------------------------ -configbody iwidgets::Dateentry::grab { - switch -- $itk_option(-grab) { - "local" - "global" {} - default { - error "bad grab option \"$itk_option(-grab)\":\ - should be local or global" - } - } -} - -# ------------------------------------------------------------------ -# OPTION: -state -# -# Specifies the state of the widget which may be disabled or -# normal. A disabled state prevents selection of the date field -# or date icon button. -# ------------------------------------------------------------------ -configbody iwidgets::Dateentry::state { - switch -- $itk_option(-state) { - normal { - bind $itk_component(iconbutton) <Button-1> [code $this _popup] - } - disabled { - bind $itk_component(iconbutton) <Button-1> {} - } - } -} - -# ------------------------------------------------------------------ -# METHODS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# PROTECTED METHOD: _getDefaultIcon -# -# This method is invoked uto retrieve the name of the default icon -# image displayed in the icon button. -# ------------------------------------------------------------------ -body iwidgets::Dateentry::_getDefaultIcon {} { - if {[lsearch [image types] pixmap] != -1} { - set _defaultIcon [image create pixmap -data { - /* XPM */ - static char *calendar[] = { - /* width height num_colors chars_per_pixel */ - " 25 20 6 1", - /* colors */ - ". c #808080", - "# c #040404", - "a c #848484", - "b c #fc0404", - "c c #fcfcfc", - "d c #c0c0c0", - /* pixels */ - "d##########d###########dd", - "d#ccccccccc##ccccccccca#d", - "##ccccccccc.#ccccccccc..#", - "##cccbbcccca#cccbbbccca.#", - "##cccbbcccc.#ccbbbbbcc..#", - "##cccbbccc####ccccbbcc..#", - "##cccbbcccca#ccccbbbcca.#", - "##cccbbcccc.#cccbbbccc..#", - "##cccbbcccca#ccbbbcccca.#", - "##cccbbbccc.#ccbbbbbcc..#", - "##ccccccccc.#ccccccccc..#", - "##ccccccccca#ccccccccca.#", - "##cc#####c#cd#c#####cc..#", - "##cccccccc####cccccccca.#", - "##cc#####cc.#cc#####cc..#", - "##ccccccccc.#ccccccccc..#", - "##ccccccccc.#ccccccccc..#", - "##..........#...........#", - "###..........#..........#", - "#########################" - }; - }] - } else { - set _defaultIcon [image create bitmap -data { - #define calendr2_width 25 - #define calendr2_height 20 - static char calendr2_bits[] = { - 0xfe,0xf7,0x7f,0xfe,0x02,0x18,0xc0,0xfe,0x03, - 0x18,0x80,0xff,0x63,0x10,0x47,0xff,0x43,0x98, - 0x8a,0xff,0x63,0x3c,0x4c,0xff,0x43,0x10,0x8a, - 0xff,0x63,0x18,0x47,0xff,0x23,0x90,0x81,0xff, - 0xe3,0x98,0x4e,0xff,0x03,0x10,0x80,0xff,0x03, - 0x10,0x40,0xff,0xf3,0xa5,0x8f,0xff,0x03,0x3c, - 0x40,0xff,0xf3,0x99,0x8f,0xff,0x03,0x10,0x40, - 0xff,0x03,0x18,0x80,0xff,0x57,0x55,0x55,0xff, - 0x57,0xb5,0xaa,0xff,0xff,0xff,0xff,0xff}; - }] - } - - # - # Since this image will only need to be created once, we redefine - # this method to just return the image name for subsequent calls. - # - body ::iwidgets::Dateentry::_getDefaultIcon {} { - return $_defaultIcon - } - - return $_defaultIcon -} - -# ------------------------------------------------------------------ -# PROTECTED METHOD: _popup -# -# This method is invoked upon selection of the icon button. It -# creates a calendar widget within a toplevel popup, calculates -# the position at which to display the calendar, performs a grab -# and displays the calendar. -# ------------------------------------------------------------------ -body iwidgets::Dateentry::_popup {} { - # - # First, let's nullify the icon binding so that any another - # selections are ignored until were done with this one. Next, - # change the relief of the icon. - # - bind $itk_component(iconbutton) <Button-1> {} - $itk_component(iconbutton) configure -relief sunken - - # - # Create a withdrawn toplevel widget and remove the window - # decoration via override redirect. - # - itk_component add -private popup { - toplevel $itk_interior.popup - } - $itk_component(popup) configure -borderwidth 2 -background black - wm withdraw $itk_component(popup) - wm overrideredirect $itk_component(popup) 1 - - # - # Add a binding to button 1 events in order to detect mouse - # clicks off the calendar in which case we'll release the grab. - # Also add a binding for Escape to always release. - # - bind $itk_component(popup) <1> [code $this _releaseGrabCheck %X %Y] - bind $itk_component(popup) <KeyPress-Escape> [code $this _releaseGrab] - - # - # Create the calendar widget and set its cursor properly. - # - itk_component add calendar { - iwidgets::Calendar $itk_component(popup).calendar \ - -command [code $this _getPopupDate %d] - } { - usual - keep -days -forwardimage -backwardimage -weekdaybackground \ - -weekendbackground -outline -buttonforeground -selectcolor \ - -selectthickness -titlefont -dayfont -datefont \ - -currentdatefont -startday -width -height - } - grid $itk_component(calendar) -row 0 -column 0 - $itk_component(calendar) configure -cursor top_left_arrow - - # - # The icon button will be used as the basis for the position of the - # popup on the screen. We'll always attempt to locate the popup - # off the lower right corner of the button. If that would put - # the popup off the screen, then we'll put above the upper left. - # - set rootx [winfo rootx $itk_component(iconbutton)] - set rooty [winfo rooty $itk_component(iconbutton)] - set popupwidth [winfo reqwidth $itk_component(popup)] - set popupheight [winfo reqheight $itk_component(popup)] - - set popupx [expr $rootx + 3 + \ - [winfo width $itk_component(iconbutton)]] - set popupy [expr $rooty + 3 + \ - [winfo height $itk_component(iconbutton)]] - - if {([expr $popupx + $popupwidth] > [winfo screenwidth .]) || \ - ([expr $popupy + $popupheight] > [winfo screenheight .])} { - set popupx [expr $rootx - 3 - $popupwidth] - set popupy [expr $rooty - 3 - $popupheight] - } - - # - # Get the current date from the datefield widget and both - # show and select it on the calendar. - # - $itk_component(calendar) show [get] - $itk_component(calendar) select [get] - - # - # Display the popup at the calculated position. - # - wm geometry $itk_component(popup) +$popupx+$popupy - wm deiconify $itk_component(popup) - tkwait visibility $itk_component(popup) - - # - # Perform either a local or global grab based on the -grab option. - # - if {$itk_option(-grab) == "local"} { - grab $itk_component(popup) - } else { - grab -global $itk_component(popup) - } - - # - # Make sure the widget is above all others and give it focus. - # - raise $itk_component(popup) - focus $itk_component(calendar) -} - -# ------------------------------------------------------------------ -# PROTECTED METHOD: _popupGetDate -# -# This method is the callback for selection of a date on the -# calendar. It releases the grab and sets the date in the -# datefield widget. -# ------------------------------------------------------------------ -body iwidgets::Dateentry::_getPopupDate {date} { - _releaseGrab - show $date -} - -# ------------------------------------------------------------------ -# PROTECTED METHOD: _releaseGrabCheck rootx rooty -# -# This method handles mouse button 1 events. If the selection -# occured within the bounds of the calendar, then return normally -# and let the calendar handle the event. Otherwise, we'll drop -# the calendar and release the grab. -# ------------------------------------------------------------------ -body iwidgets::Dateentry::_releaseGrabCheck {rootx rooty} { - set calx [winfo rootx $itk_component(calendar)] - set caly [winfo rooty $itk_component(calendar)] - set calwidth [winfo reqwidth $itk_component(calendar)] - set calheight [winfo reqheight $itk_component(calendar)] - - if {($rootx < $calx) || ($rootx > [expr $calx + $calwidth]) || \ - ($rooty < $caly) || ($rooty > [expr $caly + $calheight])} { - _releaseGrab - return -code break - } -} - -# ------------------------------------------------------------------ -# PROTECTED METHOD: _releaseGrab -# -# This method releases the grab, destroys the popup, changes the -# relief of the button back to raised and reapplies the binding -# to the icon button that engages the popup action. -# ------------------------------------------------------------------ -body iwidgets::Dateentry::_releaseGrab {} { - grab release $itk_component(popup) - $itk_component(iconbutton) configure -relief raised - destroy $itk_component(popup) - bind $itk_component(iconbutton) <Button-1> [code $this _popup] -} diff --git a/itcl/iwidgets3.0.0/generic/datefield.itk b/itcl/iwidgets3.0.0/generic/datefield.itk deleted file mode 100644 index eba7d6a8908..00000000000 --- a/itcl/iwidgets3.0.0/generic/datefield.itk +++ /dev/null @@ -1,854 +0,0 @@ -# -# Datefield -# ---------------------------------------------------------------------- -# Implements a date entry field with adjustable built-in intelligence -# levels. -# ---------------------------------------------------------------------- -# AUTHOR: Mark L. Ulferts E-mail: mulferts@austin.dsccc.com -# -# @(#) $Id$ -# ---------------------------------------------------------------------- -# Copyright (c) 1997 DSC Technologies Corporation -# ====================================================================== -# Permission to use, copy, modify, distribute and license this software -# and its documentation for any purpose, and without fee or written -# agreement with DSC, is hereby granted, provided that the above copyright -# notice appears in all copies and that both the copyright notice and -# warranty disclaimer below appear in supporting documentation, and that -# the names of DSC Technologies Corporation or DSC Communications -# Corporation not be used in advertising or publicity pertaining to the -# software without specific, written prior permission. -# -# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING -# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- -# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE -# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, -# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL -# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR -# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, -# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, -# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS -# SOFTWARE. -# ====================================================================== - -# -# Usual options. -# -itk::usual Datefield { - keep -background -borderwidth -cursor -foreground -highlightcolor \ - -highlightthickness -labelfont -textbackground -textfont -} - -# ------------------------------------------------------------------ -# DATEFIELD -# ------------------------------------------------------------------ -class iwidgets::Datefield { - inherit iwidgets::Labeledwidget - - constructor {args} {} - - itk_option define -childsitepos childSitePos Position e - itk_option define -command command Command {} - itk_option define -iq iq Iq high - - public method get {{format "-string"}} - public method isvalid {} - public method show {{date now}} - - protected method _backward {} - protected method _focusIn {} - protected method _forward {} - protected method _keyPress {char sym state} - protected method _lastDay {month year} - protected method _moveField {direction} - protected method _setField {field} - protected method _whichField {} - - protected variable _cfield "month" - protected variable _fields {month day year} -} - -# -# Provide a lowercased access method for the datefield class. -# -proc ::iwidgets::datefield {pathName args} { - uplevel ::iwidgets::Datefield $pathName $args -} - -# -# Use option database to override default resources of base classes. -# -option add *Datefield.justify center widgetDefault - -# ------------------------------------------------------------------ -# CONSTRUCTOR -# ------------------------------------------------------------------ -body iwidgets::Datefield::constructor {args} { - component hull configure -borderwidth 0 - - # - # Create an entry field for entering the date. - # - itk_component add date { - entry $itk_interior.date -width 10 - } { - keep -borderwidth -cursor -exportselection \ - -foreground -highlightcolor -highlightthickness \ - -insertbackground -justify -relief -state - - rename -font -textfont textFont Font - rename -highlightbackground -background background Background - rename -background -textbackground textBackground Background - } - - # - # Create the child site widget. - # - itk_component add -protected dfchildsite { - frame $itk_interior.dfchildsite - } - set itk_interior $itk_component(dfchildsite) - - # - # Add datefield event bindings for focus in and keypress events. - # - bind $itk_component(date) <FocusIn> [code $this _focusIn] - bind $itk_component(date) <KeyPress> [code $this _keyPress %A %K %s] - - # - # Disable some mouse button event bindings: - # Button Motion - # Double-Clicks - # Triple-Clicks - # Button2 - # - bind $itk_component(date) <Button1-Motion> break - bind $itk_component(date) <Button2-Motion> break - bind $itk_component(date) <Double-Button> break - bind $itk_component(date) <Triple-Button> break - bind $itk_component(date) <2> break - - # - # Initialize the widget based on the command line options. - # - eval itk_initialize $args - - # - # Initialize the date to the current date. - # - $itk_component(date) delete 0 end - $itk_component(date) insert end \ - [clock format [clock seconds] -format "%m/%d/%Y"] -} - -# ------------------------------------------------------------------ -# OPTIONS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# OPTION: -childsitepos -# -# Specifies the position of the child site in the widget. Valid -# locations are n, s, e, and w. -# ------------------------------------------------------------------ -configbody iwidgets::Datefield::childsitepos { - set parent [winfo parent $itk_component(date)] - - switch $itk_option(-childsitepos) { - n { - grid $itk_component(dfchildsite) -row 0 -column 0 -sticky ew - grid $itk_component(date) -row 1 -column 0 -sticky nsew - - grid rowconfigure $parent 0 -weight 0 - grid rowconfigure $parent 1 -weight 1 - grid columnconfigure $parent 0 -weight 1 - grid columnconfigure $parent 1 -weight 0 - } - - e { - grid $itk_component(dfchildsite) -row 0 -column 1 -sticky ns - grid $itk_component(date) -row 0 -column 0 -sticky nsew - - grid rowconfigure $parent 0 -weight 1 - grid rowconfigure $parent 1 -weight 0 - grid columnconfigure $parent 0 -weight 1 - grid columnconfigure $parent 1 -weight 0 - } - - s { - grid $itk_component(dfchildsite) -row 1 -column 0 -sticky ew - grid $itk_component(date) -row 0 -column 0 -sticky nsew - - grid rowconfigure $parent 0 -weight 1 - grid rowconfigure $parent 1 -weight 0 - grid columnconfigure $parent 0 -weight 1 - grid columnconfigure $parent 1 -weight 0 - } - - w { - grid $itk_component(dfchildsite) -row 0 -column 0 -sticky ns - grid $itk_component(date) -row 0 -column 1 -sticky nsew - - grid rowconfigure $parent 0 -weight 1 - grid rowconfigure $parent 1 -weight 0 - grid columnconfigure $parent 0 -weight 0 - grid columnconfigure $parent 1 -weight 1 - } - - default { - error "bad childsite option\ - \"$itk_option(-childsitepos)\":\ - should be n, e, s, or w" - } - } -} - -# ------------------------------------------------------------------ -# OPTION: -command -# -# Command invoked upon detection of return key press event. -# ------------------------------------------------------------------ -configbody iwidgets::Datefield::command {} - -# ------------------------------------------------------------------ -# OPTION: -iq -# -# Specifies the level of intelligence to be shown in the actions -# taken by the date field during the processing of keypress events. -# Valid settings include high, average, and low. With a high iq, -# the date prevents the user from typing in an invalid date. For -# example, if the current date is 05/31/1997 and the user changes -# the month to 04, then the day will be instantly modified for them -# to be 30. In addition, leap years are fully taken into account. -# With average iq, the month is limited to the values of 01-12, but -# it is possible to type in an invalid day. A setting of low iq -# instructs the widget to do no validity checking at all during -# date entry. With both average and low iq levels, it is assumed -# that the validity will be determined at a later time using the -# date's isvalid command. -# ------------------------------------------------------------------ -configbody iwidgets::Datefield::iq { - switch $itk_option(-iq) { - high - average - low { - } - default { - error "bad iq option \"$itk_option(-iq)\":\ - should be high, average or low" - } - } -} - -# ------------------------------------------------------------------ -# METHODS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# PUBLIC METHOD: get ?format? -# -# Return the current contents of the datefield in one of two formats -# string or as an integer clock value using the -string and -clicks -# options respectively. The default is by string. Reference the -# clock command for more information on obtaining dates and their -# formats. -# ------------------------------------------------------------------ -body iwidgets::Datefield::get {{format "-string"}} { - set datestr [$itk_component(date) get] - - switch -- $format { - "-string" { - return $datestr - } - "-clicks" { - return [clock scan $datestr] - } - default { - error "bad format option \"$format\":\ - should be -string or -clicks" - } - } -} - -# ------------------------------------------------------------------ -# PUBLIC METHOD: show date -# -# Changes the currently displayed date to be that of the date -# argument. The date may be specified either as a string or an -# integer clock value. Reference the clock command for more -# information on obtaining dates and their formats. -# ------------------------------------------------------------------ -body iwidgets::Datefield::show {{date "now"}} { - if {$date == "now"} { - set seconds [clock seconds] - } else { - if {[catch {clock format $date}] == 0} { - set seconds $date - } elseif {[catch {set seconds [clock scan $date]}] != 0} { - error "bad date: \"$date\", must be a valid date\ - string, clock clicks value or the keyword now" - } - } - - $itk_component(date) delete 0 end - $itk_component(date) insert end [clock format $seconds -format "%m/%d/%Y"] - - _setField month - - return -} - -# ------------------------------------------------------------------ -# PUBLIC METHOD: isvalid -# -# Returns a boolean indication of the validity of the currently -# displayed date value. For example, 3/3/1960 is valid whereas -# 02/29/1997 is invalid. -# ------------------------------------------------------------------ -body iwidgets::Datefield::isvalid {} { - if {[catch {clock scan [$itk_component(date) get]}] != 0} { - return 0 - } else { - return 1 - } -} - -# ------------------------------------------------------------------ -# PROTECTED METHOD: _focusIn -# -# This method is bound to the <FocusIn> event. It resets the -# insert cursor and field settings to be back to their last known -# positions. -# ------------------------------------------------------------------ -body iwidgets::Datefield::_focusIn {} { - _setField $_cfield -} - -# ------------------------------------------------------------------ -# PROTECTED METHOD: _keyPress -# -# This method is the workhorse of the class. It is bound to the -# <KeyPress> event and controls the processing of all key strokes. -# ------------------------------------------------------------------ -body iwidgets::Datefield::_keyPress {char sym state} { - # - # Determine which field we are in currently. This is needed - # since the user may have moved to this position via a mouse - # selection and so it would not be in the position we last - # knew it to be. - # - _whichField - - # - # Set up a few basic variables we'll be needing throughout the - # rest of the method such as the position of the insert cursor - # and the currently displayed day, month, and year. - # - set icursor [$itk_component(date) index insert] - set splist [split [$itk_component(date) get] "/"] - set month [lindex $splist 0] - set day [lindex $splist 1] - set year [lindex $splist 2] - - # - # Process numeric keystrokes. This involes a fair amount of - # processing with step one being to check and make sure we - # aren't attempting to insert more that 10 characters. If - # so ring the bell and break. - # - if {[regexp {[0-9]} $char]} { - if {[$itk_component(date) index insert] == 10} { - bell - return -code break - } - - # - # If we are currently in the month field then we process the - # number entered based on the cursor position. If we are at - # at the first position and our iq is low, then accept any - # input. - # - if {$_cfield == "month"} { - if {[$itk_component(date) index insert] == 0} { - if {$itk_option(-iq) == "low"} { - $itk_component(date) delete 0 - $itk_component(date) insert 0 $char - - } else { - - # - # Otherwise, we're slightly smarter. If the number - # is less than two insert it at position zero. If - # this makes the month greater than twelve, set the - # number at position one to zero which makes in - # effect puts the month back in range. - # - regsub {([0-9])([0-9])} $month "$char\\2" month2b - - if {$char < 2} { - $itk_component(date) delete 0 - $itk_component(date) insert 0 $char - - if {$month2b > 12} { - $itk_component(date) delete 1 - $itk_component(date) insert 1 0 - $itk_component(date) icursor 1 - } elseif {$month2b == "00"} { - $itk_component(date) delete 1 - $itk_component(date) insert 1 1 - $itk_component(date) icursor 1 - } - - # - # Finally, if the number is greater than one we'll - # assume that they really mean to be entering a zero - # followed by their number, do so for them, and - # proceed to skip to the next field which is the - # day field. - # - } else { - $itk_component(date) delete 0 2 - $itk_component(date) insert 0 0$char - _setField day - } - } - - # - # Else, we're at cursor position one. Again, if we aren't - # too smart, let them enter anything. Otherwise, if the - # number makes the month exceed twelve, set the month to - # zero followed by their number to get it back into range. - # - } else { - regsub {([0-9])([0-9])} $month "\\1$char" month2b - - if {$itk_option(-iq) == "low"} { - $itk_component(date) delete 1 - $itk_component(date) insert 1 $char - } else { - if {$month2b > 12} { - $itk_component(date) delete 0 2 - $itk_component(date) insert 0 0$char - } elseif {$month2b == "00"} { - bell - return -code break - } else { - $itk_component(date) delete 1 - $itk_component(date) insert 1 $char - } - } - - _setField day - } - - # - # Now, the month processing is complete and if we're of a - # high level of intelligence, then we'll make sure that the - # current value for the day is valid for this month. If - # it is beyond the last day for this month, change it to - # be the last day of the new month. - # - if {$itk_option(-iq) == "high"} { - set splist [split [$itk_component(date) get] "/"] - set month [lindex $splist 0] - - if {$day > [set endday [_lastDay $month $year]]} { - set icursor [$itk_component(date) index insert] - $itk_component(date) delete 3 5 - $itk_component(date) insert 3 $endday - $itk_component(date) icursor $icursor - } - } - - # - # Finally, return with a code of break to stop any normal - # processing in that we've done all that is necessary. - # - return -code break - } - - # - # This next block of code is for processing of the day field - # which is quite similar is strategy to that of the month. - # - if {$_cfield == "day"} { - if {$itk_option(-iq) == "high"} { - set endofMonth [_lastDay $month $year] - } else { - set endofMonth 31 - } - - # - # If we are at the third cursor position we are porcessing - # the first character of the day field. If we have an iq - # of low accept any input. - # - if {[$itk_component(date) index insert] == 3} { - if {$itk_option(-iq) == "low"} { - $itk_component(date) delete 3 - $itk_component(date) insert 3 $char - - } else { - - # - # If the day to be is double zero, then make the - # day be the first. - # - regsub {([0-9])([0-9])} $day "$char\\2" day2b - - if {$day2b == "00"} { - $itk_component(date) delete 3 5 - $itk_component(date) insert 3 01 - $itk_component(date) icursor 4 - - # - # Otherwise, if the character is less than four - # and the month is not Feburary, insert the number - # and if this makes the day be beyond the valid - # range for this month, than set to be back in - # range. - # - } elseif {($char < 4) && ($month != "02")} { - $itk_component(date) delete 3 - $itk_component(date) insert 3 $char - - if {$day2b > $endofMonth} { - $itk_component(date) delete 4 - $itk_component(date) insert 4 0 - $itk_component(date) icursor 4 - } - - # - # For Feburary with a number to be entered of - # less than three, make sure the number doesn't - # make the day be greater than the correct range - # and if so adjust the input. - # - } elseif {$char < 3} { - $itk_component(date) delete 3 - $itk_component(date) insert 3 $char - - if {$day2b > $endofMonth} { - $itk_component(date) delete 3 5 - $itk_component(date) insert 3 $endofMonth - $itk_component(date) icursor 4 - } - - # - # Finally, if the number is greater than three, - # set the day to be zero followed by the number - # entered and proceed to the year field. - # - } else { - $itk_component(date) delete 3 5 - $itk_component(date) insert 3 0$char - _setField year - } - } - - # - # Else, we're dealing with the second number in the day - # field. If we're not too bright accept anything, otherwise - # if the day is beyond the range for this month or equal to - # zero then ring the bell. - # - } else { - regsub {([0-9])([0-9])} $day "\\1$char" day2b - - if {($itk_option(-iq) != "low") && \ - (($day2b > $endofMonth) || ($day2b == "00"))} { - bell - } else { - $itk_component(date) delete 4 - $itk_component(date) insert 4 $char - _setField year - } - } - - # - # Return with a code of break to prevent normal processing. - # - return -code break - } - - # - # This month and day we're tough, the code for the year is - # comparitively simple. Accept any input and if we are really - # sharp, then make sure the day is correct for the month - # given the year. In short, handle leap years. - # - if {$_cfield == "year"} { - if {$itk_option(-iq) == "low"} { - $itk_component(date) delete $icursor - $itk_component(date) insert $icursor $char - } else { - - set prevdate [get] - - if {[$itk_component(date) index insert] == 6} { - set yrdgt [lindex [split [lindex \ - [split $prevdate "/"] 2] ""] 0] - if {$char != $yrdgt} { - if {$char == 1} { - $itk_component(date) delete $icursor end - $itk_component(date) insert $icursor 1999 - } elseif {$char == 2} { - $itk_component(date) delete $icursor end - $itk_component(date) insert $icursor 2000 - } else { - bell - return -code break - } - } - - $itk_component(date) icursor 7 - return -code break - } - - $itk_component(date) delete $icursor - $itk_component(date) insert $icursor $char - - if {[catch {clock scan [get]}] != 0} { - $itk_component(date) delete 6 end - $itk_component(date) insert end \ - [lindex [split $prevdate "/"] 2] - $itk_component(date) icursor $icursor - - bell - return -code break - } - - if {$itk_option(-iq) == "high"} { - set splist [split [$itk_component(date) get] "/"] - set year [lindex $splist 2] - - if {$day > [set endday [_lastDay $month $year]]} { - set icursor [$itk_component(date) index insert] - $itk_component(date) delete 3 5 - $itk_component(date) insert 3 $endday - $itk_component(date) icursor $icursor - } - } - } - - return -code break - } - - # - # Process the plus and the up arrow keys. They both yeild the same - # effect, they increment the day by one. - # - } elseif {($sym == "plus") || ($sym == "Up")} { - if {[catch {show [clock scan "1 day" -base [get -clicks]]}] != 0} { - bell - } - return -code break - - # - # Process the minus and the down arrow keys which decrement the day. - # - } elseif {($sym == "minus") || ($sym == "Down")} { - if {[catch {show [clock scan "-1 day" -base [get -clicks]]}] != 0} { - bell - } - return -code break - - # - # A tab key moves the day/month/year field forward by one unless - # the current field is the year. In that case we'll let tab - # do what is supposed to and pass the focus onto the next widget. - # - } elseif {($sym == "Tab") && ($state == 0)} { - if {$_cfield != "year"} { - _moveField forward - return -code break - } else { - _setField "month" - return -code continue - } - - # - # A ctrl-tab key moves the day/month/year field backwards by one - # unless the current field is the month. In that case we'll let - # tab take the focus to a previous widget. - # - } elseif {($sym == "Tab") && ($state == 4)} { - if {$_cfield != "month"} { - _moveField backward - return -code break - } else { - set _cfield "month" - return -code continue - } - - # - # A right arrow key moves the insert cursor to the right one. - # - } elseif {$sym == "Right"} { - _forward - return -code break - - # - # A left arrow, backspace, or delete key moves the insert cursor - # to the left one. This is what you expect for the left arrow - # and since the whole widget always operates in overstrike mode, - # it makes the most sense for backspace and delete to do the same. - # - } elseif {$sym == "Left" || $sym == "BackSpace" || $sym == "Delete"} { - _backward - return -code break - - } elseif {($sym == "Control_L") || ($sym == "Shift_L") || \ - ($sym == "Control_R") || ($sym == "Shift_R")} { - return -code break - - # - # A Return key invokes the optionally specified command option. - # - } elseif {$sym == "Return"} { - uplevel #0 $itk_option(-command) - return -code break - - } else { - bell - return -code break - } -} - -# ------------------------------------------------------------------ -# PROTECTED METHOD: _setField field -# -# Internal method which adjusts the field to be that of the -# argument, setting the insert cursor appropriately. -# ------------------------------------------------------------------ -body iwidgets::Datefield::_setField {field} { - set _cfield $field - - switch $field { - "month" { - $itk_component(date) icursor 0 - } - "day" { - $itk_component(date) icursor 3 - } - "year" { - $itk_component(date) icursor 8 - } - default { - error "bad field: \"$field\", must be month, day or year" - } - } -} - -# ------------------------------------------------------------------ -# PROTECTED METHOD: _moveField -# -# Internal method for moving the field forward or backward by one. -# ------------------------------------------------------------------ -body iwidgets::Datefield::_moveField {direction} { - set index [lsearch $_fields $_cfield] - - if {$direction == "forward"} { - set newIndex [expr $index + 1] - } else { - set newIndex [expr $index - 1] - } - - if {$newIndex == [llength $_fields]} { - set newIndex 0 - } - if {$newIndex < 0} { - set newIndex [expr [llength $_fields] - 1] - } - - _setField [lindex $_fields $newIndex] - - return -} - -# ------------------------------------------------------------------ -# PROTECTED METHOD: _whichField -# -# Internal method which returns the current field that the cursor -# is currently within. -# ------------------------------------------------------------------ -body iwidgets::Datefield::_whichField {} { - set icursor [$itk_component(date) index insert] - - switch $icursor { - 0 - 1 { - set _cfield "month" - } - 3 - 4 { - set _cfield "day" - } - 6 - 7 - 8 - 9 { - set _cfield "year" - } - } -} - -# ------------------------------------------------------------------ -# PROTECTED METHOD: _forward -# -# Internal method which moves the cursor forward by one character -# jumping over the slashes and wrapping. -# ------------------------------------------------------------------ -body iwidgets::Datefield::_forward {} { - set icursor [$itk_component(date) index insert] - - switch $icursor { - 1 { - _setField day - } - 4 { - _setField year - } - 9 - 10 { - _setField month - } - default { - $itk_component(date) icursor [expr $icursor + 1] - } - } -} - -# ------------------------------------------------------------------ -# PROTECTED METHOD: _backward -# -# Internal method which moves the cursor backward by one character -# jumping over the slashes and wrapping. -# ------------------------------------------------------------------ -body iwidgets::Datefield::_backward {} { - set icursor [$itk_component(date) index insert] - - switch $icursor { - 6 { - _setField day - } - 3 { - _setField month - } - 0 { - _setField year - } - default { - $itk_component(date) icursor [expr $icursor -1] - } - } -} - -# ------------------------------------------------------------------ -# PROTECTED METHOD: _lastDay month year -# -# Internal method which determines the last day of the month for -# the given month and year. We start at 28 and go forward till -# we fail. Crude but effective. -# ------------------------------------------------------------------ -body iwidgets::Datefield::_lastDay {month year} { - set lastone 28 - - for {set lastone 28} {$lastone < 32} {incr lastone} { - if {[catch {clock scan $month/[expr $lastone + 1]/$year}] != 0} { - return $lastone - } - } -} diff --git a/itcl/iwidgets3.0.0/generic/dialog.itk b/itcl/iwidgets3.0.0/generic/dialog.itk deleted file mode 100644 index 519d57bf37f..00000000000 --- a/itcl/iwidgets3.0.0/generic/dialog.itk +++ /dev/null @@ -1,92 +0,0 @@ -# -# Dialog -# ---------------------------------------------------------------------- -# Implements a standard dialog box providing standard buttons and a -# child site for use in derived classes. The buttons include ok, apply, -# cancel, and help. Options exist to configure the buttons. -# -# ---------------------------------------------------------------------- -# AUTHOR: Mark L. Ulferts EMAIL: mulferts@austin.dsccc.com -# -# @(#) $Id$ -# ---------------------------------------------------------------------- -# Copyright (c) 1995 DSC Technologies Corporation -# ====================================================================== -# Permission to use, copy, modify, distribute and license this software -# and its documentation for any purpose, and without fee or written -# agreement with DSC, is hereby granted, provided that the above copyright -# notice appears in all copies and that both the copyright notice and -# warranty disclaimer below appear in supporting documentation, and that -# the names of DSC Technologies Corporation or DSC Communications -# Corporation not be used in advertising or publicity pertaining to the -# software without specific, written prior permission. -# -# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING -# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- -# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE -# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, -# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL -# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR -# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, -# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, -# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS -# SOFTWARE. -# ====================================================================== - -# -# Usual options. -# -itk::usual Dialog { - keep -background -cursor -foreground -modality -} - -# ------------------------------------------------------------------ -# DIALOG -# ------------------------------------------------------------------ -class iwidgets::Dialog { - inherit iwidgets::Dialogshell - - constructor {args} {} -} - -# -# Provide a lowercased access method for the Dialog class. -# -proc ::iwidgets::dialog {pathName args} { - uplevel ::iwidgets::Dialog $pathName $args -} - -# -# Use option database to override default resources of base classes. -# -option add *Dialog.master "." widgetDefault - -# ------------------------------------------------------------------ -# CONSTRUCTOR -# ------------------------------------------------------------------ -body iwidgets::Dialog::constructor {args} { - # - # Add the standard buttons: OK, Apply, Cancel, and Help, making - # OK be the default button. - # - add OK -text OK -command [code $this deactivate 1] - add Apply -text Apply - add Cancel -text Cancel -command [code $this deactivate 0] - add Help -text Help - - default OK - - # - # Bind the window manager delete protocol to invocation of the - # cancel button. This can be overridden by the user via the - # execution of a similar command outside the class. - # - wm protocol $itk_component(hull) WM_DELETE_WINDOW \ - [code $this invoke Cancel] - - # - # Initialize the widget based on the command line options. - # - eval itk_initialize $args -} - diff --git a/itcl/iwidgets3.0.0/generic/dialogshell.itk b/itcl/iwidgets3.0.0/generic/dialogshell.itk deleted file mode 100644 index d4a52e998ef..00000000000 --- a/itcl/iwidgets3.0.0/generic/dialogshell.itk +++ /dev/null @@ -1,350 +0,0 @@ -# Dialogshell -# ---------------------------------------------------------------------- -# This class is implements a dialog shell which is a top level widget -# composed of a button box, separator, and child site area. The class -# also has methods to control button construction. -# -# ---------------------------------------------------------------------- -# AUTHOR: Mark L. Ulferts EMAIL: mulferts@austin.dsccc.com -# -# @(#) $Id$ -# ---------------------------------------------------------------------- -# Copyright (c) 1995 DSC Technologies Corporation -# ====================================================================== -# Permission to use, copy, modify, distribute and license this software -# and its documentation for any purpose, and without fee or written -# agreement with DSC, is hereby granted, provided that the above copyright -# notice appears in all copies and that both the copyright notice and -# warranty disclaimer below appear in supporting documentation, and that -# the names of DSC Technologies Corporation or DSC Communications -# Corporation not be used in advertising or publicity pertaining to the -# software without specific, written prior permission. -# -# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING -# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- -# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE -# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, -# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL -# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR -# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, -# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, -# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS -# SOFTWARE. -# ====================================================================== - -# -# Usual options. -# -itk::usual Dialogshell { - keep -background -cursor -foreground -modality -} - -# ------------------------------------------------------------------ -# DIALOGSHELL -# ------------------------------------------------------------------ -class iwidgets::Dialogshell { - inherit iwidgets::Shell - - constructor {args} {} - - itk_option define -thickness thickness Thickness 3 - itk_option define -buttonboxpos buttonBoxPos Position s - itk_option define -separator separator Separator on - itk_option define -padx padX Pad 10 - itk_option define -pady padY Pad 10 - - public method childsite {} - public method index {args} - public method add {args} - public method insert {args} - public method delete {args} - public method hide {args} - public method show {args} - public method default {args} - public method invoke {args} - public method buttonconfigure {args} - public method buttoncget {index option} -} - -# -# Provide a lowercased access method for the Dialogshell class. -# -proc ::iwidgets::dialogshell {pathName args} { - uplevel ::iwidgets::Dialogshell $pathName $args -} - -# -# Use option database to override default resources of base classes. -# -option add *Dialogshell.master "." widgetDefault - -# ------------------------------------------------------------------ -# CONSTRUCTOR -# ------------------------------------------------------------------ -body iwidgets::Dialogshell::constructor {args} { - itk_option remove iwidgets::Shell::padx iwidgets::Shell::pady - - # - # Create the user child site, separator, and button box, - # - itk_component add -protected dschildsite { - frame $itk_interior.dschildsite - } - - itk_component add separator { - frame $itk_interior.separator -relief sunken - } - - itk_component add bbox { - iwidgets::Buttonbox $itk_interior.bbox - } { - usual - - rename -padx -buttonboxpadx buttonBoxPadX Pad - rename -pady -buttonboxpady buttonBoxPadY Pad - } - - # - # Set the itk_interior variable to be the childsite for derived - # classes. - # - set itk_interior $itk_component(dschildsite) - - # - # Set up the default button so that if <Return> is pressed in - # any widget, it will invoke the default button. - # - bind $itk_component(hull) <Return> [code $this invoke] - - # - # Initialize the widget based on the command line options. - # - eval itk_initialize $args -} - -# ------------------------------------------------------------------ -# OPTIONS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# OPTION: -thickness -# -# Specifies the thickness of the separator. It sets the width and -# height of the separator to the thickness value and the borderwidth -# to half the thickness. -# ------------------------------------------------------------------ -configbody iwidgets::Dialogshell::thickness { - $itk_component(separator) config -height $itk_option(-thickness) - $itk_component(separator) config -width $itk_option(-thickness) - $itk_component(separator) config \ - -borderwidth [expr $itk_option(-thickness) / 2] -} - -# ------------------------------------------------------------------ -# OPTION: -buttonboxpos -# -# Specifies the position of the button box relative to the child site. -# The separator appears between the child site and button box. -# ------------------------------------------------------------------ -configbody iwidgets::Dialogshell::buttonboxpos { - set parent [winfo parent $itk_component(bbox)] - - switch $itk_option(-buttonboxpos) { - n { - $itk_component(bbox) configure -orient horizontal - - grid $itk_component(bbox) -row 0 -column 0 -sticky ew - grid $itk_component(separator) -row 1 -column 0 -sticky ew - grid $itk_component(dschildsite) -row 2 -column 0 -sticky nsew - - grid rowconfigure $parent 0 -weight 0 - grid rowconfigure $parent 1 -weight 0 - grid rowconfigure $parent 2 -weight 1 - grid columnconfigure $parent 0 -weight 1 - grid columnconfigure $parent 1 -weight 0 - grid columnconfigure $parent 2 -weight 0 - } - s { - $itk_component(bbox) configure -orient horizontal - - grid $itk_component(dschildsite) -row 0 -column 0 -sticky nsew - grid $itk_component(separator) -row 1 -column 0 -sticky ew - grid $itk_component(bbox) -row 2 -column 0 -sticky ew - - grid rowconfigure $parent 0 -weight 1 - grid rowconfigure $parent 1 -weight 0 - grid rowconfigure $parent 2 -weight 0 - grid columnconfigure $parent 0 -weight 1 - grid columnconfigure $parent 1 -weight 0 - grid columnconfigure $parent 2 -weight 0 - } - w { - $itk_component(bbox) configure -orient vertical - - grid $itk_component(bbox) -row 0 -column 0 -sticky ns - grid $itk_component(separator) -row 0 -column 1 -sticky ns - grid $itk_component(dschildsite) -row 0 -column 2 -sticky nsew - - grid rowconfigure $parent 0 -weight 1 - grid rowconfigure $parent 1 -weight 0 - grid rowconfigure $parent 2 -weight 0 - grid columnconfigure $parent 0 -weight 0 - grid columnconfigure $parent 1 -weight 0 - grid columnconfigure $parent 2 -weight 1 - } - e { - $itk_component(bbox) configure -orient vertical - - grid $itk_component(dschildsite) -row 0 -column 0 -sticky nsew - grid $itk_component(separator) -row 0 -column 1 -sticky ns - grid $itk_component(bbox) -row 0 -column 2 -sticky ns - - grid rowconfigure $parent 0 -weight 1 - grid rowconfigure $parent 1 -weight 0 - grid rowconfigure $parent 2 -weight 0 - grid columnconfigure $parent 0 -weight 1 - grid columnconfigure $parent 1 -weight 0 - grid columnconfigure $parent 2 -weight 0 - } - default { - error "bad buttonboxpos option\ - \"$itk_option(-buttonboxpos)\": should be n,\ - s, e, or w" - } - } -} - -# ------------------------------------------------------------------ -# OPTION: -separator -# -# Boolean option indicating wheather to display the separator. -# ------------------------------------------------------------------ -configbody iwidgets::Dialogshell::separator { - if {$itk_option(-separator)} { - $itk_component(separator) configure -relief sunken - } else { - $itk_component(separator) configure -relief flat - } -} - -# ------------------------------------------------------------------ -# OPTION: -padx -# -# Specifies a padding distance for the childsite in the X-direction. -# ------------------------------------------------------------------ -configbody iwidgets::Dialogshell::padx { - grid configure $itk_component(dschildsite) -padx $itk_option(-padx) -} - -# ------------------------------------------------------------------ -# OPTION: -pady -# -# Specifies a padding distance for the childsite in the Y-direction. -# ------------------------------------------------------------------ -configbody iwidgets::Dialogshell::pady { - grid configure $itk_component(dschildsite) -pady $itk_option(-pady) -} - -# ------------------------------------------------------------------ -# METHODS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# METHOD: childsite -# -# Return the pathname of the user accessible area. -# ------------------------------------------------------------------ -body iwidgets::Dialogshell::childsite {} { - return $itk_component(dschildsite) -} - -# ------------------------------------------------------------------ -# METHOD: index index -# -# Thin wrapper of Buttonbox's index method. -# ------------------------------------------------------------------ -body iwidgets::Dialogshell::index {args} { - uplevel $itk_component(bbox) index $args -} - -# ------------------------------------------------------------------ -# METHOD: add tag ?option value ...? -# -# Thin wrapper of Buttonbox's add method. -# ------------------------------------------------------------------ -body iwidgets::Dialogshell::add {args} { - uplevel $itk_component(bbox) add $args -} - -# ------------------------------------------------------------------ -# METHOD: insert index tag ?option value ...? -# -# Thin wrapper of Buttonbox's insert method. -# ------------------------------------------------------------------ -body iwidgets::Dialogshell::insert {args} { - uplevel $itk_component(bbox) insert $args -} - -# ------------------------------------------------------------------ -# METHOD: delete tag -# -# Thin wrapper of Buttonbox's delete method. -# ------------------------------------------------------------------ -body iwidgets::Dialogshell::delete {args} { - uplevel $itk_component(bbox) delete $args -} - -# ------------------------------------------------------------------ -# METHOD: hide index -# -# Thin wrapper of Buttonbox's hide method. -# ------------------------------------------------------------------ -body iwidgets::Dialogshell::hide {args} { - uplevel $itk_component(bbox) hide $args -} - -# ------------------------------------------------------------------ -# METHOD: show index -# -# Thin wrapper of Buttonbox's show method. -# ------------------------------------------------------------------ -body iwidgets::Dialogshell::show {args} { - uplevel $itk_component(bbox) show $args -} - -# ------------------------------------------------------------------ -# METHOD: default index -# -# Thin wrapper of Buttonbox's default method. -# ------------------------------------------------------------------ -body iwidgets::Dialogshell::default {args} { - uplevel $itk_component(bbox) default $args -} - -# ------------------------------------------------------------------ -# METHOD: invoke ?index? -# -# Thin wrapper of Buttonbox's invoke method. -# ------------------------------------------------------------------ -body iwidgets::Dialogshell::invoke {args} { - uplevel $itk_component(bbox) invoke $args -} - -# ------------------------------------------------------------------ -# METHOD: buttonconfigure index ?option? ?value option value ...? -# -# Thin wrapper of Buttonbox's buttonconfigure method. -# ------------------------------------------------------------------ -body iwidgets::Dialogshell::buttonconfigure {args} { - uplevel $itk_component(bbox) buttonconfigure $args -} - -# ------------------------------------------------------------------ -# METHOD: buttoncget index option -# -# Thin wrapper of Buttonbox's buttoncget method. -# ------------------------------------------------------------------ -body iwidgets::Dialogshell::buttoncget {index option} { - uplevel $itk_component(bbox) buttoncget [list $index] \ - [list $option] -} diff --git a/itcl/iwidgets3.0.0/generic/disjointlistbox.itk b/itcl/iwidgets3.0.0/generic/disjointlistbox.itk deleted file mode 100755 index 1234eae70e6..00000000000 --- a/itcl/iwidgets3.0.0/generic/disjointlistbox.itk +++ /dev/null @@ -1,486 +0,0 @@ -# -# ::iwidgets::Disjointlistbox -# ---------------------------------------------------------------------- -# Implements a widget which maintains a disjoint relationship between -# the items displayed by two listboxes. The disjointlistbox is composed -# of 2 Scrolledlistboxes, 2 Pushbuttons, and 2 labels. -# -# The disjoint behavior of this widget exists between the two Listboxes, -# That is, a given instance of a ::iwidgets::Disjointlistbox will never -# exist which has Listbox widgets with items in common. -# -# Users may transfer items between the two Listbox widgets using the -# the two Pushbuttons. -# -# The options include the ability to configure the "items" displayed by -# either of the two Listboxes and to control the placement of the insertion -# and removal buttons. -# -# The following depicts the allowable "-buttonplacement" option values -# and their associated layout: -# -# "-buttonplacement" => center -# -# -------------------------- -# |listbox| |listbox| -# | |________| | -# | (LHS) | button | (RHS) | -# | |========| | -# | | button | | -# |_______|--------|_______| -# | count | | count | -# -------------------------- -# -# "-buttonplacement" => bottom -# -# --------------------- -# | listbox | listbox | -# | (LHS) | (RHS) | -# |_________|_________| -# | button | button | -# |---------|---------| -# | count | count | -# --------------------- -# -# ---------------------------------------------------------------------- -# AUTHOR: John A. Tucker EMAIL: jatucker@spd.dsccc.com -# -# ====================================================================== - -# -# Default resources. -# -option add *Disjointlistbox.lhsLabelText Available widgetDefault -option add *Disjointlistbox.rhsLabelText Current widgetDefault -option add *Disjointlistbox.lhsButtonLabel {Insert >>} widgetDefault -option add *Disjointlistbox.rhsButtonLabel {<< Remove} widgetDefault -option add *Disjointlistbox.vscrollMode static widgetDefault -option add *Disjointlistbox.hscrollMode static widgetDefault -option add *Disjointlistbox.selectMode multiple widgetDefault -option add *Disjointlistbox.labelPos nw widgetDefault -option add *Disjointlistbox.buttonPlacement bottom widgetDefault - - -# -# Usual options. -# -itk::usual Disjointlistbox { - keep -background -textbackground -cursor \ - -foreground -textfont -labelfont -} - - -# ---------------------------------------------------------------------- -# ::iwidgets::Disjointlistbox -# ---------------------------------------------------------------------- -class ::iwidgets::Disjointlistbox { - - inherit itk::Widget - - # - # options - # - itk_option define -buttonplacement buttonPlacement ButtonPlacement bottom - itk_option define -lhsbuttonlabel lhsButtonLabel LabelText {Insert >>} - itk_option define -rhsbuttonlabel rhsButtonLabel LabelText {<< Remove} - - constructor {args} {} - - # - # PUBLIC - # - public { - method clear {} - method getlhs {{first 0} {last end}} - method getrhs {{first 0} {last end}} - method lhs {args} - method insertlhs {items} - method insertrhs {items} - method setlhs {items} - method setrhs {items} - method rhs {args} - } - - # - # PROTECTED - # - protected { - method insert {theListbox items} - method listboxClick {clickSide otherSide} - method listboxDblClick {clickSide otherSide} - method remove {theListbox items} - method showCount {} - method transfer {} - - variable sourceListbox {} - variable destinationListbox {} - } -} - -# -# Provide a lowercased access method for the ::iwidgets::Disjointlistbox class. -# -proc ::iwidgets::disjointlistbox {pathName args} { - uplevel ::iwidgets::Disjointlistbox $pathName $args -} - -# ------------------------------------------------------------------ -# -# Method: Constructor -# -# Purpose: -# -body ::iwidgets::Disjointlistbox::constructor {args} { - # - # Create the left-most Listbox - # - itk_component add lhs { - iwidgets::Scrolledlistbox $itk_interior.lhs \ - -selectioncommand [code $this listboxClick lhs rhs] \ - -dblclickcommand [code $this listboxDblClick lhs rhs] - } { - usual - keep -selectmode -vscrollmode -hscrollmode - rename -labeltext -lhslabeltext lhsLabelText LabelText - } - - # - # Create the right-most Listbox - # - itk_component add rhs { - iwidgets::Scrolledlistbox $itk_interior.rhs \ - -selectioncommand [code $this listboxClick rhs lhs] \ - -dblclickcommand [code $this listboxDblClick rhs lhs] - } { - usual - keep -selectmode -vscrollmode -hscrollmode - rename -labeltext -rhslabeltext rhsLabelText LabelText - } - - # - # Create the left-most item count Label - # - itk_component add lhsCount { - label $itk_interior.lhscount - } { - usual - rename -font -labelfont labelFont Font - } - - # - # Create the right-most item count Label - # - itk_component add rhsCount { - label $itk_interior.rhscount - } { - usual - rename -font -labelfont labelFont Font - } - - set sourceListbox $itk_component(lhs) - set destinationListbox $itk_component(rhs) - - # - # Bind the "showCount" method to the Map event of one of the labels - # to keep the diplayed item count current. - # - bind $itk_component(lhsCount) <Map> [code $this showCount] - - grid $itk_component(lhs) -row 0 -column 0 -sticky nsew - grid $itk_component(rhs) -row 0 -column 2 -sticky nsew - - grid rowconfigure $itk_interior 0 -weight 1 - grid columnconfigure $itk_interior 0 -weight 1 - grid columnconfigure $itk_interior 2 -weight 1 - - eval itk_initialize $args -} - -# ------------------------------------------------------------------ -# Method: listboxClick -# -# Purpose: Evaluate a single click make in the specified Listbox. -# -body ::iwidgets::Disjointlistbox::listboxClick {clickSide otherSide} { - set button "button" - $itk_component($clickSide$button) configure -state active - $itk_component($otherSide$button) configure -state disabled - set sourceListbox $itk_component($clickSide) - set destinationListbox $itk_component($otherSide) -} - -# ------------------------------------------------------------------ -# Method: listboxDblClick -# -# Purpose: Evaluate a double click in the specified Listbox. -# -body ::iwidgets::Disjointlistbox::listboxDblClick {clickSide otherSide} { - listboxClick $clickSide $otherSide - transfer -} - -# ------------------------------------------------------------------ -# Method: transfer -# -# Purpose: Transfer source Listbox items to destination Listbox -# -body ::iwidgets::Disjointlistbox::transfer {} { - - if {[$sourceListbox selecteditemcount] == 0} { - return - } - set selectedindices [lsort -integer -decreasing [$sourceListbox curselection]] - set selecteditems [$sourceListbox getcurselection] - - foreach index $selectedindices { - $sourceListbox delete $index - } - - foreach item $selecteditems { - $destinationListbox insert end $item - } - $destinationListbox sort increasing - - showCount -} - -# ------------------------------------------------------------------ -# Method: getlhs -# -# Purpose: Retrieve the items of the left Listbox widget -# -body ::iwidgets::Disjointlistbox::getlhs {{first 0} {last end}} { - return [lhs get $first $last] -} - -# ------------------------------------------------------------------ -# Method: getrhs -# -# Purpose: Retrieve the items of the right Listbox widget -# -body ::iwidgets::Disjointlistbox::getrhs {{first 0} {last end}} { - return [rhs get $first $last] -} - -# ------------------------------------------------------------------ -# Method: insertrhs -# -# Purpose: Insert items into the right Listbox widget -# -body ::iwidgets::Disjointlistbox::insertrhs {items} { - remove $itk_component(lhs) $items - insert $itk_component(rhs) $items -} - -# ------------------------------------------------------------------ -# Method: insertlhs -# -# Purpose: Insert items into the left Listbox widget -# -body ::iwidgets::Disjointlistbox::insertlhs {items} { - remove $itk_component(rhs) $items - insert $itk_component(lhs) $items -} - -# ------------------------------------------------------------------ -# Method: clear -# -# Purpose: Remove the items from the Listbox widgets and set the item count -# Labels text to 0 -# -body ::iwidgets::Disjointlistbox::clear {} { - lhs clear - rhs clear - showCount -} - -# ------------------------------------------------------------------ -# Method: insert -# -# Purpose: Insert the input items into the input Listbox widget while -# maintaining the disjoint property between them. -# -body ::iwidgets::Disjointlistbox::insert {theListbox items} { - - set curritems [$theListbox get 0 end] - - foreach item $items { - # - # if the item is not already present in the Listbox then insert it - # - if {[lsearch -exact $curritems $item] == -1} { - $theListbox insert end $item - } - } - $theListbox sort increasing - showCount -} - -# ------------------------------------------------------------------ -# Method: remove -# -# Purpose: Remove the input items from the input Listbox widget while -# maintaining the disjoint property between them. -# -body ::iwidgets::Disjointlistbox::remove {theListbox items} { - - set indexes {} - set curritems [$theListbox get 0 end] - - foreach item $items { - # - # if the item is in the listbox then add its index to the index list - # - if {[set index [lsearch -exact $curritems $item]] != -1} { - lappend indexes $index - } - } - - foreach index [lsort -integer -decreasing $indexes] { - $theListbox delete $index - } - showCount -} - -# ------------------------------------------------------------------ -# Method: showCount -# -# Purpose: Set the text of the item count Labels. -# -body ::iwidgets::Disjointlistbox::showCount {} { - $itk_component(lhsCount) config -text "item count: [lhs size]" - $itk_component(rhsCount) config -text "item count: [rhs size]" -} - -# ------------------------------------------------------------------ -# METHOD: setlhs -# -# Set the items of the left-most Listbox with the input list -# option. Remove all (if any) items from the right-most Listbox -# which exist in the input list option to maintain the disjoint -# property between the two -# -body ::iwidgets::Disjointlistbox::setlhs {items} { - lhs clear - insertlhs $items -} - -# ------------------------------------------------------------------ -# METHOD: setrhs -# -# Set the items of the right-most Listbox with the input list -# option. Remove all (if any) items from the left-most Listbox -# which exist in the input list option to maintain the disjoint -# property between the two -# -body ::iwidgets::Disjointlistbox::setrhs {items} { - rhs clear - insertrhs $items -} - -# ------------------------------------------------------------------ -# Method: lhs -# -# Purpose: Evaluates the specified arguments against the lhs Listbox -# -body ::iwidgets::Disjointlistbox::lhs {args} { - return [eval $itk_component(lhs) $args] -} - -# ------------------------------------------------------------------ -# Method: rhs -# -# Purpose: Evaluates the specified arguments against the rhs Listbox -# -body ::iwidgets::Disjointlistbox::rhs {args} { - return [eval $itk_component(rhs) $args] -} - -# ------------------------------------------------------------------ -# OPTION: buttonplacement -# -# Configure the placement of the buttons to be either between or below -# the two list boxes. -# -configbody ::iwidgets::Disjointlistbox::buttonplacement { - if {$itk_option(-buttonplacement) != ""} { - - if { [lsearch [component] lhsbutton] != -1 } { - eval destroy $itk_component(rhsbutton) $itk_component(lhsbutton) - } - - if { [lsearch [component] bbox] != -1 } { - destroy $itk_component(bbox) - } - - set where $itk_option(-buttonplacement) - - switch $where { - - center { - # - # Create the button box frame - # - itk_component add bbox { - frame $itk_interior.bbox - } - - itk_component add lhsbutton { - button $itk_component(bbox).lhsbutton -command [code $this transfer] - } { - usual - rename -text -lhsbuttonlabel lhsButtonLabel LabelText - rename -font -labelfont labelFont Font - } - - itk_component add rhsbutton { - button $itk_component(bbox).rhsbutton -command [code $this transfer] - } { - usual - rename -text -rhsbuttonlabel rhsButtonLabel LabelText - rename -font -labelfont labelFont Font - } - - grid configure $itk_component(lhsCount) -row 1 -column 0 -sticky ew - grid configure $itk_component(rhsCount) -row 1 -column 2 -sticky ew - - grid configure $itk_component(bbox) \ - -in $itk_interior -row 0 -column 1 -columnspan 1 -sticky nsew - - grid configure $itk_component(rhsbutton) \ - -in $itk_component(bbox) -row 0 -column 0 -sticky ew - grid configure $itk_component(lhsbutton) \ - -in $itk_component(bbox) -row 1 -column 0 -sticky ew - } - - bottom { - - itk_component add lhsbutton { - button $itk_interior.lhsbutton -command [code $this transfer] - } { - usual - rename -text -lhsbuttonlabel lhsButtonLabel LabelText - rename -font -labelfont labelFont Font - } - - itk_component add rhsbutton { - button $itk_interior.rhsbutton -command [code $this transfer] - } { - usual - rename -text -rhsbuttonlabel rhsButtonLabel LabelText - rename -font -labelfont labelFont Font - } - - grid $itk_component(lhsCount) -row 2 -column 0 -sticky ew - grid $itk_component(rhsCount) -row 2 -column 2 -sticky ew - grid $itk_component(lhsbutton) -row 1 -column 0 -sticky ew - grid $itk_component(rhsbutton) -row 1 -column 2 -sticky ew - } - - default { - error "bad buttonplacement option\"$where\": should be center or bottom" - } - } - } -} - diff --git a/itcl/iwidgets3.0.0/generic/entryfield.itk b/itcl/iwidgets3.0.0/generic/entryfield.itk deleted file mode 100644 index bf3880086cf..00000000000 --- a/itcl/iwidgets3.0.0/generic/entryfield.itk +++ /dev/null @@ -1,579 +0,0 @@ -# -# Entryfield -# ---------------------------------------------------------------------- -# Implements an enhanced text entry widget. -# -# ---------------------------------------------------------------------- -# AUTHOR: Sue Yockey E-mail: yockey@acm.org -# Mark L. Ulferts E-mail: mulferts@austin.dsccc.com -# -# @(#) $Id$ -# ---------------------------------------------------------------------- -# Copyright (c) 1995 DSC Technologies Corporation -# ====================================================================== -# Permission to use, copy, modify, distribute and license this software -# and its documentation for any purpose, and without fee or written -# agreement with DSC, is hereby granted, provided that the above copyright -# notice appears in all copies and that both the copyright notice and -# warranty disclaimer below appear in supporting documentation, and that -# the names of DSC Technologies Corporation or DSC Communications -# Corporation not be used in advertising or publicity pertaining to the -# software without specific, written prior permission. -# -# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING -# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- -# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE -# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, -# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL -# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR -# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, -# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, -# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS -# SOFTWARE. -# ====================================================================== - -# -# Usual options. -# -itk::usual Entryfield { - keep -background -borderwidth -cursor -foreground -highlightcolor \ - -highlightthickness -insertbackground -insertborderwidth \ - -insertofftime -insertontime -insertwidth -labelfont \ - -selectbackground -selectborderwidth -selectforeground \ - -textbackground -textfont -} - -# ------------------------------------------------------------------ -# ENTRYFIELD -# ------------------------------------------------------------------ -class iwidgets::Entryfield { - inherit iwidgets::Labeledwidget - - constructor {args} {} - - itk_option define -childsitepos childSitePos Position e - itk_option define -command command Command {} - 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 { - method childsite {} - method get {} - method delete {args} - method icursor {args} - method index {args} - method insert {args} - method scan {args} - method selection {args} - method xview {args} - method clear {} - } - - proc numeric {char} {} - proc integer {string} {} - proc alphabetic {char} {} - proc alphanumeric {char} {} - proc hexidecimal {string} {} - proc real {string} {} - - protected { - method _focusCommand {} - method _keyPress {char sym state} - } - - private method _peek {char} -} - -# -# Provide a lowercased access method for the Entryfield class. -# -proc ::iwidgets::entryfield {pathName args} { - uplevel ::iwidgets::Entryfield $pathName $args -} - -# ------------------------------------------------------------------ -# CONSTRUCTOR -# ------------------------------------------------------------------ -body iwidgets::Entryfield::constructor {args} { - component hull configure -borderwidth 0 - - itk_component add entry { - entry $itk_interior.entry - } { - keep -borderwidth -cursor -exportselection \ - -foreground -highlightcolor \ - -highlightthickness -insertbackground -insertborderwidth \ - -insertofftime -insertontime -insertwidth -justify \ - -relief -selectbackground -selectborderwidth \ - -selectforeground -show -state -textvariable -width - - rename -font -textfont textFont Font - rename -highlightbackground -background background Background - rename -background -textbackground textBackground Background - } - - # - # Create the child site widget. - # - itk_component add -protected efchildsite { - frame $itk_interior.efchildsite - } - set itk_interior $itk_component(efchildsite) - - # - # Entryfield instance bindings. - # - bind $itk_component(entry) <KeyPress> [code $this _keyPress %A %K %s] - bind $itk_component(entry) <FocusIn> [code $this _focusCommand] - - # - # Initialize the widget based on the command line options. - # - eval itk_initialize $args -} - -# ------------------------------------------------------------------ -# OPTIONS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# OPTION: -command -# -# Command associated upon detection of Return key press event -# ------------------------------------------------------------------ -configbody iwidgets::Entryfield::command {} - -# ------------------------------------------------------------------ -# OPTION: -focuscommand -# -# Command associated upon detection of focus. -# ------------------------------------------------------------------ -configbody iwidgets::Entryfield::focuscommand {} - -# ------------------------------------------------------------------ -# OPTION: -validate -# -# Specify a command to executed for the validation of Entryfields. -# ------------------------------------------------------------------ -configbody iwidgets::Entryfield::validate { - switch $itk_option(-validate) { - {} { - set itk_option(-validate) {} - } - numeric { - set itk_option(-validate) "::iwidgets::Entryfield::numeric %c" - } - integer { - set itk_option(-validate) "::iwidgets::Entryfield::integer %P" - } - hexidecimal { - set itk_option(-validate) "::iwidgets::Entryfield::hexidecimal %P" - } - real { - set itk_option(-validate) "::iwidgets::Entryfield::real %P" - } - alphabetic { - set itk_option(-validate) "::iwidgets::Entryfield::alphabetic %c" - } - alphanumeric { - set itk_option(-validate) "::iwidgets::Entryfield::alphanumeric %c" - } - } -} - -# ------------------------------------------------------------------ -# OPTION: -invalid -# -# Specify a command to executed should the current Entryfield contents -# be proven invalid. -# ------------------------------------------------------------------ -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 -# number of chars the user may type into the field, regardles of -# field width, i.e. the field width may be 20, but the user will -# only be able to type -fixed number of characters into it (or -# unlimited if -fixed = 0). -# ------------------------------------------------------------------ -configbody iwidgets::Entryfield::fixed { - if {[regexp {[^0-9]} $itk_option(-fixed)] || \ - ($itk_option(-fixed) < 0)} { - error "bad fixed option \"$itk_option(-fixed)\",\ - should be positive integer" - } -} - -# ------------------------------------------------------------------ -# OPTION: -childsitepos -# -# Specifies the position of the child site in the widget. -# ------------------------------------------------------------------ -configbody iwidgets::Entryfield::childsitepos { - set parent [winfo parent $itk_component(entry)] - - switch $itk_option(-childsitepos) { - n { - grid $itk_component(efchildsite) -row 0 -column 0 -sticky ew - grid $itk_component(entry) -row 1 -column 0 -sticky nsew - - grid rowconfigure $parent 0 -weight 0 - grid rowconfigure $parent 1 -weight 1 - grid columnconfigure $parent 0 -weight 1 - grid columnconfigure $parent 1 -weight 0 - } - - e { - grid $itk_component(efchildsite) -row 0 -column 1 -sticky ns - grid $itk_component(entry) -row 0 -column 0 -sticky nsew - - grid rowconfigure $parent 0 -weight 1 - grid rowconfigure $parent 1 -weight 0 - grid columnconfigure $parent 0 -weight 1 - grid columnconfigure $parent 1 -weight 0 - } - - s { - grid $itk_component(efchildsite) -row 1 -column 0 -sticky ew - grid $itk_component(entry) -row 0 -column 0 -sticky nsew - - grid rowconfigure $parent 0 -weight 1 - grid rowconfigure $parent 1 -weight 0 - grid columnconfigure $parent 0 -weight 1 - grid columnconfigure $parent 1 -weight 0 - } - - w { - grid $itk_component(efchildsite) -row 0 -column 0 -sticky ns - grid $itk_component(entry) -row 0 -column 1 -sticky nsew - - grid rowconfigure $parent 0 -weight 1 - grid rowconfigure $parent 1 -weight 0 - grid columnconfigure $parent 0 -weight 0 - grid columnconfigure $parent 1 -weight 1 - } - - default { - error "bad childsite option\ - \"$itk_option(-childsitepos)\":\ - should be n, e, s, or w" - } - } -} - -# ------------------------------------------------------------------ -# METHODS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# METHOD: childsite -# -# Returns the path name of the child site widget. -# ------------------------------------------------------------------ -body iwidgets::Entryfield::childsite {} { - return $itk_component(efchildsite) -} - -# ------------------------------------------------------------------ -# METHOD: get -# -# Thin wrap of the standard entry widget get method. -# ------------------------------------------------------------------ -body iwidgets::Entryfield::get {} { - return [$itk_component(entry) get] -} - -# ------------------------------------------------------------------ -# METHOD: delete -# -# Thin wrap of the standard entry widget delete method. -# ------------------------------------------------------------------ -body iwidgets::Entryfield::delete {args} { - return [eval $itk_component(entry) delete $args] -} - -# ------------------------------------------------------------------ -# METHOD: icursor -# -# Thin wrap of the standard entry widget icursor method. -# ------------------------------------------------------------------ -body iwidgets::Entryfield::icursor {args} { - return [eval $itk_component(entry) icursor $args] -} - -# ------------------------------------------------------------------ -# METHOD: index -# -# Thin wrap of the standard entry widget index method. -# ------------------------------------------------------------------ -body iwidgets::Entryfield::index {args} { - return [eval $itk_component(entry) index $args] -} - -# ------------------------------------------------------------------ -# METHOD: insert -# -# Thin wrap of the standard entry widget index method. -# ------------------------------------------------------------------ -body iwidgets::Entryfield::insert {args} { - return [eval $itk_component(entry) insert $args] -} - -# ------------------------------------------------------------------ -# METHOD: scan -# -# Thin wrap of the standard entry widget scan method. -# ------------------------------------------------------------------ -body iwidgets::Entryfield::scan {args} { - return [eval $itk_component(entry) scan $args] -} - -# ------------------------------------------------------------------ -# METHOD: selection -# -# Thin wrap of the standard entry widget selection method. -# ------------------------------------------------------------------ -body iwidgets::Entryfield::selection {args} { - return [eval $itk_component(entry) selection $args] -} - -# ------------------------------------------------------------------ -# METHOD: xview -# -# Thin wrap of the standard entry widget xview method. -# ------------------------------------------------------------------ -body iwidgets::Entryfield::xview {args} { - return [eval $itk_component(entry) xview $args] -} - -# ------------------------------------------------------------------ -# METHOD: clear -# -# Delete the current entry contents. -# ------------------------------------------------------------------ -body iwidgets::Entryfield::clear {} { - $itk_component(entry) delete 0 end - icursor 0 -} - -# ------------------------------------------------------------------ -# PROCEDURE: numeric char -# -# The numeric procedure validates character input for a given -# Entryfield to be numeric and returns the result. -# ------------------------------------------------------------------ -body iwidgets::Entryfield::numeric {char} { - return [regexp {[0-9]} $char] -} - -# ------------------------------------------------------------------ -# PROCEDURE: integer string -# -# The integer procedure validates character input for a given -# Entryfield to be integer and returns the result. -# ------------------------------------------------------------------ -body iwidgets::Entryfield::integer {string} { - return [regexp {^[-+]?[0-9]*$} $string] -} - -# ------------------------------------------------------------------ -# PROCEDURE: alphabetic char -# -# The alphabetic procedure validates character input for a given -# Entryfield to be alphabetic and returns the result. -# ------------------------------------------------------------------ -body iwidgets::Entryfield::alphabetic {char} { - return [regexp -nocase {[a-z]} $char] -} - -# ------------------------------------------------------------------ -# PROCEDURE: alphanumeric char -# -# The alphanumeric procedure validates character input for a given -# Entryfield to be alphanumeric and returns the result. -# ------------------------------------------------------------------ -body iwidgets::Entryfield::alphanumeric {char} { - return [regexp -nocase {[0-9a-z]} $char] -} - -# ------------------------------------------------------------------ -# PROCEDURE: hexadecimal string -# -# The hexidecimal procedure validates character input for a given -# Entryfield to be hexidecimal and returns the result. -# ------------------------------------------------------------------ -body iwidgets::Entryfield::hexidecimal {string} { - return [regexp {^(0x)?[0-9a-fA-F]*$} $string] -} - -# ------------------------------------------------------------------ -# PROCEDURE: real string -# -# The real procedure validates character input for a given Entryfield -# to be real and returns the result. -# ------------------------------------------------------------------ -body iwidgets::Entryfield::real {string} { - return [regexp {^[-+]?[0-9]*\.?[0-9]*([0-9]\.?[eE][-+]?[0-9]*)?$} $string] -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _peek char -# -# The peek procedure returns the value of the Entryfield with the -# char inserted at the insert position. -# ------------------------------------------------------------------ -body iwidgets::Entryfield::_peek {char} { - set str [get] - - set insertPos [index insert] - set firstPart [string range $str 0 [expr $insertPos - 1]] - set lastPart [string range $str $insertPos end] - - regsub -all {\\} "$char" {\\\\} char - append rtnVal $firstPart $char $lastPart - return $rtnVal -} - -# ------------------------------------------------------------------ -# PROTECTED METHOD: _focusCommand -# -# Method bound to focus event which evaluates the current command -# specified in the focuscommand option -# ------------------------------------------------------------------ -body iwidgets::Entryfield::_focusCommand {} { - uplevel #0 $itk_option(-focuscommand) -} - -# ------------------------------------------------------------------ -# PROTECTED METHOD: _keyPress -# -# Monitor the key press event checking for return keys, fixed width -# specification, and optional validation procedures. -# ------------------------------------------------------------------ -body iwidgets::Entryfield::_keyPress {char sym state} { - # - # A Return key invokes the optionally specified command option. - # - if {$sym == "Return"} { - uplevel #0 $itk_option(-command) - return -code break 1 - } - - # - # Tabs, BackSpace, and Delete are passed on for other bindings. - # - if {($sym == "Tab") || ($sym == "BackSpace") || ($sym == "Delete")} { - return -code continue 1 - } - - # - # Character is not printable or the state is greater than one which - # means a modifier was used such as a control, meta key, or control - # or meta key with numlock down. - # - #----------------------------------------------------------- - # 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 - } - - # - # If the fixed length option is not zero, then verify that the - # current length plus one will not exceed the limit. If so then - # invoke the invalid command procedure. - # - if {$itk_option(-fixed) != 0} { - if {[string length [get]] >= $itk_option(-fixed)} { - uplevel #0 $itk_option(-invalid) - return -code break 0 - } - } - - # - # The validate option may contain a keyword (numeric, alphabetic), - # the name of a procedure, or nothing. The numeric and alphabetic - # keywords engage typical base level checks. If a command procedure - # is specified, then invoke it with the object and character passed - # as arguments. If the validate procedure returns false, then the - # invalid procedure is called. - # - if {$itk_option(-validate) != {}} { - set cmd $itk_option(-validate) - - regsub -all "%W" "$cmd" $itk_component(hull) cmd - regsub -all "%P" "$cmd" [list [_peek $char]] cmd - regsub -all "%S" "$cmd" [list [get]] cmd - regsub -all "%c" "$cmd" [list $char] cmd - regsub -all {\\} "$cmd" {\\\\} cmd - - set valid [uplevel #0 $cmd] - - if {($valid == "") || ([regexp 0|false|off|no $valid])} { - uplevel #0 $itk_option(-invalid) - return -code break 0 - } - } - - return -code continue 1 -} - diff --git a/itcl/iwidgets3.0.0/generic/extfileselectionbox.itk b/itcl/iwidgets3.0.0/generic/extfileselectionbox.itk deleted file mode 100644 index 0b04fcf26d4..00000000000 --- a/itcl/iwidgets3.0.0/generic/extfileselectionbox.itk +++ /dev/null @@ -1,1126 +0,0 @@ -# -# Extfileselectionbox -# ---------------------------------------------------------------------- -# Implements a file selection box that is a slightly extended version -# of the OSF/Motif standard XmExtfileselectionbox composite widget. -# The Extfileselectionbox differs from the Motif standard in that the -# filter and selection fields are comboboxes and the files and directory -# lists are in a paned window. -# -# ---------------------------------------------------------------------- -# AUTHOR: Mark L. Ulferts EMAIL: mulferts@spd.dsccc.com -# Anthony L. Parent tony.parent@symbios.com -# -# @(#) $Id$ -# ---------------------------------------------------------------------- -# Copyright (c) 1997 DSC Technologies Corporation -# ====================================================================== -# Permission to use, copy, modify, distribute and license this software -# and its documentation for any purpose, and without fee or written -# agreement with DSC, is hereby granted, provided that the above copyright -# notice appears in all copies and that both the copyright notice and -# warranty disclaimer below appear in supporting documentation, and that -# the names of DSC Technologies Corporation or DSC Communications -# Corporation not be used in advertising or publicity pertaining to the -# software without specific, written prior permission. -# -# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING -# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- -# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE -# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, -# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL -# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR -# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, -# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, -# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS -# SOFTWARE. -# ====================================================================== - -# -# Usual options. -# -itk::usual Extfileselectionbox { - keep -activebackground -activerelief -background -borderwidth -cursor \ - -elementborderwidth -foreground -highlightcolor -highlightthickness \ - -insertbackground -insertborderwidth -insertofftime -insertontime \ - -insertwidth -jump -labelfont -selectbackground -selectborderwidth \ - -textbackground -textfont -troughcolor -} - -# ------------------------------------------------------------------ -# EXTFILESELECTIONBOX -# ------------------------------------------------------------------ -class iwidgets::Extfileselectionbox { - inherit itk::Widget - - constructor {args} {} - destructor {} - - itk_option define -childsitepos childSitePos Position s - itk_option define -fileson filesOn FilesOn true - itk_option define -dirson dirsOn DirsOn true - itk_option define -selectionon selectionOn SelectionOn true - itk_option define -filteron filterOn FilterOn true - itk_option define -mask mask Mask {*} - itk_option define -directory directory Directory {} - itk_option define -nomatchstring noMatchString NoMatchString {} - itk_option define -dirsearchcommand dirSearchCommand Command {} - itk_option define -filesearchcommand fileSearchCommand Command {} - itk_option define -selectioncommand selectionCommand Command {} - itk_option define -filtercommand filterCommand Command {} - itk_option define -selectdircommand selectDirCommand Command {} - itk_option define -selectfilecommand selectFileCommand Command {} - itk_option define -invalid invalid Command {bell} - itk_option define -filetype fileType FileType {regular} - itk_option define -width width Width 350 - itk_option define -height height Height 300 - - public { - method childsite {} - method get {} - method filter {} - } - - 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 {} - method _setFileList {} - - method _nPos {} - method _sPos {} - method _ePos {} - method _wPos {} - method _topPos {} - method _bottomPos {} - - variable _packToken "" ;# non-null => _packComponents pending - variable _updateToken "" ;# non-null => _updateLists pending - variable _pwd "." ;# present working dir - variable _interior ;# original interior setting - } -} - -# -# Provide a lowercased access method for the Extfileselectionbox class. -# -proc ::iwidgets::extfileselectionbox {pathName args} { - uplevel ::iwidgets::Extfileselectionbox $pathName $args -} - -# -# Use option database to override default resources of base classes. -# -option add *Extfileselectionbox.borderWidth 2 widgetDefault - -option add *Extfileselectionbox.filterLabel Filter widgetDefault -option add *Extfileselectionbox.dirsLabel Directories widgetDefault -option add *Extfileselectionbox.filesLabel Files widgetDefault -option add *Extfileselectionbox.selectionLabel Selection widgetDefault - -option add *Extfileselectionbox.width 350 widgetDefault -option add *Extfileselectionbox.height 300 widgetDefault - -# ------------------------------------------------------------------ -# CONSTRUCTOR -# ------------------------------------------------------------------ -body iwidgets::Extfileselectionbox::constructor {args} { - # - # Add back to the hull width and height options and make the - # borderwidth zero since we don't need it. - # - itk_option add hull.width hull.height - component hull configure -borderwidth 0 - - set _interior $itk_interior - - # - # Create the filter entry. - # - itk_component add filter { - iwidgets::Combobox $itk_interior.filter -unique true \ - -command [code $this _selectFilter] -exportselection 0 \ - -labelpos nw -completion 0 - - } { - usual - - rename -labeltext -filterlabel filterLabel Text - } - - set cmd [$itk_component(filter) cget -command] - set cmd "$cmd;[code $this _selectFilter]" - $itk_component(filter) configure -command "$cmd" -selectioncommand "$cmd"; - - # - # Create a paned window for the directory and file lists. - # - itk_component add listpane { - iwidgets::Panedwindow $itk_interior.listpane -orient vertical - } - - $itk_component(listpane) add dirs -margin 5 - $itk_component(listpane) add files -margin 5 - - # - # Create the directory list. - # - itk_component add dirs { - iwidgets::Scrolledlistbox [$itk_component(listpane) childsite dirs].dirs \ - -selectioncommand [code $this _selectDir] \ - -selectmode single -exportselection 0 \ - -visibleitems 1x1 -labelpos nw \ - -hscrollmode static -vscrollmode static \ - -dblclickcommand [code $this _dblSelectDir] - } { - usual - - rename -labeltext -dirslabel dirsLabel Text - } - grid $itk_component(dirs) -sticky nsew - grid rowconfigure [$itk_component(listpane) childsite dirs] 0 -weight 1 - grid columnconfigure [$itk_component(listpane) childsite dirs] 0 -weight 1 - - # - # Create the files list. - # - itk_component add files { - iwidgets::Scrolledlistbox [$itk_component(listpane) childsite files].files \ - -selectioncommand [code $this _selectFile] \ - -selectmode single -exportselection 0 \ - -visibleitems 1x1 -labelpos nw \ - -hscrollmode static -vscrollmode static - } { - usual - - rename -labeltext -fileslabel filesLabel Text - } - grid $itk_component(files) -sticky nsew - grid rowconfigure [$itk_component(listpane) childsite files] 0 -weight 1 - grid columnconfigure [$itk_component(listpane) childsite files] 0 -weight 1 - - # - # Create the selection entry. - # - itk_component add selection { - iwidgets::Combobox $itk_interior.selection -unique true \ - -command [code $this _selectSelection] -exportselection 0 \ - -labelpos nw -completion 0 - } { - usual - - rename -labeltext -selectionlabel selectionLabel Text - } - - # - # Create the child site widget. - # - itk_component add -protected childsite { - frame $itk_interior.fsbchildsite - } - - # - # Set the interior variable to the childsite for derived classes. - # - set itk_interior $itk_component(childsite) - - # - # Explicitly handle configs that may have been ignored earlier. - # - eval itk_initialize $args - - # - # When idle, pack the childsite and update the lists. - # - _packComponents - _updateLists -} - -# ------------------------------------------------------------------ -# DESTRUCTOR -# ------------------------------------------------------------------ -body iwidgets::Extfileselectionbox::destructor {} { - if {$_packToken != ""} {after cancel $_packToken} - if {$_updateToken != ""} {after cancel $_updateToken} -} - -# ------------------------------------------------------------------ -# OPTIONS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# OPTION: -childsitepos -# -# Specifies the position of the child site in the selection box. -# ------------------------------------------------------------------ -configbody iwidgets::Extfileselectionbox::childsitepos { - _packComponents -} - -# ------------------------------------------------------------------ -# OPTION: -fileson -# -# Specifies whether or not to display the files list. -# ------------------------------------------------------------------ -configbody iwidgets::Extfileselectionbox::fileson { - if {$itk_option(-fileson)} { - $itk_component(listpane) show files - - _updateLists - - } else { - $itk_component(listpane) hide files - } -} - -# ------------------------------------------------------------------ -# OPTION: -dirson -# -# Specifies whether or not to display the dirs list. -# ------------------------------------------------------------------ -configbody iwidgets::Extfileselectionbox::dirson { - if {$itk_option(-dirson)} { - $itk_component(listpane) show dirs - - _updateLists - - } else { - $itk_component(listpane) hide dirs - } -} - -# ------------------------------------------------------------------ -# OPTION: -selectionon -# -# Specifies whether or not to display the selection entry widget. -# ------------------------------------------------------------------ -configbody iwidgets::Extfileselectionbox::selectionon { - _packComponents -} - -# ------------------------------------------------------------------ -# OPTION: -filteron -# -# Specifies whether or not to display the filter entry widget. -# ------------------------------------------------------------------ -configbody iwidgets::Extfileselectionbox::filteron { - _packComponents -} - -# ------------------------------------------------------------------ -# OPTION: -mask -# -# Specifies the initial file mask string. -# ------------------------------------------------------------------ -configbody iwidgets::Extfileselectionbox::mask { - global tcl_platform - set prefix $_pwd - - # - # Remove automounter paths. - # - if {$tcl_platform(platform) == "unix"} { - regsub {^/(tmp_mnt|export)} $prefix {} prefix; - } - - set curFilter $itk_option(-mask); - $itk_component(filter) delete entry 0 end - $itk_component(filter) insert entry 0 [file join $_pwd $itk_option(-mask)] - - # - # Make sure the right most text is visable. - # - [$itk_component(filter) component entry] xview moveto 1 -} - -# ------------------------------------------------------------------ -# OPTION: -directory -# -# Specifies the initial default directory. -# ------------------------------------------------------------------ -configbody iwidgets::Extfileselectionbox::directory { - if {$itk_option(-directory) != {}} { - if {! [file exists $itk_option(-directory)]} { - error "bad directory option \"$itk_option(-directory)\":\ - directory does not exist" - } - - set olddir [pwd] - cd $itk_option(-directory) - set _pwd [pwd] - cd $olddir - - configure -mask $itk_option(-mask) - _selectFilter - } -} - -# ------------------------------------------------------------------ -# OPTION: -nomatchstring -# -# Specifies the string to be displayed in the files list should -# not regular files exist in the directory. -# ------------------------------------------------------------------ -configbody iwidgets::Extfileselectionbox::nomatchstring { -} - -# ------------------------------------------------------------------ -# OPTION: -dirsearchcommand -# -# Specifies a command to be executed to perform a directory search. -# The command will receive the current working directory and filter -# mask as arguments. The command should return a list of files which -# will be placed into the directory list. -# ------------------------------------------------------------------ -configbody iwidgets::Extfileselectionbox::dirsearchcommand { -} - -# ------------------------------------------------------------------ -# OPTION: -filesearchcommand -# -# Specifies a command to be executed to perform a file search. -# The command will receive the current working directory and filter -# mask as arguments. The command should return a list of files which -# will be placed into the file list. -# ------------------------------------------------------------------ -configbody iwidgets::Extfileselectionbox::filesearchcommand { -} - -# ------------------------------------------------------------------ -# OPTION: -selectioncommand -# -# Specifies a command to be executed upon pressing return in the -# selection entry widget. -# ------------------------------------------------------------------ -configbody iwidgets::Extfileselectionbox::selectioncommand { -} - -# ------------------------------------------------------------------ -# OPTION: -filtercommand -# -# Specifies a command to be executed upon pressing return in the -# filter entry widget. -# ------------------------------------------------------------------ -configbody iwidgets::Extfileselectionbox::filtercommand { -} - -# ------------------------------------------------------------------ -# OPTION: -selectdircommand -# -# Specifies a command to be executed following selection of a -# directory in the directory list. -# ------------------------------------------------------------------ -configbody iwidgets::Extfileselectionbox::selectdircommand { -} - -# ------------------------------------------------------------------ -# OPTION: -selectfilecommand -# -# Specifies a command to be executed following selection of a -# file in the files list. -# ------------------------------------------------------------------ -configbody iwidgets::Extfileselectionbox::selectfilecommand { -} - -# ------------------------------------------------------------------ -# OPTION: -invalid -# -# Specify a command to executed should the filter contents be -# proven invalid. -# ------------------------------------------------------------------ -configbody iwidgets::Extfileselectionbox::invalid { -} - -# ------------------------------------------------------------------ -# OPTION: -filetype -# -# Specify the type of files which may appear in the file list. -# ------------------------------------------------------------------ -configbody iwidgets::Extfileselectionbox::filetype { - switch $itk_option(-filetype) { - regular - - directory - - any { - } - default { - error "bad filetype option \"$itk_option(-filetype)\":\ - should be regular, directory, or any" - } - } - - _updateLists -} - -# ------------------------------------------------------------------ -# OPTION: -width -# -# Specifies the width of the file selection box. The value may be -# specified in any of the forms acceptable to Tk_GetPixels. -# ------------------------------------------------------------------ -configbody iwidgets::Extfileselectionbox::width { - # - # The width option was added to the hull in the constructor. - # So, any width value given is passed automatically to the - # hull. All we have to do is play with the propagation. - # - if {$itk_option(-width) != 0} { - set propagate 0 - } else { - set propagate 1 - } - - # - # Due to a bug in the tk4.2 grid, we have to check the - # propagation before setting it. Setting it to the same - # value it already is will cause it to toggle. - # - if {[grid propagate $itk_component(hull)] != $propagate} { - grid propagate $itk_component(hull) $propagate - } -} - -# ------------------------------------------------------------------ -# OPTION: -height -# -# Specifies the height of the file selection box. The value may be -# specified in any of the forms acceptable to Tk_GetPixels. -# ------------------------------------------------------------------ -configbody iwidgets::Extfileselectionbox::height { - # - # The height option was added to the hull in the constructor. - # So, any height value given is passed automatically to the - # hull. All we have to do is play with the propagation. - # - if {$itk_option(-height) != 0} { - set propagate 0 - } else { - set propagate 1 - } - - # - # Due to a bug in the tk4.2 grid, we have to check the - # propagation before setting it. Setting it to the same - # value it already is will cause it to toggle. - # - if {[grid propagate $itk_component(hull)] != $propagate} { - grid propagate $itk_component(hull) $propagate - } -} - -# ------------------------------------------------------------------ -# METHODS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# METHOD: childsite -# -# Returns the path name of the child site widget. -# ------------------------------------------------------------------ -body iwidgets::Extfileselectionbox::childsite {} { - return $itk_component(childsite) -} - -# ------------------------------------------------------------------ -# METHOD: get -# -# Returns the current selection. -# ------------------------------------------------------------------ -body iwidgets::Extfileselectionbox::get {} { - return [$itk_component(selection) get] -} - -# ------------------------------------------------------------------ -# METHOD: filter -# -# The user has pressed Return in the filter. Make sure the contents -# contain a valid directory before setting default to directory. -# Use the invalid option to warn the user of any problems. -# ------------------------------------------------------------------ -body iwidgets::Extfileselectionbox::filter {} { - set newdir [file dirname [$itk_component(filter) get]] - - if {! [file exists $newdir]} { - uplevel #0 "$itk_option(-invalid)" - return - } - - set _pwd $newdir; - if {$_pwd == "."} {set _pwd [pwd]}; - - _updateLists -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _updateLists ?now? -# -# Updates the contents of both the file and directory lists, as well -# resets the positions of the filter, and lists. -# ------------------------------------------------------------------ -body iwidgets::Extfileselectionbox::_updateLists {{when "later"}} { - switch -- $when { - later { - if {$_updateToken == ""} { - set _updateToken [after idle [code $this _updateLists now]] - } - } - now { - if {$itk_option(-dirson)} {_setDirList} - if {$itk_option(-fileson)} {_setFileList} - - if {$itk_option(-filteron)} { - _setFilter - } - if {$itk_option(-selectionon)} { - $itk_component(selection) icursor end - } - if {$itk_option(-dirson)} { - $itk_component(dirs) justify left - } - if {$itk_option(-fileson)} { - $itk_component(files) justify left - } - set _updateToken "" - } - default { - error "bad option \"$when\": should be later or now" - } - } -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _setFilter -# -# Set the filter to the current selection in the directory list plus -# any existing mask in the filter. Translate the two special cases -# of '.', and '..' directory names to full path names.. -# ------------------------------------------------------------------ -body iwidgets::Extfileselectionbox::_setFilter {} { - global tcl_platform - set prefix [$itk_component(dirs) getcurselection] - set curFilter [file tail [$itk_component(filter) get]] - - while {[regexp {\.$} $prefix]} { - if {[file tail $prefix] == "."} { - if {$prefix == "."} { - if {$_pwd == "."} { - set _pwd [pwd] - } elseif {$_pwd == ".."} { - set _pwd [file dirname [pwd]] - } - set prefix $_pwd - } else { - set prefix [file dirname $prefix] - } - } elseif {[file tail $prefix] == ".."} { - if {$prefix != ".."} { - set prefix [file dirname [file dirname $prefix]] - } else { - if {$_pwd == "."} { - set _pwd [pwd] - } elseif {$_pwd == ".."} { - set _pwd [file dirname [pwd]] - } - set prefix [file dirname $_pwd] - } - } else { - break - } - } - - if { [file pathtype $prefix] != "absolute" } { - set prefix [file join $_pwd $prefix] - } - - # - # Remove automounter paths. - # - if {$tcl_platform(platform) == "unix"} { - regsub {^/(tmp_mnt|export)} $prefix {} prefix - } - - $itk_component(filter) delete entry 0 end - $itk_component(filter) insert entry 0 [file join $prefix $curFilter] - - if {[info level -1] != "_selectDir"} { - $itk_component(filter) insert list 0 [file join $prefix $curFilter] - } - - # - # Make sure insertion cursor is at the end. - # - $itk_component(filter) icursor end - - # - # Make sure the right most text is visable. - # - [$itk_component(filter) component entry] xview moveto 1 -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _setSelection -# -# Set the contents of the selection entry to either the current -# selection of the file or directory list dependent on which lists -# are currently mapped. For the file list, avoid seleciton of the -# no match string. As for the directory list, translate file names. -# ------------------------------------------------------------------ -body iwidgets::Extfileselectionbox::_setSelection {} { - global tcl_platform - $itk_component(selection) delete entry 0 end - - if {$itk_option(-fileson)} { - set selection [$itk_component(files) getcurselection] - - if {$selection != $itk_option(-nomatchstring)} { - if {[file pathtype $selection] != "absolute"} { - set selection [file join $_pwd $selection] - } - - # - # Remove automounter paths. - # - if {$tcl_platform(platform) == "unix"} { - regsub {^/(tmp_mnt|export)} $selection {} selection; - } - - $itk_component(selection) insert entry 0 $selection - } else { - $itk_component(files) selection clear 0 end - } - - } else { - set selection [$itk_component(dirs) getcurselection] - - if {[file tail $selection] == "."} { - if {$selection != "."} { - set selection [file dirname $selection] - } else { - set selection $_pwd - } - } elseif {[file tail $selection] == ".."} { - if {$selection != ".."} { - set selection [file dirname [file dirname $selection]] - } else { - set selection [file join $_pwd ..] - } - } else { - set selection [file join $_pwd $selection] - } - - # - # Remove automounter paths. - # - if {$tcl_platform(platform) == "unix"} { - regsub {^/(tmp_mnt|export)} $selection {} selection; - } - - $itk_component(selection) insert entry 0 $selection - } - - $itk_component(selection) insert list 0 $selection - $itk_component(selection) icursor end - - # - # Make sure the right most text is visable. - # - [$itk_component(selection) component entry] xview moveto 1 -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _setDirList -# -# Clear the directory list and dependent on whether the user has -# defined their own search procedure or not fill the list with their -# results or those of a glob. Select the first element if it exists. -# ------------------------------------------------------------------ -body iwidgets::Extfileselectionbox::_setDirList {} { - $itk_component(dirs) clear - - if {$itk_option(-dirsearchcommand) == {}} { - set cwd $_pwd - - foreach i [lsort [glob -nocomplain \ - [file join $cwd .*] [file join $cwd *]]] { - if {[file isdirectory $i]} { - set insert "[file tail $i]" - $itk_component(dirs) insert end "$insert" - } - } - - } else { - set mask [file tail [$itk_component(filter) get]] - - foreach file [uplevel #0 $itk_option(-dirsearchcommand) $_pwd $mask] { - $itk_component(dirs) insert end $file - } - } - - if {[$itk_component(dirs) size]} { - $itk_component(dirs) selection clear 0 end - $itk_component(dirs) selection set 0 - } -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _setFileList -# -# Clear the file list and dependent on whether the user has defined -# their own search procedure or not fill the list with their results -# or those of a 'glob'. If the files list has no contents, then set -# the files list to the 'nomatchstring'. Clear all selections. -# ------------------------------------------------------------------ -body iwidgets::Extfileselectionbox::_setFileList {} { - $itk_component(files) clear - set mask [file tail [$itk_component(filter) get]] - - if {$itk_option(-filesearchcommand) == {}} { - if {$mask == "*"} { - set files [lsort [glob -nocomplain \ - [file join $_pwd .*] [file join $_pwd *]]] - } else { - set files [lsort [glob -nocomplain [file join $_pwd $mask]]] - } - - foreach i $files { - if {($itk_option(-filetype) == "regular" && \ - ! [file isdirectory $i]) || \ - ($itk_option(-filetype) == "directory" && \ - [file isdirectory $i]) || \ - ($itk_option(-filetype) == "any")} { - set insert "[file tail $i]" - $itk_component(files) insert end "$insert" - } - } - - } else { - foreach file [uplevel #0 $itk_option(-filesearchcommand) $_pwd $mask] { - $itk_component(files) insert end $file - } - } - - if {[$itk_component(files) size] == 0} { - if {$itk_option(-nomatchstring) != {}} { - $itk_component(files) insert end $itk_option(-nomatchstring) - } - } - - $itk_component(files) selection clear 0 end -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _selectDir -# -# For a selection in the directory list, set the filter and possibly -# the selection entry based on the fileson option. -# ------------------------------------------------------------------ -body iwidgets::Extfileselectionbox::_selectDir {} { - _setFilter - - if {$itk_option(-fileson)} {} { - _setSelection - } - - if {$itk_option(-selectdircommand) != {}} { - uplevel #0 $itk_option(-selectdircommand) - } -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _dblSelectDir -# -# For a double click event in the directory list, select the -# directory, set the default to the selection, and update both the -# file and directory lists. -# ------------------------------------------------------------------ -body iwidgets::Extfileselectionbox::_dblSelectDir {} { - filter -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _selectFile -# -# The user has selected a file. Put the current selection in the -# file list in the selection entry widget. -# ------------------------------------------------------------------ -body iwidgets::Extfileselectionbox::_selectFile {} { - _setSelection - - if {$itk_option(-selectfilecommand) != {}} { - uplevel #0 $itk_option(-selectfilecommand) - } -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _selectSelection -# -# The user has pressed Return in the selection entry widget. Call -# the defined selection command if it exists. -# ------------------------------------------------------------------ -body iwidgets::Extfileselectionbox::_selectSelection {} { - if {$itk_option(-selectioncommand) != {}} { - uplevel #0 $itk_option(-selectioncommand) - } -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _selectFilter -# -# The user has pressed Return in the filter entry widget. Call the -# defined selection command if it exists, otherwise just filter. -# ------------------------------------------------------------------ -body iwidgets::Extfileselectionbox::_selectFilter {} { - if {$itk_option(-filtercommand) != {}} { - uplevel #0 $itk_option(-filtercommand) - } else { - filter - } -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _packComponents -# -# Pack the selection, items, and child site widgets based on options. -# Using the -in option of pack, put the childsite around the frame -# in the hull for n, s, e, and w positions. Make sure and raise -# the child site since using the 'in' option may obscure the site. -# ------------------------------------------------------------------ -body iwidgets::Extfileselectionbox::_packComponents {{when "later"}} { - if {$when == "later"} { - if {$_packToken == ""} { - set _packToken [after idle [code $this _packComponents now]] - } - return - } elseif {$when != "now"} { - error "bad option \"$when\": should be now or later" - } - - set _packToken "" - - # - # Forget about any previous placements via the grid and - # reset all the possible minsizes and weights for all - # the rows and columns. - # - foreach component {childsite listpane filter selection} { - grid forget $itk_component($component) - } - - for {set row 0} {$row < 6} {incr row} { - grid rowconfigure $_interior $row -minsize 0 -weight 0 - } - - for {set col 0} {$col < 3} {incr col} { - grid columnconfigure $_interior $col -minsize 0 -weight 0 - } - - # - # Place all the components based on the childsite poisition - # option. - # - switch $itk_option(-childsitepos) { - n { _nPos } - - w { _wPos } - - s { _sPos } - - e { _ePos } - - top { _topPos } - - bottom { _bottomPos } - - default { - error "bad childsitepos option \"$itk_option(-childsitepos)\":\ - should be n, e, s, w, top, or bottom" - } - } -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _nPos -# -# Position the childsite to the north and all the other components -# appropriately based on the individual "on" options. -# ------------------------------------------------------------------ -body iwidgets::Extfileselectionbox::_nPos {} { - grid $itk_component(childsite) -row 0 -column 0 \ - -columnspan 1 -rowspan 1 -sticky nsew -padx 5 - - if {$itk_option(-filteron)} { - grid $itk_component(filter) -row 1 -column 0 \ - -columnspan 1 -sticky ew -padx 5 - grid rowconfigure $_interior 2 -minsize 7 - } - - grid $itk_component(listpane) -row 3 -column 0 \ - -columnspan 1 -sticky nsew - - grid rowconfigure $_interior 3 -weight 1 - - if {$itk_option(-selectionon)} { - grid rowconfigure $_interior 4 -minsize 7 - grid $itk_component(selection) -row 5 -column 0 \ - -columnspan 1 -sticky ew -padx 5 - } - - grid columnconfigure $_interior 0 -weight 1 -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _sPos -# -# Position the childsite to the south and all the other components -# appropriately based on the individual "on" options. -# ------------------------------------------------------------------ -body iwidgets::Extfileselectionbox::_sPos {} { - if {$itk_option(-filteron)} { - grid $itk_component(filter) -row 0 -column 0 \ - -columnspan 1 -sticky ew -padx 5 - grid rowconfigure $_interior 1 -minsize 7 - } - - grid $itk_component(listpane) -row 2 -column 0 \ - -columnspan 1 -sticky nsew - - grid rowconfigure $_interior 2 -weight 1 - - if {$itk_option(-selectionon)} { - grid rowconfigure $_interior 3 -minsize 7 - grid $itk_component(selection) -row 4 -column 0 \ - -columnspan 1 -sticky ew -padx 5 - } - - grid $itk_component(childsite) -row 5 -column 0 \ - -columnspan 1 -rowspan 1 -sticky nsew -padx 5 - - grid columnconfigure $_interior 0 -weight 1 -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _ePos -# -# Position the childsite to the east and all the other components -# appropriately based on the individual "on" options. -# ------------------------------------------------------------------ -body iwidgets::Extfileselectionbox::_ePos {} { - if {$itk_option(-filteron)} { - grid $itk_component(filter) -row 0 -column 0 \ - -columnspan 1 -sticky ew -padx 5 - grid rowconfigure $_interior 1 -minsize 7 - } - - grid $itk_component(listpane) -row 2 -column 0 \ - -columnspan 1 -sticky nsew - - grid rowconfigure $_interior 2 -weight 1 - - if {$itk_option(-selectionon)} { - grid rowconfigure $_interior 3 -minsize 7 - grid $itk_component(selection) -row 4 -column 0 \ - -columnspan 1 -sticky ew -padx 5 - } - - grid $itk_component(childsite) -row 0 -column 1 \ - -rowspan 5 -columnspan 1 -sticky nsew - - grid columnconfigure $_interior 0 -weight 1 -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _wPos -# -# Position the childsite to the west and all the other components -# appropriately based on the individual "on" options. -# ------------------------------------------------------------------ -body iwidgets::Extfileselectionbox::_wPos {} { - grid $itk_component(childsite) -row 0 -column 0 \ - -rowspan 5 -columnspan 1 -sticky nsew - - if {$itk_option(-filteron)} { - grid $itk_component(filter) -row 0 -column 1 \ - -columnspan 1 -sticky ew -padx 5 - grid rowconfigure $_interior 1 -minsize 7 - } - - grid $itk_component(listpane) -row 2 -column 1 \ - -columnspan 1 -sticky nsew - - grid rowconfigure $_interior 2 -weight 1 - - if {$itk_option(-selectionon)} { - grid rowconfigure $_interior 3 -minsize 7 - grid $itk_component(selection) -row 4 -column 1 \ - -columnspan 1 -sticky ew -padx 5 - } - - grid columnconfigure $_interior 1 -weight 1 -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _topPos -# -# Position the childsite below the filter but above the lists and -# all the other components appropriately based on the individual -# "on" options. -# ------------------------------------------------------------------ -body iwidgets::Extfileselectionbox::_topPos {} { - if {$itk_option(-filteron)} { - grid $itk_component(filter) -row 0 -column 0 \ - -columnspan 1 -sticky ew -padx 5 - } - - grid $itk_component(childsite) -row 1 -column 0 \ - -columnspan 1 -rowspan 1 -sticky nsew -padx 5 - - grid $itk_component(listpane) -row 2 -column 0 -sticky nsew - - grid rowconfigure $_interior 2 -weight 1 - - if {$itk_option(-selectionon)} { - grid rowconfigure $_interior 3 -minsize 7 - grid $itk_component(selection) -row 4 -column 0 \ - -columnspan 1 -sticky ew -padx 5 - } - - grid columnconfigure $_interior 0 -weight 1 -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _bottomPos -# -# Position the childsite below the lists and above the selection -# and all the other components appropriately based on the individual -# "on" options. -# ------------------------------------------------------------------ -body iwidgets::Extfileselectionbox::_bottomPos {} { - if {$itk_option(-filteron)} { - grid $itk_component(filter) -row 0 -column 0 \ - -columnspan 1 -sticky ew -padx 5 - grid rowconfigure $_interior 1 -minsize 7 - } - - grid $itk_component(listpane) -row 2 -column 0 -sticky nsew - - grid rowconfigure $_interior 2 -weight 1 - - grid $itk_component(childsite) -row 3 -column 0 \ - -columnspan 1 -rowspan 1 -sticky nsew -padx 5 - - if {$itk_option(-selectionon)} { - grid $itk_component(selection) -row 4 -column 0 \ - -columnspan 1 -sticky ew -padx 5 - } - - grid columnconfigure $_interior 0 -weight 1 -} diff --git a/itcl/iwidgets3.0.0/generic/extfileselectiondialog.itk b/itcl/iwidgets3.0.0/generic/extfileselectiondialog.itk deleted file mode 100644 index 06ec10557bf..00000000000 --- a/itcl/iwidgets3.0.0/generic/extfileselectiondialog.itk +++ /dev/null @@ -1,182 +0,0 @@ -# -# Extfileselectiondialog -# ---------------------------------------------------------------------- -# Implements a file selection dialog that is a slightly extended version -# of the OSF/Motif standard composite widget. The Extfileselectionbox -# differs from the Motif standard in that the filter and selection -# fields are comboboxes and the files and directory lists are in a -# paned window. -# -# ---------------------------------------------------------------------- -# AUTHOR: Mark L. Ulferts EMAIL: mulferts@spd.dsccc.com -# -# @(#) $Id$ -# ---------------------------------------------------------------------- -# Copyright (c) 1997 DSC Technologies Corporation -# ====================================================================== -# Permission to use, copy, modify, distribute and license this software -# and its documentation for any purpose, and without fee or written -# agreement with DSC, is hereby granted, provided that the above copyright -# notice appears in all copies and that both the copyright notice and -# warranty disclaimer below appear in supporting documentation, and that -# the names of DSC Technologies Corporation or DSC Communications -# Corporation not be used in advertising or publicity pertaining to the -# software without specific, written prior permission. -# -# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING -# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- -# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE -# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, -# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL -# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR -# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, -# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, -# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS -# SOFTWARE. -# ====================================================================== - -# -# Usual options. -# -itk::usual Extfileselectiondialog { - keep -activebackground -activerelief -background -borderwidth -cursor \ - -elementborderwidth -foreground -highlightcolor -highlightthickness \ - -insertbackground -insertborderwidth -insertofftime -insertontime \ - -insertwidth -jump -labelfont -modality -selectbackground \ - -selectborderwidth -textbackground -textfont -} - -# ------------------------------------------------------------------ -# EXTFILESELECTIONDIALOG -# ------------------------------------------------------------------ -class iwidgets::Extfileselectiondialog { - inherit iwidgets::Dialog - - constructor {args} {} - - public { - method childsite {} - method get {} - method filter {} - } - - protected method _dbldir {} -} - -# -# Provide a lowercased access method for the Extfileselectiondialog class. -# -proc ::iwidgets::extfileselectiondialog {pathName args} { - uplevel ::iwidgets::Extfileselectiondialog $pathName $args -} - -# -# Use option database to override default resources of base classes. -# -option add *Extfileselectiondialog.borderWidth 2 widgetDefault - -option add *Extfileselectiondialog.title "File Selection Dialog" widgetDefault - -option add *Extfileselectiondialog.width 350 widgetDefault -option add *Extfileselectiondialog.height 400 widgetDefault - -option add *Extfileselectiondialog.master "." widgetDefault - -# ------------------------------------------------------------------ -# CONSTRUCTOR -# ------------------------------------------------------------------ -body iwidgets::Extfileselectiondialog::constructor {args} { - component hull configure -borderwidth 0 - itk_option add hull.width hull.height - - # - # Turn off pack propagation for the hull widget so the width - # and height options become active. - # - pack propagate $itk_component(hull) no - - # - # Instantiate a file selection box widget. - # - itk_component add fsb { - iwidgets::Extfileselectionbox $itk_interior.fsb -width 150 -height 150 \ - -selectioncommand [code $this invoke] \ - -selectdircommand [code $this default Apply] \ - -selectfilecommand [code $this default OK] - } { - usual - - keep -labelfont -childsitepos -directory -dirslabel \ - -dirsearchcommand -dirson -fileslabel -fileson \ - -filesearchcommand -filterlabel -filteron \ - -filetype -invalid -mask -nomatchstring \ - -selectionlabel -selectionon - } - grid $itk_component(fsb) -sticky nsew - grid rowconfigure $itk_interior 0 -weight 1 - grid columnconfigure $itk_interior 0 -weight 1 - - $itk_component(fsb) component filter configure \ - -focuscommand [code $this default Apply] - $itk_component(fsb) component selection configure \ - -focuscommand [code $this default OK] - $itk_component(fsb) component dirs configure \ - -dblclickcommand [code $this _dbldir] - $itk_component(fsb) component files configure \ - -dblclickcommand [code $this invoke] - - buttonconfigure Apply -text "Filter" \ - -command [code $itk_component(fsb) filter] - - set itk_interior [$itk_component(fsb) childsite] - - hide Help - - eval itk_initialize $args -} - -# ------------------------------------------------------------------ -# METHODS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# METHOD: childsite -# -# Thinwrapped method of file selection box class. -# ------------------------------------------------------------------ -body iwidgets::Extfileselectiondialog::childsite {} { - return [$itk_component(fsb) childsite] -} - -# ------------------------------------------------------------------ -# METHOD: get -# -# Thinwrapped method of file selection box class. -# ------------------------------------------------------------------ -body iwidgets::Extfileselectiondialog::get {} { - return [$itk_component(fsb) get] -} - -# ------------------------------------------------------------------ -# METHOD: filter -# -# Thinwrapped method of file selection box class. -# ------------------------------------------------------------------ -body iwidgets::Extfileselectiondialog::filter {} { - return [$itk_component(fsb) filter] -} - -# ------------------------------------------------------------------ -# PROTECTED METHOD: _dbldir -# -# Double select in directory list. If the files list is on then -# make the default button the filter and invoke. If not, just invoke. -# ------------------------------------------------------------------ -body iwidgets::Extfileselectiondialog::_dbldir {} { - if {$itk_option(-fileson)} { - default Apply - } - - invoke -} - diff --git a/itcl/iwidgets3.0.0/generic/feedback.itk b/itcl/iwidgets3.0.0/generic/feedback.itk deleted file mode 100644 index 3e765bec3f8..00000000000 --- a/itcl/iwidgets3.0.0/generic/feedback.itk +++ /dev/null @@ -1,212 +0,0 @@ -# -# Feedback -# ---------------------------------------------------------------------- -# Implements a Feedback widget, to display feedback on the status of an -# process to the user. Display is given as a percentage and as a -# thermometer type bar. Options exist for adding a label and controlling its -# position. -# -# ---------------------------------------------------------------------- -# AUTHOR: Kris Raney EMAIL: kraney@spd.dsccc.com -# -# @(#) $Id$ -# ---------------------------------------------------------------------- -# Copyright (c) 1996 DSC Technologies Corporation -# ====================================================================== -# Permission to use, copy, modify, distribute and license this software -# and its documentation for any purpose, and without fee or written -# agreement with DSC, is hereby granted, provided that the above copyright -# notice appears in all copies and that both the copyright notice and -# warranty disclaimer below appear in supporting documentation, and that -# the names of DSC Technologies Corporation or DSC Communications -# Corporation not be used in advertising or publicity pertaining to the -# software without specific, written prior permission. -# -# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING -# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- -# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE -# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, -# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL -# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR -# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, -# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, -# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS -# SOFTWARE. -# ====================================================================== - -# Acknowledgements: -# -# Special thanks go to Sam Shen(SLShen@lbl.gov), as this code is based on his -# feedback.tcl code from tk inspect. The original code is copyright 1995 -# Lawrence Berkeley Laboratory. -# -# This software is copyright (C) 1994 by the Lawrence Berkeley Laboratory. -# -# Redistribution and use in source and binary forms, with or without -# modification, are permitted provided that: (1) source code distributions -# retain the above copyright notice and this paragraph in its entirety, (2) -# distributions including binary code include the above copyright notice and -# this paragraph in its entirety in the documentation or other materials -# provided with the distribution, and (3) all advertising materials mentioning -# features or use of this software display the following acknowledgement: -# ``This product includes software developed by the University of California, -# Lawrence Berkeley Laboratory and its contributors.'' Neither the name of -# the University nor the names of its contributors may be used to endorse -# or promote products derived from this software without specific prior -# written permission. -# -# THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED -# WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF -# MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. - -# -# Default resources. -# -option add *Feedback.borderWidth 2 widgetDefault -option add *Feedback.labelPos n widgetDefault -option add *Feedback.barHeight 20 widgetDefault -option add *Feedback.troughColor White widgetDefault -option add *Feedback.barColor Blue widgetDefault - -# -# Usual options. -# -itk::usual Feedback { - keep -background -cursor -foreground -} - -# ------------------------------------------------------------------ -# FEEDBACK -# ------------------------------------------------------------------ -class iwidgets::Feedback { - inherit iwidgets::Labeledwidget - - constructor {args} {} - destructor {} - - itk_option define -steps steps Steps 10 - - public { - method reset {} - method step {{inc 1}} - } - - private { - method _display - - variable _barwidth 0 - variable _stepval 0 - } -} - -# -# Provide a lowercased access method for the Dialogshell class. -# -proc ::iwidgets::feedback {pathName args} { - uplevel ::iwidgets::Feedback $pathName $args -} - -# ------------------------------------------------------------------ -# CONSTRUCTOR -# ------------------------------------------------------------------ -itcl::body iwidgets::Feedback::constructor {args} { - itk_component add trough { - frame $itk_interior.trough -relief sunken - } { - usual - keep -borderwidth - rename -background -troughcolor troughColor TroughColor - rename -height -barheight barHeight Height - } - - itk_component add bar { - frame $itk_component(trough).bar -relief raised - } { - usual - keep -borderwidth - rename -background -barcolor barColor BarColor - rename -height -barheight barHeight Height - } - pack $itk_component(bar) -side left -fill y -anchor w - - itk_component add percentage { - label $itk_interior.percentage -text "0%" - } - grid $itk_component(trough) -row 1 -column 0 -sticky sew -padx 2 -pady 2 - grid $itk_component(percentage) -row 2 -column 0 -sticky nsew -padx 2 -pady 2 - grid rowconfigure $itk_interior 0 -weight 1 - 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 -# ------------------------------------------------------------------ -itcl::body iwidgets::Feedback::destructor {} { -} - -# ------------------------------------------------------------------ -# OPTIONS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# OPTION: -steps -# -# Set the total number of steps. -# ------------------------------------------------------------------ -itcl::configbody iwidgets::Feedback::steps { - step 0 -} - -# ------------------------------------------------------------------ -# METHODS -# ------------------------------------------------------------------ - -# ----------------------------------------------------------------------------- -# PROTECTED METHOD: _display -# -# Displays the bar in the trough with the width set using the current number -# of steps. -# ----------------------------------------------------------------------------- -itcl::body iwidgets::Feedback::_display {} { - update idletasks - set troughwidth [winfo width $itk_component(trough)] - 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%" - $itk_component(bar) config -width [expr $_barwidth*$_stepval] - - update -} - -# ------------------------------------------------------------------ -# METHOD: reset -# -# Resets the status bar to 0 -# ------------------------------------------------------------------ -itcl::body iwidgets::Feedback::reset {} { - set _stepval 0 - _display -} - -# ------------------------------------------------------------------ -# METHOD: step ?inc? -# -# Increase the value of the status bar by inc. Default to 1 -# ------------------------------------------------------------------ -itcl::body iwidgets::Feedback::step {{inc 1}} { - - if {$_stepval >= $itk_option(-steps)} { - return - } - - incr _stepval $inc - _display -} diff --git a/itcl/iwidgets3.0.0/generic/fileselectionbox.itk b/itcl/iwidgets3.0.0/generic/fileselectionbox.itk deleted file mode 100644 index b164afbfd49..00000000000 --- a/itcl/iwidgets3.0.0/generic/fileselectionbox.itk +++ /dev/null @@ -1,1245 +0,0 @@ -# -# Fileselectionbox -# ---------------------------------------------------------------------- -# Implements a file selection box in a style similar to the OSF/Motif -# standard XmFileselectionbox composite widget. The Fileselectionbox -# is composed of directory and file scrolled lists as well as filter -# and selection entry fields. -# -# ---------------------------------------------------------------------- -# AUTHOR: Mark L. Ulferts EMAIL: mulferts@spd.dsccc.com -# -# @(#) $Id$ -# ---------------------------------------------------------------------- -# Copyright (c) 1997 DSC Technologies Corporation -# ====================================================================== -# Permission to use, copy, modify, distribute and license this software -# and its documentation for any purpose, and without fee or written -# agreement with DSC, is hereby granted, provided that the above copyright -# notice appears in all copies and that both the copyright notice and -# warranty disclaimer below appear in supporting documentation, and that -# the names of DSC Technologies Corporation or DSC Communications -# Corporation not be used in advertising or publicity pertaining to the -# software without specific, written prior permission. -# -# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING -# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- -# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE -# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, -# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL -# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR -# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, -# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, -# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS -# SOFTWARE. -# ====================================================================== - -# -# Usual options. -# -itk::usual Fileselectionbox { - keep -activebackground -activerelief -background -borderwidth -cursor \ - -elementborderwidth -foreground -highlightcolor -highlightthickness \ - -insertbackground -insertborderwidth -insertofftime -insertontime \ - -insertwidth -jump -labelfont -selectbackground -selectborderwidth \ - -textbackground -textfont -troughcolor -} - -# ------------------------------------------------------------------ -# FILESELECTIONBOX -# ------------------------------------------------------------------ -class iwidgets::Fileselectionbox { - inherit itk::Widget - - constructor {args} {} - destructor {} - - itk_option define -childsitepos childSitePos Position s - itk_option define -fileson filesOn FilesOn true - itk_option define -dirson dirsOn DirsOn true - itk_option define -selectionon selectionOn SelectionOn true - itk_option define -filteron filterOn FilterOn true - itk_option define -mask mask Mask {*} - itk_option define -directory directory Directory {} - itk_option define -nomatchstring noMatchString NoMatchString {} - itk_option define -dirsearchcommand dirSearchCommand Command {} - itk_option define -filesearchcommand fileSearchCommand Command {} - itk_option define -selectioncommand selectionCommand Command {} - itk_option define -filtercommand filterCommand Command {} - itk_option define -selectdircommand selectDirCommand Command {} - itk_option define -selectfilecommand selectFileCommand Command {} - itk_option define -invalid invalid Command {bell} - itk_option define -filetype fileType FileType {regular} - itk_option define -width width Width 350 - itk_option define -height height Height 300 - - public { - method childsite {} - method get {} - method filter {} - } - - public { - method _selectDir {} - method _dblSelectDir {} - method _selectFile {} - method _selectSelection {} - method _selectFilter {} - } - - protected { - method _packComponents {{when later}} - method _updateLists {{when later}} - } - - private { - method _setFilter {} - method _setSelection {} - method _setDirList {} - method _setFileList {} - - method _nPos {} - method _sPos {} - method _ePos {} - method _wPos {} - method _topPos {} - method _centerPos {} - method _bottomPos {} - - variable _packToken "" ;# non-null => _packComponents pending - variable _updateToken "" ;# non-null => _updateLists pending - variable _pwd "." ;# present working dir - variable _interior ;# original interior setting - } -} - -# -# Provide a lowercased access method for the Fileselectionbox class. -# -proc ::iwidgets::fileselectionbox {pathName args} { - uplevel ::iwidgets::Fileselectionbox $pathName $args -} - -# -# Use option database to override default resources of base classes. -# -option add *Fileselectionbox.borderWidth 2 widgetDefault - -option add *Fileselectionbox.filterLabel Filter widgetDefault -option add *Fileselectionbox.dirsLabel Directories widgetDefault -option add *Fileselectionbox.filesLabel Files widgetDefault -option add *Fileselectionbox.selectionLabel Selection widgetDefault - -option add *Fileselectionbox.width 350 widgetDefault -option add *Fileselectionbox.height 300 widgetDefault - -# ------------------------------------------------------------------ -# CONSTRUCTOR -# ------------------------------------------------------------------ -body iwidgets::Fileselectionbox::constructor {args} { - # - # Add back to the hull width and height options and make the - # borderwidth zero since we don't need it. - # - itk_option add hull.width hull.height - component hull configure -borderwidth 0 - - set _interior $itk_interior - - # - # Create the filter entry. - # - itk_component add filter { - iwidgets::Entryfield $itk_interior.filter -labelpos nw \ - -command [code $this _selectFilter] -exportselection 0 - } { - usual - - rename -labeltext -filterlabel filterLabel Text - } - - # - # Create the directory list. - # - itk_component add dirs { - iwidgets::Scrolledlistbox $itk_interior.dirs \ - -selectioncommand [code $this _selectDir] \ - -selectmode single -exportselection 0 \ - -visibleitems 1x1 -labelpos nw \ - -hscrollmode static -vscrollmode static \ - -dblclickcommand [code $this _dblSelectDir] - } { - usual - - rename -labeltext -dirslabel dirsLabel Text - } - - # - # Create the files list. - # - itk_component add files { - iwidgets::Scrolledlistbox $itk_interior.files \ - -selectioncommand [code $this _selectFile] \ - -selectmode single -exportselection 0 \ - -visibleitems 1x1 -labelpos nw \ - -hscrollmode static -vscrollmode static - } { - usual - - rename -labeltext -fileslabel filesLabel Text - } - - # - # Create the selection entry. - # - itk_component add selection { - iwidgets::Entryfield $itk_interior.selection -labelpos nw \ - -command [code $this _selectSelection] -exportselection 0 - } { - usual - - rename -labeltext -selectionlabel selectionLabel Text - } - - # - # Create the child site widget. - # - itk_component add -protected childsite { - frame $itk_interior.fsbchildsite - } - - # - # Set the interior variable to the childsite for derived classes. - # - set itk_interior $itk_component(childsite) - - # - # Explicitly handle configs that may have been ignored earlier. - # - eval itk_initialize $args - - # - # When idle, pack the childsite and update the lists. - # - _packComponents - _updateLists -} - -# ------------------------------------------------------------------ -# DESTRUCTOR -# ------------------------------------------------------------------ -body iwidgets::Fileselectionbox::destructor {} { - if {$_packToken != ""} {after cancel $_packToken} - if {$_updateToken != ""} {after cancel $_updateToken} -} - -# ------------------------------------------------------------------ -# OPTIONS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# OPTION: -childsitepos -# -# Specifies the position of the child site in the selection box. -# ------------------------------------------------------------------ -configbody iwidgets::Fileselectionbox::childsitepos { - _packComponents -} - -# ------------------------------------------------------------------ -# OPTION: -fileson -# -# Specifies whether or not to display the files list. -# ------------------------------------------------------------------ -configbody iwidgets::Fileselectionbox::fileson { - _packComponents -} - -# ------------------------------------------------------------------ -# OPTION: -dirson -# -# Specifies whether or not to display the dirs list. -# ------------------------------------------------------------------ -configbody iwidgets::Fileselectionbox::dirson { - _packComponents -} - -# ------------------------------------------------------------------ -# OPTION: -selectionon -# -# Specifies whether or not to display the selection entry widget. -# ------------------------------------------------------------------ -configbody iwidgets::Fileselectionbox::selectionon { - _packComponents -} - -# ------------------------------------------------------------------ -# OPTION: -filteron -# -# Specifies whether or not to display the filter entry widget. -# ------------------------------------------------------------------ -configbody iwidgets::Fileselectionbox::filteron { - _packComponents -} - -# ------------------------------------------------------------------ -# OPTION: -mask -# -# Specifies the initial file mask string. -# ------------------------------------------------------------------ -configbody iwidgets::Fileselectionbox::mask { - global tcl_platform - set prefix $_pwd - - # - # Remove automounter paths. - # - if {$tcl_platform(platform) == "unix"} { - regsub {^/(tmp_mnt|export)} $prefix {} prefix; - } - - set curFilter $itk_option(-mask); - $itk_component(filter) delete 0 end - $itk_component(filter) insert 0 [file join $_pwd $itk_option(-mask)] - - # - # Make sure the right most text is visable. - # - $itk_component(filter) xview moveto 1 -} - -# ------------------------------------------------------------------ -# OPTION: -directory -# -# Specifies the initial default directory. -# ------------------------------------------------------------------ -configbody iwidgets::Fileselectionbox::directory { - if {$itk_option(-directory) != {}} { - if {! [file exists $itk_option(-directory)]} { - error "bad directory option \"$itk_option(-directory)\":\ - directory does not exist" - } - - set olddir [pwd] - cd $itk_option(-directory) - set _pwd [pwd] - cd $olddir - - configure -mask $itk_option(-mask) - _selectFilter - } -} - -# ------------------------------------------------------------------ -# OPTION: -nomatchstring -# -# Specifies the string to be displayed in the files list should -# not regular files exist in the directory. -# ------------------------------------------------------------------ -configbody iwidgets::Fileselectionbox::nomatchstring { -} - -# ------------------------------------------------------------------ -# OPTION: -dirsearchcommand -# -# Specifies a command to be executed to perform a directory search. -# The command will receive the current working directory and filter -# mask as arguments. The command should return a list of files which -# will be placed into the directory list. -# ------------------------------------------------------------------ -configbody iwidgets::Fileselectionbox::dirsearchcommand { -} - -# ------------------------------------------------------------------ -# OPTION: -filesearchcommand -# -# Specifies a command to be executed to perform a file search. -# The command will receive the current working directory and filter -# mask as arguments. The command should return a list of files which -# will be placed into the file list. -# ------------------------------------------------------------------ -configbody iwidgets::Fileselectionbox::filesearchcommand { -} - -# ------------------------------------------------------------------ -# OPTION: -selectioncommand -# -# Specifies a command to be executed upon pressing return in the -# selection entry widget. -# ------------------------------------------------------------------ -configbody iwidgets::Fileselectionbox::selectioncommand { -} - -# ------------------------------------------------------------------ -# OPTION: -filtercommand -# -# Specifies a command to be executed upon pressing return in the -# filter entry widget. -# ------------------------------------------------------------------ -configbody iwidgets::Fileselectionbox::filtercommand { -} - -# ------------------------------------------------------------------ -# OPTION: -selectdircommand -# -# Specifies a command to be executed following selection of a -# directory in the directory list. -# ------------------------------------------------------------------ -configbody iwidgets::Fileselectionbox::selectdircommand { -} - -# ------------------------------------------------------------------ -# OPTION: -selectfilecommand -# -# Specifies a command to be executed following selection of a -# file in the files list. -# ------------------------------------------------------------------ -configbody iwidgets::Fileselectionbox::selectfilecommand { -} - -# ------------------------------------------------------------------ -# OPTION: -invalid -# -# Specify a command to executed should the filter contents be -# proven invalid. -# ------------------------------------------------------------------ -configbody iwidgets::Fileselectionbox::invalid { -} - -# ------------------------------------------------------------------ -# OPTION: -filetype -# -# Specify the type of files which may appear in the file list. -# ------------------------------------------------------------------ -configbody iwidgets::Fileselectionbox::filetype { - switch $itk_option(-filetype) { - regular - - directory - - any { - } - default { - error "bad filetype option \"$itk_option(-filetype)\":\ - should be regular, directory, or any" - } - } - - _updateLists -} - -# ------------------------------------------------------------------ -# OPTION: -width -# -# Specifies the width of the file selection box. The value may be -# specified in any of the forms acceptable to Tk_GetPixels. -# ------------------------------------------------------------------ -configbody iwidgets::Fileselectionbox::width { - # - # The width option was added to the hull in the constructor. - # So, any width value given is passed automatically to the - # hull. All we have to do is play with the propagation. - # - if {$itk_option(-width) != 0} { - set propagate 0 - } else { - set propagate 1 - } - - # - # Due to a bug in the tk4.2 grid, we have to check the - # propagation before setting it. Setting it to the same - # value it already is will cause it to toggle. - # - if {[grid propagate $itk_component(hull)] != $propagate} { - grid propagate $itk_component(hull) $propagate - } -} - -# ------------------------------------------------------------------ -# OPTION: -height -# -# Specifies the height of the file selection box. The value may be -# specified in any of the forms acceptable to Tk_GetPixels. -# ------------------------------------------------------------------ -configbody iwidgets::Fileselectionbox::height { - # - # The height option was added to the hull in the constructor. - # So, any height value given is passed automatically to the - # hull. All we have to do is play with the propagation. - # - if {$itk_option(-height) != 0} { - set propagate 0 - } else { - set propagate 1 - } - - # - # Due to a bug in the tk4.2 grid, we have to check the - # propagation before setting it. Setting it to the same - # value it already is will cause it to toggle. - # - if {[grid propagate $itk_component(hull)] != $propagate} { - grid propagate $itk_component(hull) $propagate - } -} - -# ------------------------------------------------------------------ -# METHODS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# METHOD: childsite -# -# Returns the path name of the child site widget. -# ------------------------------------------------------------------ -body iwidgets::Fileselectionbox::childsite {} { - return $itk_component(childsite) -} - -# ------------------------------------------------------------------ -# METHOD: get -# -# Returns the current selection. -# ------------------------------------------------------------------ -body iwidgets::Fileselectionbox::get {} { - return [$itk_component(selection) get] -} - -# ------------------------------------------------------------------ -# METHOD: filter -# -# The user has pressed Return in the filter. Make sure the contents -# contain a valid directory before setting default to directory. -# Use the invalid option to warn the user of any problems. -# ------------------------------------------------------------------ -body iwidgets::Fileselectionbox::filter {} { - set newdir [file dirname [$itk_component(filter) get]] - - if {! [file exists $newdir]} { - uplevel #0 "$itk_option(-invalid)" - return - } - - set _pwd $newdir; - if {$_pwd == "."} {set _pwd [pwd]}; - - _updateLists -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _updateLists ?now? -# -# Updates the contents of both the file and directory lists, as well -# resets the positions of the filter, and lists. -# ------------------------------------------------------------------ -body iwidgets::Fileselectionbox::_updateLists {{when "later"}} { - switch -- $when { - later { - if {$_updateToken == ""} { - set _updateToken [after idle [code $this _updateLists now]] - } - } - now { - if {$itk_option(-dirson)} {_setDirList} - if {$itk_option(-fileson)} {_setFileList} - - if {$itk_option(-filteron)} { - _setFilter - } - if {$itk_option(-selectionon)} { - $itk_component(selection) icursor end - } - if {$itk_option(-dirson)} { - $itk_component(dirs) justify left - } - if {$itk_option(-fileson)} { - $itk_component(files) justify left - } - set _updateToken "" - } - default { - error "bad option \"$when\": should be later or now" - } - } -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _setFilter -# -# Set the filter to the current selection in the directory list plus -# any existing mask in the filter. Translate the two special cases -# of '.', and '..' directory names to full path names.. -# ------------------------------------------------------------------ -body iwidgets::Fileselectionbox::_setFilter {} { - global tcl_platform - set prefix [$itk_component(dirs) getcurselection] - set curFilter [file tail [$itk_component(filter) get]] - - while {[regexp {\.$} $prefix]} { - if {[file tail $prefix] == "."} { - if {$prefix == "."} { - if {$_pwd == "."} { - set _pwd [pwd] - } elseif {$_pwd == ".."} { - set _pwd [file dirname [pwd]] - } - set prefix $_pwd - } else { - set prefix [file dirname $prefix] - } - } elseif {[file tail $prefix] == ".."} { - if {$prefix != ".."} { - set prefix [file dirname [file dirname $prefix]] - } else { - if {$_pwd == "."} { - set _pwd [pwd] - } elseif {$_pwd == ".."} { - set _pwd [file dirname [pwd]] - } - set prefix [file dirname $_pwd] - } - } else { - break - } - } - - if { [file pathtype $prefix] != "absolute" } { - set prefix [file join $_pwd $prefix] - } - - # - # Remove automounter paths. - # - if {$tcl_platform(platform) == "unix"} { - regsub {^/(tmp_mnt|export)} $prefix {} prefix - } - - $itk_component(filter) delete 0 end - $itk_component(filter) insert 0 [file join $prefix $curFilter] - - # - # Make sure insertion cursor is at the end. - # - $itk_component(filter) icursor end - - # - # Make sure the right most text is visable. - # - $itk_component(filter) xview moveto 1 -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _setSelection -# -# Set the contents of the selection entry to either the current -# selection of the file or directory list dependent on which lists -# are currently mapped. For the file list, avoid seleciton of the -# no match string. As for the directory list, translate file names. -# ------------------------------------------------------------------ -body iwidgets::Fileselectionbox::_setSelection {} { - global tcl_platform - $itk_component(selection) delete 0 end - - if {$itk_option(-fileson)} { - set selection [$itk_component(files) getcurselection] - - if {$selection != $itk_option(-nomatchstring)} { - if {[file pathtype $selection] != "absolute"} { - set selection [file join $_pwd $selection] - } - - # - # Remove automounter paths. - # - if {$tcl_platform(platform) == "unix"} { - regsub {^/(tmp_mnt|export)} $selection {} selection; - } - - $itk_component(selection) insert 0 $selection - } else { - $itk_component(files) selection clear 0 end - } - - } else { - set selection [$itk_component(dirs) getcurselection] - - if {[file tail $selection] == "."} { - if {$selection != "."} { - set selection [file dirname $selection] - } else { - set selection $_pwd - } - } elseif {[file tail $selection] == ".."} { - if {$selection != ".."} { - set selection [file dirname [file dirname $selection]] - } else { - set selection [file join $_pwd ..] - } - } else { - set selection [file join $_pwd $selection] - } - - # - # Remove automounter paths. - # - if {$tcl_platform(platform) == "unix"} { - regsub {^/(tmp_mnt|export)} $selection {} selection; - } - - $itk_component(selection) delete 0 end - $itk_component(selection) insert 0 $selection - } - - $itk_component(selection) icursor end - - # - # Make sure the right most text is visable. - # - $itk_component(selection) xview moveto 1 -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _setDirList -# -# Clear the directory list and dependent on whether the user has -# defined their own search procedure or not fill the list with their -# results or those of a glob. Select the first element if it exists. -# ------------------------------------------------------------------ -body iwidgets::Fileselectionbox::_setDirList {} { - $itk_component(dirs) clear - - if {$itk_option(-dirsearchcommand) == {}} { - foreach i [lsort [glob -nocomplain \ - [file join $_pwd .*] [file join $_pwd *]]] { - if {[file isdirectory $i]} { - $itk_component(dirs) insert end [file tail "$i"] - } - } - - } else { - set mask [file tail [$itk_component(filter) get]] - - foreach file [uplevel #0 $itk_option(-dirsearchcommand) $_pwd $mask] { - $itk_component(dirs) insert end $file - } - } - - if {[$itk_component(dirs) size]} { - $itk_component(dirs) selection clear 0 end - $itk_component(dirs) selection set 0 - } -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _setFileList -# -# Clear the file list and dependent on whether the user has defined -# their own search procedure or not fill the list with their results -# or those of a 'glob'. If the files list has no contents, then set -# the files list to the 'nomatchstring'. Clear all selections. -# ------------------------------------------------------------------ -body iwidgets::Fileselectionbox::_setFileList {} { - $itk_component(files) clear - set mask [file tail [$itk_component(filter) get]] - - if {$itk_option(-filesearchcommand) == {}} { - if {$mask == "*"} { - set files [lsort [glob -nocomplain \ - [file join $_pwd .*] [file join $_pwd *]]] - } else { - set files [lsort [glob -nocomplain [file join $_pwd $mask]]] - } - - foreach i $files { - if {($itk_option(-filetype) == "regular" && \ - ! [file isdirectory $i]) || \ - ($itk_option(-filetype) == "directory" && \ - [file isdirectory $i]) || \ - ($itk_option(-filetype) == "any")} { - $itk_component(files) insert end [file tail "$i"] - } - } - - } else { - foreach file [uplevel #0 $itk_option(-filesearchcommand) $_pwd $mask] { - $itk_component(files) insert end $file - } - } - - if {[$itk_component(files) size] == 0} { - if {$itk_option(-nomatchstring) != {}} { - $itk_component(files) insert end $itk_option(-nomatchstring) - } - } - - $itk_component(files) selection clear 0 end -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _selectDir -# -# For a selection in the directory list, set the filter and possibly -# the selection entry based on the fileson option. -# ------------------------------------------------------------------ -body iwidgets::Fileselectionbox::_selectDir {} { - _setFilter - - if {$itk_option(-fileson)} {} { - _setSelection - } - - if {$itk_option(-selectdircommand) != {}} { - uplevel #0 $itk_option(-selectdircommand) - } -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _dblSelectDir -# -# For a double click event in the directory list, select the -# directory, set the default to the selection, and update both the -# file and directory lists. -# ------------------------------------------------------------------ -body iwidgets::Fileselectionbox::_dblSelectDir {} { - filter -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _selectFile -# -# The user has selected a file. Put the current selection in the -# file list in the selection entry widget. -# ------------------------------------------------------------------ -body iwidgets::Fileselectionbox::_selectFile {} { - _setSelection - - if {$itk_option(-selectfilecommand) != {}} { - uplevel #0 $itk_option(-selectfilecommand) - } -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _selectSelection -# -# The user has pressed Return in the selection entry widget. Call -# the defined selection command if it exists. -# ------------------------------------------------------------------ -body iwidgets::Fileselectionbox::_selectSelection {} { - if {$itk_option(-selectioncommand) != {}} { - uplevel #0 $itk_option(-selectioncommand) - } -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _selectFilter -# -# The user has pressed Return in the filter entry widget. Call the -# defined selection command if it exists, otherwise just filter. -# ------------------------------------------------------------------ -body iwidgets::Fileselectionbox::_selectFilter {} { - if {$itk_option(-filtercommand) != {}} { - uplevel #0 $itk_option(-filtercommand) - } else { - filter - } -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _packComponents -# -# Pack the selection, items, and child site widgets based on options. -# Using the -in option of pack, put the childsite around the frame -# in the hull for n, s, e, and w positions. Make sure and raise -# the child site since using the 'in' option may obscure the site. -# ------------------------------------------------------------------ -body iwidgets::Fileselectionbox::_packComponents {{when "later"}} { - if {$when == "later"} { - if {$_packToken == ""} { - set _packToken [after idle [code $this _packComponents now]] - } - return - } elseif {$when != "now"} { - error "bad option \"$when\": should be now or later" - } - - set _packToken "" - - # - # Forget about any previous placements via the grid and - # reset all the possible minsizes and weights for all - # the rows and columns. - # - foreach component {childsite filter dirs files selection} { - grid forget $itk_component($component) - } - - for {set row 0} {$row < 6} {incr row} { - grid rowconfigure $_interior $row -minsize 0 -weight 0 - } - - for {set col 0} {$col < 4} {incr col} { - grid columnconfigure $_interior $col -minsize 0 -weight 0 - } - - # - # Place all the components based on the childsite poisition - # option. - # - switch $itk_option(-childsitepos) { - n { _nPos } - - w { _wPos } - - s { _sPos } - - e { _ePos } - - center { _centerPos } - - top { _topPos } - - bottom { _bottomPos } - - default { - error "bad childsitepos option \"$itk_option(-childsitepos)\":\ - should be n, e, s, w, center, top, or bottom" - } - } -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _nPos -# -# Position the childsite to the north and all the other components -# appropriately based on the individual "on" options. -# ------------------------------------------------------------------ -body iwidgets::Fileselectionbox::_nPos {} { - grid $itk_component(childsite) -row 0 -column 0 \ - -columnspan 3 -rowspan 1 -sticky nsew - - if {$itk_option(-filteron)} { - grid $itk_component(filter) -row 1 -column 0 \ - -columnspan 3 -sticky ew - grid rowconfigure $_interior 2 -minsize 7 - } - - if {$itk_option(-dirson)} { - grid $itk_component(dirs) -row 3 -column 0 \ - -columnspan 1 -sticky nsew - } - if {$itk_option(-fileson)} { - grid $itk_component(files) -row 3 -column 2 \ - -columnspan 1 -sticky nsew - } - if {$itk_option(-dirson)} { - if {$itk_option(-fileson)} { - grid columnconfigure $_interior 1 -minsize 7 - } else { - grid configure $itk_component(dirs) -columnspan 3 -column 0 - } - } else { - if {$itk_option(-fileson)} { - grid configure $itk_component(files) -columnspan 3 -column 0 - } - } - - grid rowconfigure $_interior 3 -weight 1 - - if {$itk_option(-selectionon)} { - grid rowconfigure $_interior 4 -minsize 7 - grid $itk_component(selection) -row 5 -column 0 \ - -columnspan 3 -sticky ew - } - - grid columnconfigure $_interior 0 -weight 1 - grid columnconfigure $_interior 2 -weight 1 -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _sPos -# -# Position the childsite to the south and all the other components -# appropriately based on the individual "on" options. -# ------------------------------------------------------------------ -body iwidgets::Fileselectionbox::_sPos {} { - if {$itk_option(-filteron)} { - grid $itk_component(filter) -row 0 -column 0 \ - -columnspan 3 -sticky ew - grid rowconfigure $_interior 1 -minsize 7 - } - - if {$itk_option(-dirson)} { - grid $itk_component(dirs) -row 2 -column 0 \ - -columnspan 1 -sticky nsew - } - if {$itk_option(-fileson)} { - grid $itk_component(files) -row 2 -column 2 \ - -columnspan 1 -sticky nsew - } - if {$itk_option(-dirson)} { - if {$itk_option(-fileson)} { - grid columnconfigure $_interior 1 -minsize 7 - } else { - grid configure $itk_component(dirs) -columnspan 3 -column 0 - } - } else { - if {$itk_option(-fileson)} { - grid configure $itk_component(files) -columnspan 3 -column 0 - } - } - - grid rowconfigure $_interior 2 -weight 1 - - if {$itk_option(-selectionon)} { - grid rowconfigure $_interior 3 -minsize 7 - grid $itk_component(selection) -row 4 -column 0 \ - -columnspan 3 -sticky ew - } - - grid $itk_component(childsite) -row 5 -column 0 \ - -columnspan 3 -rowspan 1 -sticky nsew - grid columnconfigure $_interior 0 -weight 1 - grid columnconfigure $_interior 2 -weight 1 -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _ePos -# -# Position the childsite to the east and all the other components -# appropriately based on the individual "on" options. -# ------------------------------------------------------------------ -body iwidgets::Fileselectionbox::_ePos {} { - if {$itk_option(-filteron)} { - grid $itk_component(filter) -row 0 -column 0 \ - -columnspan 3 -sticky ew - grid rowconfigure $_interior 1 -minsize 7 - } - - if {$itk_option(-dirson)} { - grid $itk_component(dirs) -row 2 -column 0 \ - -columnspan 1 -sticky nsew - } - if {$itk_option(-fileson)} { - grid $itk_component(files) -row 2 -column 2 \ - -columnspan 1 -sticky nsew - } - if {$itk_option(-dirson)} { - if {$itk_option(-fileson)} { - grid columnconfigure $_interior 1 -minsize 7 - } else { - grid configure $itk_component(dirs) -columnspan 3 -column 0 - } - } else { - if {$itk_option(-fileson)} { - grid configure $itk_component(files) -columnspan 3 -column 0 - } - } - - grid rowconfigure $_interior 2 -weight 1 - - if {$itk_option(-selectionon)} { - grid rowconfigure $_interior 3 -minsize 7 - grid $itk_component(selection) -row 4 -column 0 \ - -columnspan 3 -sticky ew - } - - grid $itk_component(childsite) -row 0 -column 3 \ - -rowspan 5 -columnspan 1 -sticky nsew - grid columnconfigure $_interior 0 -weight 1 - grid columnconfigure $_interior 2 -weight 1 -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _wPos -# -# Position the childsite to the west and all the other components -# appropriately based on the individual "on" options. -# ------------------------------------------------------------------ -body iwidgets::Fileselectionbox::_wPos {} { - grid $itk_component(childsite) -row 0 -column 0 \ - -rowspan 5 -columnspan 1 -sticky nsew - - if {$itk_option(-filteron)} { - grid $itk_component(filter) -row 0 -column 1 \ - -columnspan 3 -sticky ew - grid rowconfigure $_interior 1 -minsize 7 - } - - if {$itk_option(-dirson)} { - grid $itk_component(dirs) -row 2 -column 1 \ - -columnspan 1 -sticky nsew - } - if {$itk_option(-fileson)} { - grid $itk_component(files) -row 2 -column 3 \ - -columnspan 1 -sticky nsew - } - if {$itk_option(-dirson)} { - if {$itk_option(-fileson)} { - grid columnconfigure $_interior 2 -minsize 7 - } else { - grid configure $itk_component(dirs) -columnspan 3 -column 1 - } - } else { - if {$itk_option(-fileson)} { - grid configure $itk_component(files) -columnspan 3 -column 1 - } - } - - grid rowconfigure $_interior 2 -weight 1 - - if {$itk_option(-selectionon)} { - grid rowconfigure $_interior 3 -minsize 7 - grid $itk_component(selection) -row 4 -column 1 \ - -columnspan 3 -sticky ew - } - - grid columnconfigure $_interior 1 -weight 1 - grid columnconfigure $_interior 3 -weight 1 -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _topPos -# -# Position the childsite below the filter but above the lists and -# all the other components appropriately based on the individual -# "on" options. -# ------------------------------------------------------------------ -body iwidgets::Fileselectionbox::_topPos {} { - if {$itk_option(-filteron)} { - grid $itk_component(filter) -row 0 -column 0 \ - -columnspan 3 -sticky ew - } - - grid $itk_component(childsite) -row 1 -column 0 \ - -columnspan 3 -rowspan 1 -sticky nsew - - if {$itk_option(-dirson)} { - grid $itk_component(dirs) -row 2 -column 0 -sticky nsew - } - if {$itk_option(-fileson)} { - grid $itk_component(files) -row 2 -column 2 -sticky nsew - } - if {$itk_option(-dirson)} { - if {$itk_option(-fileson)} { - grid columnconfigure $_interior 1 -minsize 7 - } else { - grid configure $itk_component(dirs) -columnspan 3 -column 0 - } - } else { - if {$itk_option(-fileson)} { - grid configure $itk_component(files) -columnspan 3 -column 0 - } - } - - grid rowconfigure $_interior 2 -weight 1 - - if {$itk_option(-selectionon)} { - grid rowconfigure $_interior 3 -minsize 7 - grid $itk_component(selection) -row 4 -column 0 \ - -columnspan 3 -sticky ew - } - - grid columnconfigure $_interior 0 -weight 1 - grid columnconfigure $_interior 2 -weight 1 -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _centerPos -# -# Position the childsite between the lists and all the other -# components appropriately based on the individual "on" options. -# ------------------------------------------------------------------ -body iwidgets::Fileselectionbox::_centerPos {} { - if {$itk_option(-filteron)} { - grid $itk_component(filter) -row 0 -column 0 \ - -columnspan 3 -sticky ew - grid rowconfigure $_interior 1 -minsize 7 - } - - if {$itk_option(-dirson)} { - grid $itk_component(dirs) -row 2 -column 0 \ - -columnspan 1 -sticky nsew - } - if {$itk_option(-fileson)} { - grid $itk_component(files) -row 2 -column 2 \ - -columnspan 1 -sticky nsew - } - grid $itk_component(childsite) -row 2 \ - -columnspan 1 -rowspan 1 -sticky nsew - - if {$itk_option(-dirson)} { - if {$itk_option(-fileson)} { - grid configure $itk_component(childsite) -column 1 - grid columnconfigure $_interior 0 -weight 1 - grid columnconfigure $_interior 2 -weight 1 - - } else { - grid configure $itk_component(dirs) -columnspan 2 -column 0 - grid configure $itk_component(childsite) -column 2 - grid columnconfigure $_interior 0 -weight 1 - grid columnconfigure $_interior 1 -weight 1 - } - } else { - grid configure $itk_component(childsite) -column 0 - if {$itk_option(-fileson)} { - grid configure $itk_component(files) -columnspan 2 \ - -column 1 - grid columnconfigure $_interior 1 -weight 1 - grid columnconfigure $_interior 2 -weight 1 - } else { - grid columnconfigure $_interior 0 -weight 1 - } - } - - grid rowconfigure $_interior 2 -weight 1 - - if {$itk_option(-selectionon)} { - grid rowconfigure $_interior 3 -minsize 7 - grid $itk_component(selection) -row 4 -column 0 \ - -columnspan 3 -sticky ew - } -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _bottomPos -# -# Position the childsite below the lists and above the selection -# and all the other components appropriately based on the individual -# "on" options. -# ------------------------------------------------------------------ -body iwidgets::Fileselectionbox::_bottomPos {} { - if {$itk_option(-filteron)} { - grid $itk_component(filter) -row 0 -column 0 \ - -columnspan 3 -sticky ew - grid rowconfigure $_interior 1 -minsize 7 - } - - if {$itk_option(-dirson)} { - grid $itk_component(dirs) -row 2 -column 0 -sticky nsew - } - if {$itk_option(-fileson)} { - grid $itk_component(files) -row 2 -column 2 -sticky nsew - } - if {$itk_option(-dirson)} { - if {$itk_option(-fileson)} { - grid columnconfigure $_interior 1 -minsize 7 - } else { - grid configure $itk_component(dirs) -columnspan 3 -column 0 - } - } else { - if {$itk_option(-fileson)} { - grid configure $itk_component(files) -columnspan 3 -column 0 - } - } - grid rowconfigure $_interior 2 -weight 1 - - grid $itk_component(childsite) -row 3 -column 0 \ - -columnspan 3 -rowspan 1 -sticky nsew - - if {$itk_option(-selectionon)} { - grid $itk_component(selection) -row 4 -column 0 \ - -columnspan 3 -sticky ew - } - - grid columnconfigure $_interior 0 -weight 1 - grid columnconfigure $_interior 2 -weight 1 -} diff --git a/itcl/iwidgets3.0.0/generic/fileselectiondialog.itk b/itcl/iwidgets3.0.0/generic/fileselectiondialog.itk deleted file mode 100644 index 0889e4a6c5c..00000000000 --- a/itcl/iwidgets3.0.0/generic/fileselectiondialog.itk +++ /dev/null @@ -1,181 +0,0 @@ -# -# Fileselectiondialog -# ---------------------------------------------------------------------- -# Implements a file selection box similar to the OSF/Motif standard -# file selection dialog composite widget. The Fileselectiondialog is -# derived from the Dialog class and is composed of a FileSelectionBox -# with attributes set to manipulate the dialog buttons. -# -# ---------------------------------------------------------------------- -# AUTHOR: Mark L. Ulferts EMAIL: mulferts@spd.dsccc.com -# -# @(#) $Id$ -# ---------------------------------------------------------------------- -# Copyright (c) 1995 DSC Technologies Corporation -# ====================================================================== -# Permission to use, copy, modify, distribute and license this software -# and its documentation for any purpose, and without fee or written -# agreement with DSC, is hereby granted, provided that the above copyright -# notice appears in all copies and that both the copyright notice and -# warranty disclaimer below appear in supporting documentation, and that -# the names of DSC Technologies Corporation or DSC Communications -# Corporation not be used in advertising or publicity pertaining to the -# software without specific, written prior permission. -# -# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING -# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- -# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE -# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, -# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL -# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR -# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, -# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, -# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS -# SOFTWARE. -# ====================================================================== - -# -# Usual options. -# -itk::usual Fileselectiondialog { - keep -activebackground -activerelief -background -borderwidth -cursor \ - -elementborderwidth -foreground -highlightcolor -highlightthickness \ - -insertbackground -insertborderwidth -insertofftime -insertontime \ - -insertwidth -jump -labelfont -modality -selectbackground \ - -selectborderwidth -textbackground -textfont -} - -# ------------------------------------------------------------------ -# FILESELECTIONDIALOG -# ------------------------------------------------------------------ -class iwidgets::Fileselectiondialog { - inherit iwidgets::Dialog - - constructor {args} {} - - public { - method childsite {} - method get {} - method filter {} - } - - protected method _dbldir {} -} - -# -# Provide a lowercased access method for the Fileselectiondialog class. -# -proc ::iwidgets::fileselectiondialog {pathName args} { - uplevel ::iwidgets::Fileselectiondialog $pathName $args -} - -# -# Use option database to override default resources of base classes. -# -option add *Fileselectiondialog.borderWidth 2 widgetDefault - -option add *Fileselectiondialog.title "File Selection Dialog" widgetDefault - -option add *Fileselectiondialog.width 350 widgetDefault -option add *Fileselectiondialog.height 400 widgetDefault - -option add *Fileselectiondialog.master "." widgetDefault - -# ------------------------------------------------------------------ -# CONSTRUCTOR -# ------------------------------------------------------------------ -body iwidgets::Fileselectiondialog::constructor {args} { - component hull configure -borderwidth 0 - itk_option add hull.width hull.height - - # - # Turn off pack propagation for the hull widget so the width - # and height options become active. - # - pack propagate $itk_component(hull) no - - # - # Instantiate a file selection box widget. - # - itk_component add fsb { - iwidgets::Fileselectionbox $itk_interior.fsb -width 150 -height 150 \ - -selectioncommand [code $this invoke] \ - -selectdircommand [code $this default Apply] \ - -selectfilecommand [code $this default OK] - } { - usual - - keep -labelfont -childsitepos -directory -dirslabel \ - -dirsearchcommand -dirson -fileslabel -fileson \ - -filesearchcommand -filterlabel -filteron \ - -filetype -invalid -mask -nomatchstring \ - -selectionlabel -selectionon - } - grid $itk_component(fsb) -sticky nsew - grid rowconfigure $itk_interior 0 -weight 1 - grid columnconfigure $itk_interior 0 -weight 1 - - $itk_component(fsb) component filter configure \ - -focuscommand [code $this default Apply] - $itk_component(fsb) component selection configure \ - -focuscommand [code $this default OK] - $itk_component(fsb) component dirs configure \ - -dblclickcommand [code $this _dbldir] - $itk_component(fsb) component files configure \ - -dblclickcommand [code $this invoke] - - buttonconfigure Apply -text "Filter" \ - -command [code $itk_component(fsb) filter] - - set itk_interior [$itk_component(fsb) childsite] - - hide Help - - eval itk_initialize $args -} - -# ------------------------------------------------------------------ -# METHODS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# METHOD: childsite -# -# Thinwrapped method of file selection box class. -# ------------------------------------------------------------------ -body iwidgets::Fileselectiondialog::childsite {} { - return [$itk_component(fsb) childsite] -} - -# ------------------------------------------------------------------ -# METHOD: get -# -# Thinwrapped method of file selection box class. -# ------------------------------------------------------------------ -body iwidgets::Fileselectiondialog::get {} { - return [$itk_component(fsb) get] -} - -# ------------------------------------------------------------------ -# METHOD: filter -# -# Thinwrapped method of file selection box class. -# ------------------------------------------------------------------ -body iwidgets::Fileselectiondialog::filter {} { - return [$itk_component(fsb) filter] -} - -# ------------------------------------------------------------------ -# PROTECTED METHOD: _dbldir -# -# Double select in directory list. If the files list is on then -# make the default button the filter and invoke. If not, just invoke. -# ------------------------------------------------------------------ -body iwidgets::Fileselectiondialog::_dbldir {} { - if {$itk_option(-fileson)} { - default Apply - } - - invoke -} - diff --git a/itcl/iwidgets3.0.0/generic/finddialog.itk b/itcl/iwidgets3.0.0/generic/finddialog.itk deleted file mode 100755 index 894d0db4fff..00000000000 --- a/itcl/iwidgets3.0.0/generic/finddialog.itk +++ /dev/null @@ -1,488 +0,0 @@ -# -# Finddialog -# ---------------------------------------------------------------------- -# This class implements a dialog for searching text. It prompts the -# user for a search string and the method of searching which includes -# case sensitive, regular expressions, backwards, and all. -# -# ---------------------------------------------------------------------- -# AUTHOR: Mark L. Ulferts EMAIL: mulferts@austin.dsccc.com -# -# @(#) RCS: $Id$ -# ---------------------------------------------------------------------- -# Copyright (c) 1996 DSC Technologies Corporation -# ====================================================================== -# Permission to use, copy, modify, distribute and license this software -# and its documentation for any purpose, and without fee or written -# agreement with DSC, is hereby granted, provided that the above copyright -# notice appears in all copies and that both the copyright notice and -# warranty disclaimer below appear in supporting documentation, and that -# the names of DSC Technologies Corporation or DSC Communications -# Corporation not be used in advertising or publicity pertaining to the -# software without specific, written prior permission. -# -# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING -# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- -# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE -# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, -# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL -# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR -# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, -# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, -# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS -# SOFTWARE. -# ====================================================================== - -# -# Usual options. -# -itk::usual Finddialog { - keep -background -cursor -foreground -selectcolor -} - -# ------------------------------------------------------------------ -# IPRFINDDIALOG -# ------------------------------------------------------------------ -class ::iwidgets::Finddialog { - inherit iwidgets::Dialogshell - - constructor {args} {} - - itk_option define -selectcolor selectColor Background {} - itk_option define -clearcommand clearCommand Command {} - itk_option define -matchcommand matchCommand Command {} - itk_option define -patternbackground patternBackground Background \#707070 - itk_option define -patternforeground patternForeground Foreground White - itk_option define -searchbackground searchBackground Background \#c4c4c4 - itk_option define -searchforeground searchForeground Foreground Black - itk_option define -textwidget textWidget TextWidget {} - - public { - method clear {} - method find {} - } - - protected { - method _get {setting} - method _textExists {} - - common _optionValues ;# Current settings of check buttons. - common _searchPoint ;# Starting location for searches - common _matchLen ;# Matching pattern string length - } -} - -# -# Provide a lowercased access method for the ::finddialog class. -# -proc ::iwidgets::finddialog {pathName args} { - uplevel ::iwidgets::Finddialog $pathName $args -} - -# -# Use option database to override default resources of base classes. -# -option add *Finddialog.title "Find" widgetDefault - -# ------------------------------------------------------------------ -# CONSTRUCTOR -# ------------------------------------------------------------------ -body ::iwidgets::Finddialog::constructor {args} { - # - # Add the find pattern entryfield. - # - itk_component add pattern { - iwidgets::Entryfield $itk_interior.pattern -labeltext "Find:" - } - bind [$itk_component(pattern) component entry] \ - <Return> "[code $this invoke]; break" - - # - # Add the find all checkbutton. - # - itk_component add all { - checkbutton $itk_interior.all \ - -variable [scope _optionValues($this-all)] \ - -text "All" - } - - # - # Add the case consideration checkbutton. - # - itk_component add case { - checkbutton $itk_interior.case \ - -variable [scope _optionValues($this-case)] \ - -text "Consider Case" - } - - # - # Add the regular expression checkbutton. - # - itk_component add regexp { - checkbutton $itk_interior.regexp \ - -variable [scope _optionValues($this-regexp)] \ - -text "Use Regular Expression" - } - - # - # Add the find backwards checkbutton. - # - itk_component add backwards { - checkbutton $itk_interior.backwards \ - -variable [scope _optionValues($this-backwards)] \ - -text "Find Backwards" - } - - # - # Add the find, clear, and close buttons, making find be the default. - # - add Find -text Find -command [code $this find] - add Clear -text Clear -command [code $this clear] - add Close -text Close -command [code $this deactivate 0] - - default Find - - # - # Use the grid to layout the components. - # - grid $itk_component(pattern) -row 0 -column 0 \ - -padx 10 -pady 10 -columnspan 4 -sticky ew - grid $itk_component(all) -row 1 -column 0 - grid $itk_component(case) -row 1 -column 1 - grid $itk_component(regexp) -row 1 -column 2 - grid $itk_component(backwards) -row 1 -column 3 - - grid columnconfigure $itk_interior 0 -weight 1 - grid columnconfigure $itk_interior 1 -weight 1 - grid columnconfigure $itk_interior 2 -weight 1 - grid columnconfigure $itk_interior 3 -weight 1 - - # - # Initialize all the configuration options. - # - eval itk_initialize $args -} - -# ------------------------------------------------------------------ -# OPTIONS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# OPTION: -clearcommand -# -# Specifies a command to be invoked following a clear operation. -# The command is meant to be a means of notification that the -# clear has taken place and allow other actions to take place such -# as disabling a find again menu. -# ------------------------------------------------------------------ -configbody iwidgets::Finddialog::clearcommand {} - -# ------------------------------------------------------------------ -# OPTION: -matchcommand -# -# Specifies a command to be invoked following a find operation. -# The command is called with a match point as an argument. Should -# a match not be found the match point is {}. -# ------------------------------------------------------------------ -configbody iwidgets::Finddialog::matchcommand {} - -# ------------------------------------------------------------------ -# OPTION: -patternbackground -# -# Specifies the background color of the text matching the search -# pattern. It may have any of the forms accepted by Tk_GetColor. -# ------------------------------------------------------------------ -configbody iwidgets::Finddialog::patternbackground {} - -# ------------------------------------------------------------------ -# OPTION: -patternforeground -# -# Specifies the foreground color of the pattern matching a search -# operation. It may have any of the forms accepted by Tk_GetColor. -# ------------------------------------------------------------------ -configbody iwidgets::Finddialog::patternforeground {} - -# ------------------------------------------------------------------ -# OPTION: -searchforeground -# -# Specifies the foreground color of the line containing the matching -# pattern from a search operation. It may have any of the forms -# accepted by Tk_GetColor. -# ------------------------------------------------------------------ -configbody iwidgets::Finddialog::searchforeground {} - -# ------------------------------------------------------------------ -# OPTION: -searchbackground -# -# Specifies the background color of the line containing the matching -# pattern from a search operation. It may have any of the forms -# accepted by Tk_GetColor. -# ------------------------------------------------------------------ -configbody iwidgets::Finddialog::searchbackground {} - -# ------------------------------------------------------------------ -# OPTION: -textwidget -# -# Specifies the scrolledtext or text widget to be searched. -# ------------------------------------------------------------------ -configbody iwidgets::Finddialog::textwidget { - if {$itk_option(-textwidget) != {}} { - set _searchPoint($itk_option(-textwidget)) 1.0 - } -} - -# ------------------------------------------------------------------ -# METHODS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# PUBLIC METHOD: clear -# -# Clear the pattern entryfield and the indicators. -# ------------------------------------------------------------------ -body ::iwidgets::Finddialog::clear {} { - $itk_component(pattern) clear - - if {[_textExists]} { - set _searchPoint($itk_option(-textwidget)) 1.0 - - $itk_option(-textwidget) tag remove search-line 1.0 end - $itk_option(-textwidget) tag remove search-pattern 1.0 end - } - - if {$itk_option(-clearcommand) != {}} { - eval $itk_option(-clearcommand) - } -} - -# ------------------------------------------------------------------ -# PUBLIC METHOD: find -# -# Search for a specific text string in the text widget given by -# the -textwidget option. Should this option not be set to an -# existing widget, then a quick exit is made. -# ------------------------------------------------------------------ -body ::iwidgets::Finddialog::find {} { - if {! [_textExists]} { - return - } - - # - # Clear any existing indicators in the text widget. - # - $itk_option(-textwidget) tag remove search-line 1.0 end - $itk_option(-textwidget) tag remove search-pattern 1.0 end - - # - # Make sure the search pattern isn't just blank. If so, skip this. - # - set pattern [_get pattern] - - if {[string trim $pattern] == ""} { - return - } - - # - # After clearing out any old highlight indicators from a previous - # search, we'll be building our search command piece-meal based on - # the current settings of the checkbuttons in the find dialog. The - # first we'll add is a variable to catch the count of the length - # of the string matching the pattern. - # - set precmd "$itk_option(-textwidget) search \ - -count [list [scope _matchLen($this)]]" - - if {! [_get case]} { - append precmd " -nocase" - } - - if {[_get regexp]} { - append precmd " -regexp" - } else { - append precmd " -exact" - } - - # - # If we are going to find all matches, then the start point for - # the search will be the beginning of the text; otherwise, we'll - # use the last known starting point +/- a character depending on - # the direction. - # - if {[_get all]} { - set _searchPoint($itk_option(-textwidget)) 1.0 - } else { - if {[_get backwards]} { - append precmd " -backwards" - } else { - append precmd " -forwards" - } - } - - # - # Get the pattern to be matched and add it to the search command. - # Since it may contain embedded spaces, we'll wrap it in a list. - # - append precmd " [list $pattern]" - - # - # If the search is for all matches, then we'll be performing the - # search until no more matches are found; otherwise, we'll break - # out of the loop after one search. - # - while {1} { - if {[_get all]} { - set postcmd " $_searchPoint($itk_option(-textwidget)) end" - - } else { - set postcmd " $_searchPoint($itk_option(-textwidget))" - } - - # - # Create the final search command out of the pre and post parts - # and evaluate it which returns the location of the matching string. - # - set cmd {} - append cmd $precmd $postcmd - - if {[catch {eval $cmd} matchPoint] != 0} { - set _searchPoint($itk_option(-textwidget)) 1.0 - return {} - } - - # - # If a match exists, then we'll make this spot be the new starting - # position. Then we'll tag the line and the pattern in the line. - # The foreground and background settings will lite these positions - # in the text widget up. - # - if {$matchPoint != {}} { - set _searchPoint($itk_option(-textwidget)) $matchPoint - - $itk_option(-textwidget) tag add search-line \ - "$_searchPoint($itk_option(-textwidget)) linestart" \ - "$_searchPoint($itk_option(-textwidget))" - $itk_option(-textwidget) tag add search-line \ - "$_searchPoint($itk_option(-textwidget)) + \ - $_matchLen($this) chars" \ - "$_searchPoint($itk_option(-textwidget)) lineend" - $itk_option(-textwidget) tag add search-pattern \ - $_searchPoint($itk_option(-textwidget)) \ - "$_searchPoint($itk_option(-textwidget)) + \ - $_matchLen($this) chars" - } - - # - # Set the search point for the next time through to be one - # character more or less from the current search point based - # on the direction. - # - if {[_get all] || ! [_get backwards]} { - set _searchPoint($itk_option(-textwidget)) \ - [$itk_option(-textwidget) index \ - "$_searchPoint($itk_option(-textwidget)) + 1c"] - } else { - set _searchPoint($itk_option(-textwidget)) \ - [$itk_option(-textwidget) index \ - "$_searchPoint($itk_option(-textwidget)) - 1c"] - } - - # - # If this isn't a find all operation or we didn't get a match, exit. - # - if {(! [_get all]) || ($matchPoint == {})} { - break - } - } - - # - # Configure the colors for the search-line and search-pattern. - # - $itk_option(-textwidget) tag configure search-line \ - -foreground $itk_option(-searchforeground) - $itk_option(-textwidget) tag configure search-line \ - -background $itk_option(-searchbackground) - $itk_option(-textwidget) tag configure search-pattern \ - -background $itk_option(-patternbackground) - $itk_option(-textwidget) tag configure search-pattern \ - -foreground $itk_option(-patternforeground) - - # - # Adjust the view to be the last matched position. - # - if {$matchPoint != {}} { - $itk_option(-textwidget) see $matchPoint - } - - # - # There may be multiple matches of the pattern on a single line, - # so we'll set the tag priorities such that the pattern tag is higher. - # - $itk_option(-textwidget) tag raise search-pattern search-line - - # - # If a match command is defined, then call it with the match point. - # - if {$itk_option(-matchcommand) != {}} { - [subst $itk_option(-matchcommand)] $matchPoint - } - - # - # Return the match point to the caller so they know if we found - # anything and if so where - # - return $matchPoint -} - -# ------------------------------------------------------------------ -# PROTECTED METHOD: _get setting -# -# Get the current value for the pattern, case, regexp, or backwards. -# ------------------------------------------------------------------ -body ::iwidgets::Finddialog::_get {setting} { - switch $setting { - pattern { - return [$itk_component(pattern) get] - } - case { - return $_optionValues($this-case) - } - regexp { - return $_optionValues($this-regexp) - } - backwards { - return $_optionValues($this-backwards) - } - all { - return $_optionValues($this-all) - } - default { - error "bad get setting: \"$setting\", should be pattern,\ - case, regexp, backwards, or all" - } - } -} - -# ------------------------------------------------------------------ -# PROTECTED METHOD: _textExists -# -# Check the validity of the text widget option. Does it exist and -# is it of the class Text or Scrolledtext. -# ------------------------------------------------------------------ -body ::iwidgets::Finddialog::_textExists {} { - if {$itk_option(-textwidget) == {}} { - return 0 - } - - if {! [winfo exists $itk_option(-textwidget)]} { - error "bad finddialog text widget value: \"$itk_option(-textwidget)\",\ - the widget doesn't exist" - } - - if {([winfo class $itk_option(-textwidget)] != "Text") && - ([itcl::find objects -isa iwidgets::Scrolledtext *::$itk_option(-textwidget)] == "")} { - error "bad finddialog text widget value: \"$itk_option(-textwidget)\",\ - must be of the class Text or based on Scrolledtext" - } - - return 1 -} diff --git a/itcl/iwidgets3.0.0/generic/hierarchy.itk b/itcl/iwidgets3.0.0/generic/hierarchy.itk deleted file mode 100644 index f315fd07b8a..00000000000 --- a/itcl/iwidgets3.0.0/generic/hierarchy.itk +++ /dev/null @@ -1,1928 +0,0 @@ -# Hierarchy -# ---------------------------------------------------------------------- -# Hierarchical data viewer. Manages a list of nodes that can be -# expanded or collapsed. Individual nodes can be highlighted. -# Clicking with the right mouse button on any item brings up a -# special item menu. Clicking on the background area brings up -# a different popup menu. -# ---------------------------------------------------------------------- -# AUTHOR: Michael J. McLennan -# Bell Labs Innovations for Lucent Technologies -# mmclennan@lucent.com -# -# Mark L. Ulferts -# DSC Communications -# mulferts@austin.dsccc.com -# -# RCS: $Id$ -# ---------------------------------------------------------------------- -# Copyright (c) 1996 Lucent Technologies -# ====================================================================== -# Permission to use, copy, modify, and distribute this software and its -# documentation for any purpose and without fee is hereby granted, -# provided that the above copyright notice appear in all copies and that -# both that the copyright notice and warranty disclaimer appear in -# supporting documentation, and that the names of Lucent Technologies -# any of their entities not be used in advertising or publicity -# pertaining to distribution of the software without specific, written -# prior permission. -# -# Lucent Technologies disclaims all warranties with regard to this -# software, including all implied warranties of merchantability and -# fitness. In no event shall Lucent Technologies be liable for any -# special, indirect or consequential damages or any damages whatsoever -# resulting from loss of use, data or profits, whether in an action of -# contract, negligence or other tortuous action, arising out of or in -# connection with the use or performance of this software. -# -# ---------------------------------------------------------------------- -# Copyright (c) 1996 DSC Technologies Corporation -# ====================================================================== -# Permission to use, copy, modify, distribute and license this software -# and its documentation for any purpose, and without fee or written -# agreement with DSC, is hereby granted, provided that the above copyright -# notice appears in all copies and that both the copyright notice and -# warranty disclaimer below appear in supporting documentation, and that -# the names of DSC Technologies Corporation or DSC Communications -# Corporation not be used in advertising or publicity pertaining to the -# software without specific, written prior permission. -# -# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING -# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- -# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE -# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, -# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL -# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR -# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, -# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, -# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS -# SOFTWARE. -# ====================================================================== - -# -# Usual options. -# -itk::usual Hierarchy { - keep -cursor -textfont -font - keep -background -foreground -textbackground - keep -selectbackground -selectforeground -} - -# ------------------------------------------------------------------ -# HIERARCHY -# ------------------------------------------------------------------ -class iwidgets::Hierarchy { - inherit iwidgets::Scrolledwidget - - constructor {args} {} - - destructor {} - - 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 {} - itk_option define -openicon openIcon Icon {} - itk_option define -querycommand queryCommand Command {} - 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 {} - 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 - } -} - -# -# Provide a lowercased access method for the Hierarchy class. -# -proc ::iwidgets::hierarchy {pathName args} { - uplevel ::iwidgets::Hierarchy $pathName $args -} - -# -# Use option database to override default resources of base classes. -# -option add *Hierarchy.menuCursor arrow widgetDefault -option add *Hierarchy.labelPos n widgetDefault -option add *Hierarchy.tabs 30 widgetDefault - -# ------------------------------------------------------------------ -# CONSTRUCTOR -# ------------------------------------------------------------------ -body iwidgets::Hierarchy::constructor {args} { - itk_option remove iwidgets::Labeledwidget::state - - # - # Our -width and -height options are slightly different than - # those implemented by our base class, so we're going to - # remove them and redefine our own. - # - itk_option remove iwidgets::Scrolledwidget::width - itk_option remove iwidgets::Scrolledwidget::height - - # - # Create a clipping frame which will provide the border for - # relief display. - # - itk_component add clipper { - frame $itk_interior.clipper - } { - usual - - keep -borderwidth -relief -highlightthickness -highlightcolor - rename -highlightbackground -background background Background - } - grid $itk_component(clipper) -row 0 -column 0 -sticky nsew - grid rowconfigure $_interior 0 -weight 1 - grid columnconfigure $_interior 0 -weight 1 - - # - # Create a text widget for displaying our hierarchy. - # - itk_component add list { - text $itk_component(clipper).list -wrap none -cursor center_ptr \ - -state disabled -width 1 -height 1 \ - -xscrollcommand \ - [code $this _scrollWidget $itk_interior.horizsb] \ - -yscrollcommand \ - [code $this _scrollWidget $itk_interior.vertsb] \ - -borderwidth 0 -highlightthickness 0 - } { - usual - - keep -spacing1 -spacing2 -spacing3 -tabs - rename -font -textfont textFont Font - rename -background -textbackground textBackground Background - ignore -highlightthickness -highlightcolor - ignore -insertbackground -insertborderwidth - ignore -insertontime -insertofftime -insertwidth - ignore -selectborderwidth - ignore -borderwidth - } - grid $itk_component(list) -row 0 -column 0 -sticky nsew - grid rowconfigure $itk_component(clipper) 0 -weight 1 - grid columnconfigure $itk_component(clipper) 0 -weight 1 - - # - # Configure the command on the vertical scroll bar in the base class. - # - $itk_component(vertsb) configure \ - -command [code $itk_component(list) yview] - - # - # Configure the command on the horizontal scroll bar in the base class. - # - $itk_component(horizsb) configure \ - -command [code $itk_component(list) xview] - - # - # Configure our text component's tab settings for twenty levels. - # - set tabs "" - for {set i 1} {$i < 20} {incr i} { - lappend tabs [expr $i*12+4] - } - $itk_component(list) configure -tabs $tabs - - # - # Add popup menus that can be configured by the user to add - # new functionality. - # - itk_component add itemMenu { - menu $itk_component(list).itemmenu -tearoff 0 - } { - usual - ignore -tearoff - rename -cursor -menucursor menuCursor Cursor - } - - itk_component add bgMenu { - menu $itk_component(list).bgmenu -tearoff 0 - } { - usual - ignore -tearoff - rename -cursor -menucursor menuCursor Cursor - } - - # - # Adjust the bind tags to remove the class bindings. Also, add - # bindings for mouse button 1 to do selection and button 3 to - # display a popup. - # - bindtags $itk_component(list) [list $itk_component(list) . all] - - 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] - - # - # Initialize the widget based on the command line options. - # - eval itk_initialize $args -} - -# ------------------------------------------------------------------ -# DESTRUCTOR -# ------------------------------------------------------------------ -body iwidgets::Hierarchy::destructor {} { - if {$_pending != ""} { - after cancel $_pending - } -} - -# ------------------------------------------------------------------ -# OPTIONS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# OPTION: -font -# -# Font used for text in the list. -# ------------------------------------------------------------------ -configbody iwidgets::Hierarchy::font { - $itk_component(list) tag configure info \ - -font $itk_option(-font) -spacing1 6 -} - -# ------------------------------------------------------------------ -# OPTION: -selectbackground -# -# Background color scheme for selected nodes. -# ------------------------------------------------------------------ -configbody iwidgets::Hierarchy::selectbackground { - $itk_component(list) tag configure hilite \ - -background $itk_option(-selectbackground) -} - -# ------------------------------------------------------------------ -# OPTION: -selectforeground -# -# Foreground color scheme for selected nodes. -# ------------------------------------------------------------------ -configbody iwidgets::Hierarchy::selectforeground { - $itk_component(list) tag configure hilite \ - -foreground $itk_option(-selectforeground) -} - -# ------------------------------------------------------------------ -# OPTION: -markbackground -# -# Background color scheme for marked nodes. -# ------------------------------------------------------------------ -configbody iwidgets::Hierarchy::markbackground { - $itk_component(list) tag configure lowlite \ - -background $itk_option(-markbackground) -} - -# ------------------------------------------------------------------ -# OPTION: -markforeground -# -# Foreground color scheme for marked nodes. -# ------------------------------------------------------------------ -configbody iwidgets::Hierarchy::markforeground { - $itk_component(list) tag configure lowlite \ - -foreground $itk_option(-markforeground) -} - -# ------------------------------------------------------------------ -# OPTION: -querycommand -# -# Command executed to query the contents of each node. If this -# command contains "%n", it is replaced with the name of the desired -# node. In its simpilest form it should return the children of the -# given node as a list which will be depicted in the display. -# -# Since the names of the children are used as tags in the underlying -# text widget, each child must be unique in the hierarchy. Due to -# the unique requirement, the nodes shall be reffered to as uids -# or uid in the singular sense. -# -# {uid [uid ...]} -# -# where uid is a unique id and primary key for the hierarchy entry -# -# Should the unique requirement pose a problem, the list returned -# can take on another more extended form which enables the -# association of text to be displayed with the uids. The uid must -# still be unique, but the text does not have to obey the unique -# rule. In addition, the format also allows the specification of -# additional tags to be used on the same entry in the hierarchy -# as the uid and additional icons to be displayed just before -# the node. The tags and icons are considered to be the property of -# the user in that the hierarchy widget will not depend on any of -# their values. -# -# {{uid [text [tags [icons]]]} {uid [text [tags [icons]]]} ...} -# -# where uid is a unique id and primary key for the hierarchy entry -# text is the text to be displayed for this uid -# tags is a list of user tags to be applied to the entry -# icons is a list of icons to be displayed in front of the text -# -# The hierarchy widget does a look ahead from each node to determine -# if the node has a children. This can be cost some performace with -# large hierarchies. User's can avoid this by providing a hint in -# the user tags. A tag of "leaf" or "branch" tells the hierarchy -# widget the information it needs to know thereby avoiding the look -# ahead operation. -# ------------------------------------------------------------------ -configbody iwidgets::Hierarchy::querycommand { - clear - draw -eventually -} - -# ------------------------------------------------------------------ -# OPTION: -selectcommand -# -# Command executed to select 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. -# ------------------------------------------------------------------ -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 -# 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. -# ------------------------------------------------------------------ -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 -# each refresh of the display should be via a new query using -# the -querycommand option or use the values previous found the -# last time the query was made. -# ------------------------------------------------------------------ -configbody iwidgets::Hierarchy::alwaysquery { -} - -# ------------------------------------------------------------------ -# OPTION: -filter -# -# When true only the branch nodes and selected items are displayed. -# This gives a compact view of important items. -# ------------------------------------------------------------------ -configbody iwidgets::Hierarchy::filter { - switch -- $itk_option(-filter) { - 1 - true - yes - on { - set newCode {set display [info exists _selected($child)]} - } - 0 - false - no - off { - set newCode {set display 1} - } - default { - error "bad filter option \"$itk_option(-filter)\":\ - should be boolean" - } - } - if {$newCode != $_filterCode} { - set _filterCode $newCode - draw -eventually - } -} - -# ------------------------------------------------------------------ -# OPTION: -expanded -# -# When true, the hierarchy will be completely expanded when it -# is first displayed. A fresh display can be triggered by -# resetting the -querycommand option. -# ------------------------------------------------------------------ -configbody iwidgets::Hierarchy::expanded { - switch -- $itk_option(-expanded) { - 1 - true - yes - on { - ;# okay - } - 0 - false - no - off { - ;# okay - } - default { - error "bad expanded option \"$itk_option(-expanded)\":\ - should be boolean" - } - } -} - -# ------------------------------------------------------------------ -# OPTION: -openicon -# -# Specifies the open icon image to be used in the hierarchy. Should -# one not be provided, then one will be generated, pixmap if -# possible, bitmap otherwise. -# ------------------------------------------------------------------ -configbody iwidgets::Hierarchy::openicon { - if {$itk_option(-openicon) == {}} { - if {[lsearch [image names] openFolder] == -1} { - if {[lsearch [image types] pixmap] != -1} { - image create pixmap openFolder -data { - /* XPM */ - static char * dir_opened [] = { - "16 16 4 1", - /* colors */ - ". c grey85 m white g4 grey90", - "b c black m black g4 black", - "y c yellow m white g4 grey80", - "g c grey70 m white g4 grey70", - /* pixels */ - "................", - "................", - "................", - "..bbbb..........", - ".bggggb.........", - "bggggggbbbbbbb..", - "bggggggggggggb..", - "bgbbbbbbbbbbbbbb", - "bgbyyyyyyyyyyybb", - "bbyyyyyyyyyyyyb.", - "bbyyyyyyyyyyybb.", - "byyyyyyyyyyyyb..", - "bbbbbbbbbbbbbb..", - "................", - "................", - "................"}; - } - } else { - image create bitmap openFolder -data { - #define open_width 16 - #define open_height 16 - static char open_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0x3c, 0x00, 0x42, 0x00, - 0x81, 0x3f, 0x01, 0x20, 0xf9, 0xff, 0x0d, 0xc0, - 0x07, 0x40, 0x03, 0x60, 0x01, 0x20, 0x01, 0x30, - 0xff, 0x1f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; - } - } - } - set itk_option(-openicon) openFolder - } else { - if {[lsearch [image names] $itk_option(-openicon)] == -1} { - error "bad openicon option \"$itk_option(-openicon)\":\ - should be an existing image" - } - } -} - -# ------------------------------------------------------------------ -# OPTION: -closedicon -# -# Specifies the closed icon image to be used in the hierarchy. -# Should one not be provided, then one will be generated, pixmap if -# possible, bitmap otherwise. -# ------------------------------------------------------------------ -configbody iwidgets::Hierarchy::closedicon { - if {$itk_option(-closedicon) == {}} { - if {[lsearch [image names] closedFolder] == -1} { - if {[lsearch [image types] pixmap] != -1} { - image create pixmap closedFolder -data { - /* XPM */ - static char *dir_closed[] = { - "16 16 3 1", - ". c grey85 m white g4 grey90", - "b c black m black g4 black", - "y c yellow m white g4 grey80", - "................", - "................", - "................", - "..bbbb..........", - ".byyyyb.........", - "bbbbbbbbbbbbbb..", - "byyyyyyyyyyyyb..", - "byyyyyyyyyyyyb..", - "byyyyyyyyyyyyb..", - "byyyyyyyyyyyyb..", - "byyyyyyyyyyyyb..", - "byyyyyyyyyyyyb..", - "bbbbbbbbbbbbbb..", - "................", - "................", - "................"}; - } - } else { - image create bitmap closedFolder -data { - #define closed_width 16 - #define closed_height 16 - static char closed_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0x78, 0x00, 0x84, 0x00, - 0xfe, 0x7f, 0x02, 0x40, 0x02, 0x40, 0x02, 0x40, - 0x02, 0x40, 0x02, 0x40, 0x02, 0x40, 0x02, 0x40, - 0xfe, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; - } - } - } - set itk_option(-closedicon) closedFolder - } else { - if {[lsearch [image names] $itk_option(-closedicon)] == -1} { - error "bad closedicon option \"$itk_option(-closedicon)\":\ - should be an existing image" - } - } -} - -# ------------------------------------------------------------------ -# OPTION: -nodeicon -# -# Specifies the node icon image to be used in the hierarchy. Should -# one not be provided, then one will be generated, pixmap if -# possible, bitmap otherwise. -# ------------------------------------------------------------------ -configbody iwidgets::Hierarchy::nodeicon { - if {$itk_option(-nodeicon) == {}} { - if {[lsearch [image names] nodeFolder] == -1} { - if {[lsearch [image types] pixmap] != -1} { - image create pixmap nodeFolder -data { - /* XPM */ - static char *dir_node[] = { - "16 16 3 1", - ". c grey85 m white g4 grey90", - "b c black m black g4 black", - "y c yellow m white g4 grey80", - "................", - "................", - "................", - "...bbbbbbbbbbb..", - "..bybyyyyyyyyb..", - ".byybyyyyyyyyb..", - "byyybyyyyyyyyb..", - "bbbbbyyyyyyyyb..", - "byyyyyyyyyyyyb..", - "byyyyyyyyyyyyb..", - "byyyyyyyyyyyyb..", - "byyyyyyyyyyyyb..", - "bbbbbbbbbbbbbb..", - "................", - "................", - "................"}; - } - } else { - image create bitmap nodeFolder -data { - #define node_width 16 - #define node_height 16 - static char node_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0xe0, 0x7f, 0x50, 0x40, - 0x48, 0x40, 0x44, 0x40, 0x42, 0x40, 0x7e, 0x40, - 0x02, 0x40, 0x02, 0x40, 0x02, 0x40, 0x02, 0x40, - 0xfe, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; - } - } - } - set itk_option(-nodeicon) nodeFolder - } else { - if {[lsearch [image names] $itk_option(-nodeicon)] == -1} { - error "bad nodeicon option \"$itk_option(-nodeicon)\":\ - should be an existing image" - } - } -} - -# ------------------------------------------------------------------ -# OPTION: -width -# -# Specifies the width of the hierarchy widget as an entire unit. -# The value may be specified in any of the forms acceptable to -# Tk_GetPixels. Any additional space needed to display the other -# components such as labels, margins, and scrollbars force the text -# to be compressed. A value of zero along with the same value for -# the height causes the value given for the visibleitems option -# to be applied which administers geometry constraints in a different -# manner. -# ------------------------------------------------------------------ -configbody iwidgets::Hierarchy::width { - if {$itk_option(-width) != 0} { - set shell [lindex [grid info $itk_component(clipper)] 1] - - # - # Due to a bug in the tk4.2 grid, we have to check the - # propagation before setting it. Setting it to the same - # value it already is will cause it to toggle. - # - if {[grid propagate $shell]} { - grid propagate $shell no - } - - $itk_component(list) configure -width 1 - $shell configure \ - -width [winfo pixels $shell $itk_option(-width)] - } else { - configure -visibleitems $itk_option(-visibleitems) - } -} - -# ------------------------------------------------------------------ -# OPTION: -height -# -# Specifies the height of the hierarchy widget as an entire unit. -# The value may be specified in any of the forms acceptable to -# Tk_GetPixels. Any additional space needed to display the other -# components such as labels, margins, and scrollbars force the text -# to be compressed. A value of zero along with the same value for -# the width causes the value given for the visibleitems option -# to be applied which administers geometry constraints in a different -# manner. -# ------------------------------------------------------------------ -configbody iwidgets::Hierarchy::height { - if {$itk_option(-height) != 0} { - set shell [lindex [grid info $itk_component(clipper)] 1] - - # - # Due to a bug in the tk4.2 grid, we have to check the - # propagation before setting it. Setting it to the same - # value it already is will cause it to toggle. - # - if {[grid propagate $shell]} { - grid propagate $shell no - } - - $itk_component(list) configure -height 1 - $shell configure \ - -height [winfo pixels $shell $itk_option(-height)] - } else { - configure -visibleitems $itk_option(-visibleitems) - } -} - -# ------------------------------------------------------------------ -# OPTION: -visibleitems -# -# Specified the widthxheight in characters and lines for the text. -# This option is only administered if the width and height options -# are both set to zero, otherwise they take precedence. With the -# visibleitems option engaged, geometry constraints are maintained -# only on the text. The size of the other components such as -# labels, margins, and scroll bars, are additive and independent, -# effecting the overall size of the scrolled text. In contrast, -# should the width and height options have non zero values, they -# are applied to the scrolled text as a whole. The text is -# compressed or expanded to maintain the geometry constraints. -# ------------------------------------------------------------------ -configbody iwidgets::Hierarchy::visibleitems { - if {[regexp {^[0-9]+x[0-9]+$} $itk_option(-visibleitems)]} { - if {($itk_option(-width) == 0) && \ - ($itk_option(-height) == 0)} { - set chars [lindex [split $itk_option(-visibleitems) x] 0] - set lines [lindex [split $itk_option(-visibleitems) x] 1] - - set shell [lindex [grid info $itk_component(clipper)] 1] - - # - # Due to a bug in the tk4.2 grid, we have to check the - # propagation before setting it. Setting it to the same - # value it already is will cause it to toggle. - # - if {! [grid propagate $shell]} { - grid propagate $shell yes - } - - $itk_component(list) configure -width $chars -height $lines - } - - } else { - error "bad visibleitems option\ - \"$itk_option(-visibleitems)\": should be\ - widthxheight" - } -} - -# ------------------------------------------------------------------ -# 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 -# ------------------------------------------------------------------ - -# ---------------------------------------------------------------------- -# PUBLIC METHOD: clear -# -# Removes all items from the display including all tags and icons. -# The display will remain empty until the -filter or -querycommand -# options are set. -# ---------------------------------------------------------------------- -body iwidgets::Hierarchy::clear {} { - $itk_component(list) configure -state normal -cursor watch - $itk_component(list) delete 1.0 end - $itk_component(list) configure -state disabled -cursor $itk_option(-cursor) - - catch {unset _nodes} - catch {unset _text} - catch {unset _tags} - catch {unset _icons} - catch {unset _states} - catch {unset _images} - catch {unset _indents} - - return -} - -# ---------------------------------------------------------------------- -# PUBLIC METHOD: selection option ?uid uid...? -# -# Handles all operations controlling selections in the hierarchy. -# Selections may be cleared, added, removed, or queried. The add and -# remove options accept a series of unique ids. -# ---------------------------------------------------------------------- -body iwidgets::Hierarchy::selection {op args} { - switch -- $op { - clear { - $itk_component(list) tag remove hilite 1.0 end - catch {unset _selected} - return - } - add { - foreach node $args { - set _selected($node) 1 - catch { - $itk_component(list) tag add hilite \ - "$node.first" "$node.last" - } - } - } - remove { - foreach node $args { - catch { - unset _selected($node) - $itk_component(list) tag remove hilite \ - "$node.first" "$node.last" - } - } - } - get { - return [array names _selected] - } - default { - error "bad selection operation \"$op\":\ - should be add, remove, clear or get" - } - } -} - -# ---------------------------------------------------------------------- -# PUBLIC METHOD: mark option ?arg arg...? -# -# Handles all operations controlling marks in the hierarchy. Marks may -# be cleared, added, removed, or queried. The add and remove options -# accept a series of unique ids. -# ---------------------------------------------------------------------- -body iwidgets::Hierarchy::mark {op args} { - switch -- $op { - clear { - $itk_component(list) tag remove lowlite 1.0 end - catch {unset _marked} - return - } - add { - foreach node $args { - set _marked($node) 1 - catch { - $itk_component(list) tag add lowlite \ - "$node.first" "$node.last" - } - } - } - remove { - foreach node $args { - catch { - unset _marked($node) - $itk_component(list) tag remove lowlite \ - "$node.first" "$node.last" - } - } - } - get { - return [array names _marked] - } - default { - error "bad mark operation \"$op\":\ - should be add, remove, clear or get" - } - } -} - -# ---------------------------------------------------------------------- -# PUBLIC METHOD: current -# -# Returns the node that was most recently selected by the right mouse -# button when the item menu was posted. Usually used by the code -# in the item menu to figure out what item is being manipulated. -# ---------------------------------------------------------------------- -body iwidgets::Hierarchy::current {} { - return $_posted -} - -# ---------------------------------------------------------------------- -# PUBLIC METHOD: expand node -# -# Expands the hierarchy beneath the specified node. Since this can take -# a moment for large hierarchies, the cursor will be changed to a watch -# during the expansion. -# ---------------------------------------------------------------------- -body iwidgets::Hierarchy::expand {node} { - if {! [info exists _states($node)]} { - error "bad expand node argument: \"$node\", the node doesn't exist" - } - - if {!$_states($node) && \ - (([lsearch $_tags($node) branch] != -1) || \ - ([llength [_contents $node]] > 0))} { - $itk_component(list) configure -state normal -cursor watch - update - - # - # Get the indentation level for the node. - # - set indent $_indents($node) - - set _markers "" - $itk_component(list) mark set insert "$node:start" - _drawLevel $node $indent - - # - # Following the draw, all our markers need adjusting. - # - foreach {name index} $_markers { - $itk_component(list) mark set $name $index - } - - # - # Set the image to be the open icon, denote the new state, - # and set the cursor back to normal along with the state. - # - $_images($node) configure -image $itk_option(-openicon) - - set _states($node) 1 - - $itk_component(list) configure -state disabled \ - -cursor $itk_option(-cursor) - } -} - -# ---------------------------------------------------------------------- -# PUBLIC METHOD: collapse node -# -# Collapses the hierarchy beneath the specified node. Since this can -# take a moment for large hierarchies, the cursor will be changed to a -# watch during the expansion. -# ---------------------------------------------------------------------- -body iwidgets::Hierarchy::collapse {node} { - if {! [info exists _states($node)]} { - error "bad collapse node argument: \"$node\", the node doesn't exist" - } - - if {[info exists _states($node)] && $_states($node) && \ - (([lsearch $_tags($node) branch] != -1) || \ - ([llength [_contents $node]] > 0))} { - $itk_component(list) configure -state normal -cursor watch - update - - _deselectSubNodes $node - - $itk_component(list) delete "$node:start" "$node:end" - - catch {$_images($node) configure -image $itk_option(-closedicon)} - - set _states($node) 0 - - $itk_component(list) configure -state disabled \ - -cursor $itk_option(-cursor) - } -} - -# ---------------------------------------------------------------------- -# PUBLIC METHOD: toggle node -# -# Toggles the hierarchy beneath the specified node. If the hierarchy -# is currently expanded, then it is collapsed, and vice-versa. -# ---------------------------------------------------------------------- -body iwidgets::Hierarchy::toggle {node} { - if {! [info exists _states($node)]} { - error "bad toggle node argument: \"$node\", the node doesn't exist" - } - - if {$_states($node)} { - collapse $node - } else { - expand $node - } -} - -# ---------------------------------------------------------------------- -# PUBLIC METHOD: prune node -# -# Removes a particular node from the hierarchy. -# ---------------------------------------------------------------------- -body iwidgets::Hierarchy::prune {node} { - # - # While we're working, change the state and cursor so we can - # edit the text and give a busy visual clue. - # - $itk_component(list) configure -state normal -cursor watch - - # - # Recursively delete all the subnode information from our internal - # arrays and remove all the tags. - # - _deleteNodeInfo $node - - # - # If the mark $node:end exists then the node has decendents so - # so we'll remove from the mark $node:start to $node:end in order - # to delete all the subnodes below it in the text. - # - if {[lsearch [$itk_component(list) mark names] $node:end] != -1} { - $itk_component(list) delete $node:start $node:end - $itk_component(list) mark unset $node:end - } - - # - # Next we need to remove the node itself. Using the ranges for - # its tag we'll remove it from line start to the end plus one - # character which takes us to the start of the next node. - # - foreach {start end} [$itk_component(list) tag ranges $node] { - $itk_component(list) delete "$start linestart" "$end + 1 char" - } - - # - # Delete the tag for this node. - # - $itk_component(list) tag delete $node - - # - # The node must be removed from the list of subnodes for its parent. - # We don't really have a clean way to do upwards referencing, so - # the dirty way will have to do. We'll cycle through each node - # and if this node is in its list of subnodes, we'll remove it. - # - foreach uid [array names _nodes] { - if {[set index [lsearch $_nodes($uid) $node]] != -1} { - set _nodes($uid) [lreplace $_nodes($uid) $index $index] - } - } - - # - # We're done, so change the state and cursor back to their - # original values. - # - $itk_component(list) configure -state disabled -cursor $itk_option(-cursor) -} - -# ---------------------------------------------------------------------- -# PUBLIC METHOD: draw ?when? -# -# Performs a complete draw of the entire hierarchy. -# ---------------------------------------------------------------------- -body iwidgets::Hierarchy::draw {{when -now}} { - if {$when == "-eventually"} { - if {$_pending == ""} { - set _pending [after idle [code $this draw -now]] - } - return - } elseif {$when != "-now"} { - error "bad when option \"$when\": should be -eventually or -now" - } - $itk_component(list) configure -state normal -cursor watch - update - - $itk_component(list) delete 1.0 end - catch {unset _images} - set _markers "" - - _drawLevel "" "" - - foreach {name index} $_markers { - $itk_component(list) mark set $name $index - } - - $itk_component(list) configure -state disabled -cursor $itk_option(-cursor) - set _pending "" -} - -# ---------------------------------------------------------------------- -# PUBLIC METHOD: refresh node -# -# Performs a redraw of a specific node. If that node is currently -# not visible, then no action is taken. -# ---------------------------------------------------------------------- -body iwidgets::Hierarchy::refresh {node} { - if {! [info exists _nodes($node)]} { - error "bad refresh node argument: \"$node\", the node doesn't exist" - } - - - if {! $_states($node)} {return} - - foreach parent [_getHeritage $node] { - if {! $_states($parent)} {return} - } - - $itk_component(list) configure -state normal -cursor watch - $itk_component(list) delete $node:start $node:end - - set _markers "" - $itk_component(list) mark set insert "$node:start" - set indent $_indents($node) - - _drawLevel $node $indent - - foreach {name index} $_markers { - $itk_component(list) mark set $name $index - } - - $itk_component(list) configure -state disabled -cursor $itk_option(-cursor) -} - -# ------------------------------------------------------------------ -# THIN WRAPPED TEXT METHODS: -# -# The following methods are thin wraps of standard text methods. -# Consult the Tk text man pages for functionallity and argument -# documentation. -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# PUBLIC METHOD: bbox index -# -# Returns four element list describing the bounding box for the list -# item at index -# ------------------------------------------------------------------ -body iwidgets::Hierarchy::bbox {index} { - return [$itk_component(list) bbox $index] -} - -# ------------------------------------------------------------------ -# PUBLIC METHOD compare index1 op index2 -# -# Compare indices according to relational operator. -# ------------------------------------------------------------------ -body iwidgets::Hierarchy::compare {index1 op index2} { - return [$itk_component(list) compare $index1 $op $index2] -} - -# ------------------------------------------------------------------ -# PUBLIC METHOD delete first ?last? -# -# Delete a range of characters from the text. -# ------------------------------------------------------------------ -body iwidgets::Hierarchy::delete {first {last {}}} { - $itk_component(list) configure -state normal -cursor watch - $itk_component(list) delete $first $last - $itk_component(list) configure -state disabled -cursor $itk_option(-cursor) -} - -# ------------------------------------------------------------------ -# PUBLIC METHOD dump ?switches? index1 ?index2? -# -# Returns information about the contents of the text widget from -# index1 to index2. -# ------------------------------------------------------------------ -body iwidgets::Hierarchy::dump {args} { - return [eval $itk_component(list) dump $args] -} - -# ------------------------------------------------------------------ -# PUBLIC METHOD dlineinfo index -# -# Returns a five element list describing the area occupied by the -# display line containing index. -# ------------------------------------------------------------------ -body iwidgets::Hierarchy::dlineinfo {index} { - return [$itk_component(list) dlineinfo $index] -} - -# ------------------------------------------------------------------ -# PUBLIC METHOD get index1 ?index2? -# -# Return text from start index to end index. -# ------------------------------------------------------------------ -body iwidgets::Hierarchy::get {index1 {index2 {}}} { - return [$itk_component(list) get $index1 $index2] -} - -# ------------------------------------------------------------------ -# PUBLIC METHOD index index -# -# Return position corresponding to index. -# ------------------------------------------------------------------ -body iwidgets::Hierarchy::index {index} { - return [$itk_component(list) index $index] -} - -# ------------------------------------------------------------------ -# PUBLIC METHOD insert index chars ?tagList? -# -# Insert text at index. -# ------------------------------------------------------------------ -body iwidgets::Hierarchy::insert {args} { - $itk_component(list) configure -state normal -cursor watch - eval $itk_component(list) insert $args - $itk_component(list) configure -state disabled -cursor $itk_option(-cursor) -} - -# ------------------------------------------------------------------ -# PUBLIC METHOD scan option args -# -# Implements scanning on texts. -# ------------------------------------------------------------------ -body iwidgets::Hierarchy::scan {option args} { - eval $itk_component(list) scan $option $args -} - -# ------------------------------------------------------------------ -# PUBLIC METHOD search ?switches? pattern index ?varName? -# -# Searches the text for characters matching a pattern. -# ------------------------------------------------------------------ -body iwidgets::Hierarchy::search {args} { - return [eval $itk_component(list) search $args] -} - -# ------------------------------------------------------------------ -# PUBLIC METHOD see index -# -# Adjusts the view in the window so the character at index is -# visible. -# ------------------------------------------------------------------ -body iwidgets::Hierarchy::see {index} { - $itk_component(list) see $index -} - -# ------------------------------------------------------------------ -# PUBLIC METHOD tag option ?arg arg ...? -# -# Manipulate tags dependent on options. -# ------------------------------------------------------------------ -body iwidgets::Hierarchy::tag {op args} { - return [eval $itk_component(list) tag $op $args] -} - -# ------------------------------------------------------------------ -# PUBLIC METHOD window option ?arg arg ...? -# -# Manipulate embedded windows. -# ------------------------------------------------------------------ -body iwidgets::Hierarchy::window {option args} { - return [eval $itk_component(list) window $option $args] -} - -# ---------------------------------------------------------------------- -# PUBLIC METHOD: xview args -# -# Thin wrap of the text widget's xview command. -# ---------------------------------------------------------------------- -body iwidgets::Hierarchy::xview {args} { - return [eval itk_component(list) xview $args] -} - -# ---------------------------------------------------------------------- -# PUBLIC METHOD: yview args -# -# Thin wrap of the text widget's yview command. -# ---------------------------------------------------------------------- -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 -# ------------------------------------------------------------------ - -# ---------------------------------------------------------------------- -# PROTECTED METHOD: _drawLevel node indent -# -# Used internally by draw to draw one level of the hierarchy. -# Draws all of the nodes under node, using the indent string to -# indent nodes. -# ---------------------------------------------------------------------- -body iwidgets::Hierarchy::_drawLevel {node indent} { - lappend _markers "$node:start" [$itk_component(list) index insert] - set bg [$itk_component(list) cget -background] - - # - # Obtain the list of subnodes for this node and cycle through - # each one displaying it in the hierarchy. - # - foreach child [_contents $node] { - set _images($child) "$itk_component(list).hicon[incr _hcounter]" - - if {![info exists _states($child)]} { - set _states($child) $itk_option(-expanded) - } - - # - # Check the user tags to see if they have been kind enough - # to tell us ahead of time what type of node we are dealing - # with branch or leaf. If they neglected to do so, then - # get the contents of the child node to see if it has children - # itself. - # - set display 0 - - if {[lsearch $_tags($child) leaf] != -1} { - set type leaf - } elseif {[lsearch $_tags($child) branch] != -1} { - set type branch - } else { - if {[llength [_contents $child]] == 0} { - set type leaf - } else { - set type branch - } - } - - # - # Now that we know the type of node, branch or leaf, we know - # the type of icon to use. - # - if {$type == "leaf"} { - set icon $itk_option(-nodeicon) - eval $_filterCode - } else { - if {$_states($child)} { - set icon $itk_option(-openicon) - } else { - set icon $itk_option(-closedicon) - } - set display 1 - } - - # - # If display is set then we're going to be drawing this node. - # Save off the indentation level for this node and do the indent. - # - if {$display} { - set _indents($child) "$indent\t" - $itk_component(list) insert insert $indent - - # - # Add the branch or leaf icon and setup a binding to toggle - # its expanded/collapsed state. - # - label $_images($child) -image $icon -background $bg - # 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) - - # - # If any user icons exist then draw them as well. The little - # regexp is just to check and see if they've passed in a - # command which needs to be evaluated as opposed to just - # a variable. Also, attach a binding to call them if their - # icon is selected. - # - if {[info exists _icons($child)]} { - foreach image $_icons($child) { - set wid "$itk_component(list).uicon[incr _ucounter]" - - if {[regexp {\[.*\]} $image]} { - eval label $wid -image $image -background $bg - } else { - 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] - 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 - } - } - - # - # Create the list of tags to be applied to the text. Start - # out with a tag of "info" and append "hilite" if the node - # is currently selected, finally add the tags given by the - # user. - # - set texttags [list "info" $child] - - if {[info exists _selected($child)]} { - lappend texttags hilite - } - - foreach tag $_tags($child) { - lappend texttags $tag - } - - # - # Insert the text for the node along with the tags and - # append to the markers the start of this node. The text - # has been broken at newlines into a list. We'll make sure - # that each line is at the same indentation position. - # - set firstline 1 - foreach line $_text($child) { - if {$firstline} { - $itk_component(list) insert insert " " - } else { - $itk_component(list) insert insert "$indent\t" - } - - $itk_component(list) insert insert $line $texttags "\n" - set firstline 0 - } - - lappend _markers "$child:start" [$itk_component(list) index insert] - - # - # If the state of the node is open, proceed to draw the next - # node below it in the hierarchy. - # - if {$_states($child)} { - _drawLevel $child "$indent\t" - } - } - } - - lappend _markers "$node:end" [$itk_component(list) index insert] -} - -# ---------------------------------------------------------------------- -# PROTECTED METHOD: _contents uid -# -# Used internally to get the contents of a particular node. If this -# is the first time the node has been seen or the -alwaysquery -# option is set, the -querycommand code is executed to query the node -# list, and the list is stored until the next time it is needed. -# -# The querycommand may return not only the list of subnodes for the -# node but additional information on the tags and icons to be used. -# The return value must be parsed based on the number of elements in -# the list where the format is a list of lists: -# -# {{uid [text [tags [icons]]]} {uid [text [tags [icons]]]} ...} -# ---------------------------------------------------------------------- -body iwidgets::Hierarchy::_contents {uid} { - if {! $itk_option(-alwaysquery) && [info exists _nodes($uid)]} { - return $_nodes($uid) - } - - # - # Substitute any %n's for the node name whose children we're - # interested in obtaining. - # - set cmd $itk_option(-querycommand) - regsub -all {%n} $cmd [list $uid] cmd - - set nodeinfolist [uplevel \#0 $cmd] - - # - # Cycle through the node information returned by the query - # command determining if additional information such as text, - # user tags, or user icons have been provided. For text, - # break it into a list at any newline characters. - # - set _nodes($uid) {} - - foreach nodeinfo $nodeinfolist { - set subnodeuid [lindex $nodeinfo 0] - lappend _nodes($uid) $subnodeuid - - set llen [llength $nodeinfo] - - if {$llen == 0 || $llen > 4} { - error "invalid number of elements returned by query\ - command for node: \"$uid\",\ - should be uid \[text \[tags \[icons\]\]\]" - } - - if {$llen == 1} { - set _text($subnodeuid) [split $subnodeuid \n] - } - if {$llen > 1} { - set _text($subnodeuid) [split [lindex $nodeinfo 1] \n] - } - if {$llen > 2} { - set _tags($subnodeuid) [lindex $nodeinfo 2] - } else { - set _tags($subnodeuid) unknown - } - if {$llen > 3} { - set _icons($subnodeuid) [lindex $nodeinfo 3] - } - } - - # - # Return the list of nodes. - # - return $_nodes($uid) -} - -# ---------------------------------------------------------------------- -# PROTECTED METHOD: _post x y -# -# Used internally to post the popup menu at the coordinate (x,y) -# relative to the widget. If (x,y) is on an item, then the itemMenu -# component is posted. Otherwise, the bgMenu is posted. -# ---------------------------------------------------------------------- -body iwidgets::Hierarchy::_post {x y} { - set rx [expr [winfo rootx $itk_component(list)]+$x] - set ry [expr [winfo rooty $itk_component(list)]+$y] - - set index [$itk_component(list) index @$x,$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 {} - - foreach tag [$itk_component(list) tag names $index] { - if {![_isInternalTag $tag]} { - lappend _posted $tag - } - } - - # - # 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 - } -} - -# ---------------------------------------------------------------------- -# 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 -# to the widget. The command associated with the -selectcommand -# 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. -# ---------------------------------------------------------------------- -body iwidgets::Hierarchy::_select {x y} { - if {$itk_option(-selectcommand) != {}} { - 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(-selectcommand) - regsub -all {%n} $cmd [list $node] cmd - regsub -all {%s} $cmd [list $selectstatus] cmd - - uplevel #0 $cmd - } - } - - return -} - -# ---------------------------------------------------------------------- -# 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) - regsub -all {%n} $cmd [list $node] cmd - regsub -all {%i} $cmd [list $icon] cmd - - uplevel \#0 $cmd - - return {} -} - -# ---------------------------------------------------------------------- -# 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 -# particular node. -# ---------------------------------------------------------------------- -body iwidgets::Hierarchy::_deselectSubNodes {uid} { - foreach node $_nodes($uid) { - if {[array names _selected $node] != {}} { - unset _selected($node) - } - - if {[array names _nodes $node] != {}} { - _deselectSubNodes $node - } - } -} - -# ---------------------------------------------------------------------- -# PROTECTED METHOD: _deleteNodeInfo uid -# -# Used internally to recursively delete all the information about a -# node and its decendents. -# ---------------------------------------------------------------------- -body iwidgets::Hierarchy::_deleteNodeInfo {uid} { - # - # Recursively call ourseleves as we go down the hierarchy beneath - # this node. - # - if {[info exists _nodes($uid)]} { - foreach node $_nodes($uid) { - if {[array names _nodes $node] != {}} { - _deleteNodeInfo $node - } - } - } - - # - # Unset any entries in our arrays for the node. - # - catch {unset _nodes($uid)} - catch {unset _text($uid)} - catch {unset _tags($uid)} - catch {unset _icons($uid)} - catch {unset _states($uid)} - catch {unset _images($uid)} - catch {unset _indents($uid)} -} - -# ---------------------------------------------------------------------- -# PROTECTED METHOD: _getParent uid -# -# Used internally to determine the parent for a node. -# ---------------------------------------------------------------------- -body iwidgets::Hierarchy::_getParent {uid} { - foreach node [array names _nodes] { - if {[set index [lsearch $_nodes($node) $uid]] != -1} { - return $node - } - } -} - -# ---------------------------------------------------------------------- -# PROTECTED METHOD: _getHeritage uid -# -# Used internally to determine the list of parents for a node. -# ---------------------------------------------------------------------- -body iwidgets::Hierarchy::_getHeritage {uid} { - set parents {} - - if {[set parent [_getParent $uid]] != {}} { - lappend parents $parent - } - - return $parents -} - -# ---------------------------------------------------------------------- -# PROTECTED METHOD (could be proc?): _isInternalTag tag -# -# Used internally to tags not to used for user callback commands -# ---------------------------------------------------------------------- -body iwidgets::Hierarchy::_isInternalTag {tag} { - set ii [expr [lsearch -exact {info hilite lowlite unknown} $tag] != -1]; - return $ii; -} diff --git a/itcl/iwidgets3.0.0/generic/hyperhelp.itk b/itcl/iwidgets3.0.0/generic/hyperhelp.itk deleted file mode 100644 index 8eb5e80be44..00000000000 --- a/itcl/iwidgets3.0.0/generic/hyperhelp.itk +++ /dev/null @@ -1,504 +0,0 @@ -# -# Hyperhelp -# ---------------------------------------------------------------------- -# Implements a help facility using html formatted hypertext files. -# -# ---------------------------------------------------------------------- -# AUTHOR: Kris Raney EMAIL: kraney@spd.dsccc.com -# -# @(#) $Id$ -# ---------------------------------------------------------------------- -# Copyright (c) 1996 DSC Technologies Corporation -# ====================================================================== -# Permission to use, copy, modify, distribute and license this software -# and its documentation for any purpose, and without fee or written -# agreement with DSC, is hereby granted, provided that the above copyright -# notice appears in all copies and that both the copyright notice and -# warranty disclaimer below appear in supporting documentation, and that -# the names of DSC Technologies Corporation or DSC Communications -# Corporation not be used in advertising or publicity pertaining to the -# software without specific, written prior permission. -# -# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING -# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- -# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE -# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, -# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL -# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR -# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, -# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, -# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS -# SOFTWARE. -# ====================================================================== - -# -# Acknowledgements: -# -# Special thanks go to Sam Shen(SLShen@lbl.gov), as this code is based on his -# help.tcl code from tk inspect. - -# -# Default resources. -# -option add *Hyperhelp.width 575 widgetDefault -option add *Hyperhelp.height 450 widgetDefault -option add *Hyperhelp.modality none widgetDefault -option add *Hyperhelp.vscrollMode static widgetDefault -option add *Hyperhelp.hscrollMode static widgetDefault -option add *Hyperhelp.maxHistory 20 widgetDefault - -# -# Usual options. -# -itk::usual Hyperhelp { - keep -activebackground -activerelief -background -borderwidth -cursor \ - -foreground -highlightcolor -highlightthickness \ - -selectbackground -selectborderwidth -selectforeground \ - -textbackground -} - -# ------------------------------------------------------------------ -# HYPERHELP -# ------------------------------------------------------------------ -class iwidgets::Hyperhelp { - inherit iwidgets::Shell - - constructor {args} {} - - itk_option define -topics topics Topics {} - itk_option define -helpdir helpdir Directory . - itk_option define -title title Title "Help" - itk_option define -closecmd closeCmd CloseCmd {} - itk_option define -maxhistory maxHistory MaxHistory 20 - - public variable beforelink {} - public variable afterlink {} - - public method showtopic {topic} - public method followlink {link} - public method forward {} - public method back {} - public method updatefeedback {n} - - protected method _readtopic {file {anchorpoint {}}} - protected method _pageforward {} - protected method _pageback {} - protected method _lineforward {} - protected method _lineback {} - protected method _fill_go_menu {} - - protected variable _history {} ;# History list of viewed pages - protected variable _history_ndx -1 ;# current position in history list - protected variable _history_len 0 ;# length of history list - protected variable _histdir -1 ;# direction in history we just came - ;# from - protected variable _len 0 ;# length of text to be rendered - protected variable _file {} ;# current topic - - private variable _remaining 0 ;# remaining text to be rendered - private variable _rendering 0 ;# flag - in process of rendering -} - -# -# Provide a lowercased access method for the Scrolledlistbox class. -# -proc ::iwidgets::hyperhelp {pathName args} { - uplevel ::iwidgets::Hyperhelp $pathName $args -} - -# ------------------------------------------------------------------ -# CONSTRUCTOR -# ------------------------------------------------------------------ -body iwidgets::Hyperhelp::constructor {args} { - itk_option remove iwidgets::Shell::padx iwidgets::Shell::pady - - # - # Create a pulldown menu - # - itk_component add -private menubar { - frame $itk_interior.menu -relief raised -bd 2 - } { - keep -background -cursor - } - pack $itk_component(menubar) -side top -fill x - - itk_component add -private topicmb { - menubutton $itk_component(menubar).topicmb -text "Topics" \ - -menu $itk_component(menubar).topicmb.topicmenu \ - -underline 0 -padx 8 -pady 2 - } { - keep -background -cursor -font -foreground \ - -activebackground -activeforeground - } - pack $itk_component(topicmb) -side left - - itk_component add -private topicmenu { - menu $itk_component(topicmb).topicmenu -tearoff no - } { - keep -background -cursor -font -foreground \ - -activebackground -activeforeground - } - - itk_component add -private navmb { - menubutton $itk_component(menubar).navmb -text "Navigate" \ - -menu $itk_component(menubar).navmb.navmenu \ - -underline 0 -padx 8 -pady 2 - } { - keep -background -cursor -font -foreground \ - -activebackground -activeforeground - } - pack $itk_component(navmb) -side left - - itk_component add -private navmenu { - menu $itk_component(navmb).navmenu -tearoff no - } { - keep -background -cursor -font -foreground \ - -activebackground -activeforeground - } - set m $itk_component(navmenu) - $m add command -label "Forward" -underline 0 -state disabled \ - -command [code $this forward] -accelerator f - $m add command -label "Back" -underline 0 -state disabled \ - -command [code $this back] -accelerator b - $m add cascade -label "Go" -underline 0 -menu $m.go - - itk_component add -private navgo { - menu $itk_component(navmenu).go -postcommand [code $this _fill_go_menu] - } { - keep -background -cursor -font -foreground \ - -activebackground -activeforeground - } - - # - # Create a scrolledhtml object to display help pages - # - itk_component add scrtxt { - iwidgets::scrolledhtml $itk_interior.scrtxt \ - -linkcommand "$this followlink" -feedback "$this updatefeedback" - } { - keep -hscrollmode -vscrollmode -background -textbackground \ - -fontname -fontsize -fixedfont -link \ - -linkhighlight -borderwidth -cursor -sbwidth -scrollmargin \ - -width -height -foreground -highlightcolor -visibleitems \ - -highlightthickness -padx -pady -activerelief \ - -relief -selectbackground -selectborderwidth \ - -selectforeground -setgrid -wrap -unknownimage - } - pack $itk_component(scrtxt) -fill both -expand yes - - # - # Bind shortcut keys - # - bind $itk_component(hull) <Key-f> [code $this forward] - bind $itk_component(hull) <Key-b> [code $this back] - bind $itk_component(hull) <Alt-Right> [code $this forward] - bind $itk_component(hull) <Alt-Left> [code $this back] - bind $itk_component(hull) <Key-space> [code $this _pageforward] - bind $itk_component(hull) <Key-Next> [code $this _pageforward] - bind $itk_component(hull) <Key-BackSpace> [code $this _pageback] - bind $itk_component(hull) <Key-Prior> [code $this _pageback] - bind $itk_component(hull) <Key-Delete> [code $this _pageback] - bind $itk_component(hull) <Key-Down> [code $this _lineforward] - bind $itk_component(hull) <Key-Up> [code $this _lineback] - - wm title $itk_component(hull) "Help" - - eval itk_initialize $args - if {[lsearch -exact $args -closecmd] == -1} { - configure -closecmd [code $this deactivate] - } -} - -# ------------------------------------------------------------------ -# OPTIONS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# OPTION: -topics -# -# Specifies the topics to display on the menu. For each topic, there should -# be a file named <helpdir>/<topic>.html -# ------------------------------------------------------------------ -configbody iwidgets::Hyperhelp::topics { - set m $itk_component(topicmenu) - $m delete 0 last - foreach topic $itk_option(-topics) { - if {[lindex $topic 1] == {} } { - $m add radiobutton -variable topic \ - -value $topic \ - -label $topic \ - -command [list $this showtopic $topic] - } else { - if {[string index [file dirname [lindex $topic 1]] 0] != "/" && \ - [string index [file dirname [lindex $topic 1]] 0] != "~"} { - set link $itk_option(-helpdir)/[lindex $topic 1] - } else { - set link [lindex $topic 1] - } - $m add radiobutton -variable topic \ - -value [lindex $topic 0] \ - -label [lindex $topic 0] \ - -command [list $this followlink $link] - } - } - $m add separator - $m add command -label "Close Help" -underline 0 \ - -command $itk_option(-closecmd) -} - -# ------------------------------------------------------------------ -# OPTION: -title -# -# Specify the window title. -# ------------------------------------------------------------------ -configbody iwidgets::Hyperhelp::title { - wm title $itk_component(hull) $itk_option(-title) -} - -# ------------------------------------------------------------------ -# OPTION: -helpdir -# -# Set location of help files -# ------------------------------------------------------------------ -configbody iwidgets::Hyperhelp::helpdir { - if {[file pathtype $itk_option(-helpdir)] == "relative"} { - configure -helpdir [file join [pwd] $itk_option(-helpdir)] - } else { - set _history {} - set _history_len 0 - set _history_ndx -1 - $itk_component(navmenu) entryconfig 0 -state disabled - $itk_component(navmenu) entryconfig 1 -state disabled - configure -topics $itk_option(-topics) - } -} - -# ------------------------------------------------------------------ -# OPTION: -closecmd -# -# Specify the command to execute when close is selected from the menu -# ------------------------------------------------------------------ -configbody iwidgets::Hyperhelp::closecmd { - $itk_component(topicmenu) entryconfigure last -command $itk_option(-closecmd) -} - -# ------------------------------------------------------------------ -# METHODS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# METHOD: showtopic topic -# -# render text of help topic <topic>. The text is expected to be found in -# <helpdir>/<topic>.html -# ------------------------------------------------------------------ -body iwidgets::Hyperhelp::showtopic {topic} { - if ![regexp {(.*)#(.*)} $topic dummy topicname anchorpart] { - set topicname $topic - set anchorpart {} - } - if {$topicname == ""} { - set topicname $_file - set filepath $_file - } else { - set filepath $itk_option(-helpdir)/$topicname.html - } - if {[incr _history_ndx] < $itk_option(-maxhistory)} { - set _history [lrange $_history 0 [expr $_history_ndx - 1]] - set _history_len [expr $_history_ndx + 1] - } else { - incr _history_ndx -1 - set _history [lrange $_history 1 $_history_ndx] - set _history_len [expr $_history_ndx + 1] - } - lappend _history [list $topicname $filepath $anchorpart] - _readtopic $filepath $anchorpart -} - -# ------------------------------------------------------------------ -# METHOD: followlink link -# -# Callback for click on a link. Shows new topic. -# ------------------------------------------------------------------ -body iwidgets::Hyperhelp::followlink {link} { - if {[string compare $beforelink ""] != 0} { - eval $beforelink $link - } - if ![regexp {(.*)#(.*)} $link dummy filepart anchorpart] { - set filepart $link - set anchorpart {} - } - if {$filepart != "" && [string index [file dirname $filepart] 0] != "/" && \ - [string index [file dirname $filepart] 0] != "~"} { - set filepart [$itk_component(scrtxt) pwd]/$filepart - set hfile $filepart - } else { - set hfile $_file - } - incr _history_ndx - set _history [lrange $_history 0 [expr $_history_ndx - 1]] - set _history_len [expr $_history_ndx + 1] - lappend _history [list [file rootname [file tail $hfile]] $hfile $anchorpart] - set ret [_readtopic $filepart $anchorpart] - if {[string compare $afterlink ""] != 0} { - eval $afterlink $link - } - return $ret -} - -# ------------------------------------------------------------------ -# METHOD: forward -# -# Show topic one forward in history list -# ------------------------------------------------------------------ -body iwidgets::Hyperhelp::forward {} { - if {$_rendering || ($_history_ndx+1) >= $_history_len} return - incr _history_ndx - eval _readtopic [lrange [lindex $_history $_history_ndx] 1 end] -} - -# ------------------------------------------------------------------ -# METHOD: back -# -# Show topic one back in history list -# ------------------------------------------------------------------ -body iwidgets::Hyperhelp::back {} { - if {$_rendering || $_history_ndx <= 0} return - incr _history_ndx -1 - set _histdir 1 - eval _readtopic [lrange [lindex $_history $_history_ndx] 1 end] -} - -# ------------------------------------------------------------------ -# METHOD: updatefeedback remaining -# -# Callback from text to update feedback widget -# ------------------------------------------------------------------ -body iwidgets::Hyperhelp::updatefeedback {n} { - if {($_remaining - $n) > .1*$_len} { - [$itk_interior.feedbackshell childsite].helpfeedback step [expr $_remaining - $n] - update idletasks - set _remaining $n - } -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _readtopic -# -# Read in file, render it in text area, and jump to anchorpoint -# ------------------------------------------------------------------ -body iwidgets::Hyperhelp::_readtopic {file {anchorpoint {}}} { - if {$file != ""} { - if {[string compare $file $_file] != 0} { - if {[catch {set f [open $file r]} err]} { - incr _history_ndx $_histdir - set _history_len [expr $_history_ndx + 1] - set _histdir -1 - set m $itk_component(navmenu) - if {($_history_ndx+1) < $_history_len} { - $m entryconfig 0 -state normal - } else { - $m entryconfig 0 -state disabled - } - if {$_history_ndx > 0} { - $m entryconfig 1 -state normal - } else { - $m entryconfig 1 -state disabled - } - error $err - } - set _file $file - set txt [read $f] - iwidgets::shell $itk_interior.feedbackshell -title "Rendering HTML" -padx 1 -pady 1 - iwidgets::Feedback [$itk_interior.feedbackshell childsite].helpfeedback \ - -steps [set _len [string length $txt]] \ - -labeltext "Rendering HTML" -labelpos n - pack [$itk_interior.feedbackshell childsite].helpfeedback - $itk_interior.feedbackshell center $itk_interior - $itk_interior.feedbackshell activate - set _remaining $_len - set _rendering 1 - if [catch {$itk_component(scrtxt) render $txt [file dirname $file]} err] { - if [regexp "</pre>" $err] { - $itk_component(scrtxt) render "<tt>$err</tt>" - } else { - $itk_component(scrtxt) render "<pre>$err</pre>" - } - } - wm title $itk_component(hull) "Help: $file" - delete object [$itk_interior.feedbackshell childsite].helpfeedback - delete object $itk_interior.feedbackshell - set _rendering 0 - } - } - set m $itk_component(navmenu) - if {($_history_ndx+1) < $_history_len} { - $m entryconfig 0 -state normal - } else { - $m entryconfig 0 -state disabled - } - if {$_history_ndx > 0} { - $m entryconfig 1 -state normal - } else { - $m entryconfig 1 -state disabled - } - if {$anchorpoint != "{}"} { - $itk_component(scrtxt) import -link #$anchorpoint - } else { - $itk_component(scrtxt) import -link # - } - set _histdir -1 -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _fill_go_menu -# -# update go submenu with current history -# ------------------------------------------------------------------ -body iwidgets::Hyperhelp::_fill_go_menu {} { - set m $itk_component(navgo) - catch {$m delete 0 last} - for {set i [expr $_history_len - 1]} {$i >= 0} {incr i -1} { - set topic [lindex [lindex $_history $i] 0] - set filepath [lindex [lindex $_history $i] 1] - set anchor [lindex [lindex $_history $i] 2] - $m add command -label $topic \ - -command [list $this followlink $filepath#$anchor] - } -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _pageforward -# -# Callback for page forward shortcut key -# ------------------------------------------------------------------ -body iwidgets::Hyperhelp::_pageforward {} { - $itk_component(scrtxt) yview scroll 1 pages -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _pageback -# -# Callback for page back shortcut key -# ------------------------------------------------------------------ -body iwidgets::Hyperhelp::_pageback {} { - $itk_component(scrtxt) yview scroll -1 pages -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _lineforward -# -# Callback for line forward shortcut key -# ------------------------------------------------------------------ -body iwidgets::Hyperhelp::_lineforward {} { - $itk_component(scrtxt) yview scroll 1 units -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _lineback -# -# Callback for line back shortcut key -# ------------------------------------------------------------------ -body iwidgets::Hyperhelp::_lineback {} { - $itk_component(scrtxt) yview scroll -1 units -} diff --git a/itcl/iwidgets3.0.0/generic/labeledframe.itk b/itcl/iwidgets3.0.0/generic/labeledframe.itk deleted file mode 100644 index 0291c2053d2..00000000000 --- a/itcl/iwidgets3.0.0/generic/labeledframe.itk +++ /dev/null @@ -1,522 +0,0 @@ -# -# Labeledframe -# ---------------------------------------------------------------------- -# Implements a hull frame with a grooved relief, a label, and a -# frame childsite. -# -# The frame childsite can be filled with any widget via a derived class -# or though the use of the childsite method. This class was designed -# to be a general purpose base class for supporting the combination of -# a labeled frame and a childsite. The options include the ability to -# position the label at configurable locations within the grooved relief -# of the hull frame, and control the display of the label. -# -# To following demonstrates the different values which the "-labelpos" -# option may be set to and the resulting layout of the label when -# one executes the following command with "-labeltext" set to "LABEL": -# -# example: -# labeledframe .w -labeltext LABEL -labelpos <ne,n,nw,se,s,sw,en,e,es,wn,s,ws> -# -# ne n nw se s sw -# -# *LABEL**** **LABEL** ****LABEL* ********** ********* ********** -# * * * * * * * * * * * * -# * * * * * * * * * * * * -# * * * * * * * * * * * * -# ********** ********* ********** *LABEL**** **LABEL** ****LABEL* -# -# en e es wn s ws -# -# ********** ********* ********* ********* ********* ********** -# * * * * * * * * * * * * -# L * * * * * * L * * * * -# A * L * * * * A * L * L -# B * A * L * * B * A * A -# E * B * A * * E * B * B -# L * E * B * * L * E * E -# * * L * E * * * * L * L -# * * * * L * * * * * * * -# ********** ********** ********* ********** ********* ********** -# -# ---------------------------------------------------------------------- -# AUTHOR: John A. Tucker EMAIL: jatucker@spd.dsccc.com -# -# ====================================================================== -# Copyright (c) 1997 DSC Technologies Corporation -# ====================================================================== -# Permission to use, copy, modify, distribute and license this software -# and its documentation for any purpose, and without fee or written -# agreement with DSC, is hereby granted, provided that the above copyright -# notice appears in all copies and that both the copyright notice and -# warranty disclaimer below appear in supporting documentation, and that -# the names of DSC Technologies Corporation or DSC Communications -# Corporation not be used in advertising or publicity pertaining to the -# software without specific, written prior permission. -# -# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING -# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- -# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE -# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, -# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL -# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR -# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, -# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, -# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS -# SOFTWARE. -# ====================================================================== - -# -# Default resources. -# -option add *Labeledframe.labelMargin 10 widgetDefault -option add *Labeledframe.labelFont \ - "-Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*" widgetDefault -option add *Labeledframe.labelPos n widgetDefault -option add *Labeledframe.labelBorderWidth 2 widgetDefault -option add *Labeledframe.labelRelief groove widgetDefault - - -# -# Usual options. -# -itk::usual Labeledframe { - keep -background -cursor -labelfont -foreground -labelrelief -labelborderwidth -} - -class iwidgets::Labeledframe { - - inherit itk::Widget - - itk_option define -ipadx iPadX IPad 0 - itk_option define -ipady iPadY IPad 0 - - itk_option define -labelmargin labelMargin LabelMargin 10 - itk_option define -labelpos labelPos LabelPos n - itk_option define -labeltext labelText LabelText "" - - constructor {args} {} - destructor {} - - # - # Public methods - # - public method childsite {} - public method clientHandlesConfigure {{yes 1}} - - # - # Protected methods - # - - 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 - variable dontUpdate 0 - - common _LAYOUT_TABLE - } -} - -# -# Provide a lowercased access method for the Labeledframe class. -# -proc ::iwidgets::labeledframe {pathName args} { - uplevel ::iwidgets::Labeledframe $pathName $args -} - -# ----------------------------------------------------------------------------- -# CONSTRUCTOR -# ----------------------------------------------------------------------------- -body iwidgets::Labeledframe::constructor { args } { - # - # Create a window with the same name as this object - # - - itk_component add labelFrame { - frame $itk_interior.lf \ - -relief groove \ - -class [namespace tail [info class]] - } { - keep -background -cursor - rename -relief -labelrelief labelRelief LabelRelief - rename -borderwidth -labelborderwidth labelBorderWidth LabelBorderWidth - rename -highlightbackground -background background Background - rename -highlightcolor -background background Background - } - - # - # Create the childsite frame window - # _______ - # |_____| - # |_|X|_| - # |_____| - # - itk_component add childsite { - frame $itk_component(labelFrame).childsite -highlightthickness 0 -bd 0 - } - - # - # Create the label to be positioned within the grooved relief - # of the labelFrame frame. - # - itk_component add label { - label $itk_component(labelFrame).label -highlightthickness 0 -bd 0 - } { - usual - rename -bitmap -labelbitmap labelBitmap Bitmap - rename -font -labelfont labelFont Font - rename -image -labelimage labelImage Image - #rename -text -labeltext labelText Text - rename -textvariable -labelvariable labelVariable Variable - ignore -highlightthickness -highlightcolor -text - } - - grid $itk_component(childsite) -row 1 -column 1 -sticky nsew - grid columnconfigure $itk_component(labelFrame) 1 -weight 1 - grid rowconfigure $itk_component(labelFrame) 1 -weight 1 - - lappend after_script [code $this _positionLabel] - bind $itk_component(label) <Configure> +[code $this _positionLabel] - - pack $itk_component(labelFrame) -fill both -expand 1 - - # - # Initialize the class array of layout configuration options. Since - # this is a one time only thing. - # - _initTable - - eval itk_initialize $args - - # - # When idle, position the label. - # - _positionLabel -} - -# ----------------------------------------------------------------------------- -# DESTRUCTOR -# ----------------------------------------------------------------------------- -body iwidgets::Labeledframe::destructor {} { - debug "In Labeledframe destructor for $this, reposition is $_reposition" - if {$_reposition != ""} { - debug "Canceling reposition $_reposition for $this" - after cancel $_reposition - set _reposition DESTRUCTOR - } -} - -# ----------------------------------------------------------------------------- -# OPTIONS -# ----------------------------------------------------------------------------- - -# ------------------------------------------------------------------ -# OPTION: -ipadx -# -# Specifies the width of the horizontal gap from the border to the -# the child site. -# ------------------------------------------------------------------ -configbody iwidgets::Labeledframe::ipadx { - grid configure $itk_component(childsite) -padx $itk_option(-ipadx) - _positionLabel -} - -# ------------------------------------------------------------------ -# OPTION: -ipady -# -# Specifies the width of the vertical gap from the border to the -# the child site. -# ------------------------------------------------------------------ -configbody iwidgets::Labeledframe::ipady { - grid configure $itk_component(childsite) -pady $itk_option(-ipady) - _positionLabel -} - -# ----------------------------------------------------------------------------- -# OPTION: -labelmargin -# -# Set the margin of the most adjacent side of the label to the labelFrame -# relief. -# ---------------------------------------------------------------------------- -configbody iwidgets::Labeledframe::labelmargin { - _positionLabel -} - -# ----------------------------------------------------------------------------- -# OPTION: -labelpos -# -# Set the position of the label within the relief of the labelFrame frame -# widget. -# ---------------------------------------------------------------------------- -configbody iwidgets::Labeledframe::labelpos { - _positionLabel -} - -# ----------------------------------------------------------------------------- -# OPTION: -labelpos -# -# Set the position of the label within the relief of the labelFrame frame -# widget. -# ---------------------------------------------------------------------------- -configbody iwidgets::Labeledframe::labeltext { - $itk_component(label) configure -text $itk_option(-labeltext) - _positionLabel -} - -# ----------------------------------------------------------------------------- -# PROCS -# ----------------------------------------------------------------------------- - -# ----------------------------------------------------------------------------- -# PRIVATE PROC: _initTable -# -# Initializes the _LAYOUT_TABLE common variable of the Labeledframe -# class. The initialization is performed in its own proc ( as opposed -# to in the class definition ) so that the initialization occurs only -# once. -# -# _LAYOUT_TABLE common array description: -# Provides a table of the configuration option values -# used to place the label widget within the grooved relief of the labelFrame -# frame for each of the 12 possible "-labelpos" values. -# -# Each of the 12 rows is layed out as follows: -# {"-relx" "-rely" <rowconfigure|columnconfigure> <row/column number>} -# ----------------------------------------------------------------------------- -body iwidgets::Labeledframe::_initTable {} { - array set _LAYOUT_TABLE { - nw-relx 0.0 nw-rely 0.0 nw-wrap 0 nw-conf rowconfigure nw-num 0 - n-relx 0.5 n-rely 0.0 n-wrap 0 n-conf rowconfigure n-num 0 - ne-relx 1.0 ne-rely 0.0 ne-wrap 0 ne-conf rowconfigure ne-num 0 - - sw-relx 0.0 sw-rely 1.0 sw-wrap 0 sw-conf rowconfigure sw-num 2 - s-relx 0.5 s-rely 1.0 s-wrap 0 s-conf rowconfigure s-num 2 - se-relx 1.0 se-rely 1.0 se-wrap 0 se-conf rowconfigure se-num 2 - - en-relx 1.0 en-rely 0.0 en-wrap 1 en-conf columnconfigure en-num 2 - e-relx 1.0 e-rely 0.5 e-wrap 1 e-conf columnconfigure e-num 2 - es-relx 1.0 es-rely 1.0 es-wrap 1 es-conf columnconfigure es-num 2 - - wn-relx 0.0 wn-rely 0.0 wn-wrap 1 wn-conf columnconfigure wn-num 0 - w-relx 0.0 w-rely 0.5 w-wrap 1 w-conf columnconfigure w-num 0 - ws-relx 0.0 ws-rely 1.0 ws-wrap 1 ws-conf columnconfigure ws-num 0 - } - - # - # Since this is a one time only thing, we'll redefine the proc to be empty - # afterwards so it only happens once. - # - # NOTE: Be careful to use the "body" command, or the proc will get lost! - # - itcl::body ::iwidgets::Labeledframe::_initTable {} {} -} - -# ----------------------------------------------------------------------------- -# METHODS -# ----------------------------------------------------------------------------- - -# ----------------------------------------------------------------------------- -# PUBLIC METHOD:: childsite -# -# ----------------------------------------------------------------------------- -body iwidgets::Labeledframe::childsite {} { - return $itk_component(childsite) -} - -# ----------------------------------------------------------------------------- -# PUBLIC METHOD:: clientHandlesConfigure -# -# ----------------------------------------------------------------------------- -body iwidgets::Labeledframe::clientHandlesConfigure {{yes 1}} { - if {$yes} { - set dontUpdate 1 - bind $itk_component(label) <Configure> { } - return [code $this _positionLabel now] - } else { - bind $itk_component(label) <Configure> [code $this _positionLabel] - set dontUpdate 0 - } -} -# ----------------------------------------------------------------------------- -# PROTECTED METHOD: _positionLabel ?when? -# -# Places the label in the relief of the labelFrame. If "when" is "now", the -# change is applied immediately. If it is "later" or it is not -# specified, then the change is applied later, when the application -# is idle. -# ----------------------------------------------------------------------------- -body iwidgets::Labeledframe::_positionLabel {{when later}} { - - if {$when == "later"} { - if {$_reposition != ""} { - after cancel $_reposition - } - set _reposition [after idle [code $this _positionLabel now]] - return - } - - set pos $itk_option(-labelpos) - - # - # If there is not an entry for the "relx" value associated with - # the given "-labelpos" option value, then it invalid. - # - if { [catch {set relx $_LAYOUT_TABLE($pos-relx)}] } { - error "bad labelpos option\"$itk_option(-labelpos)\": should be\ - nw, n, ne, sw, s, se, en, e, es, wn, w, or ws" - } - - if {!$dontUpdate} { - update idletasks - if {[string compare $_reposition DESTRUCTOR] == 0} { - # OOPS... We are in the process of being destroyed. Get out of here... - debug "Stuck in _postionLabel during destruction" - return - } - } - - $itk_component(label) configure -wraplength $_LAYOUT_TABLE($pos-wrap) - - # If there is no text in the label, do not add it to the computation. - - if {$itk_option(-labeltext) == ""} { - set minsize 0 - if {[place slaves $itk_component(labelFrame)] != ""} { - place forget $itk_component(label) - } - _setMarginThickness 0 - } else { - set labelWidth [winfo reqwidth $itk_component(label)] - set labelHeight [winfo reqheight $itk_component(label)] - set borderwidth $itk_option(-labelborderwidth) - set margin $itk_option(-labelmargin) - - switch $pos { - nw { - set labelThickness $labelHeight - set minsize [expr $labelThickness/2.0] - set xPos [expr $minsize+$borderwidth+$margin] - set yPos -$minsize - } - n { - set labelThickness $labelHeight - set minsize [expr $labelThickness/2.0] - set xPos [expr -$labelWidth/2.0] - set yPos -$minsize - } - ne { - set labelThickness $labelHeight - set minsize [expr $labelThickness/2.0] - set xPos [expr -($minsize+$borderwidth+$margin+$labelWidth)] - set yPos -$minsize - } - - sw { - set labelThickness $labelHeight - set minsize [expr $labelThickness/2.0] - set xPos [expr $minsize+$borderwidth+$margin] - set yPos -$minsize - } - s { - set labelThickness $labelHeight - set minsize [expr $labelThickness/2.0] - set xPos [expr -$labelWidth/2.0] - set yPos [expr -$labelHeight/2.0] - } - se { - set labelThickness $labelHeight - set minsize [expr $labelThickness/2.0] - set xPos [expr -($minsize+$borderwidth+$margin+$labelWidth)] - set yPos [expr -$labelHeight/2.0] - } - - wn { - set labelThickness $labelWidth - set minsize [expr $labelThickness/2.0] - set xPos -$minsize - set yPos [expr $minsize+$margin+$borderwidth] - } - w { - set labelThickness $labelWidth - set minsize [expr $labelThickness/2.0] - set xPos -$minsize - set yPos [expr -($labelHeight/2.0)] - } - ws { - set labelThickness $labelWidth - set minsize [expr $labelThickness/2.0] - set xPos -$minsize - set yPos [expr -($minsize+$borderwidth+$margin+$labelHeight)] - } - - en { - set labelThickness $labelWidth - set minsize [expr $labelThickness/2.0] - set xPos -$minsize - set yPos [expr $minsize+$borderwidth+$margin] - } - e { - set labelThickness $labelWidth - set minsize [expr $labelThickness/2.0] - set xPos -$minsize - set yPos [expr -($labelHeight/2.0)] - } - es { - set labelThickness $labelWidth - set minsize [expr $labelThickness/2.0] - set xPos -$minsize - set yPos [expr -($minsize+$borderwidth+$margin+$labelHeight)] - } - } - _setMarginThickness $minsize - - place $itk_component(label) \ - -relx $_LAYOUT_TABLE($pos-relx) -x $xPos \ - -rely $_LAYOUT_TABLE($pos-rely) -y $yPos \ - -anchor nw - } - - set what $_LAYOUT_TABLE($pos-conf) - set number $_LAYOUT_TABLE($pos-num) - - grid $what $itk_component(labelFrame) $number -minsize $minsize - - set _reposition "" -} - -# ----------------------------------------------------------------------------- -# PROTECTED METHOD: _collapseMargin -# -# Resets the "-minsize" of all rows and columns of the labelFrame's grid -# used to set the label margin to 0 -# ----------------------------------------------------------------------------- -body iwidgets::Labeledframe::_collapseMargin {} { - grid columnconfigure $itk_component(labelFrame) 0 -minsize 0 - grid columnconfigure $itk_component(labelFrame) 2 -minsize 0 - grid rowconfigure $itk_component(labelFrame) 0 -minsize 0 - grid rowconfigure $itk_component(labelFrame) 2 -minsize 0 -} - -# ----------------------------------------------------------------------------- -# PROTECTED METHOD: _setMarginThickness -# -# Set the margin thickness ( i.e. the hidden "-highlightthickness" -# of the labelFrame ) to the input value. -# -# ----------------------------------------------------------------------------- -body iwidgets::Labeledframe::_setMarginThickness {value} { - $itk_component(labelFrame) configure -highlightthickness $value -} - - diff --git a/itcl/iwidgets3.0.0/generic/labeledwidget.itk b/itcl/iwidgets3.0.0/generic/labeledwidget.itk deleted file mode 100644 index 6c20ff110ab..00000000000 --- a/itcl/iwidgets3.0.0/generic/labeledwidget.itk +++ /dev/null @@ -1,437 +0,0 @@ -# -# Labeledwidget -# ---------------------------------------------------------------------- -# Implements a labeled widget which contains a label and child site. -# The child site is a frame which can filled with any widget via a -# derived class or though the use of the childsite method. This class -# was designed to be a general purpose base class for supporting the -# combination of label widget and a childsite, where a label may be -# text, bitmap or image. The options include the ability to position -# the label around the childsite widget, modify the font and margin, -# and control the display of the label. -# -# ---------------------------------------------------------------------- -# AUTHOR: Mark L. Ulferts EMAIL: mulferts@austin.dsccc.com -# -# @(#) $Id$ -# ---------------------------------------------------------------------- -# Copyright (c) 1995 DSC Technologies Corporation -# ====================================================================== -# Permission to use, copy, modify, distribute and license this software -# and its documentation for any purpose, and without fee or written -# agreement with DSC, is hereby granted, provided that the above copyright -# notice appears in all copies and that both the copyright notice and -# warranty disclaimer below appear in supporting documentation, and that -# the names of DSC Technologies Corporation or DSC Communications -# Corporation not be used in advertising or publicity pertaining to the -# software without specific, written prior permission. -# -# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING -# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- -# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE -# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, -# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL -# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR -# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, -# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, -# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS -# SOFTWARE. -# ====================================================================== - -# -# Usual options. -# -itk::usual Labeledwidget { - keep -background -cursor -foreground -labelfont -} - -# ------------------------------------------------------------------ -# LABELEDWIDGET -# ------------------------------------------------------------------ -class iwidgets::Labeledwidget { - inherit itk::Widget - - constructor {args} {} - destructor {} - - itk_option define -disabledforeground disabledForeground \ - DisabledForeground \#a3a3a3 - itk_option define -labelpos labelPos Position w - itk_option define -labelmargin labelMargin Margin 2 - itk_option define -labeltext labelText Text {} - itk_option define -labelvariable labelVariable Variable {} - itk_option define -labelbitmap labelBitmap Bitmap {} - itk_option define -labelimage labelImage Image {} - itk_option define -state state State normal - - public method childsite - - protected method _positionLabel {{when later}} - - proc alignlabels {args} {} - - protected variable _reposition "" ;# non-null => _positionLabel pending -} - -# -# Provide a lowercased access method for the Labeledwidget class. -# -proc ::iwidgets::labeledwidget {pathName args} { - uplevel ::iwidgets::Labeledwidget $pathName $args -} - -# ------------------------------------------------------------------ -# CONSTRUCTOR -# ------------------------------------------------------------------ -body iwidgets::Labeledwidget::constructor {args} { - # - # Create a frame for the childsite widget. - # - itk_component add -protected lwchildsite { - frame $itk_interior.lwchildsite - } - - # - # Create label. - # - itk_component add label { - label $itk_interior.label - } { - usual - - rename -font -labelfont labelFont Font - ignore -highlightcolor -highlightthickness - } - - # - # Set the interior to be the childsite for derived classes. - # - set itk_interior $itk_component(lwchildsite) - - # - # Initialize the widget based on the command line options. - # - eval itk_initialize $args - - # - # When idle, position the label. - # - _positionLabel -} - -# ------------------------------------------------------------------ -# DESTURCTOR -# ------------------------------------------------------------------ -body iwidgets::Labeledwidget::destructor {} { - if {$_reposition != ""} {after cancel $_reposition} -} - -# ------------------------------------------------------------------ -# OPTIONS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# OPTION: -disabledforeground -# -# Specified the foreground to be used on the label when disabled. -# ------------------------------------------------------------------ -configbody iwidgets::Labeledwidget::disabledforeground {} - -# ------------------------------------------------------------------ -# OPTION: -labelpos -# -# Set the position of the label on the labeled widget. The margin -# between the label and childsite comes along for the ride. -# ------------------------------------------------------------------ -configbody iwidgets::Labeledwidget::labelpos { - _positionLabel -} - -# ------------------------------------------------------------------ -# OPTION: -labelmargin -# -# Specifies the distance between the widget and label. -# ------------------------------------------------------------------ -configbody iwidgets::Labeledwidget::labelmargin { - _positionLabel -} - -# ------------------------------------------------------------------ -# OPTION: -labeltext -# -# Specifies the label text. -# ------------------------------------------------------------------ -configbody iwidgets::Labeledwidget::labeltext { - $itk_component(label) configure -text $itk_option(-labeltext) - - _positionLabel -} - -# ------------------------------------------------------------------ -# OPTION: -labelvariable -# -# Specifies the label text variable. -# ------------------------------------------------------------------ -configbody iwidgets::Labeledwidget::labelvariable { - $itk_component(label) configure -textvariable $itk_option(-labelvariable) - - uplevel [list trace variable \ - $itk_option(-labelvariable) w [code _positionLabel]] - - _positionLabel -} - -# ------------------------------------------------------------------ -# OPTION: -labelbitmap -# -# Specifies the label bitmap. -# ------------------------------------------------------------------ -configbody iwidgets::Labeledwidget::labelbitmap { - $itk_component(label) configure -bitmap $itk_option(-labelbitmap) - - _positionLabel -} - -# ------------------------------------------------------------------ -# OPTION: -labelimage -# -# Specifies the label image. -# ------------------------------------------------------------------ -configbody iwidgets::Labeledwidget::labelimage { - $itk_component(label) configure -image $itk_option(-labelimage) - - _positionLabel -} - -# ------------------------------------------------------------------ -# OPTION: -state -# -# Specifies the state of the label. -# ------------------------------------------------------------------ -configbody iwidgets::Labeledwidget::state { - _positionLabel -} - -# ------------------------------------------------------------------ -# METHODS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# METHOD: childsite -# -# Returns the path name of the child site widget. -# ------------------------------------------------------------------ -body iwidgets::Labeledwidget::childsite {} { - return $itk_component(lwchildsite) -} - -# ------------------------------------------------------------------ -# PROCEDURE: alignlabels widget ?widget ...? -# -# The alignlabels procedure takes a list of widgets derived from -# the Labeledwidget class and adjusts the label margin to align -# the labels. -# ------------------------------------------------------------------ -body iwidgets::Labeledwidget::alignlabels {args} { - update - set maxLabelWidth 0 - - # - # Verify that all the widgets are of type Labeledwidget and - # determine the size of the maximum length label string. - # - foreach iwid $args { - set objcmd [itcl::find objects -isa Labeledwidget *::$iwid] - - if {$objcmd == ""} { - error "$iwid is not a \"Labeledwidget\"" - } - - set csWidth [winfo reqwidth $iwid.lwchildsite] - set shellWidth [winfo reqwidth $iwid] - - if {[expr $shellWidth - $csWidth] > $maxLabelWidth} { - set maxLabelWidth [expr $shellWidth - $csWidth] - } - } - - # - # Adjust the margins for the labels such that the child sites and - # labels line up. - # - foreach iwid $args { - set csWidth [winfo reqwidth $iwid.lwchildsite] - set shellWidth [winfo reqwidth $iwid] - - set labelSize [expr $shellWidth - $csWidth] - - if {$maxLabelWidth > $labelSize} { - set objcmd [itcl::find objects -isa Labeledwidget *::$iwid] - set dist [expr $maxLabelWidth - \ - ($labelSize - [$objcmd cget -labelmargin])] - - $objcmd configure -labelmargin $dist - } - } -} - -# ------------------------------------------------------------------ -# PROTECTED METHOD: _positionLabel ?when? -# -# Packs the label and label margin. If "when" is "now", the -# change is applied immediately. If it is "later" or it is not -# specified, then the change is applied later, when the application -# is idle. -# ------------------------------------------------------------------ -body iwidgets::Labeledwidget::_positionLabel {{when later}} { - if {$when == "later"} { - if {$_reposition == ""} { - set _reposition [after idle [code $this _positionLabel now]] - } - return - - } elseif {$when != "now"} { - error "bad option \"$when\": should be now or later" - } - - # - # If we have a label, be it text, bitmap, or image continue. - # - if {($itk_option(-labeltext) != {}) || \ - ($itk_option(-labelbitmap) != {}) || \ - ($itk_option(-labelimage) != {}) || \ - ($itk_option(-labelvariable) != {})} { - - # - # Set the foreground color based on the state. - # - if {[info exists itk_option(-state)]} { - switch -- $itk_option(-state) { - disabled { - $itk_component(label) configure \ - -foreground $itk_option(-disabledforeground) - } - normal { - $itk_component(label) configure \ - -foreground $itk_option(-foreground) - } - } - } - - set parent [winfo parent $itk_component(lwchildsite)] - - # - # Switch on the label position option. Using the grid, - # adjust the row/column setting of the label, margin, and - # and childsite. The margin height/width is adjust based - # on the orientation as well. Finally, set the weights such - # that the childsite takes the heat on expansion and shrinkage. - # - switch $itk_option(-labelpos) { - nw - - n - - ne { - grid $itk_component(label) -row 0 -column 0 \ - -sticky $itk_option(-labelpos) - grid $itk_component(lwchildsite) -row 2 -column 0 \ - -sticky nsew - - grid rowconfigure $parent 0 -weight 0 -minsize 0 - grid rowconfigure $parent 1 -weight 0 -minsize \ - [winfo pixels $itk_component(label) \ - $itk_option(-labelmargin)] - grid rowconfigure $parent 2 -weight 1 -minsize 0 - - grid columnconfigure $parent 0 -weight 1 -minsize 0 - grid columnconfigure $parent 1 -weight 0 -minsize 0 - grid columnconfigure $parent 2 -weight 0 -minsize 0 - } - - en - - e - - es { - grid $itk_component(lwchildsite) -row 0 -column 0 \ - -sticky nsew - grid $itk_component(label) -row 0 -column 2 \ - -sticky $itk_option(-labelpos) - - grid rowconfigure $parent 0 -weight 1 -minsize 0 - grid rowconfigure $parent 1 -weight 0 -minsize 0 - grid rowconfigure $parent 2 -weight 0 -minsize 0 - - grid columnconfigure $parent 0 -weight 1 -minsize 0 - grid columnconfigure $parent 1 -weight 0 -minsize \ - [winfo pixels $itk_component(label) \ - $itk_option(-labelmargin)] - grid columnconfigure $parent 2 -weight 0 -minsize 0 - } - - se - - s - - sw { - grid $itk_component(lwchildsite) -row 0 -column 0 \ - -sticky nsew - grid $itk_component(label) -row 2 -column 0 \ - -sticky $itk_option(-labelpos) - - grid rowconfigure $parent 0 -weight 1 -minsize 0 - grid rowconfigure $parent 1 -weight 0 -minsize \ - [winfo pixels $itk_component(label) \ - $itk_option(-labelmargin)] - grid rowconfigure $parent 2 -weight 0 -minsize 0 - - grid columnconfigure $parent 0 -weight 1 -minsize 0 - grid columnconfigure $parent 1 -weight 0 -minsize 0 - grid columnconfigure $parent 2 -weight 0 -minsize 0 - } - - wn - - w - - ws { - grid $itk_component(lwchildsite) -row 0 -column 2 \ - -sticky nsew - grid $itk_component(label) -row 0 -column 0 \ - -sticky $itk_option(-labelpos) - - grid rowconfigure $parent 0 -weight 1 -minsize 0 - grid rowconfigure $parent 1 -weight 0 -minsize 0 - grid rowconfigure $parent 2 -weight 0 -minsize 0 - - grid columnconfigure $parent 0 -weight 0 -minsize 0 - grid columnconfigure $parent 1 -weight 0 -minsize \ - [winfo pixels $itk_component(label) \ - $itk_option(-labelmargin)] - grid columnconfigure $parent 2 -weight 1 -minsize 0 - } - - default { - error "bad labelpos option\ - \"$itk_option(-labelpos)\": should be\ - nw, n, ne, sw, s, se, en, e, es, wn, w, or ws" - } - } - - # - # Else, neither the label text, bitmap, or image have a value, so - # forget them so they don't appear and manage only the childsite. - # - } else { - grid forget $itk_component(label) - - grid $itk_component(lwchildsite) -row 0 -column 0 -sticky nsew - - set parent [winfo parent $itk_component(lwchildsite)] - - grid rowconfigure $parent 0 -weight 1 -minsize 0 - grid rowconfigure $parent 1 -weight 0 -minsize 0 - grid rowconfigure $parent 2 -weight 0 -minsize 0 - grid columnconfigure $parent 0 -weight 1 -minsize 0 - grid columnconfigure $parent 1 -weight 0 -minsize 0 - grid columnconfigure $parent 2 -weight 0 -minsize 0 - } - - # - # Reset the resposition flag. - # - set _reposition "" -} diff --git a/itcl/iwidgets3.0.0/generic/mainwindow.itk b/itcl/iwidgets3.0.0/generic/mainwindow.itk deleted file mode 100644 index b5cc895e88e..00000000000 --- a/itcl/iwidgets3.0.0/generic/mainwindow.itk +++ /dev/null @@ -1,313 +0,0 @@ -# -# Mainwindow -# ---------------------------------------------------------------------- -# This class implements a mainwindow containing a menubar, toolbar, -# mousebar, childsite, status line, and help line. Each item may -# be filled and configured to suit individual needs. -# -# ---------------------------------------------------------------------- -# AUTHOR: Mark L. Ulferts EMAIL: mulferts@austin.dsccc.com -# -# @(#) RCS: $Id$ -# ---------------------------------------------------------------------- -# Copyright (c) 1997 DSC Technologies Corporation -# ====================================================================== -# Permission to use, copy, modify, distribute and license this software -# and its documentation for any purpose, and without fee or written -# agreement with DSC, is hereby granted, provided that the above copyright -# notice appears in all copies and that both the copyright notice and -# warranty disclaimer below appear in supporting documentation, and that -# the names of DSC Technologies Corporation or DSC Communications -# Corporation not be used in advertising or publicity pertaining to the -# software without specific, written prior permission. -# -# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING -# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- -# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE -# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, -# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL -# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR -# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, -# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, -# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS -# SOFTWARE. -# ====================================================================== - -# ------------------------------------------------------------------ -# MAINWINDOW -# ------------------------------------------------------------------ -class iwidgets::Mainwindow { - inherit iwidgets::Shell - - constructor {args} {} - - itk_option define -helpline helpLine HelpLine 1 - itk_option define -statusline statusLine StatusLine 1 - - public { - method childsite {} - method menubar {args} - method mousebar {args} - method msgd {args} - method toolbar {args} - } - - protected { - method _exitCB {} - - common _helpVar - common _statusVar - } -} - -# -# Provide a lowercased access method for the ::iwidgets::Mainwindow class. -# -proc iwidgets::mainwindow {pathName args} { - uplevel ::iwidgets::Mainwindow $pathName $args -} - -# ------------------------------------------------------------------ -# CONSTRUCTOR -# ------------------------------------------------------------------ -body iwidgets::Mainwindow::constructor {args} { - itk_option add hull.width hull.height - - pack propagate $itk_component(hull) no - - wm protocol $itk_component(hull) WM_DELETE_WINDOW [code $this _exitCB] - - # - # Create a menubar, renaming the font, foreground, and background - # so they may be separately set. The help variable will be setup - # as well. - # - itk_component add menubar { - iwidgets::Menubar $itk_interior.menubar \ - -helpvariable [scope _helpVar($this)] - } { - keep -disabledforeground -cursor \ - -highlightbackground -highlightthickness - rename -font \ - -menubarfont menuBarFont Font - rename -foreground \ - -menubarforeground menuBarForeground Foreground - rename -background \ - -menubarbackground menuBarBackground Background - } - - # - # Add a toolbar beneath the menubar. - # - itk_component add toolbar { - iwidgets::Toolbar $itk_interior.toolbar -orient horizontal \ - -helpvariable [scope _helpVar($this)] - } { - keep -balloonbackground -balloondelay1 -balloondelay2 \ - -balloonfont -balloonforeground -disabledforeground -cursor \ - -highlightbackground -highlightthickness - rename -font -toolbarfont toolbarFont Font - rename -foreground -toolbarforeground toolbarForeground Foreground - rename -background -toolbarbackground toolbarBackground Background - } - - # - # Add a mouse bar on the left. - # - itk_component add mousebar { - iwidgets::Toolbar $itk_interior.mousebar -orient vertical \ - -helpvariable [scope _helpVar($this)] - } { - keep -balloonbackground -balloondelay1 -balloondelay2 \ - -balloonfont -balloonforeground -disabledforeground -cursor \ - -highlightbackground -highlightthickness - rename -font -toolbarfont toolbarFont Font - rename -foreground -toolbarforeground toolbarForeground Foreground - rename -background -toolbarbackground toolbarBackground Background - } - - # - # Create the childsite window window. - # - itk_component add -protected mwchildsite { - frame $itk_interior.mwchildsite - } - - # - # Add the help and system status lines - # - itk_component add -protected lineframe { - frame $itk_interior.lineframe - } - - itk_component add help { - label $itk_component(lineframe).help \ - -textvariable [scope _helpVar($this)] \ - -relief sunken -borderwidth 2 -width 10 - } - - itk_component add status { - label $itk_component(lineframe).status \ - -textvariable [scope _statusVar($this)] \ - -relief sunken -borderwidth 2 -width 10 - } - - # - # Create the message dialog for use throughout the mainwindow. - # - itk_component add msgd { - iwidgets::Messagedialog $itk_interior.msgd -modality application - } { - usual - ignore -modality - } - - # - # Use the grid to pack together the menubar, toolbar, mousebar, - # childsite, and status area. - # - grid $itk_component(menubar) -row 0 -column 0 -columnspan 2 -sticky ew - grid $itk_component(toolbar) -row 1 -column 0 -columnspan 2 -sticky ew - grid $itk_component(mousebar) -row 2 -column 0 -sticky ns - grid $itk_component(mwchildsite) -row 2 -column 1 -sticky nsew \ - -padx 5 -pady 5 - grid $itk_component(lineframe) -row 3 -column 0 -columnspan 2 -sticky ew - - grid columnconfigure $itk_interior 1 -weight 1 - grid rowconfigure $itk_interior 2 -weight 1 - - # - # Set the interior to be the childsite for derived classes. - # - set itk_interior $itk_component(mwchildsite) - - # - # Initialize all the configuration options. - # - eval itk_initialize $args -} - -# ------------------------------------------------------------------ -# OPTIONS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# OPTION: -helpline -# -# Specifies whether or not to display the help line. The value -# may be given in any of the forms acceptable to Tk_GetBoolean. -# ------------------------------------------------------------------ -configbody iwidgets::Mainwindow::helpline { - if {$itk_option(-helpline)} { - pack $itk_component(help) -side left -fill x -expand yes -padx 2 - } else { - pack forget $itk_component(help) - } -} - -# ------------------------------------------------------------------ -# OPTION: -statusline -# -# Specifies whether or not to display the status line. The value -# may be given in any of the forms acceptable to Tk_GetBoolean. -# ------------------------------------------------------------------ -configbody iwidgets::Mainwindow::statusline { - if {$itk_option(-statusline)} { - pack $itk_component(status) -side right -fill x -expand yes -padx 2 - } else { - pack forget $itk_component(status) - } -} - -# ------------------------------------------------------------------ -# METHODS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# METHOD: childsite -# -# Return the childsite widget. -# ------------------------------------------------------------------ -body iwidgets::Mainwindow::childsite {} { - return $itk_component(mwchildsite) -} - -# ------------------------------------------------------------------ -# METHOD: menubar ?args? -# -# Evaluate the args against the Menubar component. -# ------------------------------------------------------------------ -body iwidgets::Mainwindow::menubar {args} { - if {[llength $args] == 0} { - return $itk_component(menubar) - } else { - return [eval $itk_component(menubar) $args] - } -} - -# ------------------------------------------------------------------ -# METHOD: toolbar ?args? -# -# Evaluate the args against the Toolbar component. -# ------------------------------------------------------------------ -body iwidgets::Mainwindow::toolbar {args} { - if {[llength $args] == 0} { - return $itk_component(toolbar) - } else { - return [eval $itk_component(toolbar) $args] - } -} - -# ------------------------------------------------------------------ -# METHOD: mousebar ?args? -# -# Evaluate the args against the Mousebar component. -# ------------------------------------------------------------------ -body iwidgets::Mainwindow::mousebar {args} { - if {[llength $args] == 0} { - return $itk_component(mousebar) - } else { - return [eval $itk_component(mousebar) $args] - } -} - -# ------------------------------------------------------------------ -# METHOD: msgd ?args? -# -# Evaluate the args against the Messagedialog component. -# ------------------------------------------------------------------ -body iwidgets::Mainwindow::msgd {args} { - if {[llength $args] == 0} { - return $itk_component(msgd) - } else { - return [eval $itk_component(msgd) $args] - } -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _exitCB -# -# Menu callback for the exit option from the file menu. The method -# confirms the user's request to exit the application prior to -# taking the action. -# ------------------------------------------------------------------ -body iwidgets::Mainwindow::_exitCB {} { - # - # Configure the message dialog for confirmation of the exit request. - # - msgd configure -title Confirmation -bitmap questhead \ - -text "Exit confirmation\n\ - Are you sure ?" - msgd buttonconfigure OK -text Yes - msgd buttonconfigure Cancel -text No - msgd default Cancel - msgd center $itk_component(hull) - - # - # Activate the message dialog and given a positive response - # proceed to exit the application - # - if {[msgd activate]} { - ::exit - } -} diff --git a/itcl/iwidgets3.0.0/generic/menubar.itk b/itcl/iwidgets3.0.0/generic/menubar.itk deleted file mode 100644 index 1b6e0b25329..00000000000 --- a/itcl/iwidgets3.0.0/generic/menubar.itk +++ /dev/null @@ -1,2244 +0,0 @@ -# -# Menubar widget -# ---------------------------------------------------------------------- -# The Menubar command creates a new window (given by the pathName -# argument) and makes it into a Pull down menu widget. Additional -# options, described above may be specified on the command line or -# in the option database to configure aspects of the Menubar such -# as its colors and font. The Menubar command returns its pathName -# argument. At the time this command is invoked, there must not exist -# a window named pathName, but pathName's parent must exist. -# -# A Menubar is a widget that simplifies the task of creating -# menu hierarchies. It encapsulates a frame widget, as well -# as menubuttons, menus, and menu entries. The Menubar allows -# menus to be specified and refer enced in a more consistent -# manner than using Tk to build menus directly. First, Menubar -# allows a menu tree to be expressed in a hierachical "language". -# The Menubar accepts a menuButtons option that allows a list of -# menubuttons to be added to the Menubar. In turn, each menubutton -# accepts a menu option that spec ifies a list of menu entries -# to be added to the menubutton's menu (as well as an option -# set for the menu). Cascade entries in turn, accept a menu -# option that specifies a list of menu entries to be added to -# the cascade's menu (as well as an option set for the menu). In -# this manner, a complete menu grammar can be expressed to the -# Menubar. Additionally, the Menubar allows each component of -# the Menubar system to be referenced by a simple componentPathName -# syntax. Finally, the Menubar extends the option set of menu -# entries to include the helpStr option used to implement status -# bar help. -# -# WISH LIST: -# This section lists possible future enhancements. -# -# ---------------------------------------------------------------------- -# AUTHOR: Bill W. Scott EMAIL: bscott@spd.dsccc.com -# -# @(#) $Id$ -# ---------------------------------------------------------------------- -# Copyright (c) 1995 DSC Technologies Corporation -# ====================================================================== -# Permission to use, copy, modify, distribute and license this software -# and its documentation for any purpose, and without fee or written -# agreement with DSC, is hereby granted, provided that the above copyright -# notice appears in all copies and that both the copyright notice and -# warranty disclaimer below appear in supporting documentation, and that -# the names of DSC Technologies Corporation or DSC Communications -# Corporation not be used in advertising or publicity pertaining to the -# software without specific, written prior permission. -# -# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING -# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- -# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE -# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, -# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL -# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR -# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, -# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, -# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS -# SOFTWARE. -# ====================================================================== - - -# -# Usual options. -# -itk::usual Menubar { - keep -activebackground -activeborderwidth -activeforeground \ - -anchor -background -borderwidth -cursor -disabledforeground \ - -font -foreground -highlightbackground -highlightthickness \ - -highlightcolor -justify -padx -pady -wraplength -} - -class iwidgets::Menubar { - inherit itk::Widget - - constructor { args } {} - - itk_option define -foreground foreground Foreground Black - itk_option define -activebackground activeBackground Foreground "#ececec" - itk_option define -activeborderwidth activeBorderWidth BorderWidth 2 - itk_option define -activeforeground activeForeground Background black - itk_option define -anchor anchor Anchor center - itk_option define -borderwidth borderWidth BorderWidth 2 - itk_option define \ - -disabledforeground disabledForeground DisabledForeground #a3a3a3 - itk_option define \ - -font font Font "-Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*" - itk_option define \ - -highlightbackground highlightBackground HighlightBackground #d9d9d9 - itk_option define -highlightcolor highlightColor HighlightColor Black - itk_option define \ - -highlightthickness highlightThickness HighlightThickness 0 - itk_option define -justify justify Justify center - itk_option define -padx padX Pad 4p - itk_option define -pady padY Pad 3p - itk_option define -wraplength wrapLength WrapLength 0 - itk_option define -menubuttons menuButtons MenuButtons {} - itk_option define -helpvariable helpVariable HelpVariable {} - - public { - method add { type path args } { } - method delete { args } { } - method index { path } { } - method insert { beforeComponent type name args } - method invoke { entryPath } { } - method menucget { args } { } - method menuconfigure { path args } { } - method path { args } { } - method type { path } { } - method yposition { entryPath } { } - } - - private { - method menubutton { menuName args } { } - method options { args } { } - method command { cmdName args } { } - method checkbutton { chkName args } { } - 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} { } - method _makeMenu \ - { componentName widgetName menuPath menuEvalStr } { } - method _substEvalStr { evalStr } { } - method _deleteMenu { menuPath {menuPath2 {}} } { } - method _deleteAMenu { path } { } - method _addEntry { type path args } { } - method _addCascade { tkMenuPath path args } { } - method _insertEntry { beforeEntryPath type name args } { } - method _insertCascade { bfIndex tkMenuPath path args } { } - method _deleteEntry { entryPath {entryPath2 {}} } { } - method _configureMenu { path tkPath {option {}} args } { } - method _configureMenuOption { type path args } { } - method _configureMenuEntry { path index {option {}} args } { } - method _unsetPaths { parent } { } - method _entryPathToTkMenuPath {entryPath} { } - method _getTkIndex { tkMenuPath tkIndex} { } - method _getPdIndex { tkMenuPath tkIndex } { } - method _getMenuList { } { } - method _getEntryList { menu } { } - method _parsePath { path } { } - method _getSymbolicPath { parent segment } { } - method _getCallerLevel { } - - variable _parseLevel 0 ;# The parse level depth - variable _callerLevel #0 ;# abs level of caller - variable _pathMap ;# Array indexed by Menubar's path - ;# naming, yields tk menu path - variable _entryIndex -1 ;# current entry help is displayed - ;# for during help <motion> events - - variable _tkMenuPath ;# last tk menu being added to - variable _ourMenuPath ;# our last valid path constructed. - - variable _menuOption ;# The -menu option - variable _helpString ;# The -helpstr optio - } -} - -# -# Use option database to override default resources. -# -option add *Menubar*Menu*tearOff false widgetDefault -option add *Menubar*Menubutton*relief flat widgetDefault -option add *Menubar*Menu*relief raised widgetDefault - -# -# Provide a lowercase access method for the menubar class -# -proc ::iwidgets::menubar { args } { - uplevel ::iwidgets::Menubar $args -} - -# ------------------------------------------------------------------ -# CONSTRUCTOR -# ------------------------------------------------------------------ -body iwidgets::Menubar::constructor { args } { - component hull configure -borderwidth 0 - - # - # Create the Menubar Frame that will hold the menus. - # - # might want to make -relief and -bd options with defaults - itk_component add menubar { - frame $itk_interior.menubar -relief raised -bd 2 - } { - keep -cursor -background -width -height - } - pack $itk_component(menubar) -fill both -expand yes - - # Map our pathname to class to the actual menubar frame - set _pathMap(.) $itk_component(menubar) - - eval itk_initialize $args - - # - # HACK HACK HACK - # Tk expects some variables to be defined and due to some - # unknown reason we confuse its normal ordering. So, if - # the user creates a menubutton with no menu it will fail - # when clicked on with a "Error: can't read $tkPriv(oldGrab): - # no such element in array". So by setting it to null we - # avoid this error. - uplevel #0 "set tkPriv(oldGrab) {}" - -} - -# ------------------------------------------------------------------ -# OPTIONS -# ------------------------------------------------------------------ -# This first set of options are for configuring menus and/or menubuttons -# at the menu level. -# -# ------------------------------------------------------------------ -# OPTION -foreground -# -# menu -# menubutton -# ------------------------------------------------------------------ -configbody iwidgets::Menubar::foreground { -} - -# ------------------------------------------------------------------ -# OPTION -activebackground -# -# menu -# menubutton -# ------------------------------------------------------------------ -configbody iwidgets::Menubar::activebackground { -} - -# ------------------------------------------------------------------ -# OPTION -activeborderwidth -# -# menu -# ------------------------------------------------------------------ -configbody iwidgets::Menubar::activeborderwidth { -} - -# ------------------------------------------------------------------ -# OPTION -activeforeground -# -# menu -# menubutton -# ------------------------------------------------------------------ -configbody iwidgets::Menubar::activeforeground { -} - -# ------------------------------------------------------------------ -# OPTION -anchor -# -# menubutton -# ------------------------------------------------------------------ -configbody iwidgets::Menubar::anchor { -} - -# ------------------------------------------------------------------ -# OPTION -borderwidth -# -# menu -# menubutton -# ------------------------------------------------------------------ -configbody iwidgets::Menubar::borderwidth { -} - -# ------------------------------------------------------------------ -# OPTION -disabledforeground -# -# menu -# menubutton -# ------------------------------------------------------------------ -configbody iwidgets::Menubar::disabledforeground { -} - -# ------------------------------------------------------------------ -# OPTION -font -# -# menu -# menubutton -# ------------------------------------------------------------------ -configbody iwidgets::Menubar::font { -} - -# ------------------------------------------------------------------ -# OPTION -highlightbackground -# -# menubutton -# ------------------------------------------------------------------ -configbody iwidgets::Menubar::highlightbackground { -} - -# ------------------------------------------------------------------ -# OPTION -highlightcolor -# -# menubutton -# ------------------------------------------------------------------ -configbody iwidgets::Menubar::highlightcolor { -} - -# ------------------------------------------------------------------ -# OPTION -highlightthickness -# -# menubutton -# ------------------------------------------------------------------ -configbody iwidgets::Menubar::highlightthickness { -} - -# ------------------------------------------------------------------ -# OPTION -justify -# -# menubutton -# ------------------------------------------------------------------ -configbody iwidgets::Menubar::justify { -} - -# ------------------------------------------------------------------ -# OPTION -padx -# -# menubutton -# ------------------------------------------------------------------ -configbody iwidgets::Menubar::padx { -} - -# ------------------------------------------------------------------ -# OPTION -pady -# -# menubutton -# ------------------------------------------------------------------ -configbody iwidgets::Menubar::pady { -} - -# ------------------------------------------------------------------ -# OPTION -wraplength -# -# menubutton -# ------------------------------------------------------------------ -configbody iwidgets::Menubar::wraplength { -} - -# ------------------------------------------------------------------ -# OPTION -menubuttons -# -# The menuButton option is a string which specifies the arrangement -# of menubuttons on the Menubar frame. Each menubutton entry is -# delimited by the newline character. Each entry is treated as -# an add command to the Menubar. -# -# ------------------------------------------------------------------ -configbody iwidgets::Menubar::menubuttons { - if { $itk_option(-menubuttons) != {} } { - - # IF one exists already, delete the old one and create - # a new one - if { ! [catch {_parsePath .0}] } { - delete .0 .last - } - - # - # Determine the context level to evaluate the option string at - # - set _callerLevel [_getCallerLevel] - - # - # Parse the option string in their scope, then execute it in - # our scope. - # - incr _parseLevel - _substEvalStr itk_option(-menubuttons) - eval $itk_option(-menubuttons) - - # reset so that we know we aren't parsing in a scope currently. - incr _parseLevel -1 - } -} - -# ------------------------------------------------------------------ -# OPTION -helpvariable -# -# Specifies the global variable to update whenever the mouse is in -# motion over a menu entry. This global variable is updated with the -# current value of the active menu entry's helpStr. Other widgets -# can "watch" this variable with the trace command, or as is the -# case with entry or label widgets, they can set their textVariable -# to the same global variable. This allows for a simple implementation -# of a help status bar. Whenever the mouse leaves a menu entry, -# the helpVariable is set to the empty string {}. -# ------------------------------------------------------------------ -configbody iwidgets::Menubar::helpvariable { - if {"" != $itk_option(-helpvariable) && - ![string match ::* $itk_option(-helpvariable)] && - ![string match @itcl* $itk_option(-helpvariable)]} { - set itk_option(-helpvariable) "::$itk_option(-helpvariable)" - } -} - - -# ------------------------------------------------------------- -# -# METHOD: add type path args -# -# Adds either a menu to the menu bar or a menu entry to a -# menu pane. -# -# If the type is one of cascade, checkbutton, command, -# radiobutton, or separator it adds a new entry to the bottom -# of the menu denoted by the menuPath prefix of componentPath- -# Name. The new entry's type is given by type. If additional -# arguments are present, they specify options available to -# component type Entry. See the man pages for menu(n) in the -# section on Entries. In addition all entries accept an added -# option, helpStr: -# -# -helpstr value -# -# Specifes the string to associate with the entry. -# When the mouse moves over the associated entry, the variable -# denoted by helpVariable is set. Another widget can bind to -# the helpVariable and thus display status help. -# -# If the type is menubutton, it adds a new menubut- -# ton to the menu bar. If additional arguments are present, -# they specify options available to component type MenuButton. -# -# If the type is menubutton or cascade, the menu -# option is available in addition to normal Tk options for -# these to types. -# -# -menu menuSpec -# -# This is only valid for componentPathNames of type -# menubutton or cascade. Specifes an option set and/or a set -# of entries to place on a menu and associate with the menu- -# button or cascade. The option keyword allows the menu widget -# to be configured. Each item in the menuSpec is treated as -# add commands (each with the possibility of having other -# -menu options). In this way a menu can be recursively built. -# -# The last segment of componentPathName cannot be -# one of the keywords last, menu, end. Additionally, it may -# not be a number. However the componentPathName may be refer- -# enced in this manner (see discussion of Component Path -# Names). -# -# ------------------------------------------------------------- -body iwidgets::Menubar::add { type path args } { - if ![regexp \ - {^(menubutton|command|cascade|separator|radiobutton|checkbutton)$} \ - $type] { - error "bad type \"$type\": must be one of the following:\ - \"command\", \"checkbutton\", \"radiobutton\",\ - \"separator\", \"cascade\", or \"menubutton\"" - } - regexp {[^.]+$} $path segName - if [regexp {^(menu|last|end|[0-9]+)$} $segName] { - error "bad name \"$segName\": user created component \ - path names may not end with \ - \"end\", \"last\", \"menu\", \ - or be an integer" - } - - # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, - # OK, either add a menu - # ''''''''''''''''''''''''''''''''''''''''''''''''''''' - if { $type == "menubutton" } { - # grab the last component name (the menu name) - eval _addMenuButton $segName $args - # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, - # Or add an entry - # ''''''''''''''''''''''''''''''''''''''''''''''''''''' - } else { - eval _addEntry $type $path $args - } -} - - -# ------------------------------------------------------------- -# -# METHOD: delete entryPath ?entryPath2? -# -# If componentPathName is of component type MenuButton or -# Menu, delete operates on menus. If componentPathName is of -# component type Entry, delete operates on menu entries. -# -# This command deletes all components between com- -# ponentPathName and componentPathName2 inclusive. If com- -# ponentPathName2 is omitted then it defaults to com- -# ponentPathName. Returns an empty string. -# -# If componentPathName is of type Menubar, then all menus -# and the menu bar frame will be destroyed. In this case com- -# ponentPathName2 is ignored. -# -# ------------------------------------------------------------- -body iwidgets::Menubar::delete { args } { - - # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, - # Handle out of bounds in arg lengths - # ''''''''''''''''''''''''''''''''''''''''''''''''''''' - if { [llength $args] > 0 && [llength $args] <=2 } { - - # Path Conversions - # ''''''''''''''''''''''''''''''''''''''''''''''''''''' - set path [_parsePath [lindex $args 0]] - - set pathOrIndex $_pathMap($path) - - # Menu Entry - # ''''''''''''''''''''''''''''''''''''''''''''''''''''' - if { [regexp {^[0-9]+$} $pathOrIndex] } { - eval "_deleteEntry $args" - - # Menu - # ''''''''''''''''''''''''''''''''''''''''''''''''''''' - } else { - eval "_deleteMenu $args" - } - } else { - error "wrong # args: should be \ - \"$itk_component(hull) delete pathName ?pathName2?\"" - } - return "" -} - -# ------------------------------------------------------------- -# -# METHOD: index path -# -# If componentPathName is of type menubutton or menu, it -# returns the position of the menu/menubutton on the Menubar -# frame. -# -# If componentPathName is of type command, separator, -# radiobutton, checkbutton, or cascade, it returns the menu -# widget's numerical index for the entry corresponding to com- -# ponentPathName. If path is not found or the Menubar frame is -# passed in, -1 is returned. -# -# ------------------------------------------------------------- -body iwidgets::Menubar::index { path } { - - # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, - # Path conversions - # ''''''''''''''''''''''''''''''''''''''''''''''''''''' - if { [catch {set fullPath [_parsePath $path]} ] } { - return -1 - } - if { [catch {set tkPathOrIndex $_pathMap($fullPath)} ] } { - return -1 - } - - # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, - # If integer, return the value, otherwise look up the menu position - # ''''''''''''''''''''''''''''''''''''''''''''''''''''' - if { [regexp {^[0-9]+$} $tkPathOrIndex] } { - set index $tkPathOrIndex - } else { - set index [lsearch [_getMenuList] $fullPath] - } - - return $index -} - -# ------------------------------------------------------------- -# -# METHOD: insert beforeComponent type name ?option value? -# -# Insert a new component named name before the component -# specified by componentPathName. -# -# If componentPathName is of type MenuButton or Menu, the -# new component inserted is of type Menu and given the name -# name. In this case valid option value pairs are those -# accepted by menubuttons. -# -# If componentPathName is of type Entry, the new com- -# ponent inserted is of type Entry and given the name name. In -# this case valid option value pairs are those accepted by -# menu entries. -# -# name cannot be one of the keywords last, menu, end. -# dditionally, it may not be a number. However the com- -# ponentPathName may be referenced in this manner (see discus- -# sion of Component Path Names). -# -# Returns -1 if the menubar frame is passed in. -# -# ------------------------------------------------------------- -body iwidgets::Menubar::insert { beforeComponent type name args } { - if ![regexp \ - {^(menubutton|command|cascade|separator|radiobutton|checkbutton)$} \ - $type] { - error "bad type \"$type\": must be one of the following:\ - \"command\", \"checkbutton\", \"radiobutton\",\ - \"separator\", \"cascade\", or \"menubutton\"" - } - regexp {[^.]+$} $name segName - if [regexp {^(menu|last|end|[0-9]+)$} $segName] { - error "bad name \"$name\": user created component \ - path names may not end with \ - \"end\", \"last\", \"menu\", \ - or be an integer" - } - - set beforeComponent [_parsePath $beforeComponent] - - # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, - # Choose menu insertion or entry insertion - # ''''''''''''''''''''''''''''''''''''''''''''''''''''' - if { $type == "menubutton" } { - eval _insertMenuButton $beforeComponent $name $args - } else { - eval _insertEntry $beforeComponent $type $name $args - } -} - - -# ------------------------------------------------------------- -# -# METHOD: invoke entryPath -# -# Invoke the action of the menu entry denoted by -# entryComponentPathName. See the sections on the individual -# entries in the menu(n) man pages. If the menu entry is dis- -# abled then nothing happens. If the entry has a command -# associated with it then the result of that command is -# returned as the result of the invoke widget command. Other- -# wise the result is an empty string. -# -# If componentPathName is not a menu entry, an error is -# issued. -# -# ------------------------------------------------------------- -body iwidgets::Menubar::invoke { entryPath } { - - # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, - # Path Conversions - # ''''''''''''''''''''''''''''''''''''''''''''''''''''' - set entryPath [_parsePath $entryPath] - set index $_pathMap($entryPath) - - # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, - # Error Processing - # ''''''''''''''''''''''''''''''''''''''''''''''''''''' - # first verify that beforeEntryPath is actually a path to - # an entry and not to menu, menubutton, etc. - if { ! [regexp {^[0-9]+$} $index] } { - error "bad entry path: beforeEntryPath is not an entry" - } - - # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, - # Call invoke command - # ''''''''''''''''''''''''''''''''''''''''''''''''''''' - # get the tk menu path to call - set tkMenuPath [_entryPathToTkMenuPath $entryPath] - - # call the menu's invoke command, adjusting index based on tearoff - $tkMenuPath invoke [_getTkIndex $tkMenuPath $index] -} - -# ------------------------------------------------------------- -# -# METHOD: menucget componentPath option -# -# Returns the current value of the configuration option -# given by option. The component type of componentPathName -# determines the valid available options. -# -# ------------------------------------------------------------- -body iwidgets::Menubar::menucget { path opt } { - return [lindex [menuconfigure $path $opt] 4] -} - -# ------------------------------------------------------------- -# -# METHOD: menuconfigure componentPath ?option? ?value option value...? -# -# Query or modify the configuration options of the sub- -# component of the Menubar specified by componentPathName. If -# no option is specified, returns a list describing all of the -# available options for componentPathName (see -# Tk_ConfigureInfo for information on the format of this -# list). If option is specified with no value, then the com- -# mand returns a list describing the one named option (this -# list will be identical to the corresponding sublist of the -# value returned if no option is specified). If one or more -# option-value pairs are specified, then the command modifies -# the given widget option(s) to have the given value(s); in -# this case the command returns an empty string. The component -# type of componentPathName determines the valid available -# options. -# -# ------------------------------------------------------------- -body iwidgets::Menubar::menuconfigure { path args } { - - # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, - # Path Conversions - # ''''''''''''''''''''''''''''''''''''''''''''''''''''' - set path [_parsePath $path] - set tkPathOrIndex $_pathMap($path) - - # Case: Menu entry being configured - # ''''''''''''''''''''''''''''''''''''''''''''''''''''' - if { [regexp {^[0-9]+$} $tkPathOrIndex] } { - eval "_configureMenuEntry $path $tkPathOrIndex $args" - - # Case: Menu (button and pane) being configured. - # ''''''''''''''''''''''''''''''''''''''''''''''''''''' - } else { - eval _configureMenu $path $tkPathOrIndex $args - } -} - -# ------------------------------------------------------------- -# -# METHOD: path -# -# SYNOPIS: path ?<mode>? <pattern> -# -# Returns a fully formed component path that matches pat- -# tern. If no match is found it returns -1. The mode argument -# indicates how the search is to be matched against pattern -# and it must have one of the following values: -# -# -glob Pattern is a glob-style pattern which is -# matched against each component path using the same rules as -# the string match command. -# -# -regexp Pattern is treated as a regular expression -# and matched against each component path using the same -# rules as the regexp command. -# -# The default mode is -glob. -# -# ------------------------------------------------------------- -body iwidgets::Menubar::path { args } { - - set len [llength $args] - if { $len < 1 || $len > 2 } { - error "wrong # args: should be \ - \"$itk_component(hull) path ?mode?> <pattern>\"" - } - - set pathList [array names _pathMap] - - set len [llength $args] - switch -- $len { - 1 { - # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, - # Case: no search modes given - # ''''''''''''''''''''''''''''''''''''''''''''''''''''' - set pattern [lindex $args 0] - set found [lindex $pathList [lsearch -glob $pathList $pattern]] - } - 2 { - # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, - # Case: search modes present (-glob, -regexp) - # ''''''''''''''''''''''''''''''''''''''''''''''''''''' - set options [lindex $args 0] - set pattern [lindex $args 1] - set found \ - [lindex $pathList [lsearch $options $pathList $pattern]] - } - default { - # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, - # Case: wrong # arguments - # ''''''''''''''''''''''''''''''''''''''''''''''''''''' - error "wrong # args: \ - should be \"$itk_component(hull) path ?-glob? ?-regexp? pattern\"" - } - } - - return $found -} - -# ------------------------------------------------------------- -# -# METHOD: type path -# -# Returns the type of the component given by entryCom- -# ponentPathName. For menu entries, this is the type argument -# passed to the add/insert widget command when the entry was -# created, such as command or separator. Othewise it is either -# a menubutton or a menu. -# -# ------------------------------------------------------------- -body iwidgets::Menubar::type { path } { - - # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, - # Path Conversions - # ''''''''''''''''''''''''''''''''''''''''''''''''''''' - set path [_parsePath $path] - - # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, - # Error Handling: does the path exist? - # ''''''''''''''''''''''''''''''''''''''''''''''''''''' - if { [catch {set index $_pathMap($path)} ] } { - error "bad path \"$path\"" - } - - # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, - # ENTRY, Ask TK for type - # ''''''''''''''''''''''''''''''''''''''''''''''''''''' - if { [regexp {^[0-9]+$} $index] } { - # get the menu path from the entry path name - set tkMenuPath [_entryPathToTkMenuPath $path] - - # call the menu's type command, adjusting index based on tearoff - set type [$tkMenuPath type [_getTkIndex $tkMenuPath $index]] - # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, - # MENUBUTTON, MENU, or FRAME - # ''''''''''''''''''''''''''''''''''''''''''''''''''''' - } else { - # should not happen, but have a path that is not a valid window. - if { [catch {set className [winfo class $_pathMap($path)]}] } { - error "serious error: \"$path\" is not a valid window" - } - # get the classname, look it up, get index, us it to look up type - set type [ lindex \ - {frame menubutton menu} \ - [lsearch { Frame Menubutton Menu } $className] \ - ] - } - return $type -} - -# ------------------------------------------------------------- -# -# METHOD: yposition entryPath -# -# Returns a decimal string giving the y-coordinate within -# the menu window of the topmost pixel in the entry specified -# by componentPathName. If the componentPathName is not an -# entry, an error is issued. -# -# ------------------------------------------------------------- -body iwidgets::Menubar::yposition { entryPath } { - - # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, - # Path Conversions - # ''''''''''''''''''''''''''''''''''''''''''''''''''''' - set entryPath [_parsePath $entryPath] - set index $_pathMap($entryPath) - - # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, - # Error Handling - # ''''''''''''''''''''''''''''''''''''''''''''''''''''' - # first verify that entryPath is actually a path to - # an entry and not to menu, menubutton, etc. - if { ! [regexp {^[0-9]+$} $index] } { - error "bad value: entryPath is not an entry" - } - - # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, - # Call yposition command - # ''''''''''''''''''''''''''''''''''''''''''''''''''''' - # get the menu path from the entry path name - set tkMenuPath [_entryPathToTkMenuPath $entryPath] - - # call the menu's yposition command, adjusting index based on tearoff - return [$tkMenuPath yposition [_getTkIndex $tkMenuPath $index]] - -} - -# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -# PARSING METHODS -# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -# ------------------------------------------------------------- -# -# PARSING METHOD: menubutton -# -# This method is invoked via an evaluation of the -menubuttons -# option for the Menubar. -# -# It adds a new menubutton and processes any -menu options -# for creating entries on the menu pane associated with the -# menubutton -# ------------------------------------------------------------- -body iwidgets::Menubar::menubutton { menuName args } { - eval "add menubutton .$menuName $args" -} - -# ------------------------------------------------------------- -# -# PARSING METHOD: options -# -# This method is invoked via an evaluation of the -menu -# option for menubutton commands. -# -# It configures the current menu ($_ourMenuPath) with the options -# that follow (args) -# -# ------------------------------------------------------------- -body iwidgets::Menubar::options { args } { - eval "$_tkMenuPath configure $args" -} - - -# ------------------------------------------------------------- -# -# PARSING METHOD: command -# -# This method is invoked via an evaluation of the -menu -# option for menubutton commands. -# -# It adds a new command entry to the current menu, $_ourMenuPath -# naming it $cmdName. Since this is the most common case when -# creating menus, streamline it by duplicating some code from -# the add{} method. -# -# ------------------------------------------------------------- -body iwidgets::Menubar::command { cmdName args } { - set path $_ourMenuPath.$cmdName - - # error checking - regsub {.*[.]} $path "" segName - if [regexp {^(menu|last|end|[0-9]+)$} $segName] { - error "bad name \"$segName\": user created component \ - path names may not end with \ - \"end\", \"last\", \"menu\", \ - or be an integer" - } - - eval _addEntry command $path $args -} - -# ------------------------------------------------------------- -# -# PARSING METHOD: checkbutton -# -# This method is invoked via an evaluation of the -menu -# option for menubutton/cascade commands. -# -# It adds a new checkbutton entry to the current menu, $_ourMenuPath -# naming it $chkName. -# -# ------------------------------------------------------------- -body iwidgets::Menubar::checkbutton { chkName args } { - eval "add checkbutton $_ourMenuPath.$chkName $args" -} - -# ------------------------------------------------------------- -# -# PARSING METHOD: radiobutton -# -# This method is invoked via an evaluation of the -menu -# option for menubutton/cascade commands. -# -# It adds a new radiobutton entry to the current menu, $_ourMenuPath -# naming it $radName. -# -# ------------------------------------------------------------- -body iwidgets::Menubar::radiobutton { radName args } { - eval "add radiobutton $_ourMenuPath.$radName $args" -} - -# ------------------------------------------------------------- -# -# PARSING METHOD: separator -# -# This method is invoked via an evaluation of the -menu -# option for menubutton/cascade commands. -# -# It adds a new separator entry to the current menu, $_ourMenuPath -# naming it $sepName. -# -# ------------------------------------------------------------- -body iwidgets::Menubar::separator { sepName args } { - eval $_tkMenuPath add separator - set _pathMap($_ourMenuPath.$sepName) [_getPdIndex $_tkMenuPath end] -} - -# ------------------------------------------------------------- -# -# PARSING METHOD: cascade -# -# This method is invoked via an evaluation of the -menu -# option for menubutton/cascade commands. -# -# It adds a new cascade entry to the current menu, $_ourMenuPath -# naming it $casName. It processes the -menu option if present, -# adding a new menu pane and its associated entries found. -# -# ------------------------------------------------------------- -body iwidgets::Menubar::cascade { casName args } { - - # Save the current menu we are adding to, cascade can change - # the current menu through -menu options. - set saveOMP $_ourMenuPath - set saveTKP $_tkMenuPath - - eval "add cascade $_ourMenuPath.$casName $args" - - # Restore the saved menu states so that the next entries of - # the -menu/-menubuttons we are processing will be at correct level. - set _ourMenuPath $saveOMP - set _tkMenuPath $saveTKP -} - -# ... A P I S U P P O R T M E T H O D S... - -# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -# MENU ADD, INSERT, DELETE -# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -# ------------------------------------------------------------- -# -# PRIVATE METHOD: _addMenuButton -# -# Makes a new menubutton & associated -menu, pack appended -# -# ------------------------------------------------------------- -body iwidgets::Menubar::_addMenuButton { buttonName args} { - - eval "_makeMenuButton $buttonName $args" - - #,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, - # Pack at end, adjust for help buttonName - # '''''''''''''''''''''''''''''''''' - if { $buttonName == "help" } { - pack $itk_component($buttonName) -side right - } else { - pack $itk_component($buttonName) -side left - } - - return $itk_component($buttonName) -} - -# ------------------------------------------------------------- -# -# PRIVATE METHOD: _insertMenuButton -# -# inserts a menubutton named $buttonName on a menu bar before -# another menubutton specified by $beforeMenuPath -# -# ------------------------------------------------------------- -body iwidgets::Menubar::_insertMenuButton { beforeMenuPath buttonName args} { - - eval "_makeMenuButton $buttonName $args" - - #,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, - # Pack before the $beforeMenuPath - # '''''''''''''''''''''''''''''''' - set beforeTkMenu $_pathMap($beforeMenuPath) - regsub {[.]menu$} $beforeTkMenu "" beforeTkMenu - pack $itk_component(menubar).$buttonName \ - -side left \ - -before $beforeTkMenu - - return $itk_component($buttonName) -} - -# ------------------------------------------------------------- -# -# PRIVATE METHOD: _makeMenuButton -# -# creates a menubutton named buttonName on the menubar with args. -# The -menu option if present will trigger attaching a menu pane. -# -# ------------------------------------------------------------- -body iwidgets::Menubar::_makeMenuButton {buttonName args} { - - #,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, - # Capture the -menu option if present - # ''''''''''''''''''''''''''''''''''' - array set temp $args - if { [::info exists temp(-menu)] } { - # We only keep this in case of menuconfigure or menucget - set _menuOption(.$buttonName) $temp(-menu) - set menuEvalStr $temp(-menu) - } else { - set menuEvalStr {} - } - - # attach the actual menu widget to the menubutton's arg list - set temp(-menu) $itk_component(menubar).$buttonName.menu - set args [array get temp] - - #,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, - # Create menubutton component - # '''''''''''''''''''''''''''''''' - itk_component add $buttonName { - eval ::menubutton \ - $itk_component(menubar).$buttonName \ - $args - } { - keep \ - -activebackground \ - -activeforeground \ - -anchor \ - -background \ - -borderwidth \ - -cursor \ - -disabledforeground \ - -font \ - -foreground \ - -highlightbackground \ - -highlightcolor \ - -highlightthickness \ - -justify \ - -padx \ - -pady \ - -wraplength - } - - set _pathMap(.$buttonName) $itk_component($buttonName) - - _makeMenu \ - $buttonName-menu \ - $itk_component($buttonName).menu \ - .$buttonName \ - $menuEvalStr - - return $itk_component($buttonName) - -} - -# ------------------------------------------------------------- -# -# PRIVATE METHOD: _makeMenu -# -# Creates a menu. -# It then evaluates the $menuEvalStr to create entries on the menu. -# -# Assumes the existence of $itk_component($buttonName) -# -# ------------------------------------------------------------- -body iwidgets::Menubar::_makeMenu \ - { componentName widgetName menuPath menuEvalStr } { - - #,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, - # Create menu component - # '''''''''''''''''''''''''''''''' - itk_component add $componentName { - ::menu $widgetName - } { - keep \ - -activebackground \ - -activeborderwidth \ - -activeforeground \ - -background \ - -borderwidth \ - -cursor \ - -disabledforeground \ - -font \ - -foreground - } - - set _pathMap($menuPath.menu) $itk_component($componentName) - - #,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, - # Attach help handler to this menu - # '''''''''''''''''''''''''''''''' - bind $itk_component($componentName) <<MenuSelect>> \ - [code $this _helpHandler $menuPath.menu] - - #,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, - # Handle -menu - #''''''''''''''''''''''''''''''''' - set _ourMenuPath $menuPath - set _tkMenuPath $itk_component($componentName) - - # - # A zero parseLevel says we are at the top of the parse tree, - # so get the context scope level and do a subst for the menuEvalStr. - # - if { $_parseLevel == 0 } { - set _callerLevel [_getCallerLevel] - } - - # - # bump up the parse level, so if we get called via the 'eval $menuEvalStr' - # we know to skip the above steps... - # - incr _parseLevel - eval $menuEvalStr - - # - # leaving, so done with this parse level, so bump it back down - # - incr _parseLevel -1 -} - -# ------------------------------------------------------------- -# -# PRIVATE METHOD: _substEvalStr -# -# This performs the substitution and evaluation of $ [], \ found -# in the -menubutton/-menus options -# -# ------------------------------------------------------------- -body iwidgets::Menubar::_substEvalStr { evalStr } { - upvar $evalStr evalStrRef - set evalStrRef [uplevel $_callerLevel [list subst $evalStrRef]] -} - - -# ------------------------------------------------------------- -# -# PRIVATE METHOD: _deleteMenu -# -# _deleteMenu menuPath ?menuPath2? -# -# deletes menuPath or from menuPath to menuPath2 -# -# Menu paths may be formed in one of two ways -# .MENUBAR.menuName where menuName is the name of the menu -# .MENUBAR.menuName.menu where menuName is the name of the menu -# -# The basic rule is '.menu' is not needed. -# ------------------------------------------------------------- -body iwidgets::Menubar::_deleteMenu { menuPath {menuPath2 {}} } { - - if { $menuPath2 == "" } { - # get a corrected path (subst for number, last, end) - set path [_parsePath $menuPath] - - _deleteAMenu $path - - } else { - # gets the list of menus in interface order - set menuList [_getMenuList] - - # ... get the start menu and the last menu ... - - # get a corrected path (subst for number, last, end) - set menuStartPath [_parsePath $menuPath] - - regsub {[.]menu$} $menuStartPath "" menuStartPath - - set menuEndPath [_parsePath $menuPath2] - - regsub {[.]menu$} $menuEndPath "" menuEndPath - - # get the menu position (0 based) of the start and end menus. - set start [lsearch -exact $menuList $menuStartPath] - if { $start == -1 } { - error "bad menu path \"$menuStartPath\": \ - should be one of $menuList" - } - set end [lsearch -exact $menuList $menuEndPath] - if { $end == -1 } { - error "bad menu path \"$menuEndPath\": \ - should be one of $menuList" - } - - # now create the list from this range of menus - set delList [lrange $menuList $start $end] - - # walk thru them deleting each menu. - # this list has no .menu on the end. - foreach m $delList { - _deleteAMenu $m.menu - } - } -} - -# ------------------------------------------------------------- -# -# PRIVATE METHOD: _deleteAMenu -# -# _deleteMenu menuPath -# -# deletes a single Menu (menubutton and menu pane with entries) -# -# ------------------------------------------------------------- -body iwidgets::Menubar::_deleteAMenu { path } { - - # We will normalize the path to not include the '.menu' if - # it is on the path already. - - regsub {[.]menu$} $path "" menuButtonPath - regsub {.*[.]} $menuButtonPath "" buttonName - - # Loop through and destroy any cascades, etc on menu. - set entryList [_getEntryList $menuButtonPath] - foreach entry $entryList { - _deleteEntry $entry - } - - # Delete the menubutton and menu components... - destroy $itk_component($buttonName-menu) - destroy $itk_component($buttonName) - - # This is because of some itcl bug that doesn't delete - # the component on the destroy in some cases... - catch {itk_component delete $buttonName-menu} - catch {itk_component delete $buttonName} - - # unset our paths - _unsetPaths $menuButtonPath - -} - -# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -# ENTRY ADD, INSERT, DELETE -# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -# ------------------------------------------------------------- -# -# PRIVATE METHOD: _addEntry -# -# Adds an entry to menu. -# -# ------------------------------------------------------------- -body iwidgets::Menubar::_addEntry { type path args } { - - # Error Checking - # '''''''''''''' - # the path should not end with '.menu' - # Not needed -- already checked by add{} - # if { [regexp {[.]menu$} $path] } { - # error "bad entry path: \"$path\". \ - # The name \"menu\" is reserved for menu panes" - # } - - # get the tkMenuPath - set tkMenuPath [_entryPathToTkMenuPath $path] - if { $tkMenuPath == "" } { - error "bad entry path: \"$path\". The menu path prefix is not valid" - } - - # get the -helpstr option if present - array set temp $args - if { [::info exists temp(-helpstr)] } { - set helpStr $temp(-helpstr) - unset temp(-helpstr) - } else { - set helpStr {} - } - set args [array get temp] - - # Handle CASCADE - # '''''''''''''' - # if this is a cascade go ahead and add in the menu... - if { $type == "cascade" } { - eval [list _addCascade $tkMenuPath $path] $args - # Handle Non-CASCADE - # '''''''''''''''''' - } else { - # add the entry - eval [list $tkMenuPath add $type] $args - set _pathMap($path) [_getPdIndex $tkMenuPath end] - } - - # Remember the help string - set _helpString($path) $helpStr - - return $_pathMap($path) -} - -# ------------------------------------------------------------- -# -# PRIVATE METHOD: _addCascade -# -# Creates a cascade button. Handles the -menu option -# -# ------------------------------------------------------------- -body iwidgets::Menubar::_addCascade { tkMenuPath path args } { - - # get the cascade name from our path - regsub {.*[.]} $path "" cascadeName - - #,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, - # Capture the -menu option if present - # ''''''''''''''''''''''''''''''''''' - array set temp $args - if { [::info exists temp(-menu)] } { - set menuEvalStr $temp(-menu) - } else { - set menuEvalStr {} - } - - # attach the menu pane - set temp(-menu) $tkMenuPath.$cascadeName - set args [array get temp] - - # Create the cascade entry - eval $tkMenuPath add cascade $args - - # Keep the -menu string in case of menuconfigure or menucget - if { $menuEvalStr != "" } { - set _menuOption($path) $menuEvalStr - } - - # update our pathmap - set _pathMap($path) [_getPdIndex $tkMenuPath end] - - _makeMenu \ - $cascadeName-menu \ - $tkMenuPath.$cascadeName \ - $path \ - $menuEvalStr - - #return $itk_component($cascadeName) - -} - -# ------------------------------------------------------------- -# -# PRIVATE METHOD: _insertEntry -# -# inserts an entry on a menu before entry given by beforeEntryPath. -# The added entry is of type TYPE and its name is NAME. ARGS are -# passed for customization of the entry. -# -# ------------------------------------------------------------- -body iwidgets::Menubar::_insertEntry { beforeEntryPath type name args } { - - # convert entryPath to an index value - set bfIndex $_pathMap($beforeEntryPath) - - # first verify that beforeEntryPath is actually a path to - # an entry and not to menu, menubutton, etc. - if { ! [regexp {^[0-9]+$} $bfIndex] } { - error "bad entry path: beforeEntryPath is not an entry" - } - - # get the menu path from the entry path name - regsub {[.][^.]*$} $beforeEntryPath "" menuPathPrefix - set tkMenuPath $_pathMap($menuPathPrefix.menu) - - # INDEX is zero based at this point. - - # ENTRIES is a zero based list... - set entries [_getEntryList $menuPathPrefix] - - # - # Adjust the entries after the inserted item, to have - # the correct index numbers. Note, we stay zero based - # even though tk flips back and forth depending on tearoffs. - # - for {set i $bfIndex} {$i < [llength $entries]} {incr i} { - # path==entry path in numerical order - set path [lindex $entries $i] - - # add one to each entry after the inserted one. - set _pathMap($path) [expr $i + 1] - } - - # get the -helpstr option if present - array set temp $args - if { [::info exists temp(-helpstr)] } { - set helpStr $temp(-helpstr) - unset temp(-helpstr) - } else { - set helpStr {} - } - set args [array get temp] - - set path $menuPathPrefix.$name - - # Handle CASCADE - # '''''''''''''' - # if this is a cascade go ahead and add in the menu... - if { [string match cascade $type] } { - - if { [ catch {eval "_insertCascade \ - $bfIndex $tkMenuPath $path $args"} errMsg ]} { - for {set i $bfIndex} {$i < [llength $entries]} {incr i} { - # path==entry path in numerical order - set path [lindex $entries $i] - - # sub the one we added earlier. - set _pathMap($path) [expr $_pathMap($path) - 1] - # @@ delete $hs - } - error $errMsg - } - - # Handle Entry - # '''''''''''''' - } else { - - # give us a zero or 1-based index based on tear-off menu status - # invoke the menu's insert command - if { [catch {eval "$tkMenuPath insert \ - [_getTkIndex $tkMenuPath $bfIndex] $type $args"} errMsg]} { - for {set i $bfIndex} {$i < [llength $entries]} {incr i} { - # path==entry path in numerical order - set path [lindex $entries $i] - - # sub the one we added earlier. - set _pathMap($path) [expr $_pathMap($path) - 1] - # @@ delete $hs - } - error $errMsg - } - - - # add the helpstr option to our options list (attach to entry) - set _helpString($path) $helpStr - - # Insert the new entry path into pathmap giving it an index value - set _pathMap($menuPathPrefix.$name) $bfIndex - - } - - return [_getTkIndex $tkMenuPath $bfIndex] -} - -# ------------------------------------------------------------- -# -# PRIVATE METHOD: _insertCascade -# -# Creates a cascade button. Handles the -menu option -# -# ------------------------------------------------------------- -body iwidgets::Menubar::_insertCascade { bfIndex tkMenuPath path args } { - - # get the cascade name from our path - regsub {.*[.]} $path "" cascadeName - - #,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, - # Capture the -menu option if present - # ''''''''''''''''''''''''''''''''''' - array set temp $args - if { [::info exists temp(-menu)] } { - # Keep the -menu string in case of menuconfigure or menucget - set _menuOption($path) $temp(-menu) - set menuEvalStr $temp(-menu) - } else { - set menuEvalStr {} - } - - # attach the menu pane - set temp(-menu) $tkMenuPath.$cascadeName - set args [array get temp] - - # give us a zero or 1-based index based on tear-off menu status - # invoke the menu's insert command - eval "$tkMenuPath insert \ - [_getTkIndex $tkMenuPath $bfIndex] cascade $args" - - # Insert the new entry path into pathmap giving it an index value - set _pathMap($path) $bfIndex - _makeMenu \ - $cascadeName-menu \ - $tkMenuPath.$cascadeName \ - $path \ - $menuEvalStr - - #return $itk_component($cascadeName) -} - -# ------------------------------------------------------------- -# -# PRIVATE METHOD: _deleteEntry -# -# _deleteEntry entryPath ?entryPath2? -# -# either -# deletes the entry entryPath -# or -# deletes the entries from entryPath to entryPath2 -# -# ------------------------------------------------------------- -body iwidgets::Menubar::_deleteEntry { entryPath {entryPath2 {}} } { - - if { $entryPath2 == "" } { - # get a corrected path (subst for number, last, end) - set path [_parsePath $entryPath] - - set entryIndex $_pathMap($path) - if { $entryIndex == -1 } { - error "bad value for pathName: \ - $entryPath in call to delet" - } - - # get the type, if cascade, we will want to delete menu - set type [type $path] - - # ... munge up the menu name ... - - # the tkMenuPath is looked up with the .menu added to lookup - # strip off the entry component - regsub {[.][^.]*$} $path "" menuPath - set tkMenuPath $_pathMap($menuPath.menu) - - # get the ordered entry list - set entries [_getEntryList $menuPath] - - # ... Fix up path entry indices ... - - # delete the path from the map - unset _pathMap([lindex $entries $entryIndex]) - - # Subtract off 1 for each entry below the deleted one. - for {set i [expr $entryIndex + 1]} \ - {$i < [llength $entries]} \ - {incr i} { - set epath [lindex $entries $i] - incr _pathMap($epath) -1 - } - - # ... Delete the menu entry widget ... - - # delete the menu entry, ajusting index for TK - $tkMenuPath delete [_getTkIndex $tkMenuPath $entryIndex] - - if { $type == "cascade" } { - regsub {.*[.]} $path "" cascadeName - destroy $itk_component($cascadeName-menu) - - # This is because of some itcl bug that doesn't delete - # the component on the destroy in some cases... - catch {itk_component delete $cascadeName-menu} - - _unsetPaths $path - } - - } else { - # get a corrected path (subst for number, last, end) - set path1 [_parsePath $entryPath] - set path2 [_parsePath $entryPath2] - - set fromEntryIndex $_pathMap($path1) - if { $fromEntryIndex == -1 } { - error "bad value for entryPath1: \ - $entryPath in call to delet" - } - set toEntryIndex $_pathMap($path2) - if { $toEntryIndex == -1 } { - error "bad value for entryPath2: \ - $entryPath2 in call to delet" - } - # ... munge up the menu name ... - - # the tkMenuPath is looked up with the .menu added to lookup - # strip off the entry component - regsub {[.][^.]*$} $path1 "" menuPath - set tkMenuPath $_pathMap($menuPath.menu) - - # get the ordered entry list - set entries [_getEntryList $menuPath] - - # ... Fix up path entry indices ... - - # delete the range from the pathMap list - for {set i $fromEntryIndex} {$i <= $toEntryIndex} {incr i} { - unset _pathMap([lindex $entries $i]) - } - - # Subtract off 1 for each entry below the deleted range. - # Loop from one below the bottom delete entry to end list - for {set i [expr $toEntryIndex + 1]} \ - {$i < [llength $entries]} \ - {incr i} { - # take this path and sets its index back by size of - # deleted range. - set path [lindex $entries $i] - set _pathMap($path) \ - [expr $_pathMap($path) - \ - (($toEntryIndex - $fromEntryIndex) + 1)] - } - - # ... Delete the menu entry widget ... - - # delete the menu entry, ajusting index for TK - $tkMenuPath delete \ - [_getTkIndex $tkMenuPath $fromEntryIndex] \ - [_getTkIndex $tkMenuPath $toEntryIndex] - - } -} - -# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -# CONFIGURATION SUPPORT -# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -# ------------------------------------------------------------- -# -# PRIVATE METHOD: _configureMenu -# -# This configures a menu. A menu is a true tk widget, thus we -# pass the tkPath variable. This path may point to either a -# menu button (does not end with the name 'menu', or a menu -# which ends with the name 'menu' -# -# path : our Menubar path name to this menu button or menu pane. -# if we end with the name '.menu' then it is a menu pane. -# tkPath : the path to the corresponding Tk menubutton or menu. -# args : the args for configuration -# -# ------------------------------------------------------------- -body iwidgets::Menubar::_configureMenu { path tkPath {option {}} args } { - - set class [winfo class $tkPath] - - if { $option == "" } { - # No arguments: return all options - set configList [$tkPath configure] - - if { [info exists _menuOption($path)] } { - lappend configList [list -menu menu Menu {} $_menuOption($path)] - } else { - lappend configList [list -menu menu Menu {} {}] - } - if { [info exists _helpString($path)] } { - lappend configList [list -helpstr helpStr HelpStr {} \ - $_helpString($path)] - } else { - lappend configList [list -helpstr helpStr HelpStr {} {}] - } - return $configList - - } elseif {$args == "" } { - if { $option == "-menu" } { - if { [info exists _menuOption($path)] } { - return [list -menu menu Menu {} $_menuOption($path)] - } else { - return [list -menu menu Menu {} {}] - } - } elseif { $option == "-helpstr" } { - if { [info exists _helpString($path)] } { - return [list -helpstr helpStr HelpStr {} $_helpString($path)] - } else { - return [list -helpstr helpStr HelpStr {} {}] - } - } else { - # ... OTHERWISE, let Tk get it. - return [$tkPath configure $option] - } - } else { - set args [concat $option $args] - - # If this is a menubutton, and has -menu option, process it - if { $class == "Menubutton" && [regexp -- {-menu} $args] } { - eval _configureMenuOption menubutton $path $args - } else { - eval $tkPath configure $args - } - return "" - } -} - -# ------------------------------------------------------------- -# -# PRIVATE METHOD: _configureMenuOption -# -# Allows for configuration of the -menu option on -# menubuttons and cascades -# -# find out if we are the last menu, or are before one. -# delete the old menu. -# if we are the last, then add us back at the end -# if we are before another menu, get the beforePath -# -# ------------------------------------------------------------- -body iwidgets::Menubar::_configureMenuOption { type path args } { - - regsub {[.][^.]*$} $path "" pathPrefix - - if { $type == "menubutton" } { - set menuList [_getMenuList] - set pos [lsearch $menuList $path] - if { $pos == [expr [llength $menuList] - 1] } { - set insert false - } else { - set insert true - } - } elseif { $type == "cascade" } { - set lastEntryPath [_parsePath $pathPrefix.last] - if { $lastEntryPath == $path } { - set insert false - } else { - set insert true - } - set pos [index $path] - - } - - - eval "delete $pathPrefix.$pos" - if { $insert } { - # get name from path... - regsub {.*[.]} $path "" name - - eval insert $pathPrefix.$pos $type \ - $name $args - } else { - eval add $type $path $args - } -} - -# ------------------------------------------------------------- -# -# PRIVATE METHOD: _configureMenuEntry -# -# This configures a menu entry. A menu entry is either a command, -# radiobutton, separator, checkbutton, or a cascade. These have -# a corresponding Tk index value for the corresponding tk menu -# path. -# -# path : our Menubar path name to this menu entry. -# index : the t -# args : the args for configuration -# -# ------------------------------------------------------------- -body iwidgets::Menubar::_configureMenuEntry { path index {option {}} args } { - - set type [type $path] - - # set len [llength $args] - - # get the menu path from the entry path name - set tkMenuPath [_entryPathToTkMenuPath $path] - - if { $option == "" } { - set configList [$tkMenuPath entryconfigure \ - [_getTkIndex $tkMenuPath $index]] - - if { $type == "cascade" } { - if { [info exists _menuOption($path)] } { - lappend configList [list -menu menu Menu {} \ - $_menuOption($path)] - } else { - lappend configList [list -menu menu Menu {} {}] - } - } - if { [info exists _helpString($path)] } { - lappend configList [list -helpstr helpStr HelpStr {} \ - $_helpString($path)] - } else { - lappend configList [list -helpstr helpStr HelpStr {} {}] - } - return $configList - - } elseif { $args == "" } { - if { $option == "-menu" } { - if { [info exists _menuOption($path)] } { - return [list -menu menu Menu {} $_menuOption($path)] - } else { - return [list -menu menu Menu {} {}] - } - } elseif { $option == "-helpstr" } { - if { [info exists _helpString($path)] } { - return [list -helpstr helpStr HelpStr {} \ - $_helpString($path)] - } else { - return [list -helpstr helpStr HelpStr {} {}] - } - } else { - # ... OTHERWISE, let Tk get it. - return [$tkMenuPath entryconfigure \ - [_getTkIndex $tkMenuPath $index] $option] - } - } else { - array set temp [concat $option $args] - - # ... Store -helpstr val,strip out -helpstr val from args - if { [::info exists temp(-helpstr)] } { - set _helpString($path) $temp(-helpstr) - unset temp(-helpstr) - } - - set args [array get temp] - if { $type == "cascade" && [::info exists temp(-menu)] } { - eval "_configureMenuOption cascade $path $args" - } else { - # invoke the menu's entryconfigure command - # being careful to ajust the INDEX to be 0 or 1 based - # depending on the tearoff status - # if the stripping process brought us down to no options - # to set, then forget the configure of widget. - if { [llength $args] != 0 } { - eval $tkMenuPath entryconfigure \ - [_getTkIndex $tkMenuPath $index] $args - } - } - return "" - } -} - -# ------------------------------------------------------------- -# -# PRIVATE METHOD: _unsetPaths -# -# comment -# -# ------------------------------------------------------------- -body iwidgets::Menubar::_unsetPaths { parent } { - - # first get the complete list of all menu paths - set pathList [array names _pathMap] - - # for each path that matches parent prefix, unset it. - foreach path $pathList { - if { [regexp [subst -nocommands {^$parent}] $path] } { - unset _pathMap($path) - } - } -} - -# ------------------------------------------------------------- -# -# PRIVATE METHOD: _entryPathToTkMenuPath -# -# Takes an entry path like .mbar.file.new and changes it to -# .mbar.file.menu and performs a lookup in the pathMap to -# get the corresponding menu widget name for tk -# -# ------------------------------------------------------------- -body iwidgets::Menubar::_entryPathToTkMenuPath {entryPath} { - - # get the menu path from the entry path name - # by stripping off the entry component of the path - regsub {[.][^.]*$} $entryPath "" menuPath - - # the tkMenuPath is looked up with the .menu added to lookup - if { [catch {set tkMenuPath $_pathMap($menuPath.menu)}] } { - return "" - } else { - return $_pathMap($menuPath.menu) - } -} - - -# ------------------------------------------------------------- -# -# These two methods address the issue of menu entry indices being -# zero-based when the menu is not a tearoff menu and 1-based when -# it is a tearoff menu. Our strategy is to hide this difference. -# -# _getTkIndex returns the index as tk likes it: 0 based for non-tearoff -# and 1 based for tearoff menus. -# -# _getPdIndex (get pulldown index) always returns it as 0 based. -# -# ------------------------------------------------------------- - -# ------------------------------------------------------------- -# -# PRIVATE METHOD: _getTkIndex -# -# give us a zero or 1-based answer depending on the tearoff -# status of the menu. If the menu denoted by tkMenuPath is a -# tearoff menu it returns a 1-based result, otherwise a -# zero-based result. -# -# ------------------------------------------------------------- -body iwidgets::Menubar::_getTkIndex { tkMenuPath tkIndex} { - - # if there is a tear off make it 1-based index - if { [$tkMenuPath cget -tearoff] } { - incr tkIndex - } - - return $tkIndex -} - -# ------------------------------------------------------------- -# -# PRIVATE METHOD: _getPdIndex -# -# Take a tk index and give me a zero based numerical index -# -# Ask the menu widget for the index of the entry denoted by -# 'tkIndex'. Then if the menu is a tearoff adjust the value -# to be zero based. -# -# This method returns the index as if tearoffs did not exist. -# Always returns a zero-based index. -# -# ------------------------------------------------------------- -body iwidgets::Menubar::_getPdIndex { tkMenuPath tkIndex } { - - # get the index from the tk menu - # this 0 based for non-tearoff and 1-based for tearoffs - set pdIndex [$tkMenuPath index $tkIndex] - - # if there is a tear off make it 0-based index - if { [$tkMenuPath cget -tearoff] } { - incr pdIndex -1 - } - - return $pdIndex -} - -# ------------------------------------------------------------- -# -# PRIVATE METHOD: _getMenuList -# -# Returns the list of menus in the order they are on the interface -# returned list is a list of our menu paths -# -# ------------------------------------------------------------- -body iwidgets::Menubar::_getMenuList { } { - # get the menus that are packed - set tkPathList [pack slaves $itk_component(menubar)] - - regsub -- {[.]} $itk_component(hull) "" mbName - regsub -all -- "\[.\]$mbName\[.\]menubar\[.\]" $tkPathList "." menuPathList - - return $menuPathList -} - -# ------------------------------------------------------------- -# -# PRIVATE METHOD: _getEntryList -# -# -# This method looks at a menupath and gets all the entries and -# returns a list of all the entry path names in numerical order -# based on their index values. -# -# MENU is the path to a menu, like .mbar.file.menu or .mbar.file -# we will calculate a menuPath from this: .mbar.file -# then we will build a list of entries in this menu excluding the -# path .mbar.file.menu -# -# ------------------------------------------------------------- -body iwidgets::Menubar::_getEntryList { menu } { - - # if it ends with menu, clip it off - regsub {[.]menu$} $menu "" menuPath - - # first get the complete list of all menu paths - set pathList [array names _pathMap] - - set numEntries 0 - # iterate over the pathList and put on menuPathList those - # that match the menuPattern - foreach path $pathList { - # if this path is on the menuPath's branch - if { [regexp [subst -nocommands {$menuPath[.][^.]*$}] $path] } { - # if not a menu itself - if { ! [regexp {[.]menu$} $path] } { - set orderedList($_pathMap($path)) $path - incr numEntries - } - } - } - set entryList {} - - for {set i 0} {$i < $numEntries} {incr i} { - lappend entryList $orderedList($i) - } - - return $entryList - -} - -# ------------------------------------------------------------- -# -# PRIVATE METHOD: _parsePath -# -# given path, PATH, _parsePath splits the path name into its -# component segments. It then puts the name back together one -# segment at a time and calls _getSymbolicPath to replace the -# keywords 'last' and 'end' as well as numeric digits. -# -# ------------------------------------------------------------- -body iwidgets::Menubar::_parsePath { path } { - set segments [split [string trimleft $path .] .] - - set concatPath "" - foreach seg $segments { - - set concatPath [_getSymbolicPath $concatPath $seg] - - if { [catch {set _pathMap($concatPath)} ] } { - error "bad path: \"$path\" does not exist. \"$seg\" not valid" - } - } - return $concatPath -} - -# ------------------------------------------------------------- -# -# PRIVATE METHOD: _getSymbolicPath -# -# Given a PATH, _getSymbolicPath looks for the last segment of -# PATH to contain: a number, the keywords last or end. If one -# of these it figures out how to get us the actual pathname -# to the searched widget -# -# Implementor's notes: -# Surely there is a shorter way to do this. The only diff -# for non-numeric is getting the llength of the correct list -# It is hard to know this upfront so it seems harder to generalize. -# -# ------------------------------------------------------------- -body iwidgets::Menubar::_getSymbolicPath { parent segment } { - - # if the segment is a number, then look it up positionally - # MATCH numeric index - if { [regexp {^[0-9]+$} $segment] } { - - # if we have no parent, then we area menubutton - if { $parent == {} } { - set returnPath [lindex [_getMenuList] $segment] - } else { - set returnPath [lindex [_getEntryList $parent.menu] $segment] - } - - # MATCH 'end' or 'last' keywords. - } elseif { $segment == "end" || $segment == "last" } { - - # if we have no parent, then we are a menubutton - if { $parent == {} } { - set returnPath [lindex [_getMenuList] end] - } else { - set returnPath [lindex [_getEntryList $parent.menu] end] - } - } else { - set returnPath $parent.$segment - } - - return $returnPath -} - -# ------------------------------------------------------------- -# -# PRIVATE METHOD: _helpHandler -# -# Bound to the <Motion> event on a menu pane. This puts the -# help string associated with the menu entry into the -# status widget help area. If no help exists for the current -# entry, the status widget is cleared. -# -# ------------------------------------------------------------- -body iwidgets::Menubar::_helpHandler { menuPath } { - - if { $itk_option(-helpvariable) == {} } { - return - } - - set tkMenuWidget $_pathMap($menuPath) - - set entryIndex [$tkMenuWidget index active] - - # already on this item? - if { $entryIndex == $_entryIndex } { - return - } - - set _entryIndex $entryIndex - - if {"none" != $entryIndex} { - set entries [_getEntryList $menuPath] - - set menuEntryHit \ - [lindex $entries [_getPdIndex $tkMenuWidget $entryIndex]] - - # blank out the old one - set $itk_option(-helpvariable) {} - - # if there is a help string for this entry - if { [::info exists _helpString($menuEntryHit)] } { - set $itk_option(-helpvariable) $_helpString($menuEntryHit) - } - } else { - set $itk_option(-helpvariable) {} - set _entryIndex -1 - } -} - -# ------------------------------------------------------------- -# -# PRIVATE METHOD: _getCallerLevel -# -# Starts at stack frame #0 and works down till we either hit -# a ::Menubar stack frame or an ::itk::Archetype stack frame -# (the latter happens when a configure is called via the 'component' -# method -# -# Returns the level of the actual caller of the menubar command -# in the form of #num where num is the level number caller stack frame. -# -# ------------------------------------------------------------- -body iwidgets::Menubar::_getCallerLevel { } { - - set levelName {} - set levelsAreValid true - set level 0 - set callerLevel #$level - - while { $levelsAreValid } { - # Hit the end of the stack frame - if [catch {uplevel #$level {namespace current}}] { - set levelsAreValid false - set callerLevel #[expr $level - 1] - # still going - } else { - set newLevelName [uplevel #$level {namespace current}] - # See if we have run into the first ::Menubar level - if { $newLevelName == "::itk::Archetype" || \ - $newLevelName == "::iwidgets::Menubar" } { - # If so, we are done-- set the callerLevel - set levelsAreValid false - set callerLevel #[expr $level - 1] - } else { - set levelName $newLevelName - } - } - incr level - } - return $callerLevel -} - - -# -# The default tkMenuFind proc in menu.tcl only looks for menubuttons -# 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] - - foreach child [winfo child $w] { - switch [winfo class $child] { - Menubutton { - set qchild [info command $child] - set char2 [string index [$qchild cget -text] \ - [$qchild cget -underline]] - if {([string compare $char [string tolower $char2]] == 0) - || ($char == "")} { - if {[$qchild cget -state] != "disabled"} { - return $child - } - } - } - Frame - - Menubar { - set match [tkMenuFind $child $char] - if {$match != ""} { - return $match - } - } - } - } - return {} -} - - diff --git a/itcl/iwidgets3.0.0/generic/messagebox.itk b/itcl/iwidgets3.0.0/generic/messagebox.itk deleted file mode 100644 index 3710ed37ee4..00000000000 --- a/itcl/iwidgets3.0.0/generic/messagebox.itk +++ /dev/null @@ -1,403 +0,0 @@ -# -# Messagebox -# ---------------------------------------------------------------------- -# Implements an information messages area widget with scrollbars. -# Message types can be user defined and configured. Their options -# include foreground, background, font, bell, and their display -# mode of on or off. This allows message types to defined as needed, -# removed when no longer so, and modified when necessary. An export -# method is provided for file I/O. -# -# The number of lines that can be displayed may be limited with -# the default being 1000. When this limit is reached, the oldest line -# is removed. There is also support for saving the contents to a -# file, using a file selection dialog. -# ---------------------------------------------------------------------- -# -# History: -# 01/16/97 - Alfredo Jahn Renamed from InfoMsgBox to MessageBox -# Initial release... -# 01/20/97 - Alfredo Jahn Add a popup window so that 3rd mouse -# button can be used to configure/access the message area. -# New methods added: _post and _toggleDebug. -# 01/30/97 - Alfredo Jahn Add -filename option -# 05/11/97 - Mark Ulferts Added the ability to define and configure -# new types. Changed print method to be issue. -# 09/05/97 - John Tucker Added export method. -# -# ---------------------------------------------------------------------- -# AUTHOR: Alfredo Jahn V EMAIL: ajahn@spd.dsccc.com -# Mark L. Ulferts mulferts@austin.dsccc.com -# -# @(#) $Id$ -# ---------------------------------------------------------------------- -# Copyright (c) 1997 DSC Technologies Corporation -# ====================================================================== -# Permission to use, copy, modify, distribute and license this software -# and its documentation for any purpose, and without fee or written -# agreement with DSC, is hereby granted, provided that the above copyright -# notice appears in all copies and that both the copyright notice and -# warranty disclaimer below appear in supporting documentation, and that -# the names of DSC Technologies Corporation or DSC Communications -# Corporation not be used in advertising or publicity pertaining to the -# software without specific, written prior permission. -# -# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING -# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- -# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE -# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, -# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL -# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR -# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, -# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, -# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS -# SOFTWARE. -# ====================================================================== - -# -# Usual options. -# -itk::usual Messagebox { - keep -activebackground -activeforeground -background -borderwidth \ - -cursor -highlightcolor -highlightthickness \ - -jump -labelfont -textbackground -troughcolor -} - -# ------------------------------------------------------------------ -# MSGTYPE -# ------------------------------------------------------------------ - -class iwidgets::MsgType { - constructor {args} {eval configure $args} - - public variable background \#d9d9d9 - public variable bell 0 - public variable font -*-Courier-Medium-R-Normal--*-120-*-*-*-*-*-* - public variable foreground Black - public variable show 1 -} - -# ------------------------------------------------------------------ -# MESSAGEBOX -# ------------------------------------------------------------------ -class iwidgets::Messagebox { - inherit itk::Widget - - constructor {args} {} - destructor {} - - itk_option define -filename fileName FileName "" - itk_option define -maxlines maxLines MaxLines 1000 - itk_option define -savedir saveDir SaveDir "[pwd]" - - public { - method clear {} - method export {filename} - method find {} - method issue {string {type DEFAULT} args} - method save {} - method type {op tag args} - } - - protected { - variable _unique 0 - variable _types {} - variable _interior {} - - method _post {x y} - } -} - -# -# Provide a lowercased access method for the Messagebox class. -# -proc ::iwidgets::messagebox {pathName args} { - uplevel ::iwidgets::Messagebox $pathName $args -} - -# -# Use option database to override default resources of base classes. -# -option add *Messagebox.labelPos n widgetDefault -option add *Messagebox.cursor top_left_arrow widgetDefault -option add *Messagebox.height 0 widgetDefault -option add *Messagebox.width 0 widgetDefault -option add *Messagebox.visibleItems 80x24 widgetDefault - -# ------------------------------------------------------------------ -# CONSTRUCTOR -# ------------------------------------------------------------------ -body iwidgets::Messagebox::constructor {args} { - set _interior $itk_interior - - # - # Create the text area. - # - itk_component add text { - iwidgets::Scrolledtext $itk_interior.text -width 1 -height 1 \ - -state disabled -wrap none - } { - keep -borderwidth -cursor -exportselection -highlightcolor \ - -highlightthickness -padx -pady -relief -setgrid -spacing1 \ - -spacing2 -spacing3 - - keep -activerelief -elementborderwidth -jump -troughcolor - - keep -hscrollmode -height -sbwidth -scrollmargin -textbackground \ - -visibleitems -vscrollmode -width - - keep -labelbitmap -labelfont -labelimage -labelmargin \ - -labelpos -labeltext -labelvariable - } - grid $itk_component(text) -row 0 -column 0 -sticky nsew - grid rowconfigure $_interior 0 -weight 1 - grid columnconfigure $_interior 0 -weight 1 - - # - # Setup right mouse button binding to post a user configurable - # popup menu and diable the binding for left mouse clicks. - # - bind [$itk_component(text) component text] <ButtonPress-1> "break" - bind [$itk_component(text) component text] \ - <ButtonPress-3> [code $this _post %x %y] - - # - # Create the small popup menu that can be configurable by users. - # - itk_component add itemMenu { - menu $itk_component(hull).itemmenu -tearoff 0 - } { - keep -background -font -foreground \ - -activebackground -activeforeground - ignore -tearoff - } - - # - # Add clear and svae options to the popup menu. - # - $itk_component(itemMenu) add command -label "Clear" \ - -command [code $this clear] - $itk_component(itemMenu) add command -label "Save" \ - -command [code $this save] - $itk_component(itemMenu) add command -label "Find" \ - -command [code $this find] - - # - # Create a standard type to be used if no others are specified. - # - type add DEFAULT - - eval itk_initialize $args -} - -# ------------------------------------------------------------------ -# DESTURCTOR -# ------------------------------------------------------------------ -body iwidgets::Messagebox::destructor {} { - foreach type $_types { - type remove $type - } -} - -# ------------------------------------------------------------------ -# METHODS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# METHOD clear -# -# Clear the text area. -# ------------------------------------------------------------------ -body iwidgets::Messagebox::clear {} { - $itk_component(text) configure -state normal - - $itk_component(text) delete 1.0 end - - $itk_component(text) configure -state disabled -} - -# ------------------------------------------------------------------ -# PUBLIC METHOD: type <op> <tag> <args> -# -# The type method supports several subcommands. Types can be added -# removed and configured. All the subcommands use the MsgType class -# to implement the functionaility. -# ------------------------------------------------------------------ -body iwidgets::Messagebox::type {op tag args} { - switch $op { - add { - eval iwidgets::MsgType $this$tag $args - - lappend _types $tag - - $itk_component(text) tag configure $tag \ - -font [$this$tag cget -font] \ - -background [$this$tag cget -background] \ - -foreground [$this$tag cget -foreground] - - return $tag - } - - remove { - if {[set index [lsearch $_types $tag]] != -1} { - delete object $this$tag - set _types [lreplace $_types $index $index] - - return - } else { - error "bad message type: \"$tag\", does not exist" - } - } - - configure { - if {[set index [lsearch $_types $tag]] != -1} { - set retVal [eval $this$tag configure $args] - - $itk_component(text) tag configure $tag \ - -font [$this$tag cget -font] \ - -background [$this$tag cget -background] \ - -foreground [$this$tag cget -foreground] - - return $retVal - - } else { - error "bad message type: \"$tag\", does not exist" - } - } - - cget { - if {[set index [lsearch $_types $tag]] != -1} { - return [eval $this$tag cget $args] - } else { - error "bad message type: \"$tag\", does not exist" - } - } - - default { - error "bad type operation: \"$op\", should be add,\ - remove, configure or cget" - } - } -} - -# ------------------------------------------------------------------ -# PUBLIC METHOD: issue string ?type? args -# -# Print the string out to the Messagebox. Check the options of the -# message type to see if it should be displayed or if the bell -# should be wrong. -# ------------------------------------------------------------------ -body iwidgets::Messagebox::issue {string {type DEFAULT} args} { - if {[lsearch $_types $type] == -1} { - error "bad message type: \"$type\", use the type\ - command to create a new types" - } - - # - # If the type is currently configured to be displayed, then insert - # it in the text widget, add the tag to the line and move the - # vertical scroll bar to the bottom. - # - set tag $this$type - - if {[$tag cget -show]} { - $itk_component(text) configure -state normal - - # - # Find end of last message. - # - set prevend [$itk_component(text) index "end - 1 chars"] - - $itk_component(text) insert end "$string\n" $args - - $itk_component(text) tag add $type $prevend "end - 1 chars" - $itk_component(text) yview end - - # - # Sound a beep if the message type is configured such. - # - if {[$tag cget -bell]} { - bell - } - - # - # If we reached our max lines limit, then remove enough lines to - # get it back under. - # - set lineCount [lindex [split [$itk_component(text) index end] "."] 0] - - if { $lineCount > $itk_option(-maxlines) } { - set numLines [expr $lineCount - $itk_option(-maxlines) -1] - - $itk_component(text) delete 1.0 $numLines.0 - } - - $itk_component(text) configure -state disabled - } -} - -# ------------------------------------------------------------------ -# PUBLIC METHOD: save -# -# Save contents of messages area to a file using a fileselectionbox. -# ------------------------------------------------------------------ -body iwidgets::Messagebox::save {} { - set saveFile "" - set filter "" - - set saveFile [tk_getSaveFile -title "Save Messages" \ - -initialdir $itk_option(-savedir) \ - -initialfile $itk_option(-filename)] - - if { $saveFile != "" } { - $itk_component(text) export $saveFile - issue "Contents saved to $pathname" INFO - } -} - -# ------------------------------------------------------------------ -# PUBLIC METHOD: find -# -# Search the contents of messages area for a specific string. -# ------------------------------------------------------------------ -body iwidgets::Messagebox::find {} { - if {! [info exists itk_component(findd)]} { - itk_component add findd { - iwidgets::Finddialog $itk_interior.findd \ - -textwidget $itk_component(text) - } - } - - $itk_component(findd) center $itk_component(text) - $itk_component(findd) activate -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _post -# -# Used internally to post the popup menu at the coordinate (x,y) -# relative to the widget. -# ------------------------------------------------------------------ -body iwidgets::Messagebox::_post {x y} { - set rx [expr [winfo rootx $itk_component(text)]+$x] - set ry [expr [winfo rooty $itk_component(text)]+$y] - - tk_popup $itk_component(itemMenu) $rx $ry -} - - -# ------------------------------------------------------------------ -# METHOD export filename -# -# write text to a file (export filename) -# ------------------------------------------------------------------ -body iwidgets::Messagebox::export {filename} { - set f [open $filename w] - - set txt [$itk_component(text) get 1.0 end] - puts $f $txt - - flush $f - close $f -} - diff --git a/itcl/iwidgets3.0.0/generic/messagedialog.itk b/itcl/iwidgets3.0.0/generic/messagedialog.itk deleted file mode 100644 index ba1927a194f..00000000000 --- a/itcl/iwidgets3.0.0/generic/messagedialog.itk +++ /dev/null @@ -1,144 +0,0 @@ -# -# Messagedialog -# ---------------------------------------------------------------------- -# Implements a message dialog composite widget. The Messagedialog is -# derived from the Dialog class and is composed of an image and text -# component. The image will accept both images as well as bitmaps. -# The text can extend mutliple lines by embedding newlines. -# -# ---------------------------------------------------------------------- -# AUTHOR: Mark L. Ulferts EMAIL: mulferts@austin.dsccc.com -# -# @(#) $Id$ -# ---------------------------------------------------------------------- -# Copyright (c) 1995 DSC Technologies Corporation -# ====================================================================== -# Permission to use, copy, modify, distribute and license this software -# and its documentation for any purpose, and without fee or written -# agreement with DSC, is hereby granted, provided that the above copyright -# notice appears in all copies and that both the copyright notice and -# warranty disclaimer below appear in supporting documentation, and that -# the names of DSC Technologies Corporation or DSC Communications -# Corporation not be used in advertising or publicity pertaining to the -# software without specific, written prior permission. -# -# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING -# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- -# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE -# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, -# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL -# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR -# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, -# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, -# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS -# SOFTWARE. -# ====================================================================== - -# -# Usual options. -# -itk::usual Messagedialog { - keep -background -cursor -font -foreground -modality - keep -wraplength -justify -} - -# ------------------------------------------------------------------ -# MESSAGEDIALOG -# ------------------------------------------------------------------ -class iwidgets::Messagedialog { - inherit iwidgets::Dialog - - constructor {args} {} - - itk_option define -imagepos imagePos Position w -} - -# -# Provide a lowercased access method for the Messagedialog class. -# -proc ::iwidgets::messagedialog {pathName args} { - uplevel ::iwidgets::Messagedialog $pathName $args -} - -# -# Use option database to override default resources of base classes. -# -option add *Messagedialog.title "Message Dialog" widgetDefault -option add *Messagedialog.master "." widgetDefault -option add *Messagedialog.textPadX 20 widgetDefault -option add *Messagedialog.textPadY 20 widgetDefault - -# ------------------------------------------------------------------ -# CONSTRUCTOR -# ------------------------------------------------------------------ -body iwidgets::Messagedialog::constructor {args} { - # - # Create the image component which may be either a bitmap or image. - # - itk_component add image { - label $itk_interior.image - } { - keep -background -bitmap -cursor -foreground -image - } - - # - # Create the text message component. The message may extend over - # several lines by embedding '\n' characters. - # - itk_component add message { - label $itk_interior.message - } { - keep -background -cursor -font -foreground -text - keep -wraplength -justify - - rename -padx -textpadx textPadX Pad - rename -pady -textpady textPadY Pad - } - - # - # Hide the apply and help buttons. - # - hide Apply - hide Help - - # - # Initialize the widget based on the command line options. - # - eval itk_initialize $args -} - -# ------------------------------------------------------------------ -# OPTIONS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# OPTION: -imagepos -# -# Specifies the image position relative to the message: n, s, -# e, or w. The default is w. -# ------------------------------------------------------------------ -configbody iwidgets::Messagedialog::imagepos { - switch $itk_option(-imagepos) { - n { - grid $itk_component(image) -row 0 -column 0 - grid $itk_component(message) -row 1 -column 0 - } - s { - grid $itk_component(message) -row 0 -column 0 - grid $itk_component(image) -row 1 -column 0 - } - e { - grid $itk_component(message) -row 0 -column 0 - grid $itk_component(image) -row 0 -column 1 - } - w { - grid $itk_component(image) -row 0 -column 0 - grid $itk_component(message) -row 0 -column 1 - } - - default { - error "bad imagepos option \"$itk_option(-imagepos)\":\ - should be n, e, s, or w" - } - } -} diff --git a/itcl/iwidgets3.0.0/generic/notebook.itk b/itcl/iwidgets3.0.0/generic/notebook.itk deleted file mode 100644 index a83a7984933..00000000000 --- a/itcl/iwidgets3.0.0/generic/notebook.itk +++ /dev/null @@ -1,946 +0,0 @@ -# -# Notebook Widget -# ---------------------------------------------------------------------- -# The Notebook command creates a new window (given by the pathName -# argument) and makes it into a Notebook widget. Additional options, -# described above may be specified on the command line or in the -# option database to configure aspects of the Notebook such as its -# colors, font, and text. The Notebook command returns its pathName -# argument. At the time this command is invoked, there must not exist -# a window named pathName, but path Name's parent must exist. -# -# A Notebook is a widget that contains a set of pages. It displays one -# page from the set as the selected page. When a page is selected, the -# page's contents are displayed in the page area. When first created a -# Notebook has no pages. Pages may be added or deleted using widget commands -# described below. -# -# A special option may be provided to the Notebook. The -auto option -# specifies whether the Nptebook will automatically handle the unpacking -# and packing of pages when pages are selected. A value of true signifies -# that the notebook will automatically manage it. This is the default -# value. A value of false signifies the notebook will not perform automatic -# switching of pages. -# -# WISH LIST: -# This section lists possible future enhancements. -# -# ---------------------------------------------------------------------- -# AUTHOR: Bill W. Scott EMAIL: bscott@spd.dsccc.com -# -# @(#) $Id$ -# ---------------------------------------------------------------------- -# Copyright (c) 1995 DSC Technologies Corporation -# ====================================================================== -# Permission to use, copy, modify, distribute and license this software -# and its documentation for any purpose, and without fee or written -# agreement with DSC, is hereby granted, provided that the above copyright -# notice appears in all copies and that both the copyright notice and -# warranty disclaimer below appear in supporting documentation, and that -# the names of DSC Technologies Corporation or DSC Communications -# Corporation not be used in advertising or publicity pertaining to the -# software without specific, written prior permission. -# -# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING -# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- -# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE -# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, -# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL -# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR -# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, -# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, -# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS -# SOFTWARE. -# ====================================================================== - -# -# Default resources. -# -option add *Notebook.background #d9d9d9 widgetDefault -option add *Notebook.auto true widgetDefault - -# -# Usual options. -# -itk::usual Notebook { - keep -background -cursor -} - -# ------------------------------------------------------------------ -# NOTEBOOK -# ------------------------------------------------------------------ -class iwidgets::Notebook { - inherit itk::Widget - - constructor {args} {} - - itk_option define -background background Background #d9d9d9 - itk_option define -auto auto Auto true - itk_option define -scrollcommand scrollCommand ScrollCommand {} - - public method add { args } - public method childsite { args } - public method delete { args } - public method index { args } - public method insert { args } - public method prev { } - public method next { } - public method pageconfigure { args } - public method pagecget { index option } - public method select { index } - public method view { args } - - private method _childSites { } - private method _scrollCommand { } - private method _index { pathList index select} - private method _createPage { args } - private method _deletePages { fromPage toPage } - private method _configurePages { args } - private method _tabCommand { } - - private variable _currPage -1 ;# numerical index of current page selected - private variable _pages {} ;# list of Page components - private variable _uniqueID 0 ;# one-up number for unique page numbering - -} - -# -# Provide a lowercase access method for the Notebook class -# -proc ::iwidgets::notebook {pathName args} { - uplevel ::iwidgets::Notebook $pathName $args -} - -# ------------------------------------------------------------------ -# CONSTRUCTOR -# ------------------------------------------------------------------ -body iwidgets::Notebook::constructor {args} { - # - # Create the outermost frame to maintain geometry. - # - itk_component add cs { - frame $itk_interior.cs - } { - keep -cursor -background -width -height - } - pack $itk_component(cs) -fill both -expand yes - pack propagate $itk_component(cs) no - - eval itk_initialize $args - - # force bg of all pages to reflect Notebook's background. - _configurePages -background $itk_option(-background) -} - -# ------------------------------------------------------------------ -# OPTIONS -# ------------------------------------------------------------------ -# ------------------------------------------------------------------ -# OPTION -background -# -# Sets the bg color of all the pages in the Notebook. -# ------------------------------------------------------------------ -configbody iwidgets::Notebook::background { - if {$itk_option(-background) != {}} { - _configurePages -background $itk_option(-background) - } -} - -# ------------------------------------------------------------------ -# OPTION -auto -# -# Determines whether pages are automatically unpacked and -# packed when pages get selected. -# ------------------------------------------------------------------ -configbody iwidgets::Notebook::auto { - if {$itk_option(-auto) != {}} { - } -} - -# ------------------------------------------------------------------ -# OPTION -scrollcommand -# -# Command string to be invoked when the notebook -# has any changes to its current page, or number of pages. -# -# typically for scrollbars. -# ------------------------------------------------------------------ -configbody iwidgets::Notebook::scrollcommand { - if {$itk_option(-scrollcommand) != {}} { - _scrollCommand - } -} - -# ------------------------------------------------------------------ -# METHOD: add add ?<option> <value>...? -# -# Creates a page and appends it to the list of pages. -# processes pageconfigure for the page added. -# ------------------------------------------------------------------ -body iwidgets::Notebook::add { args } { - # The args list should be an even # of params, if not then - # prob missing value for last item in args list. Signal error. - set len [llength $args] - if { [expr $len % 2] } { - error "value for \"[lindex $args [expr $len - 1]]\" missing" - } - - # add a Page component - set pathName [eval _createPage $args] - lappend _pages $pathName - - # update scroller - _scrollCommand - - # return childsite for the Page component - return [eval $pathName childsite] -} - -# ------------------------------------------------------------------ -# METHOD: childsite ?<index>? -# -# If index is supplied, returns the child site widget corresponding -# to the page index. If called with no arguments, returns a list -# of all child sites -# ------------------------------------------------------------------ -body iwidgets::Notebook::childsite { args } { - set len [llength $args] - - switch $len { - 0 { - # ... called with no arguments, return a list - if { [llength $args] == 0 } { - return [_childSites] - } - } - 1 { - set index [lindex $args 0] - # ... otherwise, return child site for the index given - # empty notebook - if { $_pages == {} } { - error "can't get childsite,\ - no pages in the notebook \"$itk_component(hull)\"" - } - - set index [_index $_pages $index $_currPage] - - # index out of range - if { $index < 0 || $index >= [llength $_pages] } { - error "bad Notebook page index in childsite method:\ - should be between 0 and [expr [llength $_pages] - 1]" - } - - set pathName [lindex $_pages $index] - - set cs [eval $pathName childsite] - return $cs - } - default { - # ... too many parameters passed - error "wrong # args: should be\ - \"$itk_component(hull) childsite ?index?\"" - } - } -} - -# ------------------------------------------------------------------ -# METHOD: delete <index1> ?<index2>? -# -# Deletes a page or range of pages from the notebook -# ------------------------------------------------------------------ -body iwidgets::Notebook::delete { args } { - # empty notebook - if { $_pages == {} } { - error "can't delete page, no pages in the notebook\ - \"$itk_component(hull)\"" - } - - set len [llength $args] - switch -- $len { - 1 { - set fromPage [_index $_pages [lindex $args 0] $_currPage] - - if { $fromPage < 0 || $fromPage >= [llength $_pages] } { - error "bad Notebook page index in delete method:\ - should be between 0 and [expr [llength $_pages] - 1]" - } - - set toPage $fromPage - _deletePages $fromPage $toPage - } - - 2 { - set fromPage [_index $_pages [lindex $args 0] $_currPage] - - if { $fromPage < 0 || $fromPage >= [llength $_pages] } { - error "bad Notebook page index1 in delete method:\ - should be between 0 and [expr [llength $_pages] - 1]" - } - - set toPage [_index $_pages [lindex $args 1] $_currPage] - - if { $toPage < 0 || $toPage >= [llength $_pages] } { - error "bad Notebook page index2 in delete method:\ - should be between 0 and [expr [llength $_pages] - 1]" - error "bad Notebook page index2" - } - - if { $fromPage > $toPage } { - error "bad Notebook page index1 in delete method:\ - index1 is greater than index2" - } - - _deletePages $fromPage $toPage - - } - - default { - # ... too few/many parameters passed - error "wrong # args: should be\ - \"$itk_component(hull) delete index1 ?index2?\"" - } - } -} - -# ------------------------------------------------------------------ -# METHOD: index <index> -# -# Given an index identifier returns the numeric index of the page -# ------------------------------------------------------------------ -body iwidgets::Notebook::index { args } { - if { [llength $args] != 1 } { - error "wrong # args: should be\ - \"$itk_component(hull) index index\"" - } - - set index $args - - set number [_index $_pages $index $_currPage] - - return $number -} - -# ------------------------------------------------------------------ -# METHOD: insert <index> ?<option> <value>...? -# -# Inserts a page before a index. The before page may -# be specified as a label or a page position. -# ------------------------------------------------------------------ -body iwidgets::Notebook::insert { args } { - # ... Error: no args passed - set len [llength $args] - if { $len == 0 } { - error "wrong # args: should be\ - \"$itk_component(hull) insert index ?option value?\"" - } - - # ... set up index and args - set index [lindex $args 0] - set args [lrange $args 1 $len] - - # ... Error: unmatched option value pair (len is odd) - # The args list should be an even # of params, if not then - # prob missing value for last item in args list. Signal error. - set len [llength $args] - if { [expr $len % 2] } { - error "value for \"[lindex $args [expr $len - 1]]\" missing" - } - - # ... Error: catch notebook empty - if { $_pages == {} } { - error "can't insert page, no pages in the notebook\ - \"$itk_component(hull)\"" - } - - # ok, get the page - set page [_index $_pages $index $_currPage] - - # ... Error: catch bad value for before page. - if { $page < 0 || $page >= [llength $_pages] } { - error "bad Notebook page index in insert method:\ - should be between 0 and [expr [llength $_pages] - 1]" - } - - # ... Start the business of inserting - # create the new page and get its path name... - set pathName [eval _createPage $args] - - # grab the name of the page currently selected. (to keep in sync) - set currPathName [lindex $_pages $_currPage] - - # insert pathName before $page - set _pages [linsert $_pages $page $pathName] - - # keep the _currPage in sync with the insert. - set _currPage [lsearch -exact $_pages $currPathName] - - # give scrollcommand chance to update - _scrollCommand - - # give them child site back... - return [eval $pathName childsite] -} - -# ------------------------------------------------------------------ -# METHOD: prev -# -# Selects the previous page. Wraps at first back to last page. -# ------------------------------------------------------------------ -body iwidgets::Notebook::prev { } { - # catch empty notebook - if { $_pages == {} } { - error "can't move to previous page,\ - no pages in the notebook \"$itk_component(hull)\"" - } - - # bump to the previous page and wrap if necessary - set prev [expr $_currPage - 1] - if { $prev < 0 } { - set prev [expr [llength $_pages] - 1] - } - - select $prev - - return $prev -} - -# ------------------------------------------------------------------ -# METHOD: next -# -# Selects the next page. Wraps at last back to first page. -# ------------------------------------------------------------------ -body iwidgets::Notebook::next { } { - # catch empty notebook - if { $_pages == {} } { - error "can't move to next page,\ - no pages in the notebook \"$itk_component(hull)\"" - } - - # bump to the next page and wrap if necessary - set next [expr $_currPage + 1] - if { $next >= [llength $_pages] } { - set next 0 - } - - select $next - - return $next -} - -# ------------------------------------------------------------------ -# METHOD: pageconfigure <index> ?<option> <value>...? -# -# Performs configure on a given page denoted by index. Index may -# be a page number or a pattern matching the label associated with -# a page. -# ------------------------------------------------------------------ -body iwidgets::Notebook::pageconfigure { args } { - # ... Error: no args passed - set len [llength $args] - if { $len == 0 } { - error "wrong # args: should be\ - \"$itk_component(hull) pageconfigure index ?option value?\"" - } - - # ... set up index and args - set index [lindex $args 0] - set args [lrange $args 1 $len] - - set page [_index $_pages $index $_currPage] - - # ... Error: page out of range - if { $page < 0 || $page >= [llength $_pages] } { - error "bad Notebook page index in pageconfigure method:\ - should be between 0 and [expr [llength $_pages] - 1]" - } - - # Configure the page component - set pathName [lindex $_pages $page] - return [eval $pathName configure $args] -} - -# ------------------------------------------------------------------ -# METHOD: pagecget <index> <option> -# -# Performs cget on a given page denoted by index. Index may -# be a page number or a pattern matching the label associated with -# a page. -# ------------------------------------------------------------------ -body iwidgets::Notebook::pagecget { index option } { - set page [_index $_pages $index $_currPage] - - # ... Error: page out of range - if { $page < 0 || $page >= [llength $_pages] } { - error "bad Notebook page index in pagecget method:\ - should be between 0 and [expr [llength $_pages] - 1]" - } - - # Get the page info. - set pathName [lindex $_pages $page] - return [$pathName cget $option] -} - -# ------------------------------------------------------------------ -# METHOD: select <index> -# -# Select a page by index. Hide the last _currPage if it existed. -# Then show the new one if it exists. Returns the currently -# selected page or -1 if tried to do a select select when there is -# no selection. -# ------------------------------------------------------------------ -body iwidgets::Notebook::select { index } { - global page$itk_component(hull) - - # ... Error: empty notebook - if { $_pages == {} } { - error "can't select page $index,\ - no pages in the notebook \"$itk_component(hull)\"" - } - - # if there is not current selection just ignore trying this selection - if { $index == "select" && $_currPage == -1 } { - return -1 - } - - set reqPage [_index $_pages $index $_currPage] - - if { $reqPage < 0 || $reqPage >= [llength $_pages] } { - error "bad Notebook page index in select method:\ - should be between 0 and [expr [llength $_pages] - 1]" - } - - # if we already have this page selected, then ignore selection. - if { $reqPage == $_currPage } { - return $_currPage - } - - # if we are handling packing and unpacking the unpack if we can - if { $itk_option(-auto) } { - # if there is a current page packed, then unpack it - if { $_currPage != -1 } { - set currPathName [lindex $_pages $_currPage] - pack forget $currPathName - } - } - - # set this now so that the -command cmd can do an 'index select' - # to operate on this page. - set _currPage $reqPage - - # invoke the command for this page - set cmd [lindex [pageconfigure $index -command] 4] - eval $cmd - - # give scrollcommand chance to update - _scrollCommand - - # if we are handling packing and unpacking the pack if we can - if { $itk_option(-auto) } { - set reqPathName [lindex $_pages $reqPage] - pack $reqPathName -anchor nw -fill both -expand yes - } - - return $_currPage -} - - -# ------------------------------------------------------------------ -# METHOD: view -# -# Return the current page -# -# view <index> -# -# Selects the page denoted by index to be current page -# -# view 'moveto' <fraction> -# -# Selects the page by using fraction amount -# -# view 'scroll' <num> <what> -# -# Selects the page by using num as indicator of next or previous -# ------------------------------------------------------------------ -body iwidgets::Notebook::view { args } { - set len [llength $args] - switch -- $len { - 0 { - # Return current page - return $_currPage - } - 1 { - # Select by index - select [lindex $args 0] - } - 2 { - # Select using moveto - set arg [lindex $args 0] - if { $arg == "moveto" } { - set fraction [lindex $args 1] - if { [catch { set page \ - [expr round($fraction/(1.0/[llength $_pages]))]}]} { - error "expected floating-point number \ - but got \"$fraction\"" - } - if { $page == [llength $_pages] } { - incr page -1 - } - - if { $page >= 0 && $page < [llength $_pages] } { - select $page - } - } else { - error "expected \"moveto\" but got $arg" - } - } - 3 { - # Select using scroll keyword - set arg [lindex $args 0] - if { $arg == "scroll" } { - set amount [lindex $args 1] - # check for integer value - if { ! [regexp {^[-]*[0-9]*$} $amount] } { - error "expected integer but got \"$amount\"" - } - set page [expr $_currPage + $amount] - if { $page >= 0 && $page < [llength $_pages] } { - select $page - } - - } else { - error "expected \"scroll\" but got $arg" - } - } - default { - set arg [lindex $args 0] - if { $arg == "moveto" } { - error "wrong # args: should be\ - \"$itk_component(hull) view moveto fraction\"" - } elseif { $arg == "scroll" } { - error "wrong # args: should be\ - \"$itk_component(hull) view scroll units|pages\"" - } else { - error "wrong # args: should be\ - \"$itk_component(hull) view index\"" - } - } - } -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _childSites -# -# Returns a list of child sites for all pages in the notebook. -# ------------------------------------------------------------------ -body iwidgets::Notebook::_childSites { } { - # empty notebook - if { $_pages == {} } { - error "can't get childsite list,\ - no pages in the notebook \"$itk_component(hull)\"" - } - - set csList {} - - foreach pathName $_pages { - lappend csList [eval $pathName childsite] - } - - return $csList -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _scrollCommand -# -# If there is a -scrollcommand set up, then call the tcl command -# and suffix onto it the standard 4 numbers scrollbars get. -# -# Invoke the scrollcommand, this is like the y/xscrollcommand -# it is designed to talk to scrollbars and the the -# tabset also knows how to obey scrollbar protocol. -# ------------------------------------------------------------------ -body iwidgets::Notebook::_scrollCommand { } { - if { $itk_option(-scrollcommand) != {} } { - if { $_currPage != -1 } { - set relTop [expr ($_currPage*1.0) / [llength $_pages]] - set relBottom [expr (($_currPage+1)*1.0) / [llength $_pages]] - set scrollCommand "$itk_option(-scrollcommand) $relTop $relBottom" - } else { - set scrollCommand "$itk_option(-scrollcommand) 0 1" - } - uplevel #0 $scrollCommand - } -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _index -# -# pathList : list of path names to search thru if index is a label -# index : either number, 'select', 'end', or pattern -# select : current selection -# -# _index takes takes the value $index converts it to -# a numeric identifier. If the value is not already -# an integer it looks it up in the $pathList array. -# If it fails it returns -1 -# ------------------------------------------------------------------ -body iwidgets::Notebook::_index { pathList index select} { - switch -- $index { - select { - set number $select - } - end { - set number [expr [llength $pathList] -1] - } - default { - # is it a number already? - if { [regexp {^[0-9]+$} $index] } { - set number $index - if { $number < 0 || $number >= [llength $pathList] } { - set number -1 - } - - # otherwise it is a label - } else { - # look thru the pathList of pathNames and - # get each label and compare with index. - # if we get a match then set number to postion in $pathList - # and break out. - # otherwise number is still -1 - set i 0 - set number -1 - foreach pathName $pathList { - set label [lindex [$pathName configure -label] 4] - if { [string match $label $index] } { - set number $i - break - } - incr i - } - } - } - } - - return $number -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _createPage -# -# Creates a page, using unique page naming, propagates background -# and keeps unique id up to date. -# ------------------------------------------------------------------ -body iwidgets::Notebook::_createPage { args } { - # - # create an internal name for the page: .n.cs.page0, .n.cs.page1, etc. - # - set pathName $itk_component(cs).page$_uniqueID - - eval iwidgets::Page $pathName -background $itk_option(-background) $args - - incr _uniqueID - return $pathName - -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _deletePages -# -# Deletes pages from $fromPage to $toPage. -# -# Operates in two passes, destroys all the widgets -# Then removes the pathName from the page list -# -# Also keeps the current selection in bounds. -# ------------------------------------------------------------------ -body iwidgets::Notebook::_deletePages { fromPage toPage } { - for { set page $fromPage } { $page <= $toPage } { incr page } { - # kill the widget - set pathName [lindex $_pages $page] - destroy $pathName - } - - # physically remove the page - set _pages [lreplace $_pages $fromPage $toPage] - - # If we deleted a selected page set our selection to none - if { $_currPage >= $fromPage && $_currPage <= $toPage } { - set _currPage -1 - } - - # make sure _currPage stays in sync with new numbering... - if { $_pages == {} } { - # if deleted only remaining page, - # reset current page to undefined - set _currPage -1 - - # or if the current page was the last page, it needs come back - } elseif { $_currPage >= [llength $_pages] } { - incr _currPage -1 - if { $_currPage < 0 } { - # but only to zero - set _currPage 0 - } - } - - # give scrollcommand chance to update - _scrollCommand -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _configurePages -# -# Does the pageconfigure method on each page in the notebook -# ------------------------------------------------------------------ -body iwidgets::Notebook::_configurePages { args } { - # make sure we have pages - if { [catch {set _pages}] } { - return - } - - # go thru all pages and pageconfigure them. - foreach pathName $_pages { - eval "$pathName configure $args" - } -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _tabCommand -# -# Calls the command that was passed in through the -# $itk_option(-tabcommand) argument. -# -# This method is up for debate... do we need the -tabcommand option? -# ------------------------------------------------------------------ -body iwidgets::Notebook::_tabCommand { } { - global page$itk_component(hull) - - if { $itk_option(-tabcommand) != {} } { - set newTabCmdStr $itk_option(-tabcommand) - lappend newTabCmdStr [set page$itk_component(hull)] - - #eval $newTabCmdStr - uplevel #0 $newTabCmdStr - } -} - -# -# Page widget -# ------------------------------------------------------------------ -# -# The Page command creates a new window (given by the pathName argument) -# and makes it into a Page widget. Additional options, described above -# may be specified on the com mand line or in the option database to -# configure aspects of the Page such as its back ground, cursor, and -# geometry. The Page command returns its pathName argument. At the time -# this command is invoked, there must not exist a window named pathName, -# but path Name's parent must exist. -# -# A Page is a frame that holds a child site. It is nothing more than a -# frame widget with some intelligence built in. Its primary purpose is -# to support the Notebook's concept of a page. It allows another widget -# like the Notebook to treat a page as a single object. The Page has an -# associated label and knows how to return its child site. -# -# ------------------------------------------------------------------ -# AUTHOR: Bill W. Scott EMAIL: bscott@spd.dsccc.com -# -# ------------------------------------------------------------------ -# Copyright (c) 1995 DSC Communications Corp. -# ====================================================================== -# Permission is hereby granted, without written agreement and without -# license or royalty fees, to use, copy, modify, and distribute this -# software and its documentation for any purpose, provided that the -# above copyright notice and the following two paragraphs appear in -# all copies of this software. -# -# IN NO EVENT SHALL THE COPYRIGHT HOLDER BE LIABLE TO ANY PARTY FOR -# DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES -# ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN -# IF THE COPYRIGHT HOLDER HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH -# DAMAGE. -# -# THE COPYRIGHT HOLDER SPECIFICALLY DISCLAIMS ANY WARRANTIES, INCLUDING, -# BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND -# FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS -# ON AN "AS IS" BASIS, AND THE COPYRIGHT HOLDER HAS NO OBLIGATION TO -# PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. -# ====================================================================== -# -# Option database default resources: -# -option add *Page.disabledForeground #a3a3a3 widgetDefault -option add *Page.label {} widgetDefault -option add *Page.command {} widgetDefault - -class iwidgets::Page { - inherit itk::Widget - - constructor {args} {} - - itk_option define \ - -disabledforeground disabledForeground DisabledForeground #a3a3a3 - itk_option define -label label Label {} - itk_option define -command command Command {} - - public method childsite { } -} - -# ------------------------------------------------------------------ -# CONSTRUCTOR -# ------------------------------------------------------------------ -body iwidgets::Page::constructor {args} { - # - # Create the outermost frame to maintain geometry. - # - itk_component add cs { - frame $itk_interior.cs - } { - keep -cursor -background -width -height - } - pack $itk_component(cs) -fill both -expand yes - pack propagate $itk_component(cs) no - - eval itk_initialize $args -} - -# ------------------------------------------------------------------ -# OPTIONS -# ------------------------------------------------------------------ -# ------------------------------------------------------------------ -# OPTION -disabledforeground -# -# Sets the disabledForeground color of this page -# ------------------------------------------------------------------ -configbody iwidgets::Page::disabledforeground { -} - -# ------------------------------------------------------------------ -# OPTION -label -# -# Sets the label of this page. The label is a string identifier -# for this page. -# ------------------------------------------------------------------ -configbody iwidgets::Page::label { -} - -# ------------------------------------------------------------------ -# OPTION -command -# -# The Tcl Command to associate with this page. -# ------------------------------------------------------------------ -configbody iwidgets::Page::command { -} - -# ------------------------------------------------------------------ -# METHODS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# METHOD: childsite -# -# Returns the child site widget of this page -# ------------------------------------------------------------------ -body iwidgets::Page::childsite { } { - return $itk_component(cs) -} - diff --git a/itcl/iwidgets3.0.0/generic/optionmenu.itk b/itcl/iwidgets3.0.0/generic/optionmenu.itk deleted file mode 100644 index f0fd8b998cd..00000000000 --- a/itcl/iwidgets3.0.0/generic/optionmenu.itk +++ /dev/null @@ -1,660 +0,0 @@ -# -# Optionmenu -# ---------------------------------------------------------------------- -# Implements an option menu widget with options to manage it. -# An option menu displays a frame containing a label and a button. -# A pop-up menu will allow for the value of the button to change. -# -# ---------------------------------------------------------------------- -# AUTHOR: Alfredo Jahn Phone: (214) 519-3545 -# Email: ajahn@spd.dsccc.com -# alfredo@wn.com -# -# @(#) $Id$ -# ---------------------------------------------------------------------- -# Copyright (c) 1995 DSC Technologies Corporation -# ====================================================================== -# Permission to use, copy, modify, distribute and license this software -# and its documentation for any purpose, and without fee or written -# agreement with DSC, is hereby granted, provided that the above copyright -# notice appears in all copies and that both the copyright notice and -# warranty disclaimer below appear in supporting documentation, and that -# the names of DSC Technologies Corporation or DSC Communications -# Corporation not be used in advertising or publicity pertaining to the -# software without specific, written prior permission. -# -# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING -# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- -# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE -# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, -# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL -# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR -# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, -# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, -# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS -# SOFTWARE. -# ====================================================================== - -# -# Default resources. -# - -option add *Optionmenu.highlightThickness 1 widgetDefault -option add *Optionmenu.borderWidth 2 widgetDefault -option add *Optionmenu.labelPos w widgetDefault -option add *Optionmenu.labelMargin 2 widgetDefault -option add *Optionmenu.popupCursor arrow widgetDefault - -# -# Usual options. -# -itk::usual Optionmenu { - keep -activebackground -activeborderwidth -activeforeground \ - -background -borderwidth -cursor -disabledforeground -font \ - -foreground -highlightcolor -highlightthickness -labelfont \ - -popupcursor -} - -# ------------------------------------------------------------------ -# OPTONMENU -# ------------------------------------------------------------------ -class iwidgets::Optionmenu { - inherit iwidgets::Labeledwidget - - constructor {args} {} - destructor {} - - itk_option define -clicktime clickTime ClickTime 150 - itk_option define -command command Command {} - itk_option define -cyclicon cyclicOn CyclicOn true - itk_option define -width width Width 0 - itk_option define -font font Font -Adobe-Helvetica-Bold-R-Normal--*-120-* - itk_option define -borderwidth borderWidth BorderWidth 2 - itk_option define -highlightthickness highlightThickness HighlightThickness 1 - itk_option define -state state State normal - - public { - method index {index} - method delete {first {last {}}} - method disable {index} - method enable {args} - method get {{first "current"} {last ""}} - method insert {index string args} - method popupMenu {args} - method select {index} - method sort {{mode "increasing"}} - } - - protected { - variable _calcSize "" ;# non-null => _calcSize pending - } - - private { - method _buttonRelease {time} - method _getNextItem {index} - method _next {} - method _postMenu {time} - method _previous {} - method _setItem {item} - method _setSize {{when later}} - method _setitems {items} ;# Set the list of menu entries - - variable _postTime 0 - variable _items {} ;# List of popup menu entries - variable _numitems 0 ;# List of popup menu entries - - variable _currentItem "" ;# Active menu selection - } -} - -# -# Provide a lowercased access method for the Optionmenu class. -# -proc ::iwidgets::optionmenu {pathName args} { - uplevel ::iwidgets::Optionmenu $pathName $args -} - -# ------------------------------------------------------------------ -# CONSTRUCTOR -# ------------------------------------------------------------------ -body iwidgets::Optionmenu::constructor {args} { - global tcl_platform - - component hull configure -highlightthickness 0 - - itk_component add menuBtn { - menubutton $itk_interior.menuBtn -relief raised -indicatoron on \ - -textvariable [scope _currentItem] -takefocus 1 \ - -menu $itk_interior.menuBtn.menu - } { - usual - keep -borderwidth - if {$tcl_platform(platform) != "unix"} { - ignore -activebackground -activeforeground - } - } - pack $itk_interior.menuBtn -fill x - pack propagate $itk_interior no - - itk_component add popupMenu { - menu $itk_interior.menuBtn.menu -tearoff no - } { - usual - ignore -tearoff - keep -activeborderwidth -borderwidth - rename -cursor -popupcursor popupCursor Cursor - } - - # - # Bind to button release for all components. - # - bind $itk_component(menuBtn) <ButtonPress-1> \ - "[code $this _postMenu %t]; break" - bind $itk_component(menuBtn) <KeyPress-space> \ - "[code $this _postMenu %t]; break" - bind $itk_component(popupMenu) <ButtonRelease-1> \ - [code $this _buttonRelease %t] - - # - # Initialize the widget based on the command line options. - # - eval itk_initialize $args -} - -# ------------------------------------------------------------------ -# DESTRUCTOR -# ------------------------------------------------------------------ -body iwidgets::Optionmenu::destructor {} { - if {$_calcSize != ""} {after cancel $_calcSize} -} - -# ------------------------------------------------------------------ -# OPTIONS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# OPTION -clicktime -# -# Interval time (in msec) used to determine that a single mouse -# click has occurred. Used to post menu on a quick mouse click. -# **WARNING** changing this value may cause the sigle-click -# functionality to not work properly! -# ------------------------------------------------------------------ -configbody iwidgets::Optionmenu::clicktime {} - -# ------------------------------------------------------------------ -# OPTION -command -# -# Specifies a command to be evaluated upon change in option menu. -# ------------------------------------------------------------------ -configbody iwidgets::Optionmenu::command {} - -# ------------------------------------------------------------------ -# OPTION -cyclicon -# -# Turns on/off the 3rd mouse button capability. This feature -# allows the right mouse button to cycle through the popup -# menu list without poping it up. <shift>M3 cycles through -# the menu in reverse order. -# ------------------------------------------------------------------ -configbody iwidgets::Optionmenu::cyclicon { - if {$itk_option(-cyclicon)} { - bind $itk_component(menuBtn) <3> [code $this _next] - bind $itk_component(menuBtn) <Shift-3> [code $this _previous] - bind $itk_component(menuBtn) <KeyPress-Down> [code $this _next] - bind $itk_component(menuBtn) <KeyPress-Up> [code $this _previous] - } else { - bind $itk_component(menuBtn) <3> break - bind $itk_component(menuBtn) <Shift-3> break - bind $itk_component(menuBtn) <KeyPress-Down> break - bind $itk_component(menuBtn) <KeyPress-Up> break - } -} - -# ------------------------------------------------------------------ -# OPTION -width -# -# Allows the menu label width to be set to a fixed size -# ------------------------------------------------------------------ -configbody iwidgets::Optionmenu::width { - _setSize -} - -# ------------------------------------------------------------------ -# OPTION -font -# -# Change all fonts for this widget. Also re-calculate height based -# on font size (used to line up menu items over menu button label). -# ------------------------------------------------------------------ -configbody iwidgets::Optionmenu::font { - _setSize -} - -# ------------------------------------------------------------------ -# OPTION -borderwidth -# -# Change borderwidth for this widget. Also re-calculate height based -# on font size (used to line up menu items over menu button label). -# ------------------------------------------------------------------ -configbody iwidgets::Optionmenu::borderwidth { - _setSize -} - -# ------------------------------------------------------------------ -# OPTION -highlightthickness -# -# Change highlightthickness for this widget. Also re-calculate -# height based on font size (used to line up menu items over -# menu button label). -# ------------------------------------------------------------------ -configbody iwidgets::Optionmenu::highlightthickness { - _setSize -} - -# ------------------------------------------------------------------ -# OPTION -state -# -# Specified one of two states for the Optionmenu: normal, or -# disabled. If the Optionmenu is disabled, then option menu -# selection is ignored. -# ------------------------------------------------------------------ -configbody iwidgets::Optionmenu::state { - switch $itk_option(-state) { - normal { - $itk_component(menuBtn) config -state normal - $itk_component(label) config -fg $itk_option(-foreground) - } - disabled { - $itk_component(menuBtn) config -state disabled - $itk_component(label) config -fg $itk_option(-disabledforeground) - } - default { - error "bad state option \"$itk_option(-state)\":\ - should be disabled or normal" - } - } -} - -# ------------------------------------------------------------------ -# METHODS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# METHOD: index index -# -# Return the numerical index corresponding to index. -# ------------------------------------------------------------------ -body iwidgets::Optionmenu::index {index} { - - if {[regexp {(^[0-9]+$)} $index]} { - set idx [$itk_component(popupMenu) index $index] - - if {$idx == "none"} { - return 0 - } - return [expr {$index > $idx ? $_numitems : $idx}] - - } elseif {$index == "end"} { - return $_numitems - - } elseif {$index == "select"} { - return [lsearch $_items $_currentItem] - - } - - set numValue [lsearch -glob $_items $index] - - if {$numValue == -1} { - error "bad Optionmenu index \"$index\"" - } - return $numValue -} - -# ------------------------------------------------------------------ -# METHOD: delete first ?last? -# -# Remove an item (or range of items) from the popup menu. -# ------------------------------------------------------------------ -body iwidgets::Optionmenu::delete {first {last {}}} { - - set first [index $first] - set last [expr {$last != {} ? [index $last] : $first}] - set nextAvail $_currentItem - - # - # If current item is in delete range point to next available. - # - if {$_numitems > 1 && - ([lsearch -exact [lrange $_items $first $last] [get]] != -1)} { - set nextAvail [_getNextItem $last] - } - - _setitems [lreplace $_items $first $last] - - # - # Make sure "nextAvail" is still in the list. - # - set index [lsearch -exact $_items $nextAvail] - _setItem [expr {$index != -1 ? $nextAvail : ""}] -} - -# ------------------------------------------------------------------ -# METHOD: disable index -# -# Disable a menu item in the option menu. This will prevent the user -# from being able to select this item from the menu. This only effects -# the state of the item in the menu, in other words, should the item -# be the currently selected item, the user is responsible for -# determining this condition and taking appropriate action. -# ------------------------------------------------------------------ -body iwidgets::Optionmenu::disable {index} { - set index [index $index] - $itk_component(popupMenu) entryconfigure $index -state disabled -} - -# ------------------------------------------------------------------ -# METHOD: enable index -# -# Enable a menu item in the option menu. This will allow the user -# to select this item from the menu. -# ------------------------------------------------------------------ -body iwidgets::Optionmenu::enable {index} { - set index [index $index] - $itk_component(popupMenu) entryconfigure $index -state normal -} - -# ------------------------------------------------------------------ -# METHOD: get -# -# Returns the current menu item. -# ------------------------------------------------------------------ -body iwidgets::Optionmenu::get {{first "current"} {last ""}} { - if {"current" == $first} { - return $_currentItem - } - - set first [index $first] - if {"" == $last} { - return [$itk_component(popupMenu) entrycget $first -label] - } - - if {"end" == $last} { - set last [$itk_component(popupMenu) index end] - } else { - set last [index $last] - } - set rval "" - while {$first <= $last} { - lappend rval [$itk_component(popupMenu) entrycget $first -label] - incr first - } - return $rval -} - -# ------------------------------------------------------------------ -# METHOD: insert index string ?string? -# -# Insert an item in the popup menu. -# ------------------------------------------------------------------ -body iwidgets::Optionmenu::insert {index string args} { - set index [index $index] - set args [linsert $args 0 $string] - _setitems [eval linsert {$_items} $index $args] - return "" -} - -# ------------------------------------------------------------------ -# METHOD: select index -# -# Select an item from the popup menu to display on the menu label -# button. -# ------------------------------------------------------------------ -body iwidgets::Optionmenu::select {index} { - set index [index $index] - if {$index > [expr $_numitems - 1]} { - incr index -1 - } - _setItem [lindex $_items $index] -} - -# ------------------------------------------------------------------ -# METHOD: popupMenu -# -# Evaluates the specified args against the popup menu component -# and returns the result. -# ------------------------------------------------------------------ -body iwidgets::Optionmenu::popupMenu {args} { - return [eval $itk_component(popupMenu) $args] -} - -# ------------------------------------------------------------------ -# METHOD: sort mode -# -# Sort the current menu in either "ascending" or "descending" order. -# ------------------------------------------------------------------ -body iwidgets::Optionmenu::sort {{mode "increasing"}} { - switch $mode { - ascending - - increasing { - _setitems [lsort -increasing $_items] - } - descending - - decreasing { - _setitems [lsort -decreasing $_items] - } - default { - error "bad sort argument \"$mode\": should be ascending,\ - descending, increasing, or decreasing" - } - } -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _buttonRelease -# -# Display the popup menu. Menu position is calculated. -# ------------------------------------------------------------------ -body iwidgets::Optionmenu::_buttonRelease {time} { - if {[expr abs([expr $_postTime - $time])] <= $itk_option(-clicktime)} { - return -code break - } -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _getNextItem index -# -# Allows either a string or index number to be passed in, and returns -# the next item in the list in string format. Wrap around is automatic. -# ------------------------------------------------------------------ -body iwidgets::Optionmenu::_getNextItem {index} { - - if {[incr index] >= $_numitems} { - set index 0 ;# wrap around - } - return [lindex $_items $index] -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _next -# -# Sets the current option label to next item in list if that item is -# not disbaled. -# ------------------------------------------------------------------ -body iwidgets::Optionmenu::_next {} { - if {$itk_option(-state) != "normal"} { - return - } - set i [lsearch -exact $_items $_currentItem] - - for {set cnt 0} {$cnt < $_numitems} {incr cnt} { - - if {[incr i] >= $_numitems} { - set i 0 - } - - if {[$itk_component(popupMenu) entrycget $i -state] != "disabled"} { - _setItem [lindex $_items $i] - break - } - } -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _previous -# -# Sets the current option label to previous item in list if that -# item is not disbaled. -# ------------------------------------------------------------------ -body iwidgets::Optionmenu::_previous {} { - if {$itk_option(-state) != "normal"} { - return - } - - set i [lsearch -exact $_items $_currentItem] - - for {set cnt 0} {$cnt < $_numitems} {incr cnt} { - set i [expr $i - 1] - - if {$i < 0} { - set i [expr $_numitems - 1] - } - - if {[$itk_component(popupMenu) entrycget $i -state] != "disabled"} { - _setItem [lindex $_items $i] - break - } - } -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _postMenu time -# -# Display the popup menu. Menu position is calculated. -# ------------------------------------------------------------------ -body iwidgets::Optionmenu::_postMenu {time} { - # - # Don't bother to post if menu is empty. - # - if {[llength $_items] > 0 && $itk_option(-state) == "normal"} { - set _postTime $time - set itemIndex [lsearch -exact $_items $_currentItem] - - set margin [expr $itk_option(-borderwidth) \ - + $itk_option(-highlightthickness)] - - set x [expr [winfo rootx $itk_component(menuBtn)] + $margin] - set y [expr [winfo rooty $itk_component(menuBtn)] \ - - [$itk_component(popupMenu) yposition $itemIndex] + $margin] - - tk_popup $itk_component(popupMenu) $x $y - } -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _setItem -# -# Set the menu button label to item, then dismiss the popup menu. -# Also check if item has been changed. If so, also call user-supplied -# command. -# ------------------------------------------------------------------ -body iwidgets::Optionmenu::_setItem {item} { - if {$_currentItem != $item} { - set _currentItem $item - if {[winfo ismapped $itk_component(hull)]} { - uplevel #0 $itk_option(-command) - } - } -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _setitems items -# -# Create a list of items available on the menu. Used to create the -# popup menu. -# ------------------------------------------------------------------ -body iwidgets::Optionmenu::_setitems {items_} { - - # - # Delete the old menu entries, and set the new list of - # menu entries to those specified in "items_". - # - $itk_component(popupMenu) delete 0 last - set _items "" - set _numitems [llength $items_] - - # - # Clear the menu button label. - # - if {$_numitems == 0} { - _setItem "" - return - } - - set savedCurrentItem $_currentItem - - foreach opt $items_ { - lappend _items $opt - $itk_component(popupMenu) add command -label $opt \ - -command [code $this _setItem $opt] - } - set first [lindex $_items 0] - - # - # Make sure "savedCurrentItem" is still in the list. - # - if {$first != ""} { - set i [lsearch -exact $_items $savedCurrentItem] - #------------------------------------------------------------- - # 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 "" - } - - _setSize -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _setSize ?when? -# -# Set the size of the option menu. If "when" is "now", the change -# is applied immediately. If it is "later" or it is not specified, -# then the change is applied later, when the application is idle. -# ------------------------------------------------------------------ -body iwidgets::Optionmenu::_setSize {{when later}} { - - if {$when == "later"} { - if {$_calcSize == ""} { - set _calcSize [after idle [code $this _setSize now]] - } - return - } - - set margin [expr 2*($itk_option(-borderwidth) \ - + $itk_option(-highlightthickness))] - - if {"0" != $itk_option(-width)} { - set width $itk_option(-width) - } else { - set width [expr [winfo reqwidth $itk_component(popupMenu)]+$margin+20] - } - set height [winfo reqheight $itk_component(menuBtn)] - $itk_component(lwchildsite) configure -width $width -height $height - - set _calcSize "" -} diff --git a/itcl/iwidgets3.0.0/generic/pane.itk b/itcl/iwidgets3.0.0/generic/pane.itk deleted file mode 100644 index b7260f3815c..00000000000 --- a/itcl/iwidgets3.0.0/generic/pane.itk +++ /dev/null @@ -1,128 +0,0 @@ -# -# Paned -# ---------------------------------------------------------------------- -# Implements a pane for a paned window widget. The pane is itself a -# frame with a child site for other widgets. The pane class performs -# basic option management. -# -# ---------------------------------------------------------------------- -# AUTHOR: Mark L. Ulferts EMAIL: mulferts@austin.dsccc.com -# -# @(#) $Id$ -# ---------------------------------------------------------------------- -# Copyright (c) 1995 DSC Technologies Corporation -# ====================================================================== -# Permission to use, copy, modify, distribute and license this software -# and its documentation for any purpose, and without fee or written -# agreement with DSC, is hereby granted, provided that the above copyright -# notice appears in all copies and that both the copyright notice and -# warranty disclaimer below appear in supporting documentation, and that -# the names of DSC Technologies Corporation or DSC Communications -# Corporation not be used in advertising or publicity pertaining to the -# software without specific, written prior permission. -# -# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING -# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- -# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE -# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, -# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL -# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR -# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, -# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, -# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS -# SOFTWARE. -# ====================================================================== - -# -# Usual options. -# -itk::usual Pane { - keep -background -cursor -} - -# ------------------------------------------------------------------ -# PANE -# ------------------------------------------------------------------ -class iwidgets::Pane { - inherit itk::Widget - - constructor {args} {} - - itk_option define -minimum minimum Minimum 10 - itk_option define -margin margin Margin 8 - - public method childSite {} {} -} - -# -# Provide a lowercased access method for the Pane class. -# -proc ::iwidgets::pane {pathName args} { - uplevel ::iwidgets::Pane $pathName $args -} - -# ------------------------------------------------------------------ -# CONSTRUCTOR -# ------------------------------------------------------------------ -body iwidgets::Pane::constructor {args} { - # - # Create the pane childsite. - # - itk_component add childsite { - frame $itk_interior.childsite - } { - keep -background -cursor - } - pack $itk_component(childsite) -fill both -expand yes - - # - # Set the itk_interior variable to be the childsite for derived - # classes. - # - set itk_interior $itk_component(childsite) - - eval itk_initialize $args -} - -# ------------------------------------------------------------------ -# OPTIONS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# OPTION: -minimum -# -# Specifies the minimum size that the pane may reach. -# ------------------------------------------------------------------ -configbody iwidgets::Pane::minimum { - set pixels \ - [winfo pixels $itk_component(hull) $itk_option(-minimum)] - - set itk_option(-minimum) $pixels -} - -# ------------------------------------------------------------------ -# OPTION: -margin -# -# Specifies the border distance between the pane and pane contents. -# This is done by setting the borderwidth of the pane to the margin. -# ------------------------------------------------------------------ -configbody iwidgets::Pane::margin { - set pixels [winfo pixels $itk_component(hull) $itk_option(-margin)] - set itk_option(-margin) $pixels - - $itk_component(childsite) configure \ - -borderwidth $itk_option(-margin) -} - -# ------------------------------------------------------------------ -# METHODS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# METHOD: childSite -# -# Return the pane child site path name. -# ------------------------------------------------------------------ -body iwidgets::Pane::childSite {} { - return $itk_component(childsite) -} diff --git a/itcl/iwidgets3.0.0/generic/panedwindow.itk b/itcl/iwidgets3.0.0/generic/panedwindow.itk deleted file mode 100644 index 644d1d6c8f7..00000000000 --- a/itcl/iwidgets3.0.0/generic/panedwindow.itk +++ /dev/null @@ -1,892 +0,0 @@ -# -# Panedwindow -# ---------------------------------------------------------------------- -# Implements a multiple paned window widget capable of orienting the panes -# either vertically or horizontally. Each pane is itself a frame acting -# as a child site for other widgets. The border separating each pane -# contains a sash which allows user positioning of the panes relative to -# one another. -# -# ---------------------------------------------------------------------- -# AUTHOR: Mark L. Ulferts EMAIL: mulferts@austin.dsccc.com -# -# @(#) $Id$ -# ---------------------------------------------------------------------- -# Copyright (c) 1995 DSC Technologies Corporation -# ====================================================================== -# Permission to use, copy, modify, distribute and license this software -# and its documentation for any purpose, and without fee or written -# agreement with DSC, is hereby granted, provided that the above copyright -# notice appears in all copies and that both the copyright notice and -# warranty disclaimer below appear in supporting documentation, and that -# the names of DSC Technologies Corporation or DSC Communications -# Corporation not be used in advertising or publicity pertaining to the -# software without specific, written prior permission. -# -# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING -# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- -# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE -# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, -# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL -# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR -# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, -# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, -# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS -# SOFTWARE. -# ====================================================================== - -# -# Usual options. -# -itk::usual Panedwindow { - keep -background -cursor -sashcursor -} - -# ------------------------------------------------------------------ -# PANEDWINDOW -# ------------------------------------------------------------------ -class iwidgets::Panedwindow { - inherit itk::Widget - - constructor {args} {} - - itk_option define -orient orient Orient horizontal - itk_option define -sashborderwidth sashBorderWidth SashBorderWidth 2 - itk_option define -sashcursor sashCursor SashCursor crosshair - itk_option define -sashwidth sashWidth SashWidth 10 - itk_option define -sashheight sashHeight SashHeight 10 - itk_option define -thickness thickness Thickness 3 - itk_option define -sashindent sashIndent SashIndent -10 - - public method index {index} - public method childsite {args} - public method fraction {percentage1 percentage2 args} - public method add {tag args} - public method insert {index tag args} - public method delete {index} - public method hide {index} - public method show {index} - public method paneconfigure {index args} - public method reset {} - - protected method _pwConfigureEventHandler {width height} - protected method _startGrip {where num} - protected method _endGrip {where num} - protected method _configGrip {where num} - protected method _handleGrip {where num} - protected method _moveSash {where num} - - private method _setFracArray {} - private method _setActivePanes {} - private method _calcFraction {where num} - private method _makeSashes {} - private method _placeSash {i} - private method _placePanes {{start 0} {end end}} - - private variable _initialized 0 ;# Denotes initialized state. - private variable _panes {} ;# List of panes. - private variable _activePanes {} ;# List of active panes. - private variable _sashes {} ;# List of sashes. - private variable _separators {} ;# List of separators. - private variable _frac ;# Array of fraction percentages. - private variable _lowerlimit ;# Margin distance above/left of sash. - private variable _upperlimit ;# Margin distance below/right of sash. - private variable _dimension ;# Width/Height at start of drag. - private variable _sashloc ;# Array of dist of sash from above/left. - private variable _pixels ;# Array of dist of sash from above/left. - private variable _minheight ;# Array of min heights for panes. - private variable _minsashmoved ;# Lowest sash moved during dragging. - private variable _maxsashmoved ;# Highest sash moved during dragging. - private variable _dragging 0 ;# Boolean for dragging enabled. - private variable _movecount 0 ;# Kludge counter to get sashes to - ;# display without calling update - ;# idletasks too often. - private variable _width 0 ;# hull's width. - private variable _height 0 ;# hull's height. - private variable _unique -1 ;# Unique number for pane names. -} - -# -# Provide a lowercased access method for the Panedwindow class. -# -proc ::iwidgets::panedwindow {pathName args} { - uplevel ::iwidgets::Panedwindow $pathName $args -} - -# -# Use option database to override default resources of base classes. -# -option add *Panedwindow.width 10 widgetDefault -option add *Panedwindow.height 10 widgetDefault - -# ------------------------------------------------------------------ -# CONSTRUCTOR -# ------------------------------------------------------------------ -body iwidgets::Panedwindow::constructor {args} { - itk_option add hull.width hull.height - - pack propagate $itk_component(hull) no - - # - # Add binding for the configure event. - # - bind pw-config-$this <Configure> [code $this _pwConfigureEventHandler %w %h] - bindtags $itk_component(hull) \ - [linsert [bindtags $itk_component(hull)] 0 pw-config-$this] - - eval itk_initialize $args -} - -# ------------------------------------------------------------------ -# OPTIONS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# OPTION: -orient -# -# Specifies the orientation of the sashes. Once the paned window -# has been mapped, set the sash bindings and place the panes. -# ------------------------------------------------------------------ -configbody iwidgets::Panedwindow::orient { - if {$_initialized} { - switch $itk_option(-orient) { - vertical { - 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> \ - [code $this _handleGrip %x $i] - bind $itk_component(sash$i) <B1-ButtonRelease-1> \ - [code $this _endGrip %x $i] - bind $itk_component(sash$i) <Configure> \ - [code $this _configGrip %x $i] - } - - _setFracArray - _makeSashes - _placePanes - } - - horizontal { - 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> \ - [code $this _handleGrip %y $i] - bind $itk_component(sash$i) <B1-ButtonRelease-1> \ - [code $this _endGrip %y $i] - bind $itk_component(sash$i) <Configure> \ - [code $this _configGrip %y $i] - } - - _setFracArray - _makeSashes - _placePanes - } - - default { - error "bad orientation option \"$itk_option(-orient)\":\ - should be horizontal or vertical" - } - } - } -} - -# ------------------------------------------------------------------ -# OPTION: -sashborderwidth -# -# Specifies a non-negative value indicating the width of the 3-D -# border to draw around the outside of the sash. -# ------------------------------------------------------------------ -configbody iwidgets::Panedwindow::sashborderwidth { - set pixels [winfo pixels $itk_component(hull) \ - $itk_option(-sashborderwidth)] - set itk_option(-sashborderwidth) $pixels - - if {$_initialized} { - for {set i 1} {$i < [llength $_activePanes]} {incr i} { - $itk_component(sash$i) configure \ - -borderwidth $itk_option(-sashborderwidth) - } - } -} - -# ------------------------------------------------------------------ -# OPTION: -sashcursor -# -# Specifies the type of cursor to be used when over the sash. -# ------------------------------------------------------------------ -configbody iwidgets::Panedwindow::sashcursor { - if {$_initialized} { - for {set i 1} {$i < [llength $_activePanes]} {incr i} { - $itk_component(sash$i) configure -cursor $itk_option(-sashcursor) - } - } -} - -# ------------------------------------------------------------------ -# OPTION: -sashwidth -# -# Specifies the width of the sash. -# ------------------------------------------------------------------ -configbody iwidgets::Panedwindow::sashwidth { - set pixels [winfo pixels $itk_component(hull) \ - $itk_option(-sashwidth)] - set itk_option(-sashwidth) $pixels - - if {$_initialized} { - for {set i 1} {$i < [llength $_activePanes]} {incr i} { - $itk_component(sash$i) configure \ - -width $itk_option(-sashwidth) - } - } -} - -# ------------------------------------------------------------------ -# OPTION: -sashheight -# -# Specifies the height of the sash, -# ------------------------------------------------------------------ -configbody iwidgets::Panedwindow::sashheight { - set pixels [winfo pixels $itk_component(hull) \ - $itk_option(-sashheight)] - set itk_option(-sashheight) $pixels - - if {$_initialized} { - for {set i 1} {$i < [llength $_activePanes]} {incr i} { - $itk_component(sash$i) configure \ - -height $itk_option(-sashheight) - } - } -} - -# ------------------------------------------------------------------ -# OPTION: -thickness -# -# Specifies the thickness of the separators. It sets the width and -# height of the separator to the thickness value and the borderwidth -# to half the thickness. -# ------------------------------------------------------------------ -configbody iwidgets::Panedwindow::thickness { - set pixels [winfo pixels $itk_component(hull) \ - $itk_option(-thickness)] - set itk_option(-thickness) $pixels - - if {$_initialized} { - for {set i 1} {$i < [llength $_activePanes]} {incr i} { - $itk_component(separator$i) configure \ - -height $itk_option(-thickness) - $itk_component(separator$i) configure \ - -width $itk_option(-thickness) - $itk_component(separator$i) configure \ - -borderwidth [expr $itk_option(-thickness) / 2] - } - - for {set i 1} {$i < [llength $_activePanes]} {incr i} { - _placeSash $i - } - } -} - -# ------------------------------------------------------------------ -# OPTION: -sashindent -# -# Specifies the placement of the sash along the panes. A positive -# value causes the sash to be offset from the near (left/top) side -# of the pane, and a negative value causes the sash to be offset from -# the far (right/bottom) side. If the offset is greater than the -# width, then the sash is placed flush against the side. -# ------------------------------------------------------------------ -configbody iwidgets::Panedwindow::sashindent { - set pixels [winfo pixels $itk_component(hull) \ - $itk_option(-sashindent)] - set itk_option(-sashindent) $pixels - - if {$_initialized} { - for {set i 1} {$i < [llength $_activePanes]} {incr i} { - _placeSash $i - } - } -} - -# ------------------------------------------------------------------ -# METHODS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# METHOD: index index -# -# Searches the panes in the paned window for the one with the -# requested tag, numerical index, or keyword "end". Returns the pane's -# numerical index if found, otherwise error. -# ------------------------------------------------------------------ -body iwidgets::Panedwindow::index {index} { - if {[llength $_panes] > 0} { - if {[regexp {(^[0-9]+$)} $index]} { - if {$index < [llength $_panes]} { - return $index - } else { - error "Panedwindow index \"$index\" is out of range" - } - - } elseif {$index == "end"} { - return [expr [llength $_panes] - 1] - - } else { - if {[set idx [lsearch $_panes $index]] != -1} { - return $idx - } - - error "bad Panedwindow index \"$index\": must be number, end,\ - or pattern" - } - - } else { - error "Panedwindow \"$itk_component(hull)\" has no panes" - } -} - -# ------------------------------------------------------------------ -# METHOD: childsite ?index? -# -# Given an index return the specifc childsite path name. Invoked -# without an index return a list of all the child site panes. The -# list is ordered from the near side (left/top). -# ------------------------------------------------------------------ -body iwidgets::Panedwindow::childsite {args} { - if {! $_initialized} { - set _initialized 1 - reset - } - - if {[llength $args] == 0} { - set children {} - - foreach pane $_panes { - lappend children [$itk_component($pane) childSite] - } - - return $children - - } else { - set index [index [lindex $args 0]] - return [$itk_component([lindex $_panes $index]) childSite] - } -} - -# ------------------------------------------------------------------ -# METHOD: fraction percentage percentage ?percentage ...? -# -# Sets the visible percentage of the panes. Specifies a list of -# percentages which are applied to the currently visible panes from -# the near side (left/top). The number of percentages must be equal -# to the current number of visible (mapped) panes and add up to 100. -# ------------------------------------------------------------------ -body iwidgets::Panedwindow::fraction {percentage1 percentage2 args} { - set args [linsert $args 0 $percentage1 $percentage2] - - if {[llength $args] == [llength $_activePanes]} { - set sum 0 - - for {set i 0} {$i < [llength $args]} {incr i} { - set sum [expr $sum + [lindex $args $i]] - } - - if {$sum == 100} { - set perc 0.0 - - for {set i 0} {$i < [llength $_activePanes]} {incr i} { - set _frac($i) $perc - set perc [expr $perc + [expr [lindex $args $i] / 100.0]] - } - - set _frac($i) 1.0 - - if {[winfo ismapped $itk_component(hull)]} { - _placePanes - } - - } else { - error "bad fraction arguments \"$args\": they should add\ - up to 100" - } - - } else { - error "wrong # args: should be \"$itk_component(hull)\ - fraction percentage percentage ?percentage ...?\",\ - where the number of percentages is\ - [llength $_activePanes] and equal 100" - } -} - -# ------------------------------------------------------------------ -# METHOD: add tag ?option value option value ...? -# -# Add a new pane to the paned window to the far (right/bottom) side. -# The method takes additional options which are passed on to the -# pane constructor. These include -margin, and -minimum. The path -# of the pane is returned. -# ------------------------------------------------------------------ -body iwidgets::Panedwindow::add {tag args} { - # - # Create panes. - # - itk_component add $tag { - eval iwidgets::Pane $itk_interior.pane[incr _unique] $args - } { - keep -background -cursor - } - - lappend _panes $tag - lappend _activePanes $tag - - reset - - return $itk_component($tag) -} - -# ------------------------------------------------------------------ -# METHOD: insert index tag ?option value option value ...? -# -# Insert the specified pane in the paned window just before the one -# given by index. Any additional options which are passed on to the -# pane constructor. These include -margin, -minimum. The path of -# the pane is returned. -# ------------------------------------------------------------------ -body iwidgets::Panedwindow::insert {index tag args} { - # - # Create panes. - # - itk_component add $tag { - eval iwidgets::Pane $itk_interior.pane[incr _unique] $args - } { - keep -background -cursor - } - - set index [index $index] - set _panes [linsert $_panes $index $tag] - lappend _activePanes $tag - - reset - - return $itk_component($tag) -} - -# ------------------------------------------------------------------ -# METHOD: delete index -# -# Delete the specified pane. -# ------------------------------------------------------------------ -body iwidgets::Panedwindow::delete {index} { - set index [index $index] - set tag [lindex $_panes $index] - - destroy $itk_component($tag) - - set _panes [lreplace $_panes $index $index] - - reset -} - -# ------------------------------------------------------------------ -# METHOD: hide index -# -# Remove the specified pane from the paned window. -# ------------------------------------------------------------------ -body iwidgets::Panedwindow::hide {index} { - set index [index $index] - set tag [lindex $_panes $index] - - if {[set idx [lsearch -exact $_activePanes $tag]] != -1} { - set _activePanes [lreplace $_activePanes $idx $idx] - } - - reset -} - -# ------------------------------------------------------------------ -# METHOD: show index -# -# Display the specified pane in the paned window. -# ------------------------------------------------------------------ -body iwidgets::Panedwindow::show {index} { - set index [index $index] - set tag [lindex $_panes $index] - - if {[lsearch -exact $_activePanes $tag] == -1} { - lappend _activePanes $tag - } - - reset -} - -# ------------------------------------------------------------------ -# METHOD: paneconfigure index ?option? ?value option value ...? -# -# Configure a specified pane. This method allows configuration of -# panes from the Panedwindow level. The options may have any of the -# values accepted by the add method. -# ------------------------------------------------------------------ -body iwidgets::Panedwindow::paneconfigure {index args} { - set index [index $index] - set tag [lindex $_panes $index] - - return [uplevel $itk_component($tag) configure $args] -} - -# ------------------------------------------------------------------ -# METHOD: reset -# -# Redisplay the panes based on the default percentages of the panes. -# ------------------------------------------------------------------ -body iwidgets::Panedwindow::reset {} { - if {$_initialized && [llength $_panes]} { - _setActivePanes - _setFracArray - - _makeSashes - _placePanes - } -} - -# ------------------------------------------------------------------ -# PROTECTED METHOD: _pwConfigureEventHandler -# -# Performs operations necessary following a configure event. This -# includes placing the panes. -# ------------------------------------------------------------------ -body iwidgets::Panedwindow::_pwConfigureEventHandler {width height} { - set _width $width - set _height $height - if {$_initialized} { - _placePanes - } else { - set _initialized 1 - reset - } -} - -# ------------------------------------------------------------------ -# PROTECTED METHOD: _startGrip where num -# -# Starts the sash drag and drop operation. At the start of the drag -# operation all the information is known as for the upper and lower -# limits for sash movement. The calculation is made at this time and -# stored in protected variables for later access during the drag -# handling routines. -# ------------------------------------------------------------------ -body iwidgets::Panedwindow::_startGrip {where num} { - if {$itk_option(-orient) == "horizontal"} { - set _dimension $_height - } else { - set _dimension $_width - } - - set _minsashmoved $num - set _maxsashmoved $num - set totMinHeight 0 - set cnt [llength $_activePanes] - set _sashloc(0) 0 - set _pixels($cnt) [expr int($_dimension)] - for {set i 0} {$i < $cnt} {incr i} { - set _pixels($i) [expr int($_frac($i) * $_dimension)] - set margaft [$itk_component([lindex $_activePanes $i]) cget -margin] - set minaft [$itk_component([lindex $_activePanes $i]) cget -minimum] - set _minheight($i) [expr $minaft + (2 * $margaft)] - incr totMinHeight $_minheight($i) - } - set _dragging [expr $_dimension > $totMinHeight] - - grab $itk_component(sash$num) - raise $itk_component(separator$num) - raise $itk_component(sash$num) - - $itk_component(sash$num) configure -relief sunken -} - -# ------------------------------------------------------------------ -# PROTECTED METHOD: _endGrip where num -# -# Ends the sash drag and drop operation. -# ------------------------------------------------------------------ -body iwidgets::Panedwindow::_endGrip {where num} { - $itk_component(sash$num) configure -relief raised - grab release $itk_component(sash$num) - if {$_dragging} { - _calcFraction [expr $_sashloc($num) + $where] $num - _placePanes [expr $_minsashmoved - 1] $_maxsashmoved - set _dragging 0 - } -} - -# ------------------------------------------------------------------ -# PROTECTED METHOD: _configGrip where num -# -# Configure action for sash. -# ------------------------------------------------------------------ -body iwidgets::Panedwindow::_configGrip {where num} { - set _sashloc($num) $where -} - -# ------------------------------------------------------------------ -# PROTECTED METHOD: _handleGrip where num -# -# Motion action for sash. -# ------------------------------------------------------------------ -body iwidgets::Panedwindow::_handleGrip {where num} { - if {$_dragging} { - _moveSash [expr $where + $_sashloc($num)] $num - incr _movecount - if {$_movecount>4} { - set _movecount 0 - update idletasks - } - } -} - -# ------------------------------------------------------------------ -# PROTECTED METHOD: _moveSash where num -# -# Move the sash to the absolute pixel location -# ------------------------------------------------------------------ -body iwidgets::Panedwindow::_moveSash {where num} { - set _minsashmoved [expr ($_minsashmoved<$num)?$_minsashmoved:$num] - set _maxsashmoved [expr ($_maxsashmoved>$num)?$_maxsashmoved:$num] - set oldfrac $_frac($num) - _calcFraction $where $num - if {$_frac($num)!=$oldfrac} { _placeSash $num } -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _setFracArray -# -# Calculates the percentages for the fraction array which lists the -# percentages for each pane. -# ------------------------------------------------------------------ -body iwidgets::Panedwindow::_setFracArray {} { - set perc 0.0 - if {[llength $_activePanes] != 0} { - set percIncr [expr 1.0 / [llength $_activePanes]] - } - - for {set i 0} {$i < [llength $_activePanes]} {incr i} { - set _frac($i) $perc - set perc [expr $perc + $percIncr] - } - - set _frac($i) 1.0 -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _setActivePanes -# -# Resets the active pane list. -# ------------------------------------------------------------------ -body iwidgets::Panedwindow::_setActivePanes {} { - set _prevActivePanes $_activePanes - - set _activePanes {} - - foreach pane $_panes { - if {[lsearch -exact $_prevActivePanes $pane] != -1} { - lappend _activePanes $pane - } - } -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _calcFraction where num -# -# Determines the fraction for the sash. Make sure the fraction does -# not go past the minimum for the pane on each side of the separator. -# ------------------------------------------------------------------ -body iwidgets::Panedwindow::_calcFraction {where num} { - - set _lowerlimit \ - [expr $_pixels([expr $num - 1]) + $_minheight([expr $num - 1])] - set _upperlimit \ - [expr $_pixels([expr $num + 1]) - $_minheight($num)] - - set dir [expr $where - $_pixels($num)] - - if {$where < $_lowerlimit && $dir <= 0} { - if {$num == 1} { - set _pixels($num) $_lowerlimit - } { - _moveSash [expr $where - $_minheight([expr $num - 1])] [expr $num -1] - set _pixels($num) \ - [expr $_pixels([expr $num - 1]) + $_minheight([expr $num - 1])] - } - } elseif {$where > $_upperlimit && $dir >= 0} { - if {[expr $num + 1] == [llength $_activePanes]} { - set _pixels($num) $_upperlimit - } { - _moveSash [expr $where + $_minheight($num)] [expr $num +1] - set _pixels($num) \ - [expr $_pixels([expr $num + 1]) - $_minheight($num)] - } - } else { - set _pixels($num) $where - } - set _frac($num) [expr $_pixels($num).0 / $_dimension] -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _makeSashes -# -# Removes any previous sashes and separators and creates new one. -# ------------------------------------------------------------------ -body iwidgets::Panedwindow::_makeSashes {} { - # - # Remove any existing sashes and separators. - # - foreach sash $_sashes { - destroy $itk_component($sash) - } - - foreach separator $_separators { - destroy $itk_component($separator) - } - - set _sashes {} - set _separators {} - - # - # Create one less separator and sash than the number of panes. - # - for {set id 1} {$id < [llength $_activePanes]} {incr id} { - itk_component add sash$id { - frame $itk_interior.sash$id -relief raised \ - -borderwidth $itk_option(-sashborderwidth) \ - -cursor $itk_option(-sashcursor) \ - -width $itk_option(-sashwidth) \ - -height $itk_option(-sashheight) - } { - keep -background - } - - lappend _sashes sash$id - - switch $itk_option(-orient) { - vertical { - bind $itk_component(sash$id) <Button-1> \ - [code $this _startGrip %x $id] - bind $itk_component(sash$id) <B1-Motion> \ - [code $this _handleGrip %x $id] - bind $itk_component(sash$id) <B1-ButtonRelease-1> \ - [code $this _endGrip %x $id] - bind $itk_component(sash$id) <Configure> \ - [code $this _configGrip %x $id] - } - - horizontal { - bind $itk_component(sash$id) <Button-1> \ - [code $this _startGrip %y $id] - bind $itk_component(sash$id) <B1-Motion> \ - [code $this _handleGrip %y $id] - bind $itk_component(sash$id) <B1-ButtonRelease-1> \ - [code $this _endGrip %y $id] - bind $itk_component(sash$id) <Configure> \ - [code $this _configGrip %y $id] - } - } - - itk_component add separator$id { - frame $itk_interior.separator$id -relief sunken \ - -height $itk_option(-thickness) \ - -width $itk_option(-thickness) \ - -borderwidth [expr $itk_option(-thickness) / 2] - } { - keep -background -cursor - } - - lappend _separators separator$id - } -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _placeSash i -# -# Places the position of the sash and separator. -# ------------------------------------------------------------------ -body iwidgets::Panedwindow::_placeSash {i} { - if {$itk_option(-orient) == "horizontal"} { - place $itk_component(separator$i) -in $itk_component(hull) \ - -x 0 -relwidth 1 -rely $_frac($i) -anchor w \ - -height $itk_option(-thickness) - - if {$itk_option(-sashindent) < 0} { - set sashPos [expr $_width + $itk_option(-sashindent)] - set sashAnchor e - } else { - set sashPos $itk_option(-sashindent) - set sashAnchor w - } - - place $itk_component(sash$i) -in $itk_component(hull) \ - -x $sashPos -rely $_frac($i) -anchor $sashAnchor - - } else { - place $itk_component(separator$i) -in $itk_component(hull) \ - -y 0 -relheight 1 -relx $_frac($i) -anchor n \ - -width $itk_option(-thickness) - - if {$itk_option(-sashindent) < 0} { - set sashPos [expr $_height + $itk_option(-sashindent)] - set sashAnchor s - } else { - set sashPos $itk_option(-sashindent) - set sashAnchor n - } - - place $itk_component(sash$i) -in $itk_component(hull) \ - -y $sashPos -relx $_frac($i) -anchor $sashAnchor - } -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _placePanes -# -# Resets the panes of the window following movement of the sash. -# ------------------------------------------------------------------ -body iwidgets::Panedwindow::_placePanes {{start 0} {end end}} { - if {$end=="end"} { set end [expr [llength $_activePanes] - 1] } - set _updatePanes [lrange $_activePanes $start $end] - if {$_updatePanes == $_activePanes} { - set _forgetPanes $_panes - } { - set _forgetPanes $_updatePanes - } - foreach pane $_forgetPanes { - place forget $itk_component($pane) - } - - - if {$itk_option(-orient) == "horizontal"} { - set i $start - foreach pane $_updatePanes { - place $itk_component($pane) -in $itk_component(hull) \ - -x 0 -rely $_frac($i) -relwidth 1 \ - -relheight [expr $_frac([expr $i + 1]) - $_frac($i)] - incr i - } - - } else { - set i $start - foreach pane $_updatePanes { - place $itk_component($pane) -in $itk_component(hull) \ - -y 0 -relx $_frac($i) -relheight 1 \ - -relwidth [expr $_frac([expr $i + 1]) - $_frac($i)] - incr i - } - - } - - for {set i [expr $start+1]} {$i <= $end} {incr i} { - if {[array names itk_component separator$i] != ""} { - _placeSash $i - raise $itk_component(separator$i) - raise $itk_component(sash$i) - } - } -} diff --git a/itcl/iwidgets3.0.0/generic/promptdialog.itk b/itcl/iwidgets3.0.0/generic/promptdialog.itk deleted file mode 100644 index 0348fb958e6..00000000000 --- a/itcl/iwidgets3.0.0/generic/promptdialog.itk +++ /dev/null @@ -1,199 +0,0 @@ -# -# Promptdialog -# ---------------------------------------------------------------------- -# Implements a prompt dialog similar to the OSF/Motif standard prompt -# dialog composite widget. The Promptdialog is derived from the -# Dialog class and is composed of a EntryField with methods to -# manipulate the dialog buttons. -# -# ---------------------------------------------------------------------- -# AUTHOR: Mark L. Ulferts EMAIL: mulferts@austin.dsccc.com -# -# @(#) $Id$ -# ---------------------------------------------------------------------- -# Copyright (c) 1995 DSC Technologies Corporation -# ====================================================================== -# Permission to use, copy, modify, distribute and license this software -# and its documentation for any purpose, and without fee or written -# agreement with DSC, is hereby granted, provided that the above copyright -# notice appears in all copies and that both the copyright notice and -# warranty disclaimer below appear in supporting documentation, and that -# the names of DSC Technologies Corporation or DSC Communications -# Corporation not be used in advertising or publicity pertaining to the -# software without specific, written prior permission. -# -# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING -# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- -# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE -# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, -# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL -# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR -# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, -# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, -# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS -# SOFTWARE. -# ====================================================================== - -# -# Usual options. -# -itk::usual Promptdialog { - keep -background -borderwidth -cursor -foreground -highlightcolor \ - -highlightthickness -insertbackground -insertborderwidth \ - -insertofftime -insertontime -insertwidth -labelfont -modality \ - -selectbackground -selectborderwidth -selectforeground \ - -textbackground -textfont -} - -# ------------------------------------------------------------------ -# PROMPTDIALOG -# ------------------------------------------------------------------ -class iwidgets::Promptdialog { - inherit iwidgets::Dialog - - constructor {args} {} - - public method get {} - public method clear {} - public method insert {args} - public method delete {args} - public method icursor {args} - public method index {args} - public method scan {args} - public method selection {args} - method xview {args} -} - -# -# Provide a lowercased access method for the Dialogshell class. -# -proc ::iwidgets::promptdialog {pathName args} { - uplevel ::iwidgets::Promptdialog $pathName $args -} - -# -# Use option database to override default resources of base classes. -# -option add *Promptdialog.labelText Selection widgetDefault -option add *Promptdialog.labelPos nw widgetDefault -option add *Promptdialog.title "Prompt Dialog" widgetDefault -option add *Promptdialog.master "." widgetDefault - -# ------------------------------------------------------------------ -# CONSTRUCTOR -# ------------------------------------------------------------------ -body iwidgets::Promptdialog::constructor {args} { - # - # Set the borderwidth to zero. - # - component hull configure -borderwidth 0 - - # - # Create an entry field widget. - # - itk_component add prompt { - iwidgets::Entryfield $itk_interior.prompt -command [code $this invoke] - } { - usual - - keep -exportselection -invalid -labelpos -labeltext -relief \ - -show -textbackground -textfont -validate - } - - pack $itk_component(prompt) -fill x -expand yes - set itk_interior [childsite] - - hide Help - - # - # Initialize the widget based on the command line options. - # - eval itk_initialize $args -} - -# ------------------------------------------------------------------ -# METHODS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# METHOD: get -# -# Thinwrapped method of entry field class. -# ------------------------------------------------------------------ -body iwidgets::Promptdialog::get {} { - return [$itk_component(prompt) get] -} - -# ------------------------------------------------------------------ -# METHOD: clear -# -# Thinwrapped method of entry field class. -# ------------------------------------------------------------------ -body iwidgets::Promptdialog::clear {} { - eval $itk_component(prompt) clear -} - -# ------------------------------------------------------------------ -# METHOD: insert args -# -# Thinwrapped method of entry field class. -# ------------------------------------------------------------------ -body iwidgets::Promptdialog::insert {args} { - eval $itk_component(prompt) insert $args -} - -# ------------------------------------------------------------------ -# METHOD: delete first ?last? -# -# Thinwrapped method of entry field class. -# ------------------------------------------------------------------ -body iwidgets::Promptdialog::delete {args} { - eval $itk_component(prompt) delete $args -} - -# ------------------------------------------------------------------ -# METHOD: icursor -# -# Thinwrapped method of entry field class. -# ------------------------------------------------------------------ -body iwidgets::Promptdialog::icursor {args} { - eval $itk_component(prompt) icursor $args -} - -# ------------------------------------------------------------------ -# METHOD: index -# -# Thinwrapped method of entry field class. -# ------------------------------------------------------------------ -body iwidgets::Promptdialog::index {args} { - return [eval $itk_component(prompt) index $args] -} - -# ------------------------------------------------------------------ -# METHOD: scan option args -# -# Thinwrapped method of entry field class. -# ------------------------------------------------------------------ -body iwidgets::Promptdialog::scan {args} { - eval $itk_component(prompt) scan $args -} - -# ------------------------------------------------------------------ -# METHOD: selection args -# -# Thinwrapped method of entry field class. -# ------------------------------------------------------------------ -body iwidgets::Promptdialog::selection {args} { - eval $itk_component(prompt) selection $args -} - -# ------------------------------------------------------------------ -# METHOD: xview args -# -# Thinwrapped method of entry field class. -# ------------------------------------------------------------------ -body iwidgets::Promptdialog::xview {args} { - eval $itk_component(prompt) xview $args -} - - diff --git a/itcl/iwidgets3.0.0/generic/pushbutton.itk b/itcl/iwidgets3.0.0/generic/pushbutton.itk deleted file mode 100644 index 5961458a89b..00000000000 --- a/itcl/iwidgets3.0.0/generic/pushbutton.itk +++ /dev/null @@ -1,356 +0,0 @@ -# -# Pushbutton -# ---------------------------------------------------------------------- -# Implements a Motif-like Pushbutton with an optional default ring. -# -# WISH LIST: -# 1) Allow bitmaps and text on the same button face (Tk limitation). -# 2) provide arm and disarm bitmaps. -# -# ---------------------------------------------------------------------- -# AUTHOR: Mark L. Ulferts EMAIL: mulferts@austin.dsccc.com -# Bret A. Schuhmacher EMAIL: bas@wn.com -# -# @(#) $Id$ -# ---------------------------------------------------------------------- -# Copyright (c) 1995 DSC Technologies Corporation -# ====================================================================== -# Permission to use, copy, modify, distribute and license this software -# and its documentation for any purpose, and without fee or written -# agreement with DSC, is hereby granted, provided that the above copyright -# notice appears in all copies and that both the copyright notice and -# warranty disclaimer below appear in supporting documentation, and that -# the names of DSC Technologies Corporation or DSC Communications -# Corporation not be used in advertising or publicity pertaining to the -# software without specific, written prior permission. -# -# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING -# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- -# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE -# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, -# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL -# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR -# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, -# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, -# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS -# SOFTWARE. -# ====================================================================== - -# -# Usual options. -# -itk::usual Pushbutton { - keep -activebackground -activeforeground -background -borderwidth \ - -cursor -disabledforeground -font -foreground -highlightbackground \ - -highlightcolor -highlightthickness -} - -# ------------------------------------------------------------------ -# PUSHBUTTON -# ------------------------------------------------------------------ -class iwidgets::Pushbutton { - inherit itk::Widget - - constructor {args} {} - destructor {} - - itk_option define -padx padX Pad 11 - itk_option define -pady padY Pad 4 - itk_option define -font font Font \ - -Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-* - itk_option define -text text Text {} - itk_option define -bitmap bitmap Bitmap {} - itk_option define -image image Image {} - itk_option define -highlightthickness highlightThickness \ - HighlightThickness 2 - itk_option define -borderwidth borderWidth BorderWidth 2 - itk_option define -defaultring defaultRing DefaultRing 0 - itk_option define -defaultringpad defaultRingPad Pad 4 - itk_option define -height height Height 0 - itk_option define -width width Width 0 - itk_option define -takefocus takeFocus TakeFocus 0 - - public method flash {} - public method invoke {} - - protected method _relayout {{when later}} - protected variable _reposition "" ;# non-null => _relayout pending -} - -# -# Provide a lowercased access method for the Pushbutton class. -# -proc ::iwidgets::pushbutton {pathName args} { - uplevel ::iwidgets::Pushbutton $pathName $args -} - -# -# Use option database to override default resources of base classes. -# -option add *Pushbutton.borderWidth 2 widgetDefault - -# ------------------------------------------------------------------ -# CONSTRUCTOR -# ------------------------------------------------------------------ -body iwidgets::Pushbutton::constructor {args} { - # - # Reconfigure the hull to act as the outer sunken ring of - # the pushbutton, complete with focus ring. - # - itk_option add hull.borderwidth hull.relief - itk_option add hull.highlightcolor - itk_option add hull.highlightbackground - - component hull configure \ - -borderwidth [$this cget -borderwidth] - - pack propagate $itk_component(hull) no - - itk_component add pushbutton { - button $itk_component(hull).pushbutton \ - } { - usual - keep -underline -wraplength -state -command - } - pack $itk_component(pushbutton) -expand 1 -fill both - - # - # Initialize the widget based on the command line options. - # - eval itk_initialize $args - - # - # Layout the pushbutton. - # - _relayout -} - -# ------------------------------------------------------------------ -# DESTRUCTOR -# ------------------------------------------------------------------ -body iwidgets::Pushbutton::destructor {} { - if {$_reposition != ""} {after cancel $_reposition} -} - -# ------------------------------------------------------------------ -# OPTIONS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# OPTION: -padx -# -# Specifies the extra space surrounding the label in the x direction. -# ------------------------------------------------------------------ -configbody iwidgets::Pushbutton::padx { - $itk_component(pushbutton) configure -padx $itk_option(-padx) - - _relayout -} - -# ------------------------------------------------------------------ -# OPTION: -pady -# -# Specifies the extra space surrounding the label in the y direction. -# ------------------------------------------------------------------ -configbody iwidgets::Pushbutton::pady { - $itk_component(pushbutton) configure -pady $itk_option(-pady) - - _relayout -} - -# ------------------------------------------------------------------ -# OPTION: -font -# -# Specifies the label font. -# ------------------------------------------------------------------ -configbody iwidgets::Pushbutton::font { - $itk_component(pushbutton) configure -font $itk_option(-font) - - _relayout -} - -# ------------------------------------------------------------------ -# OPTION: -text -# -# Specifies the label text. -# ------------------------------------------------------------------ -configbody iwidgets::Pushbutton::text { - $itk_component(pushbutton) configure -text $itk_option(-text) - - _relayout -} - -# ------------------------------------------------------------------ -# OPTION: -bitmap -# -# Specifies the label bitmap. -# ------------------------------------------------------------------ -configbody iwidgets::Pushbutton::bitmap { - $itk_component(pushbutton) configure -bitmap $itk_option(-bitmap) - - _relayout -} - -# ------------------------------------------------------------------ -# OPTION: -image -# -# Specifies the label image. -# ------------------------------------------------------------------ -configbody iwidgets::Pushbutton::image { - $itk_component(pushbutton) configure -image $itk_option(-image) - - _relayout -} - -# ------------------------------------------------------------------ -# OPTION: -highlightthickness -# -# Specifies the thickness of the highlight ring. -# ------------------------------------------------------------------ -configbody iwidgets::Pushbutton::highlightthickness { - $itk_component(pushbutton) configure \ - -highlightthickness $itk_option(-highlightthickness) - - _relayout -} - -# ------------------------------------------------------------------ -# OPTION: -borderwidth -# -# Specifies the width of the relief border. -# ------------------------------------------------------------------ -configbody iwidgets::Pushbutton::borderwidth { - $itk_component(pushbutton) configure -borderwidth $itk_option(-borderwidth) - - _relayout -} - -# ------------------------------------------------------------------ -# OPTION: -defaultring -# -# Boolean describing whether the button displays its default ring. -# ------------------------------------------------------------------ -configbody iwidgets::Pushbutton::defaultring { - _relayout -} - -# ------------------------------------------------------------------ -# OPTION: -defaultringpad -# -# The size of the padded default ring around the button. -# ------------------------------------------------------------------ -configbody iwidgets::Pushbutton::defaultringpad { - pack $itk_component(pushbutton) \ - -padx $itk_option(-defaultringpad) \ - -pady $itk_option(-defaultringpad) -} - -# ------------------------------------------------------------------ -# OPTION: -height -# -# Specifies the height of the button inclusive of any default ring. -# A value of zero lets the push button determine the height based -# on the requested height plus highlightring and defaultringpad. -# ------------------------------------------------------------------ -configbody iwidgets::Pushbutton::height { - _relayout -} - -# ------------------------------------------------------------------ -# OPTION: -width -# -# Specifies the width of the button inclusive of any default ring. -# A value of zero lets the push button determine the width based -# on the requested width plus highlightring and defaultringpad. -# ------------------------------------------------------------------ -configbody iwidgets::Pushbutton::width { - _relayout -} - -# ------------------------------------------------------------------ -# METHODS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# METHOD: flash -# -# Thin wrap of standard button widget flash method. -# ------------------------------------------------------------------ -body iwidgets::Pushbutton::flash {} { - $itk_component(pushbutton) flash -} - -# ------------------------------------------------------------------ -# METHOD: invoke -# -# Thin wrap of standard button widget invoke method. -# ------------------------------------------------------------------ -body iwidgets::Pushbutton::invoke {} { - $itk_component(pushbutton) invoke -} - -# ------------------------------------------------------------------ -# PROTECTED METHOD: _relayout ?when? -# -# Adjust the width and height of the Pushbutton to accomadate all the -# current options settings. Add back in the highlightthickness to -# the button such that the correct reqwidth and reqheight are computed. -# Set the width and height based on the reqwidth/reqheight, -# highlightthickness, and ringpad. Finally, configure the defaultring -# properly. If "when" is "now", the change is applied immediately. If -# it is "later" or it is not specified, then the change is applied later, -# when the application is idle. -# ------------------------------------------------------------------ -body iwidgets::Pushbutton::_relayout {{when later}} { - if {$when == "later"} { - if {$_reposition == ""} { - set _reposition [after idle [code $this _relayout now]] - } - return - } elseif {$when != "now"} { - error "bad option \"$when\": should be now or later" - } - - set _reposition "" - - if {$itk_option(-width) == 0} { - set w [expr [winfo reqwidth $itk_component(pushbutton)] \ - + 2 * $itk_option(-highlightthickness) \ - + 2 * $itk_option(-borderwidth) \ - + 2 * $itk_option(-defaultringpad)] - } else { - set w $itk_option(-width) - } - - if {$itk_option(-height) == 0} { - set h [expr [winfo reqheight $itk_component(pushbutton)] \ - + 2 * $itk_option(-highlightthickness) \ - + 2 * $itk_option(-borderwidth) \ - + 2 * $itk_option(-defaultringpad)] - } else { - set h $itk_option(-height) - } - - component hull configure -width $w -height $h - - if {$itk_option(-defaultring)} { - component hull configure -relief sunken \ - -highlightthickness [$this cget -highlightthickness] \ - -takefocus 1 - - configure -takefocus 1 - - component pushbutton configure \ - -highlightthickness 0 -takefocus 0 - - } else { - component hull configure -relief flat \ - -highlightthickness 0 -takefocus 0 - - component pushbutton configure \ - -highlightthickness [$this cget -highlightthickness] \ - -takefocus 1 - - configure -takefocus 0 - } -} diff --git a/itcl/iwidgets3.0.0/generic/radiobox.itk b/itcl/iwidgets3.0.0/generic/radiobox.itk deleted file mode 100644 index 7ec9a31da5d..00000000000 --- a/itcl/iwidgets3.0.0/generic/radiobox.itk +++ /dev/null @@ -1,354 +0,0 @@ -# -# Radiobox -# ---------------------------------------------------------------------- -# Implements a radiobuttonbox. Supports adding, inserting, deleting, -# selecting, and deselecting of radiobuttons by tag and index. -# -# ---------------------------------------------------------------------- -# AUTHOR: Michael J. McLennan EMAIL: mmclennan@lucent.com -# Mark L. Ulferts EMAIL: mulferts@austin.dsccc.com -# -# @(#) $Id$ -# ---------------------------------------------------------------------- -# Copyright (c) 1995 DSC Technologies Corporation -# ====================================================================== -# Permission to use, copy, modify, distribute and license this software -# and its documentation for any purpose, and without fee or written -# agreement with DSC, is hereby granted, provided that the above copyright -# notice appears in all copies and that both the copyright notice and -# warranty disclaimer below appear in supporting documentation, and that -# the names of DSC Technologies Corporation or DSC Communications -# Corporation not be used in advertising or publicity pertaining to the -# software without specific, written prior permission. -# -# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING -# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- -# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE -# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, -# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL -# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR -# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, -# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, -# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS -# SOFTWARE. -# ====================================================================== - -# -# Usual options. -# -itk::usual Radiobox { - keep -background -borderwidth -cursor -disabledforeground \ - -foreground -labelfont -selectcolor -} - -# ------------------------------------------------------------------ -# RADIOBOX -# ------------------------------------------------------------------ -class iwidgets::Radiobox { - inherit iwidgets::Labeledframe - - 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} - method buttonconfigure {index args} - method delete {index} - method deselect {index} - method flash {index} - method get {} - method index {index} - method insert {index tag args} - method select {index} - } - - protected method _command { name1 name2 opt } - - private { - method gettag {index} ;# Get the tag of the checkbutton associated - ;# with a numeric index - - method _rearrange {} ;# List of radiobutton tags. - variable _buttons {} ;# List of radiobutton tags. - common _modes ;# Current selection. - variable _unique 0 ;# Unique id for choice creation. - } -} - -# -# Provide a lowercased access method for the Radiobox class. -# -proc ::iwidgets::radiobox {pathName args} { - uplevel ::iwidgets::Radiobox $pathName $args -} - -# -# Use option database to override default resources of base classes. -# -option add *Radiobox.labelMargin 10 widgetDefault -option add *Radiobox.labelFont \ - "-Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*" widgetDefault -option add *Radiobox.labelPos nw widgetDefault -option add *Radiobox.borderWidth 2 widgetDefault -option add *Radiobox.relief groove widgetDefault - -# ------------------------------------------------------------------ -# CONSTRUCTOR -# ------------------------------------------------------------------ -body iwidgets::Radiobox::constructor {args} { - trace variable [scope _modes($this)] w [code $this _command] - - grid columnconfigure $itk_component(childsite) 0 -weight 1 - - eval itk_initialize $args -} - -# ------------------------------------------------------------------ -# OPTIONS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# OPTION: -command -# -# Specifies a command to be evaluated upon change in the radiobox -# ------------------------------------------------------------------ -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 -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# METHOD: index index -# -# Searches the radiobutton tags in the radiobox for the one with the -# requested tag, numerical index, or keyword "end". Returns the -# choices's numerical index if found, otherwise error. -# ------------------------------------------------------------------ -body iwidgets::Radiobox::index {index} { - if {[llength $_buttons] > 0} { - if {[regexp {(^[0-9]+$)} $index]} { - if {$index < [llength $_buttons]} { - return $index - } else { - error "Radiobox index \"$index\" is out of range" - } - - } elseif {$index == "end"} { - return [expr [llength $_buttons] - 1] - - } else { - if {[set idx [lsearch $_buttons $index]] != -1} { - return $idx - } - - error "bad Radiobox index \"$index\": must be number, end,\ - or pattern" - } - - } else { - error "Radiobox \"$itk_component(hull)\" has no radiobuttons" - } -} - -# ------------------------------------------------------------------ -# METHOD: add tag ?option value option value ...? -# -# Add a new tagged radiobutton to the radiobox at the end. The method -# takes additional options which are passed on to the radiobutton -# constructor. These include most of the typical radiobutton -# options. The tag is returned. -# ------------------------------------------------------------------ -body iwidgets::Radiobox::add {tag args} { - itk_component add $tag { - eval radiobutton $itk_component(childsite).rb[incr _unique] \ - -variable [list [scope _modes($this)]] \ - -anchor w \ - -justify left \ - -highlightthickness 0 \ - -value $tag $args - } { - usual - ignore -highlightthickness -highlightcolor - rename -font -labelfont labelFont Font - } - lappend _buttons $tag - grid $itk_component($tag) - after idle [code $this _rearrange] - - return $tag -} - -# ------------------------------------------------------------------ -# METHOD: insert index tag ?option value option value ...? -# -# Insert the tagged radiobutton in the radiobox just before the -# one given by index. Any additional options are passed on to the -# radiobutton constructor. These include the typical radiobutton -# options. The tag is returned. -# ------------------------------------------------------------------ -body iwidgets::Radiobox::insert {index tag args} { - itk_component add $tag { - eval radiobutton $itk_component(childsite).rb[incr _unique] \ - -variable [list [scope _modes($this)]] \ - -highlightthickness 0 \ - -anchor w \ - -justify left \ - -value $tag $args - } { - usual - ignore -highlightthickness -highlightcolor - rename -font -labelfont labelFont Font - } - set index [index $index] - set before [lindex $_buttons $index] - set _buttons [linsert $_buttons $index $tag] - grid $itk_component($tag) - after idle [code $this _rearrange] - - return $tag -} - -# ------------------------------------------------------------------ -# METHOD: _rearrange -# -# 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 {} { - if {[set count [llength $_buttons]] > 0} { - 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 - } - } - } -} - -# ------------------------------------------------------------------ -# METHOD: delete index -# -# Delete the specified radiobutton. -# ------------------------------------------------------------------ -body iwidgets::Radiobox::delete {index} { - - set tag [gettag $index] - set index [index $index] - - destroy $itk_component($tag) - - set _buttons [lreplace $_buttons $index $index] - - if {$_modes($this) == $tag} { - set _modes($this) {} - } - after idle [code $this _rearrange] - return -} - -# ------------------------------------------------------------------ -# METHOD: select index -# -# Select the specified radiobutton. -# ------------------------------------------------------------------ -body iwidgets::Radiobox::select {index} { - set tag [gettag $index] - $itk_component($tag) invoke -} - -# ------------------------------------------------------------------ -# METHOD: get -# -# Return the tag of the currently selected radiobutton. -# ------------------------------------------------------------------ -body iwidgets::Radiobox::get {} { - return $_modes($this) -} - -# ------------------------------------------------------------------ -# METHOD: deselect index -# -# Deselect the specified radiobutton. -# ------------------------------------------------------------------ -body iwidgets::Radiobox::deselect {index} { - set tag [gettag $index] - $itk_component($tag) deselect -} - -# ------------------------------------------------------------------ -# METHOD: flash index -# -# Flash the specified radiobutton. -# ------------------------------------------------------------------ -body iwidgets::Radiobox::flash {index} { - set tag [gettag $index] - $itk_component($tag) flash -} - -# ------------------------------------------------------------------ -# METHOD: buttonconfigure index ?option? ?value option value ...? -# -# Configure a specified radiobutton. This method allows configuration -# of radiobuttons from the Radiobox level. The options may have any -# of the values accepted by the add method. -# ------------------------------------------------------------------ -body iwidgets::Radiobox::buttonconfigure {index args} { - set tag [gettag $index] - eval $itk_component($tag) configure $args -} - -# ------------------------------------------------------------------ -# CALLBACK METHOD: _command name1 name2 opt -# -# Tied to the trace on _modes($this). Whenever our -variable for our -# radiobuttons change, this method is invoked. It in turn calls -# the user specified tcl script given by -command. -# ------------------------------------------------------------------ -body iwidgets::Radiobox::_command { name1 name2 opt } { - uplevel #0 $itk_option(-command) -} - -# ------------------------------------------------------------------ -# METHOD: gettag index -# -# Return the tag of the checkbutton associated with a specified -# numeric index -# ------------------------------------------------------------------ -body iwidgets::Radiobox::gettag {index} { - return [lindex $_buttons [index $index]] -} - diff --git a/itcl/iwidgets3.0.0/generic/regexpfield.itk b/itcl/iwidgets3.0.0/generic/regexpfield.itk deleted file mode 100755 index d7e2e7c50b7..00000000000 --- a/itcl/iwidgets3.0.0/generic/regexpfield.itk +++ /dev/null @@ -1,455 +0,0 @@ -# -# Regexpfield -# ---------------------------------------------------------------------- -# Implements a text entry widget which accepts input that matches its -# regular expression, and invalidates input which doesn't. -# -# -# ---------------------------------------------------------------------- -# AUTHOR: John A. Tucker E-mail: jatucker@austin.dsccc.com -# -# ---------------------------------------------------------------------- -# Copyright (c) 1995 DSC Technologies Corporation -# ====================================================================== -# Permission to use, copy, modify, distribute and license this software -# and its documentation for any purpose, and without fee or written -# agreement with DSC, is hereby granted, provided that the above copyright -# notice appears in all copies and that both the copyright notice and -# warranty disclaimer below appear in supporting documentation, and that -# the names of DSC Technologies Corporation or DSC Communications -# Corporation not be used in advertising or publicity pertaining to the -# software without specific, written prior permission. -# -# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING -# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- -# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE -# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, -# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL -# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR -# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, -# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, -# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS -# SOFTWARE. -# ====================================================================== - -# -# Usual options. -# -itk::usual Regexpfield { - keep -background -borderwidth -cursor -foreground -highlightcolor \ - -highlightthickness -insertbackground -insertborderwidth \ - -insertofftime -insertontime -insertwidth -labelfont \ - -selectbackground -selectborderwidth -selectforeground \ - -textbackground -textfont -} - -# ------------------------------------------------------------------ -# ENTRYFIELD -# ------------------------------------------------------------------ -class iwidgets::Regexpfield { - inherit iwidgets::Labeledwidget - - constructor {args} {} - - itk_option define -childsitepos childSitePos Position e - itk_option define -command command Command {} - itk_option define -fixed fixed Fixed 0 - itk_option define -focuscommand focusCommand Command {} - itk_option define -invalid invalid Command bell - itk_option define -regexp regexp Regexp {.*} - itk_option define -nocase nocase Nocase 0 - - public { - method childsite {} - method get {} - method delete {args} - method icursor {args} - method index {args} - method insert {args} - method scan {args} - method selection {args} - method xview {args} - method clear {} - } - - protected { - method _focusCommand {} - method _keyPress {char sym state} - } - - private { - method _peek {char} - } -} - -# -# Provide a lowercased access method for the Regexpfield class. -# -proc ::iwidgets::regexpfield {pathName args} { - uplevel ::iwidgets::Regexpfield $pathName $args -} - -# ------------------------------------------------------------------ -# CONSTRUCTOR -# ------------------------------------------------------------------ -body iwidgets::Regexpfield::constructor {args} { - component hull configure -borderwidth 0 - - itk_component add entry { - entry $itk_interior.entry - } { - keep -borderwidth -cursor -exportselection \ - -foreground -highlightcolor \ - -highlightthickness -insertbackground -insertborderwidth \ - -insertofftime -insertontime -insertwidth -justify \ - -relief -selectbackground -selectborderwidth \ - -selectforeground -show -state -textvariable -width - - rename -font -textfont textFont Font - rename -highlightbackground -background background Background - rename -background -textbackground textBackground Background - } - - # - # Create the child site widget. - # - itk_component add -protected efchildsite { - frame $itk_interior.efchildsite - } - set itk_interior $itk_component(efchildsite) - - # - # Regexpfield instance bindings. - # - bind $itk_component(entry) <KeyPress> [code $this _keyPress %A %K %s] - bind $itk_component(entry) <FocusIn> [code $this _focusCommand] - - # - # Initialize the widget based on the command line options. - # - eval itk_initialize $args -} - -# ------------------------------------------------------------------ -# OPTIONS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# OPTION: -command -# -# Command associated upon detection of Return key press event -# ------------------------------------------------------------------ -configbody iwidgets::Regexpfield::command {} - -# ------------------------------------------------------------------ -# OPTION: -focuscommand -# -# Command associated upon detection of focus. -# ------------------------------------------------------------------ -configbody iwidgets::Regexpfield::focuscommand {} - -# ------------------------------------------------------------------ -# OPTION: -regexp -# -# Specify a regular expression to use in performing validation -# of the content of the entry widget. -# ------------------------------------------------------------------ -configbody iwidgets::Regexpfield::regexp { -} - -# ------------------------------------------------------------------ -# OPTION: -invalid -# -# Specify a command to executed should the current Regexpfield contents -# be proven invalid. -# ------------------------------------------------------------------ -configbody iwidgets::Regexpfield::invalid {} - -# ------------------------------------------------------------------ -# OPTION: -fixed -# -# Restrict entry to 0 (unlimited) chars. The value is the maximum -# number of chars the user may type into the field, regardles of -# field width, i.e. the field width may be 20, but the user will -# only be able to type -fixed number of characters into it (or -# unlimited if -fixed = 0). -# ------------------------------------------------------------------ -configbody iwidgets::Regexpfield::fixed { - if {[regexp {[^0-9]} $itk_option(-fixed)] || \ - ($itk_option(-fixed) < 0)} { - error "bad fixed option \"$itk_option(-fixed)\",\ - should be positive integer" - } -} - -# ------------------------------------------------------------------ -# OPTION: -childsitepos -# -# Specifies the position of the child site in the widget. -# ------------------------------------------------------------------ -configbody iwidgets::Regexpfield::childsitepos { - set parent [winfo parent $itk_component(entry)] - - switch $itk_option(-childsitepos) { - n { - grid $itk_component(efchildsite) -row 0 -column 0 -sticky ew - grid $itk_component(entry) -row 1 -column 0 -sticky nsew - - grid rowconfigure $parent 0 -weight 0 - grid rowconfigure $parent 1 -weight 1 - grid columnconfigure $parent 0 -weight 1 - grid columnconfigure $parent 1 -weight 0 - } - - e { - grid $itk_component(efchildsite) -row 0 -column 1 -sticky ns - grid $itk_component(entry) -row 0 -column 0 -sticky nsew - - grid rowconfigure $parent 0 -weight 1 - grid rowconfigure $parent 1 -weight 0 - grid columnconfigure $parent 0 -weight 1 - grid columnconfigure $parent 1 -weight 0 - } - - s { - grid $itk_component(efchildsite) -row 1 -column 0 -sticky ew - grid $itk_component(entry) -row 0 -column 0 -sticky nsew - - grid rowconfigure $parent 0 -weight 1 - grid rowconfigure $parent 1 -weight 0 - grid columnconfigure $parent 0 -weight 1 - grid columnconfigure $parent 1 -weight 0 - } - - w { - grid $itk_component(efchildsite) -row 0 -column 0 -sticky ns - grid $itk_component(entry) -row 0 -column 1 -sticky nsew - - grid rowconfigure $parent 0 -weight 1 - grid rowconfigure $parent 1 -weight 0 - grid columnconfigure $parent 0 -weight 0 - grid columnconfigure $parent 1 -weight 1 - } - - default { - error "bad childsite option\ - \"$itk_option(-childsitepos)\":\ - should be n, e, s, or w" - } - } -} -# ------------------------------------------------------------------ -# OPTION: -nocase -# -# Specifies whether or not lowercase characters can match either -# lowercase or uppercase letters in string. -# ------------------------------------------------------------------ -configbody iwidgets::Regexpfield::nocase { - - switch $itk_option(-nocase) { - 0 - 1 { - - } - - default { - error "bad nocase option \"$itk_option(-nocase)\":\ - should be 0 or 1" - } - } -} - -# ------------------------------------------------------------------ -# METHODS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# METHOD: childsite -# -# Returns the path name of the child site widget. -# ------------------------------------------------------------------ -body iwidgets::Regexpfield::childsite {} { - return $itk_component(efchildsite) -} - -# ------------------------------------------------------------------ -# METHOD: get -# -# Thin wrap of the standard entry widget get method. -# ------------------------------------------------------------------ -body iwidgets::Regexpfield::get {} { - return [$itk_component(entry) get] -} - -# ------------------------------------------------------------------ -# METHOD: delete -# -# Thin wrap of the standard entry widget delete method. -# ------------------------------------------------------------------ -body iwidgets::Regexpfield::delete {args} { - return [eval $itk_component(entry) delete $args] -} - -# ------------------------------------------------------------------ -# METHOD: icursor -# -# Thin wrap of the standard entry widget icursor method. -# ------------------------------------------------------------------ -body iwidgets::Regexpfield::icursor {args} { - return [eval $itk_component(entry) icursor $args] -} - -# ------------------------------------------------------------------ -# METHOD: index -# -# Thin wrap of the standard entry widget index method. -# ------------------------------------------------------------------ -body iwidgets::Regexpfield::index {args} { - return [eval $itk_component(entry) index $args] -} - -# ------------------------------------------------------------------ -# METHOD: insert -# -# Thin wrap of the standard entry widget index method. -# ------------------------------------------------------------------ -body iwidgets::Regexpfield::insert {args} { - return [eval $itk_component(entry) insert $args] -} - -# ------------------------------------------------------------------ -# METHOD: scan -# -# Thin wrap of the standard entry widget scan method. -# ------------------------------------------------------------------ -body iwidgets::Regexpfield::scan {args} { - return [eval $itk_component(entry) scan $args] -} - -# ------------------------------------------------------------------ -# METHOD: selection -# -# Thin wrap of the standard entry widget selection method. -# ------------------------------------------------------------------ -body iwidgets::Regexpfield::selection {args} { - return [eval $itk_component(entry) selection $args] -} - -# ------------------------------------------------------------------ -# METHOD: xview -# -# Thin wrap of the standard entry widget xview method. -# ------------------------------------------------------------------ -body iwidgets::Regexpfield::xview {args} { - return [eval $itk_component(entry) xview $args] -} - -# ------------------------------------------------------------------ -# METHOD: clear -# -# Delete the current entry contents. -# ------------------------------------------------------------------ -body iwidgets::Regexpfield::clear {} { - $itk_component(entry) delete 0 end - icursor 0 -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _peek char -# -# The peek procedure returns the value of the Regexpfield with the -# char inserted at the insert position. -# ------------------------------------------------------------------ -body iwidgets::Regexpfield::_peek {char} { - set str [get] - - set insertPos [index insert] - set firstPart [string range $str 0 [expr $insertPos - 1]] - set lastPart [string range $str $insertPos end] - - append rtnVal $firstPart $char $lastPart - return $rtnVal -} - -# ------------------------------------------------------------------ -# PROTECTED METHOD: _focusCommand -# -# Method bound to focus event which evaluates the current command -# specified in the focuscommand option -# ------------------------------------------------------------------ -body iwidgets::Regexpfield::_focusCommand {} { - uplevel #0 $itk_option(-focuscommand) -} - -# ------------------------------------------------------------------ -# PROTECTED METHOD: _keyPress -# -# Monitor the key press event checking for return keys, fixed width -# specification, and optional validation procedures. -# ------------------------------------------------------------------ -body iwidgets::Regexpfield::_keyPress {char sym state} { - # - # A Return key invokes the optionally specified command option. - # - if {$sym == "Return"} { - uplevel #0 $itk_option(-command) - return -code break 1 - } - - # - # Tabs, BackSpace, and Delete are passed on for other bindings. - # - if {($sym == "Tab") || ($sym == "BackSpace") || ($sym == "Delete")} { - return -code continue 1 - } - - # - # Character is not printable or the state is greater than one which - # 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 - } - - # - # If the fixed length option is not zero, then verify that the - # current length plus one will not exceed the limit. If so then - # invoke the invalid command procedure. - # - if {$itk_option(-fixed) != 0} { - if {[string length [get]] >= $itk_option(-fixed)} { - uplevel #0 $itk_option(-invalid) - return -code break 0 - } - } - - set flags "" - - # - # Get the new value of the Regexpfield with the char inserted at the - # insert position. - # - # If the new value doesn't match up with the pattern stored in the - # -regexp option, then the invalid procedure is called. - # - # If the value of the "-nocase" option is true, then add the - # "-nocase" flag to the list of flags. - # - set newVal [_peek $char] - - if {$itk_option(-nocase)} { - set valid [::regexp -nocase -- $itk_option(-regexp) $newVal] - } else { - set valid [::regexp $itk_option(-regexp) $newVal] - } - - if {!$valid} { - uplevel #0 $itk_option(-invalid) - return -code break 0 - } - - return -code continue 1 -} - diff --git a/itcl/iwidgets3.0.0/generic/roman.itcl b/itcl/iwidgets3.0.0/generic/roman.itcl deleted file mode 100644 index 2fe5164a0f3..00000000000 --- a/itcl/iwidgets3.0.0/generic/roman.itcl +++ /dev/null @@ -1,28 +0,0 @@ -namespace eval ::iwidgets { - set romand(val) {1000 900 500 400 100 90 50 40 10 9 5 4 1} - set romand(upper) { M CM D CD C XC L XL X IX V IV I} - set romand(lower) { m cm d cd c xc l xl x ix v iv i} - - proc roman2 {n {case upper}} { - global romand - set r "" - foreach val $romand(val) sym $romand($case) { - while {$n >= $val} { - set r "$r$sym" - incr n -$val - } - } - return $r - } - - proc roman {n {case upper}} { - global romand - set r "" - foreach val $romand(val) sym $romand($case) { - for {} {$n >= $val} {incr n -$val} { - set r "$r$sym" - } - } - return $r - } -} diff --git a/itcl/iwidgets3.0.0/generic/scopedobject.itcl b/itcl/iwidgets3.0.0/generic/scopedobject.itcl deleted file mode 100755 index 8a274c77777..00000000000 --- a/itcl/iwidgets3.0.0/generic/scopedobject.itcl +++ /dev/null @@ -1,181 +0,0 @@ -# -# Scopedobject -# ----------------------------------------------------------------------------- -# Implements a base class for defining Itcl classes which posses -# scoped behavior like Tcl variables. The objects are only accessible -# within the procedure in which they are instantiated and are deleted -# when the procedure returns. -# -# Option(s): -# -# -enterscopecommand: Tcl command to invoke when a object enters scope -# (i.e. when it is created ...). -# -# -exitscopecommand: Tcl command to invoke when a object exits scope -# (i.e. when it is deleted ...). -# -# Note(s): -# -# Although a Scopedobject instance will automatically destroy itself -# when it goes out of scope, one may explicity delete an instance -# before it destroys itself. -# -# Example(s): -# -# Creating an instance at local scope in a procedure provides -# an opportunity for tracing the entry and exiting of that -# procedure. Users can register their proc/method tracing handlers -# with the Scopedobject class via either of the following two ways: -# -# 1.) configure the "-exitscopecommand" on a Scopedobject instance; -# e.g. -# #!/usr/local/bin/wish -# -# proc tracedProc {} { -# scopedobject #auto \ -# -exitscopecommand {puts "enter tracedProc"} \ -# -exitscopecommand {puts "exit tracedProc"} -# } -# -# 2.) deriving from the Scopedobject and implementing the exit handling -# in their derived classes destructor. -# e.g. -# -# #!/usr/local/bin/wish -# -# class Proctrace { -# inherit Scopedobject -# -# proc procname {} { -# return [info level -1] -# } -# -# constructor {args} { -# puts "enter [procname]" -# eval configure $args -# } -# -# destructor { -# puts "exit [procname]" -# } -# } -# -# proc tracedProc {} { -# Proctrace #auto -# } -# -# ----------------------------------------------------------------------------- -# AUTHOR: John Tucker -# DSC Communications Corp -# ----------------------------------------------------------------------------- - -class iwidgets::Scopedobject { - - # - # OPTIONS: - # - public { - variable enterscopecommand {} - variable exitscopecommand {} - } - - # - # PUBLIC: - # - constructor {args} {} - destructor {} - - # - # PRIVATE: - # - private { - - # Implements the Tcl trace command callback which is responsible - # for destroying a Scopedobject instance when its corresponding - # Tcl variable goes out of scope. - # - method _traceCommand {varName varValue op} - - # Stores the stack level of the invoking procedure in which - # a Scopedobject instance in created. - # - variable _level 0 - } -} - -# -# Provide a lowercased access method for the Scopedobject class. -# -proc ::iwidgets::scopedobject {pathName args} { - uplevel ::iwidgets::Scopedobject $pathName $args -} - -#-------------------------------------------------------------------------------- -# CONSTRUCTOR -#-------------------------------------------------------------------------------- -body iwidgets::Scopedobject::constructor {args} { - - # Create a local variable in the procedure which this instance was created, - # and then register out instance deletion command (i.e. _traceCommand) - # to be called whenever the local variable is unset. - # - # If this is a derived class, then we will need to perform the variable creation - # and tracing N levels up the stack frame, where: - # N = depth of inheritance hierarchy. - # - set depth [llength [$this info heritage]] - set _level "#[uplevel $depth info level]" - uplevel $_level set _localVar($this) $this - uplevel $_level trace variable _localVar($this) u \"[code $this _traceCommand]\" - - eval configure $args - - if {$enterscopecommand != {}} { - eval $enterscopecommand - } -} - -#-------------------------------------------------------------------------------- -# DESTRUCTOR -#-------------------------------------------------------------------------------- -body iwidgets::Scopedobject::destructor {} { - - uplevel $_level trace vdelete _localVar($this) u \"[code $this _traceCommand]\" - - if {$exitscopecommand != {}} { - eval $exitscopecommand - } -} - -#--------------------------------------------------------------------------------# -# -# METHOD: _traceCommand -# -# PURPOSE: -# Callback used to destroy instances when their locally created variable -# goes out of scope. -# -body iwidgets::Scopedobject::_traceCommand {varName varValue op} { - delete object $this -} - -#------------------------------------------------------------------------------ -# -# OPTION: -enterscopecommand -# -# PURPOSE: -# Specifies a Tcl command to invoke when a object enters scope. -# -configbody iwidgets::Scopedobject::enterscopecommand { -} - -#------------------------------------------------------------------------------ -# -# OPTION: -exitscopecommand -# -# PURPOSE: -# Specifies a Tcl command to invoke when an object exits scope. -# -configbody iwidgets::Scopedobject::exitscopecommand { -} - diff --git a/itcl/iwidgets3.0.0/generic/scrolledcanvas.itk b/itcl/iwidgets3.0.0/generic/scrolledcanvas.itk deleted file mode 100644 index 22b237dcfc8..00000000000 --- a/itcl/iwidgets3.0.0/generic/scrolledcanvas.itk +++ /dev/null @@ -1,477 +0,0 @@ -# -# Scrolledcanvas -# ---------------------------------------------------------------------- -# Implements horizontal and vertical scrollbars around a canvas childsite -# Includes options to control display of scrollbars. The standard -# canvas options and methods are supported. -# -# ---------------------------------------------------------------------- -# AUTHOR: Mark Ulferts mulferts@austin.dsccc.com -# -# @(#) $Id$ -# ---------------------------------------------------------------------- -# Copyright (c) 1995 DSC Technologies Corporation -# ====================================================================== -# Permission to use, copy, modify, distribute and license this software -# and its documentation for any purpose, and without fee or written -# agreement with DSC, is hereby granted, provided that the above copyright -# notice appears in all copies and that both the copyright notice and -# warranty disclaimer below appear in supporting documentation, and that -# the names of DSC Technologies Corporation or DSC Communications -# Corporation not be used in advertising or publicity pertaining to the -# software without specific, written prior permission. -# -# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING -# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- -# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE -# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, -# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL -# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR -# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, -# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, -# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS -# SOFTWARE. -# ====================================================================== - -# -# Usual options. -# -itk::usual Scrolledcanvas { - keep -activebackground -activerelief -background -borderwidth -cursor \ - -elementborderwidth -foreground -highlightcolor -highlightthickness \ - -insertbackground -insertborderwidth -insertofftime -insertontime \ - -insertwidth -jump -labelfont -selectbackground -selectborderwidth \ - -selectforeground -textbackground -troughcolor -} - -# ------------------------------------------------------------------ -# SCROLLEDCANVAS -# ------------------------------------------------------------------ -class iwidgets::Scrolledcanvas { - inherit iwidgets::Scrolledwidget - - constructor {args} {} - destructor {} - - itk_option define -autoresize autoResize AutoResize 1 - itk_option define -automargin autoMargin AutoMargin 0 - - public method childsite {} - public method justify {direction} - - public method addtag {args} - public method bbox {args} - public method bind {args} - public method canvasx {args} - public method canvasy {args} - public method coords {args} - public method create {args} - public method dchars {args} - public method delete {args} - public method dtag {args} - public method find {args} - public method focus {args} - public method gettags {args} - public method icursor {args} - public method index {args} - public method insert {args} - public method itemconfigure {args} - public method itemcget {args} - public method lower {args} - public method move {args} - public method postscript {args} - public method raise {args} - public method scale {args} - public method scan {args} - public method select {args} - public method type {args} - public method xview {args} - public method yview {args} -} - -# -# Provide a lowercased access method for the Scrolledcanvas class. -# -proc ::iwidgets::scrolledcanvas {pathName args} { - uplevel ::iwidgets::Scrolledcanvas $pathName $args -} - -# -# Use option database to override default resources of base classes. -# -option add *Scrolledcanvas.width 200 widgetDefault -option add *Scrolledcanvas.height 230 widgetDefault -option add *Scrolledcanvas.labelPos n widgetDefault - -# ------------------------------------------------------------------ -# CONSTRUCTOR -# ------------------------------------------------------------------ -body iwidgets::Scrolledcanvas::constructor {args} { - # - # Create a clipping frame which will provide the border for - # relief display. - # - itk_component add clipper { - frame $itk_interior.clipper - } { - usual - - keep -borderwidth -relief -highlightthickness -highlightcolor - rename -highlightbackground -background background Background - } - grid $itk_component(clipper) -row 1 -column 1 -sticky nsew - grid rowconfigure $_interior 1 -weight 1 - grid columnconfigure $_interior 1 -weight 1 - - # - # Create a canvas to scroll - # - itk_component add canvas { - canvas $itk_component(clipper).canvas \ - -height 1.0 -width 1.0 \ - -scrollregion "0 0 1 1" \ - -xscrollcommand \ - [code $this _scrollWidget $itk_interior.horizsb] \ - -yscrollcommand \ - [code $this _scrollWidget $itk_interior.vertsb] - } { - usual - - ignore -highlightthickness -highlightcolor - - keep -closeenough -confine -scrollregion - keep -xscrollincrement -yscrollincrement - - rename -background -textbackground textBackground Background - } - grid $itk_component(canvas) -row 0 -column 0 -sticky nsew - grid rowconfigure $itk_component(clipper) 0 -weight 1 - grid columnconfigure $itk_component(clipper) 0 -weight 1 - - # - # Configure the command on the vertical scroll bar in the base class. - # - $itk_component(vertsb) configure \ - -command [code $itk_component(canvas) yview] - - # - # Configure the command on the horizontal scroll bar in the base class. - # - $itk_component(horizsb) configure \ - -command [code $itk_component(canvas) xview] - - # - # Initialize the widget based on the command line options. - # - eval itk_initialize $args -} - -# ------------------------------------------------------------------ -# DESTURCTOR -# ------------------------------------------------------------------ -body iwidgets::Scrolledcanvas::destructor {} { -} - -# ------------------------------------------------------------------ -# OPTIONS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# OPTION: -autoresize -# -# Automatically adjusts the scrolled region to be the bounding -# box covering all the items in the canvas following the execution -# of any method which creates or destroys items. Thus, as new -# items are added, the scrollbars adjust accordingly. -# ------------------------------------------------------------------ -configbody iwidgets::Scrolledcanvas::autoresize { - if {$itk_option(-autoresize)} { - set bbox [$itk_component(canvas) bbox all] - - if {$bbox != {}} { - set marg $itk_option(-automargin) - set bbox [lreplace $bbox 0 0 [expr [lindex $bbox 0] - $marg]] - set bbox [lreplace $bbox 1 1 [expr [lindex $bbox 1] - $marg]] - set bbox [lreplace $bbox 2 2 [expr [lindex $bbox 2] + $marg]] - set bbox [lreplace $bbox 3 3 [expr [lindex $bbox 3] + $marg]] - } - - $itk_component(canvas) configure -scrollregion $bbox - } -} - -# ------------------------------------------------------------------ -# METHODS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# METHOD: childsite -# -# Returns the path name of the child site widget. -# ------------------------------------------------------------------ -body iwidgets::Scrolledcanvas::childsite {} { - return $itk_component(canvas) -} - -# ------------------------------------------------------------------ -# METHOD: justify -# -# Justifies the canvas scrolled region in one of four directions: top, -# bottom, left, or right. -# ------------------------------------------------------------------ -body iwidgets::Scrolledcanvas::justify {direction} { - if {[winfo ismapped $itk_component(canvas)]} { - update idletasks - - switch $direction { - left { - $itk_component(canvas) xview moveto 0 - } - right { - $itk_component(canvas) xview moveto 1 - } - top { - $itk_component(canvas) yview moveto 0 - } - bottom { - $itk_component(canvas) yview moveto 1 - } - default { - error "bad justify argument \"$direction\": should be\ - left, right, top, or bottom" - } - } - } -} - -# ------------------------------------------------------------------ -# CANVAS METHODS: -# -# The following methods are thin wraps of standard canvas methods. -# Consult the Tk canvas man pages for functionallity and argument -# documentation -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# METHOD: addtag tag searchSpec ?arg arg ...? -# ------------------------------------------------------------------ -body iwidgets::Scrolledcanvas::addtag {args} { - return [eval $itk_component(canvas) addtag $args] -} - -# ------------------------------------------------------------------ -# METHOD: bbox tagOrId ?tagOrId tagOrId ...? -# ------------------------------------------------------------------ -body iwidgets::Scrolledcanvas::bbox {args} { - return [eval $itk_component(canvas) bbox $args] -} - -# ------------------------------------------------------------------ -# METHOD: bind tagOrId ?sequence? ?command? -# ------------------------------------------------------------------ -body iwidgets::Scrolledcanvas::bind {args} { - return [eval $itk_component(canvas) bind $args] -} - -# ------------------------------------------------------------------ -# METHOD: canvasx screenx ?gridspacing? -# ------------------------------------------------------------------ -body iwidgets::Scrolledcanvas::canvasx {args} { - return [eval $itk_component(canvas) canvasx $args] -} - -# ------------------------------------------------------------------ -# METHOD: canvasy screeny ?gridspacing? -# ------------------------------------------------------------------ -body iwidgets::Scrolledcanvas::canvasy {args} { - return [eval $itk_component(canvas) canvasy $args] -} - -# ------------------------------------------------------------------ -# METHOD: coords tagOrId ?x0 y0 ...? -# ------------------------------------------------------------------ -body iwidgets::Scrolledcanvas::coords {args} { - return [eval $itk_component(canvas) coords $args] -} - -# ------------------------------------------------------------------ -# METHOD: create type x y ?x y ...? ?option value ...? -# ------------------------------------------------------------------ -body iwidgets::Scrolledcanvas::create {args} { - set retval [eval $itk_component(canvas) create $args] - - configure -autoresize $itk_option(-autoresize) - - return $retval -} - -# ------------------------------------------------------------------ -# METHOD: dchars tagOrId first ?last? -# ------------------------------------------------------------------ -body iwidgets::Scrolledcanvas::dchars {args} { - return [eval $itk_component(canvas) dchars $args] -} - -# ------------------------------------------------------------------ -# METHOD: delete tagOrId ?tagOrId tagOrId ...? -# ------------------------------------------------------------------ -body iwidgets::Scrolledcanvas::delete {args} { - set retval [eval $itk_component(canvas) delete $args] - - configure -autoresize $itk_option(-autoresize) - - return $retval -} - -# ------------------------------------------------------------------ -# METHOD: dtag tagOrId ?tagToDelete? -# ------------------------------------------------------------------ -body iwidgets::Scrolledcanvas::dtag {args} { - eval $itk_component(canvas) dtag $args - - configure -autoresize $itk_option(-autoresize) -} - -# ------------------------------------------------------------------ -# METHOD: find searchCommand ?arg arg ...? -# ------------------------------------------------------------------ -body iwidgets::Scrolledcanvas::find {args} { - return [eval $itk_component(canvas) find $args] -} - -# ------------------------------------------------------------------ -# METHOD: focus ?tagOrId? -# ------------------------------------------------------------------ -body iwidgets::Scrolledcanvas::focus {args} { - return [eval $itk_component(canvas) focus $args] -} - -# ------------------------------------------------------------------ -# METHOD: gettags tagOrId -# ------------------------------------------------------------------ -body iwidgets::Scrolledcanvas::gettags {args} { - return [eval $itk_component(canvas) gettags $args] -} - -# ------------------------------------------------------------------ -# METHOD: icursor tagOrId index -# ------------------------------------------------------------------ -body iwidgets::Scrolledcanvas::icursor {args} { - eval $itk_component(canvas) icursor $args -} - -# ------------------------------------------------------------------ -# METHOD: index tagOrId index -# ------------------------------------------------------------------ -body iwidgets::Scrolledcanvas::index {args} { - return [eval $itk_component(canvas) index $args] -} - -# ------------------------------------------------------------------ -# METHOD: insert tagOrId beforeThis string -# ------------------------------------------------------------------ -body iwidgets::Scrolledcanvas::insert {args} { - eval $itk_component(canvas) insert $args -} - -# ------------------------------------------------------------------ -# METHOD: itemconfigure tagOrId ?option? ?value? ?option value ...? -# ------------------------------------------------------------------ -body iwidgets::Scrolledcanvas::itemconfigure {args} { - set retval [eval $itk_component(canvas) itemconfigure $args] - - configure -autoresize $itk_option(-autoresize) - - return $retval -} - -# ------------------------------------------------------------------ -# METHOD: itemcget tagOrId ?option? -# ------------------------------------------------------------------ -body iwidgets::Scrolledcanvas::itemcget {args} { - set retval [eval $itk_component(canvas) itemcget $args] - - return $retval -} - -# ------------------------------------------------------------------ -# METHOD: lower tagOrId ?belowThis? -# ------------------------------------------------------------------ -body iwidgets::Scrolledcanvas::lower {args} { - eval $itk_component(canvas) lower $args -} - -# ------------------------------------------------------------------ -# METHOD: move tagOrId xAmount yAmount -# ------------------------------------------------------------------ -body iwidgets::Scrolledcanvas::move {args} { - eval $itk_component(canvas) move $args - - configure -autoresize $itk_option(-autoresize) -} - -# ------------------------------------------------------------------ -# METHOD: postscript ?option value ...? -# ------------------------------------------------------------------ -body iwidgets::Scrolledcanvas::postscript {args} { - # - # Make sure the fontmap is in scope. - # - set fontmap "" - regexp -- {-fontmap +([^ ]+)} $args all fontmap - - if {$fontmap != ""} { - global $fontmap - } - - return [eval $itk_component(canvas) postscript $args] -} - -# ------------------------------------------------------------------ -# METHOD: raise tagOrId ?aboveThis? -# ------------------------------------------------------------------ -body iwidgets::Scrolledcanvas::raise {args} { - eval $itk_component(canvas) raise $args -} - -# ------------------------------------------------------------------ -# METHOD: scale tagOrId xOrigin yOrigin xScale yScale -# ------------------------------------------------------------------ -body iwidgets::Scrolledcanvas::scale {args} { - eval $itk_component(canvas) scale $args -} - -# ------------------------------------------------------------------ -# METHOD: scan option args -# ------------------------------------------------------------------ -body iwidgets::Scrolledcanvas::scan {args} { - eval $itk_component(canvas) scan $args -} - -# ------------------------------------------------------------------ -# METHOD: select option ?tagOrId arg? -# ------------------------------------------------------------------ -body iwidgets::Scrolledcanvas::select {args} { - eval $itk_component(canvas) select $args -} - -# ------------------------------------------------------------------ -# METHOD: type tagOrId -# ------------------------------------------------------------------ -body iwidgets::Scrolledcanvas::type {args} { - return [eval $itk_component(canvas) type $args] -} - -# ------------------------------------------------------------------ -# METHOD: xview index -# ------------------------------------------------------------------ -body iwidgets::Scrolledcanvas::xview {args} { - eval $itk_component(canvas) xview $args -} - -# ------------------------------------------------------------------ -# METHOD: yview index -# ------------------------------------------------------------------ -body iwidgets::Scrolledcanvas::yview {args} { - eval $itk_component(canvas) yview $args -} diff --git a/itcl/iwidgets3.0.0/generic/scrolledframe.itk b/itcl/iwidgets3.0.0/generic/scrolledframe.itk deleted file mode 100644 index ec01c37de46..00000000000 --- a/itcl/iwidgets3.0.0/generic/scrolledframe.itk +++ /dev/null @@ -1,250 +0,0 @@ -# -# Scrolledframe -# ---------------------------------------------------------------------- -# Implements horizontal and vertical scrollbars around a childsite -# frame. Includes options to control display of scrollbars. -# -# ---------------------------------------------------------------------- -# AUTHOR: Mark Ulferts mulferts@austin.dsccc.com -# -# @(#) $Id$ -# ---------------------------------------------------------------------- -# Copyright (c) 1995 DSC Technologies Corporation -# ====================================================================== -# Permission to use, copy, modify, distribute and license this software -# and its documentation for any purpose, and without fee or written -# agreement with DSC, is hereby granted, provided that the above copyright -# notice appears in all copies and that both the copyright notice and -# warranty disclaimer below appear in supporting documentation, and that -# the names of DSC Technologies Corporation or DSC Communications -# Corporation not be used in advertising or publicity pertaining to the -# software without specific, written prior permission. -# -# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING -# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- -# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE -# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, -# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL -# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR -# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, -# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, -# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS -# SOFTWARE. -# ====================================================================== - -# -# Usual options. -# -itk::usual Scrolledframe { - keep -activebackground -activerelief -background -borderwidth -cursor \ - -elementborderwidth -foreground -highlightcolor -highlightthickness \ - -jump -labelfont -troughcolor -} - -# ------------------------------------------------------------------ -# SCROLLEDFRAME -# ------------------------------------------------------------------ -class iwidgets::Scrolledframe { - inherit iwidgets::Scrolledwidget - - constructor {args} {} - destructor {} - - public method childsite {} - public method justify {direction} - public method xview {args} - public method yview {args} - - protected method _configureCanvas {} - protected method _configureFrame {} -} - -# -# Provide a lowercased access method for the Scrolledframe class. -# -proc ::iwidgets::scrolledframe {pathName args} { - uplevel ::iwidgets::Scrolledframe $pathName $args -} - -# -# Use option database to override default resources of base classes. -# -option add *Scrolledframe.width 100 widgetDefault -option add *Scrolledframe.height 100 widgetDefault -option add *Scrolledframe.labelPos n widgetDefault - -# ------------------------------------------------------------------ -# CONSTRUCTOR -# ------------------------------------------------------------------ -body iwidgets::Scrolledframe::constructor {args} { - itk_option remove iwidgets::Labeledwidget::state - - # - # Create a clipping frame which will provide the border for - # relief display. - # - itk_component add clipper { - frame $itk_interior.clipper - } { - usual - - keep -borderwidth -relief - } - grid $itk_component(clipper) -row 1 -column 1 -sticky nsew - grid rowconfigure $_interior 1 -weight 1 - grid columnconfigure $_interior 1 -weight 1 - - # - # Create a canvas to scroll - # - itk_component add canvas { - canvas $itk_component(clipper).canvas \ - -height 1.0 -width 1.0 \ - -scrollregion "0 0 1 1" \ - -xscrollcommand \ - [code $this _scrollWidget $itk_interior.horizsb] \ - -yscrollcommand \ - [code $this _scrollWidget $itk_interior.vertsb] \ - -highlightthickness 0 -takefocus 0 - } { - ignore -highlightcolor -highlightthickness - keep -background -cursor - } - grid $itk_component(canvas) -row 0 -column 0 -sticky nsew - grid rowconfigure $itk_component(clipper) 0 -weight 1 - grid columnconfigure $itk_component(clipper) 0 -weight 1 - - # - # Configure the command on the vertical scroll bar in the base class. - # - $itk_component(vertsb) configure \ - -command [code $itk_component(canvas) yview] - - # - # Configure the command on the horizontal scroll bar in the base class. - # - $itk_component(horizsb) configure \ - -command [code $itk_component(canvas) xview] - - # - # Handle configure events on the canvas to adjust the frame size - # according to the scrollregion. - # - bind $itk_component(canvas) <Configure> [code $this _configureCanvas] - - # - # Create a Frame inside canvas to hold widgets to be scrolled - # - itk_component add -protected sfchildsite { - frame $itk_component(canvas).sfchildsite - } { - keep -background -cursor - } - pack $itk_component(sfchildsite) -fill both -expand yes - $itk_component(canvas) create window 0 0 -tags frameTag \ - -window $itk_component(sfchildsite) -anchor nw - set itk_interior $itk_component(sfchildsite) - bind $itk_component(sfchildsite) <Configure> [code $this _configureFrame] - - # - # Initialize the widget based on the command line options. - # - eval itk_initialize $args -} - -# ------------------------------------------------------------------ -# DESTURCTOR -# ------------------------------------------------------------------ -body iwidgets::Scrolledframe::destructor {} { -} - - -# ------------------------------------------------------------------ -# METHODS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# METHOD: childsite -# -# Returns the path name of the child site widget. -# ------------------------------------------------------------------ -body iwidgets::Scrolledframe::childsite {} { - return $itk_component(sfchildsite) -} - -# ------------------------------------------------------------------ -# METHOD: justify -# -# Justifies the scrolled region in one of four directions: top, -# bottom, left, or right. -# ------------------------------------------------------------------ -body iwidgets::Scrolledframe::justify {direction} { - if {[winfo ismapped $itk_component(canvas)]} { - update idletasks - - switch $direction { - left { - $itk_component(canvas) xview moveto 0 - } - right { - $itk_component(canvas) xview moveto 1 - } - top { - $itk_component(canvas) yview moveto 0 - } - bottom { - $itk_component(canvas) yview moveto 1 - } - default { - error "bad justify argument \"$direction\": should be\ - left, right, top, or bottom" - } - } - } -} - -# ------------------------------------------------------------------ -# METHOD: xview index -# -# Adjust the view in the frame so that character position index -# is displayed at the left edge of the widget. -# ------------------------------------------------------------------ -body iwidgets::Scrolledframe::xview {args} { - return [eval $itk_component(canvas) xview $args] -} - -# ------------------------------------------------------------------ -# METHOD: yview index -# -# Adjust the view in the frame so that character position index -# is displayed at the top edge of the widget. -# ------------------------------------------------------------------ -body iwidgets::Scrolledframe::yview {args} { - return [eval $itk_component(canvas) yview $args] -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _configureCanvas -# -# Responds to configure events on the canvas widget. When canvas -# changes size, adjust frame size. -# ------------------------------------------------------------------ -body iwidgets::Scrolledframe::_configureCanvas {} { - set sr [$itk_component(canvas) cget -scrollregion] - set srw [lindex $sr 2] - set srh [lindex $sr 3] - - $itk_component(sfchildsite) configure -height $srh -width $srw -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _configureFrame -# -# Responds to configure events on the frame widget. When the frame -# changes size, adjust scrolling region size. -# ------------------------------------------------------------------ -body iwidgets::Scrolledframe::_configureFrame {} { - $itk_component(canvas) configure \ - -scrollregion [$itk_component(canvas) bbox frameTag] -} - diff --git a/itcl/iwidgets3.0.0/generic/scrolledhtml.itk b/itcl/iwidgets3.0.0/generic/scrolledhtml.itk deleted file mode 100644 index 66c0e3d42e6..00000000000 --- a/itcl/iwidgets3.0.0/generic/scrolledhtml.itk +++ /dev/null @@ -1,2545 +0,0 @@ -# Scrolledhtml -# ---------------------------------------------------------------------- -# Implements a scrolled html text widget by inheritance from scrolledtext -# Import reads from an html file, while export still writes plain text -# Also provides a render command, to display html text passed in as an -# argument. -# -# This widget is HTML3.2 compliant, with the following exceptions: -# a) nothing requiring a connection to an HTTP server is supported -# b) some of the image alignments aren't supported, because they're not -# supported by the text widget -# c) the br attributes that go with the image alignments aren't implemented -# d) background images are not supported, because they're not supported -# by the text widget -# e) automatic table/table cell sizing doesn't work very well. -# -# WISH LIST: -# This section lists possible future enhancements. -# -# 1) size tables better using dlineinfo. -# 2) make images scroll smoothly off top like they do off bottom. (limitation -# of text widget?) -# 3) add ability to get non-local URLs -# a) support forms -# b) support imagemaps -# 4) keep track of visited links -# 5) add tclets support -# -# BUGS: -# Cells in a table can be caused to overlap. ex: -# <table border width="100%"> -# <tr><td>cell1</td><td align=right rowspan=2>cell2</td></tr> -# <tr><td colspan=2>cell3 w/ overlap</td> -# </table> -# It hasn't been fixed because 1) it's a pain to fix, 2) the fix would slow -# tables down by a significant amount, and 3) netscape has the same -# bug, as of V3.01, and no one seems to care. -# -# In order to size tables properly, they must be visible, which causes an -# annoying jump from table to table through the document at render time. -# -# ---------------------------------------------------------------------- -# AUTHOR: Kris Raney EMAIL: kraney@spd.dsccc.com -# -# @(#) $Id$ -# ---------------------------------------------------------------------- -# Copyright (c) 1996 DSC Technologies Corporation -# ====================================================================== -# Permission to use, copy, modify, distribute and license this software -# and its documentation for any purpose, and without fee or written -# agreement with DSC, is hereby granted, provided that the above copyright -# notice appears in all copies and that both the copyright notice and -# warranty disclaimer below appear in supporting documentation, and that -# the names of DSC Technologies Corporation or DSC Communications -# Corporation not be used in advertising or publicity pertaining to the -# software without specific, written prior permission. -# -# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING -# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- -# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE -# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, -# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL -# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR -# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, -# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, -# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS -# SOFTWARE. -# ====================================================================== - -# Acknowledgements: -# -# Special thanks go to Sam Shen(SLShen@lbl.gov), as this code is based on his -# tkhtml.tcl code from tk inspect. The original code is copyright 1995 -# Lawrence Berkeley Laboratory. -# -# This software is copyright (C) 1995 by the Lawrence Berkeley Laboratory. -# -# Redistribution and use in source and binary forms, with or without -# modification, are permitted provided that: (1) source code distributions -# retain the above copyright notice and this paragraph in its entirety, (2) -# distributions including binary code include the above copyright notice and -# this paragraph in its entirety in the documentation or other materials -# provided with the distribution, and (3) all advertising materials mentioning -# features or use of this software display the following acknowledgement: -# ``This product includes software developed by the University of California, -# Lawrence Berkeley Laboratory and its contributors.'' Neither the name of -# the University nor the names of its contributors may be used to endorse -# or promote products derived from this software without specific prior -# written permission. -# -# THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED -# WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF -# MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. -# -# This code is based on Angel Li's (angel@flipper.rsmas.miami.edu) HTML - - -# -# Default resources. -# -option add *Scrolledhtml.borderWidth 2 widgetDefault -option add *Scrolledhtml.relief sunken widgetDefault -option add *Scrolledhtml.scrollMargin 3 widgetDefault -option add *Scrolledhtml.width 500 widgetDefault -option add *Scrolledhtml.height 600 widgetDefault -option add *Scrolledhtml.visibleItems 80x24 widgetDefault -option add *Scrolledhtml.vscrollMode static widgetDefault -option add *Scrolledhtml.hscrollMode static widgetDefault -option add *Scrolledhtml.labelPos n widgetDefault -option add *Scrolledhtml.wrap word widgetDefault - -# -# Usual options. -# -itk::usual Scrolledhtml { - keep -fontname -fontsize -fixedfont -link -alink -linkhighlight \ - -activebackground -activerelief -background -borderwidth -cursor \ - -elementborderwidth -foreground -highlightcolor -highlightthickness \ - -insertbackground -insertborderwidth -insertofftime -insertontime \ - -insertwidth -jump -labelfont -selectbackground -selectborderwidth \ - -selectforeground -textbackground -textfont -troughcolor -unknownimage -} - -# ------------------------------------------------------------------ -# SCROLLEDHTML -# ------------------------------------------------------------------ -class iwidgets::Scrolledhtml { - inherit iwidgets::Scrolledtext - - constructor {args} {} - destructor {} - - itk_option define -feedback feedBack FeedBack {} - itk_option define -linkcommand linkCommand LinkCommand {} - itk_option define -fontname fontname FontName times - itk_option define -fixedfont fixedFont FixedFont courier - itk_option define -fontsize fontSize FontSize medium - itk_option define -link link Link blue - itk_option define -alink alink ALink red - itk_option define -linkhighlight alink ALink red - 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 {} - public method render {html {wd .}} - public method title {} {return $_title} - public method pwd {} {return $_cwd} - - protected method _setup {} - protected method _set_tag {} - protected method _reconfig_tags {} - protected method _append_text {text} - protected method _do {text} - protected method _definefont {name foundry family weight slant registry} - protected method _peek {instack} - protected method _push {instack value} - protected method _pop {instack} - protected method _parse_fields {array_var string} - protected method _href_click {cmd href} - protected method _set_align {align} - protected method _fixtablewidth {hottext table multiplier} - - protected method _header {level args} - protected method _/header {level} - - protected method _entity_a {args} - protected method _entity_/a {} - protected method _entity_address {} - protected method _entity_/address {} - protected method _entity_b {} - protected method _entity_/b {} - protected method _entity_base {{args {}}} - protected method _entity_basefont {{args {}}} - protected method _entity_big {} - protected method _entity_/big {} - protected method _entity_blockquote {} - protected method _entity_/blockquote {} - protected method _entity_body {{args {}}} - protected method _entity_/body {} - protected method _entity_br {{args {}}} - protected method _entity_center {} - protected method _entity_/center {} - protected method _entity_cite {} - protected method _entity_/cite {} - protected method _entity_code {} - protected method _entity_/code {} - protected method _entity_dir {{args {}}} - protected method _entity_/dir {} - protected method _entity_div {{args {}}} - protected method _entity_dl {{args {}}} - protected method _entity_/dl {} - protected method _entity_dt {} - protected method _entity_dd {} - protected method _entity_dfn {} - protected method _entity_/dfn {} - protected method _entity_em {} - protected method _entity_/em {} - protected method _entity_font {{args {}}} - protected method _entity_/font {} - protected method _entity_h1 {{args {}}} - protected method _entity_/h1 {} - protected method _entity_h2 {{args {}}} - protected method _entity_/h2 {} - protected method _entity_h3 {{args {}}} - protected method _entity_/h3 {} - protected method _entity_h4 {{args {}}} - protected method _entity_/h4 {} - protected method _entity_h5 {{args {}}} - protected method _entity_/h5 {} - protected method _entity_h6 {{args {}}} - protected method _entity_/h6 {} - protected method _entity_hr {{args {}}} - protected method _entity_i {} - protected method _entity_/i {} - protected method _entity_img {{args {}}} - protected method _entity_kbd {} - protected method _entity_/kbd {} - protected method _entity_li {{args {}}} - protected method _entity_listing {} - protected method _entity_/listing {} - protected method _entity_menu {{args {}}} - protected method _entity_/menu {} - protected method _entity_ol {{args {}}} - protected method _entity_/ol {} - protected method _entity_p {{args {}}} - protected method _entity_pre {{args {}}} - protected method _entity_/pre {} - protected method _entity_samp {} - protected method _entity_/samp {} - protected method _entity_small {} - protected method _entity_/small {} - protected method _entity_sub {} - protected method _entity_/sub {} - protected method _entity_sup {} - protected method _entity_/sup {} - protected method _entity_strong {} - protected method _entity_/strong {} - protected method _entity_table {{args {}}} - protected method _entity_/table {} - protected method _entity_td {{args {}}} - protected method _entity_/td {} - protected method _entity_th {{args {}}} - protected method _entity_/th {} - protected method _entity_title {} - protected method _entity_/title {} - protected method _entity_tr {{args {}}} - protected method _entity_/tr {} - protected method _entity_tt {} - protected method _entity_/tt {} - protected method _entity_u {} - protected method _entity_/u {} - protected method _entity_ul {{args {}}} - protected method _entity_/ul {} - protected method _entity_var {} - protected method _entity_/var {} - - protected variable _title {} ;# The title of the html document - protected variable _licount 1 ;# list element count - protected variable _listyle bullet ;# list element style - protected variable _lipic {} ;# picture to use as bullet - protected variable _color black ;# current text color - protected variable _bgcolor #d9d9d9 ;# current background color - protected variable _link blue ;# current link color - protected variable _alink red ;# current highlight link color - protected variable _smallpoints "60 80 100 120 140 180 240" ;# font point - protected variable _mediumpoints "80 100 120 140 180 240 360" ;# sizes for - protected variable _largepoints "100 120 140 180 240 360 480" ;# various - protected variable _hugepoints "120 140 180 240 360 480 640" ;# fontsizes - protected variable _font times ;# name of current font - protected variable _rulerheight 6 ;# - protected variable _indentincr 4 ;# increment to indent by - protected variable _counter -1 ;# counter to give unique numbers - protected variable _left 0 ;# initial left margin - protected variable _left2 0 ;# subsequent left margin - protected variable _right 0 ;# right margin - protected variable _justify L ;# text justification - protected variable _offset 0 ;# text offset (super/subscript) - protected variable _textweight 0 ;# boldness of text - protected variable _textslant 0 ;# whether to use italics - protected variable _underline 0 ;# whether to use underline - protected variable _verbatim 0 ;# whether to skip formatting - protected variable _pre 0 ;# preformatted text - protected variable _intitle 0 ;# in <title>...</title> - protected variable _anchorcount 0 ;# number of anchors - protected variable _stack ;# array of stacks - protected variable _pointsndx 2 ;# - protected variable _fontnames ;# list of accepted font names - protected variable _fontinfo ;# array of font info given font name - protected variable _tag ;# - protected variable _tagl ;# - protected variable _tagfont ;# - protected variable _cwd . ;# base directory of current page - protected variable _anchor ;# array of indexes by anchorname - protected variable _defaulttextbackground;# default text background - protected variable _intable 0 ;# whether we are in a table now - protected variable _hottext ;# widget where text currently goes - protected variable _basefontsize 2 ;# as named - protected variable _unknownimg {} ;# name of unknown image - protected variable _images {} ;# list of images we created - protected variable _prevpos {} ;# temporary used for table updates - protected variable _prevtext {} ;# temporary used for table updates - - private variable _initialized 0 - - private variable _defUnknownImg [image create photo -data { -R0lGODdhHwAgAPQAAP///wAAAMzMzC9PT76+vvnTogCR/1WRVaoAVf//qvT09OKdcWlcx19f -X9/f339/f8vN/J2d/aq2qoKCggAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA -ACwAAAAAHwAgAAAF/iAgjqRDnmiKmqOkqsTaToDjvudTttLjOITJbTQhGI+iQE0xMvZqQIDw -NAEiAcqRVdKAGh0NyVCkuyqZBEmwofgRrFIxSaI0JmuA9KTrthIicWMTAQ8xWHgSe15AVgcJ -eVMjDwECOkome22Mb0cHCzEPOiQPgwGXCjomakedA0VgY1IPDZcuP3l5YkcRDwMHqDQoEzq2 -Pz8IQkK7Bw8HDg+xO26PCAgRDcpGswEK2Dh9ItUMDdirPYUKwTKMjwDV1gHlR2oCkSmcI9UE -BabYrGnQoolgBCGckX7yWJWDYaUMAYSRFECAwMXeiU1BHpKTB4CBR4+oBOb5By1UNgUfXj0C -8HaP079sBCCkZIAKWst/OGPOhNBNHQmXOeftJBASRVCcEiIojQDBwIOeRo+SpGXKFFGbP6Xi -nLWxEMsmWpEOC9XDYtigYtKSwsH2xdq2cEfRmFS1rt27eE09CAEAOw== -}] -} - -# -# Provide a lowercased access method for the Scrolledhtml class. -# -proc ::iwidgets::scrolledhtml {pathName args} { - uplevel ::iwidgets::Scrolledhtml $pathName $args -} - -# ------------------------------------------------------------------ -# CONSTRUCTOR -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::constructor {args} { - # define the fonts we're going to use - set _fontnames "" - _definefont helvetica adobe helvetica "medium bold" "r o" iso8859 - _definefont courier adobe courier "medium bold" "r o" iso8859 - _definefont times adobe times "medium bold" "r i" iso8859 - _definefont symbol adobe symbol "medium medium" "r r" adobe - - $itk_component(text) configure -state disabled - - eval itk_initialize $args - if {[lsearch -exact $args -linkcommand] == -1} { - configure -linkcommand [code $this import -link] - } - set _initialized 1 -} - -# ------------------------------------------------------------------ -# DESTRUCTOR -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::destructor {} { - foreach x $_images { - image delete $x - } - if {$_unknownimg != $_defUnknownImg} { - image delete $_unknownimg - } -} - -# ------------------------------------------------------------------ -# OPTIONS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# OPTION: -fontsize -# -# Set the general size of the font. -# ------------------------------------------------------------------ -configbody iwidgets::Scrolledhtml::fontsize { - switch $itk_option(-fontsize) { - small { } - medium { } - large { } - huge { } - default { - error "bad fontsize option\ - \"$itk_option(-fontsize)\": should\ - be small, medium, large, or huge" - } - } - _reconfig_tags -} - -# ------------------------------------------------------------------ -# OPTION: -fixedfont -# -# Set the fixed font name -# ------------------------------------------------------------------ -configbody iwidgets::Scrolledhtml::fixedfont { - if {[lsearch -exact $_fontnames $itk_option(-fixedfont)] == -1} { - error "Invalid font name \"$itk_option(-fixedfont)\". Must be one of \ - $_fontnames" - } -} - -# ------------------------------------------------------------------ -# OPTION: -fontname -# -# Set the default font name -# ------------------------------------------------------------------ -configbody iwidgets::Scrolledhtml::fontname { - if {[lsearch -exact $_fontnames $itk_option(-fontname)] == -1} { - error "Invalid font name \"$itk_option(-fontname)\". Must be one of \ - $_fontnames" - } -} - -# ------------------------------------------------------------------ -# OPTION: -textbackground -# -# Set the default text background -# ------------------------------------------------------------------ -configbody iwidgets::Scrolledhtml::textbackground { - set _defaulttextbackground $itk_option(-textbackground) -} - -# ------------------------------------------------------------------ -# OPTION: -linkhighlight -# -# same as alink -# ------------------------------------------------------------------ -configbody iwidgets::Scrolledhtml::linkhighlight { - configure -alink $itk_option(-linkhighlight) -} - -# ------------------------------------------------------------------ -# OPTION: -unknownimage -# -# set image to use as substitute for images that aren't found -# ------------------------------------------------------------------ -configbody iwidgets::Scrolledhtml::unknownimage { - set oldimage $_unknownimg - if {$itk_option(-unknownimage) != {}} { - set uki $itk_option(-unknownimage) - if [catch { set _unknownimg [image create photo -file $uki] } err] { - error "Couldn't create image $uki:\n$err\nUnknown image not found" - } - } else { - set _unknownimg $_defUnknownImg - } - if {$oldimage != {} && $oldimage != $_defUnknownImg} { - image delete $oldimage - } -} - -# ------------------------------------------------------------------ -# OPTION: -update -# -# boolean indicating whether to update during rendering -# ------------------------------------------------------------------ -configbody iwidgets::Scrolledhtml::update { - switch -- $itk_option(-update) { - 0 {} - 1 {} - true { - configure -update 1 - } - yes { - configure -update 1 - } - false { - configure -update 0 - } - yes { - configure -update 0 - } - default { - error "invalid -update; must be boolean" - } - } -} - -# ------------------------------------------------------------------ -# METHODS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# METHOD: clear -# -# Clears the text out -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::clear {} { - $itk_component(text) config -state normal - $itk_component(text) delete 1.0 end - foreach x $_images { - image delete $x - } - set _images {} - _setup - $itk_component(text) config -state disabled -} - -# ------------------------------------------------------------------ -# METHOD import ?-link? filename?#anchorname? -# -# read html text from a file (import filename) if the keyword link is present, -# pathname is relative to last page, otherwise it is relative to current -# directory. This allows the user to use a linkcommand of -# "<widgetname> import -link" -# -# if '#anchorname' is appended to the filename, the page is displayed starting -# at the anchor named 'anchorname' If an anchor is specified without a filename, -# the current page is assumed. -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::import {args} { - set len [llength $args] - if {$len != 1 && $len != 2} { - error "wrong # args: should be \ - \"$itk_component(hull) import ?-link? filename\"" - } - set linkname [lindex $args [expr $len - 1]] - - # - # Seperate filename#anchorname - # - if ![regexp {(.*)#(.*)} $linkname dummy filename anchorname] { - set filename $linkname - } - if {$filename!=""} { - # - # Check for -link option - # - switch -- $len { - 1 { - # - # open file & set cwd to that file's directory - # - set f [open $filename r] - set _cwd [file dirname $filename] - } - 2 { - switch -- [lindex $args 0] { - -link { - # - # got -link, so set path relative to current locale, if path - # is a relative pathname - # - if {[string compare "." [file dirname $filename]] == 0} { - set f [open $_cwd/$filename r] - } else { - if {[string index [file dirname $filename] 0] != "/" &&\ - [string index [file dirname $filename] 0] != "~"} { - set f [open $_cwd/$filename r] - append _cwd / - append _cwd [file dirname $filename] - } else { - set f [open $filename r] - set _cwd [file dirname $filename] - } - } - } - default { - # got something other than -link - error "invalid format: should be \ - \"$itk_component(hull) import ?-link? filename\"" - } - } - } - } - set txt [read $f] - close $f - render $txt $_cwd - } - - # - # if an anchor was requested, move that anchor into view - # - if [ info exists anchorname] { - if {$anchorname!=""} { - if [info exists _anchor($anchorname)] { - $itk_component(text) see end - $itk_component(text) see $_anchor($anchorname) - } - } else { - $itk_component(text) see 0.0 - } - } -} - -# ------------------------------------------------------------------ -# METHOD: render text ?wd? -# -# Clear the text, then render html formatted text. Optional wd argument -# sets the base directory for any links or images. -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::render {html {wd .}} { - # - # blank text and reset all state variables - # - clear - set _cwd $wd - - # - # make text writable - # - $itk_component(text) config -state normal - set continuerendering 1 - _set_tag - while {$continuerendering} { - # normal state - while {[set len [string length $html]]} { - # look for text up to the next <> element - if [regexp -indices "^\[^<\]+" $html match] { - set text [string range $html 0 [lindex $match 1]] - _append_text "$text" - set html \ - [string range $html [expr [lindex $match 1]+1] end] - } - # we're either at a <>, or at the eot - if [regexp -indices "^<((\[^>\"\]+|(\"\[^\"\]*\"))*)>" $html match entity] { - regsub -all "\n" [string range $html [lindex $entity 0] \ - [lindex $entity 1]] "" entity - set cmd [string tolower [lindex $entity 0]] - if {[info command _entity_$cmd]!=""} { - 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] - } - if {$itk_option(-feedback) != {} } { - eval $itk_option(-feedback) $len - } - if $_verbatim break - } - # we reach here if html is empty, or _verbatim is 1 - if !$len break - # _verbatim must be 1 - # append text until next tag is reached - if [regexp -indices "<.*>" $html match] { - set text [string range $html 0 [expr [lindex $match 0]-1]] - set html [string range $html [expr [lindex $match 0]] end] - } else { - set text $html - set html "" - } - _append_text "$text" - } - $itk_component(text) config -state disabled -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _setup -# -# Reset all state variables to prepare for a new page. -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_setup {} { - set _font $itk_option(-fontname) - set _left 0 - set _left2 0 - set _right 0 - set _justify L - set _textweight 0 - set _textslant 0 - set _underline 0 - set _verbatim 0 - set _pre 0 - set _title {} - set _intitle 0 - set _anchorcount 0 - set _intable 0 - set _hottext $itk_component(text) - set _stack(font) {} - set _stack(color) {} - set _stack(bgcolor) {} - set _stack(link) {} - set _stack(alink) {} - set _stack(justify) {} - set _stack(listyle) {} - set _stack(lipic) {} - set _stack(href) {} - set _stack(pointsndx) {} - set _stack(left) {} - set _stack(left2) {} - set _stack(offset) {} - set _stack(table) {} - set _stack(tablewidth) {} - set _stack(row) {} - set _stack(column) {} - set _stack(hottext) {} - set _stack(tableborder) {} - set _stack(cellpadding) {} - set _stack(cellspacing) {} - set _stack(licount) {} - set _basefontsize 2 - set _pointsndx 2 - set _counter -1 - set _bgcolor $_defaulttextbackground - set _color $itk_option(-foreground) - set _link $itk_option(-link) - set _alink $itk_option(-alink) - config -textbackground $_bgcolor - foreach x [array names _anchor] { unset _anchor($x) } - $itk_component(text) tag config hr -relief sunken -borderwidth 2 \ - -font -*-*-*-*-*-*-$_rulerheight-*-*-*-*-*-*-* -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _definefont name foundry family weight slant registry -# -# define font information used to generate font value from font name -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_definefont \ - {name foundry family weight slant registry} { - if {[lsearch -exact $_fontnames $name] == -1 } { - lappend _fontnames $name - } - set _fontinfo($name) \ - [list $foundry $family $weight $slant $registry] -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _append_text text -# -# append text in the format described by the state variables -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_append_text {text} { - if {!$_intable && $itk_option(-update)} {update} - if {[string first "&" $text] != -1} { - regsub -nocase -all "&" $text {\&} text - regsub -nocase -all "<" $text "<" text - regsub -nocase -all ">" $text ">" text - regsub -nocase -all """ $text "\"" text - } - if !$_verbatim { - if !$_pre { - set text [string trim $text "\n\r"] - regsub -all "\[ \n\r\t\]+" $text " " text - } - if ![string length $text] return - } - if {!$_pre && !$_intitle} { - 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] - } - if {[catch {$_hottext insert end $text $_tag}]} { - set pht [winfo parent $_hottext] - catch {$pht insert end $text $_tag} - } - return - } - if {$_pre && !$_intitle} { - if {[catch {$_hottext insert end $text $_tag}]} { - set pht [winfo parent $_hottext] - catch {$pht insert end $text $_tag} - } - return - } - append _title $text -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _set_tag -# -# generate a tag -# ------------------------------------------------------------------ -# a tag is constructed as: font?B?I?U?Points-LeftLeft2RightColorJustify -body iwidgets::Scrolledhtml::_set_tag {} { - set i -1 - foreach var {foundry family weight slant registry} { - set $var [lindex $_fontinfo($_font) \ - [incr i]] - } - set x_font "-$foundry-$family-" - set _tag $_font - set args {} - if {$_textweight > 0} { - append _tag "B" - append x_font [lindex $weight 1]- - } else { - append x_font [lindex $weight 0]- - } - if {$_textslant > 0} { - append _tag "I" - append x_font [lindex $slant 1]- - } else { - append x_font [lindex $slant 0]- - } - if {$_underline > 0} { - append _tag "U" - append args " -underline 1" - } - switch $_justify { - L { append args " -justify left" } - R { append args " -justify right" } - C { append args " -justify center" } - } - append args " -offset $_offset" - - set pts [lindex [set [format "_%spoints" $itk_option(-fontsize)]] \ - $_pointsndx] - append _tag $_pointsndx - $_left \ - $_left2 $_right \ - $_color $_justify - append x_font "normal-*-*-$pts-*-*-*-*-$registry-*" - if $_anchorcount { - set href [_peek href] - set href_tag href[incr _counter] - set tags [list $_tag $href_tag] - if { $itk_option(-linkcommand)!= {} } { - $_hottext tag bind $href_tag <1> \ - [list uplevel #0 $itk_option(-linkcommand) $href] - } - $_hottext tag bind $href_tag <Enter> \ - [list $_hottext tag configure $href_tag \ - -foreground $_alink] - $_hottext tag bind $href_tag <Leave> \ - [list $_hottext tag configure $href_tag \ - -foreground $_color] - } else { - set tags $_tag - } - if {![info exists _tagl($_tag)]} { - set _tagfont($_tag) 1 - eval $_hottext tag configure $_tag \ - -foreground ${_color} \ - -lmargin1 ${_left}m \ - -lmargin2 ${_left2}m $args - if [catch {eval $_hottext tag configure $_tag \ - -font $x_font} err] { - _definefont $_font * $family $weight $slant * - regsub \$foundry $x_font * x_font - regsub \$registry $x_font * x_font - catch {eval $_hottext tag configure $_tag -font $x_font} - } - } - if [info exists href_tag] { - $_hottext tag raise $href_tag $_tag - } - set _tag $tags -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _reconfig_tags -# -# reconfigure tags following a configuration change -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_reconfig_tags {} { - if $_initialized { - foreach tag [$itk_component(text) tag names] { - foreach efont $_fontnames { - if [regexp "${efont}(B?)(I?)(U?)(\[1-9\]\[0-9\]*)-" $tag t b i u points] { - set j -1 - set _font $efont - foreach var {foundry family weight slant registry} { - set $var [lindex $_fontinfo($_font) [incr j]] - } - set x_font "-$foundry-$family-" - if {$b == "B"} { - append x_font [lindex $weight 1]- - } else { - append x_font [lindex $weight 0]- - } - if {$i == "I"} { - append x_font [lindex $slant 1]- - } else { - append x_font [lindex $slant 0]- - } - set pts [lindex [set [format \ - "_%spoints" $itk_option(-fontsize)]] $points] - append x_font "normal-*-*-$pts-*-*-*-*-$registry-*" - $itk_component(text) tag config $tag -font $x_font - break - } - } - } - } -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _push instack value -# -# push value onto stack(instack) -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_push {instack value} { - set _stack($instack) [linsert $_stack($instack) 0 $value] -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _pop instack -# -# pop value from stack(instack) -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_pop {instack} { - if {$_stack($instack) == ""} { - error "popping empty _stack $instack" - } - set val [lindex $_stack($instack) 0] - set _stack($instack) [lrange $_stack($instack) 1 end] - return $val -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _peek instack -# -# peek at top value on stack(instack) -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_peek {instack} { - return [lindex $_stack($instack) 0] -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _parse_fields array_var string -# -# parse fields from a href or image tag. At the moment, doesn't support -# spaces in field values. (e.g. alt="not avaliable") -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_parse_fields {array_var string} { - upvar $array_var array - if {$string != "{}" } { - regsub -all "( *)=( *)" $string = string - regsub -all {\\\"} $string \" string - while {$string != ""} { - if ![regexp "^ *(\[^ \n\r=\]+)=\"(\[^\"\n\r\t\]*)(.*)" $string \ - dummy field value newstring] { - if ![regexp "^ *(\[^ \n\r=\]+)=(\[^\n\r\t \]*)(.*)" $string \ - dummy field value newstring] { - if ![regexp "^ *(\[^ \n\r\]+)(.*)" $string dummy field newstring] { - error "malformed command field; field = \"$string\"" - continue - } - set value "" - } - } - set array([string tolower $field]) $value - set string "$newstring" - } - } -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _href_click -# -# process a click on an href -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_href_click {cmd href} { - uplevel #0 $cmd $href -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _set_align -# -# set text alignment -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_set_align {align} { - switch [string tolower $align] { - center { - set _justify C - } - left { - set _justify L - } - right { - set _justify R - } - default {} - } -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _fixtablewidth -# -# fix table width & height -# essentially, with nested tables the outer table must be configured before -# the inner table, but the idle tasks get queued up in the opposite order, -# so process later idle tasks before sizing yourself. -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_fixtablewidth {hottext table multiplier} { - update idletasks - $hottext see $_anchor($table) - update idletasks - $table configure \ - -width [expr $multiplier * [winfo width $hottext] - \ - 2* [$hottext cget -padx] - \ - 2* [$hottext cget -borderwidth] ] \ - -height [winfo height $table] - grid propagate $table 0 -} - - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _header level -# -# generic entity to set state for <hn> tag -# Accepts argument of the form ?align=[left,right,center]? ?src=<image pname>? -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_header {level args} { - eval _parse_fields ar $args - _push justify $_justify - if [info exists ar(align)] { - _entity_p align=$ar(align) - } else { - _entity_p - } - if [info exists ar(src)] { - _entity_img src=$ar(src) - } - _push pointsndx $_pointsndx - set _pointsndx [expr 7-$level] - incr _textweight - _set_tag -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _/header level -# -# generic entity to set state for </hn> tag -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_/header {level} { - set _justify [_pop justify] - set _pointsndx [_pop pointsndx] - incr _textweight -1 - _set_tag - _entity_p -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_a -# -# add an anchor. Accepts arguments of the form ?href=filename#anchorpoint? -# ?name=anchorname? -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_a {args} { - _parse_fields ar $args - _push color $_color - if [info exists ar(href)] { - _push href $ar(href) - incr _anchorcount - set _color $_link - _entity_u - } else { - _push href {} - } - if [info exists ar(name)] { - set _anchor($ar(name)) [$itk_component(text) index end] - } - if [info exists ar(id)] { - set _anchor($ar(id)) [$itk_component(text) index end] - } -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_/a -# -# End anchor -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_/a {} { - set href [_pop href] - if {$href != {}} { - incr _anchorcount -1 - set _color [_pop color] - _entity_/u - } -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_address -# -# display an address -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_address {} { - _entity_br - _entity_i -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_/address -# -# change state back from address display -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_/address {} { - _entity_/i - _entity_br -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_b -# -# Change current font to bold -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_b {} { - incr _textweight - _set_tag -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_/b -# -# change current font back from bold -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_/b {} { - incr _textweight -1 - _set_tag -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_base -# -# set the cwd of the document -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_base {{args {}}} { - _parse_fields ar $args - if [info exists ar(href)] { - set _cwd [file dirname $ar(href)] - } -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_basefont -# -# set base font size -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_basefont {{args {}}} { - _parse_fields ar $args - if {[info exists ar(size)]} { - set _basefontsize $ar(size) - } -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_big -# -# Change current font to a bigger size -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_big {} { - _push pointsndx $_pointsndx - if {[incr _pointsndx 2] > 6} { - set _pointsndx 6 - } - _set_tag -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_/big -# -# change current font back from bigger size -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_/big {} { - set _pointsndx [_pop pointsndx] - _set_tag -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_blockquote -# -# display a block quote -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_blockquote {} { - _entity_p - _push left $_left - incr _left $_indentincr - _push left2 $_left2 - set _left2 $_left - _set_tag -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_/blockquote -# -# change back from blockquote -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_/blockquote {} { - _entity_p - set _left [_pop left] - set _left2 [_pop left2] - _set_tag -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_body -# -# begin body text. Takes argument of the form ?bgcolor=<color>? ?text=<color>? -# ?link=<color>? -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_body {{args {}}} { - _parse_fields ar $args - if [info exists ar(bgcolor)] { - set _bgcolor $ar(bgcolor) - set temp $itk_option(-textbackground) - config -textbackground $_bgcolor - set _defaulttextbackground $temp - } - if [info exists ar(text)] { - set _color $ar(text) - } - if [info exists ar(link)] { - set _link $ar(link) - } - if [info exists ar(alink)] { - set _alink $ar(alink) - } -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_/body -# -# end body text -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_/body {} { -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_br -# -# line break -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_br {{args {}}} { - $_hottext insert end "\n" -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_center -# -# change justification to center -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_center {} { - _push justify $_justify - set _justify C - _set_tag -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_/center -# -# change state back from center -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_/center {} { - set _justify [_pop justify] - _set_tag -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_cite -# -# display citation -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_cite {} { - _entity_i -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_/cite -# -# change state back from citation -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_/cite {} { - _entity_/i -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_code -# -# display code listing -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_code {} { - _entity_pre -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_/code -# -# end code listing -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_/code {} { - _entity_/pre -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_dir -# -# display dir list -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_dir {{args {}}} { - _entity_ul plain $args -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_/dir -# -# end dir list -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_/dir {} { - _entity_/ul -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_div -# -# divide text. same as <p> -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_div {{args {}}} { - _entity_p $args -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_dl -# -# begin definition list -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_dl {{args {}}} { - if {$_left == 0} { - _entity_p - } - _push left $_left - _push left2 $_left2 - if {$_left2 == $_left } { - incr _left2 [expr $_indentincr+3] - } else { - incr _left2 $_indentincr - } - incr _left $_indentincr - _push listyle $_listyle - _push licount $_licount - set _listyle none - _set_tag -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_/dl -# -# end definition list -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_/dl {} { - set _left [_pop left] - set _left2 [_pop left2] - set _listyle [_pop listyle] - set _licount [_pop licount] - _set_tag - if {$_left == 0} { - _entity_p - } -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_dt -# -# definition term -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_dt {} { - set _left [expr $_left2 - 3] - _set_tag - _entity_p -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_dd -# -# definition definition -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_dd {} { - set _left $_left2 - _set_tag - _entity_br -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_dfn -# -# display defining instance of a term -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_dfn {} { - _entity_i - _entity_b -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_/dfn -# -# change state back from defining instance of term -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_/dfn {} { - _entity_/b - _entity_/i -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_em -# -# display emphasized text -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_em {} { - _entity_i -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_/em -# -# change state back from emphasized text -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_/em {} { - _entity_/i -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_font -# -# set font size and color -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_font {{args {}}} { - _parse_fields ar $args - _push pointsndx $_pointsndx - _push color $_color - if [info exists ar(size)] { - if {![regexp {^[+-].*} $ar(size)]} { - set _pointsndx $ar(size) - } else { - set _pointsndx [expr $_basefontsize $ar(size)] - } - if { $_pointsndx > 6 } { - set _pointsndx 6 - } else { - if { $_pointsndx < 0 } { - set _pointsndx 0 - } - } - } - if {[info exists ar(color)]} { - set _color $ar(color) - } - _set_tag -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_/font -# -# close current font size -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_/font {} { - set _pointsndx [_pop pointsndx] - set _color [_pop color] - _set_tag -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_h1 -# -# display header level 1. -# Accepts argument of the form ?align=[left,right,center]? ?src=<image pname>? -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_h1 {{args {}}} { - _header 1 $args -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_/h1 -# -# change state back from header 1 -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_/h1 {} { - _/header 1 -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_h2 -# -# display header level 2 -# Accepts argument of the form ?align=[left,right,center]? ?src=<image pname>? -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_h2 {{args {}}} { - _header 2 $args -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_/h2 -# -# change state back from header 2 -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_/h2 {} { - _/header 2 -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_h3 -# -# display header level 3 -# Accepts argument of the form ?align=[left,right,center]? ?src=<image pname>? -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_h3 {{args {}}} { - _header 3 $args -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_/h3 -# -# change state back from header 3 -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_/h3 {} { - _/header 3 -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_h4 -# -# display header level 4 -# Accepts argument of the form ?align=[left,right,center]? ?src=<image pname>? -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_h4 {{args {}}} { - _header 4 $args -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_/h4 -# -# change state back from header 4 -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_/h4 {} { - _/header 4 -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_h5 -# -# display header level 5 -# Accepts argument of the form ?align=[left,right,center]? ?src=<image pname>? -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_h5 {{args {}}} { - _header 5 $args -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_/h5 -# -# change state back from header 5 -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_/h5 {} { - _/header 5 -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_h6 -# -# display header level 6 -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_h6 {{args {}}} { - _header 6 $args -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_/h6 -# -# change state back from header 6 -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_/h6 {} { - _/header 6 -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_hr -# -# Add a horizontal rule -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_hr {{args {}}} { - _parse_fields ar $args - if [info exists ar(size)] { - set font "-font -*-*-*-*-*-*-$ar(size)-*-*-*-*-*-*-*" - } else { - set font "-font -*-*-*-*-*-*-2-*-*-*-*-*-*-*" - } - if [info exists ar(width)] { - } - if [info exists ar(noshade)] { - set relief "-relief flat" - set background "-background black" - } else { - set relief "-relief sunken" - set background "" - } -# if [info exists ar(align)] { -# $_hottext tag config hr$_counter -justify $ar(align) -# set justify -justify $ar(align) -# } else { -# set justify "" -# } - eval $_hottext tag config hr[incr _counter] $relief $background $font \ - -borderwidth 2 - _entity_p - $_hottext insert end " \n" hr$_counter -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_i -# -# display italicized text -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_i {} { - incr _textslant - _set_tag -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_/i -# -# change state back from italicized text -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_/i {} { - incr _textslant -1 - _set_tag -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_img -# -# display an image. takes argument of the form img=<filename> -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_img {{args {}}} { - _parse_fields ar $args - set alttext "<image>" - - # - # If proper argument exists - # - if [info exists ar(src)] { - set imgframe $_hottext.img[incr _counter] - # - # if this is an anchor - # - if $_anchorcount { - # create link colored border - frame $imgframe -borderwidth 2 -background $_link - bind $imgframe <Enter> \ - [list $imgframe configure -background $_alink] - bind $imgframe <Leave> \ - [list $imgframe configure -background $_link] - } else { - # create plain frame - frame $imgframe -borderwidth 0 -background $_color - } - - # - # try to load image - # - if {[string index $ar(src) 0] == "/" || [string index $ar(src) 0] == "~"} { - set file $ar(src) - } else { - set file $_cwd/$ar(src) - } - if [catch {set img [image create photo -file $file]} err] { - if {[info exists ar(width)] && [info exists ar(height)] } { - # suggestions exist, so make frame appropriate size and add a border - $imgframe configure -width $ar(width) -height $ar(height) -borderwidth 2 - pack propagate $imgframe false - } - - # - # If alt text is specified, display that - # - if [info exists ar(alt)] { - # add a border - $imgframe configure -borderwidth 2 - set win $imgframe.text - label $win -text "$ar(alt)" -background $_bgcolor \ - -foreground $_color - } else { - # - # use 'unknown image' - set win $imgframe.image#auto - # - # make label containing image - # - label $win -image $_unknownimg -borderwidth 0 -background $_bgcolor - } - pack $win -fill both -expand true - - } else { ;# no error loading image - lappend _images $img - set win $imgframe.$img - - # - # make label containing image - # - label $win -image $img -borderwidth 0 - } - pack $win - - # - # set alignment - # - set align bottom - if [info exists ar(align)] { - switch $ar(align) { - middle { - set align center - } - right { - set align center - } - default { - set align [string tolower $ar(align)] - } - } - } - - # - # create window in text to display image - # - $_hottext window create end -window \ - $imgframe -align $align - - # - # set tag for window - # - $_hottext tag add $_tag $imgframe - if $_anchorcount { - set href [_peek href] - set href_tag href[incr _counter] - set tags [list $_tag $href_tag] - if { $itk_option(-linkcommand)!= {} } { - bind $win <1> [list uplevel #0 $itk_option(-linkcommand) $href] - } - } - } -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_kbd -# -# Display keyboard input -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_kbd {} { - incr _textweight - _entity_tt - _set_tag -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_/kbd -# -# change state back from displaying keyboard input -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_/kbd {} { - _entity_/tt - incr _textweight -1 - _set_tag -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_li -# -# begin new list entry -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_li {{args {}}} { - _parse_fields ar $args - if [info exists ar(value)] { - set _licount $ar(value) - } - _entity_br - switch -exact $_listyle { - bullet { - set old_font $_font - set _font symbol - _set_tag - $_hottext insert end "\xb7" $_tag - set _font $old_font - _set_tag - } - none { - } - picture { - _entity_img src="$_lipic" width=4 height=4 align=middle - } - A { - _entity_b - $_hottext insert end [format "%c) " [expr $_licount + 0x40]] $_tag - _entity_/b - incr _licount - } - a { - _entity_b - $_hottext insert end [format "%c) " [expr $_licount + 0x60]] $_tag - _entity_/b - incr _licount - } - I { - _entity_b - $_hottext insert end "[::iwidgets::roman $_licount]) " $_tag - _entity_/b - incr _licount - } - i { - _entity_b - $_hottext insert end "[::iwidgets::roman $_licount lower])] " $_tag - _entity_/b - incr _licount - } - default { - _entity_b - $_hottext insert end "$_licount) " $_tag - _entity_/b - incr _licount - } - } -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_listing -# -# diplay code listing -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_listing {} { - _entity_pre -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_/listing -# -# end code listing -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_/listing {} { - _entity_/pre -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_menu -# -# diplay menu list -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_menu {{args {}}} { - _entity_ul plain $args -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_/menu -# -# end menu list -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_/menu {} { - _entity_/ul -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_ol -# -# begin ordered list -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_ol {{args {}}} { - _parse_fields ar $args - if $_left { - _entity_br - } else { - _entity_p - } - if {![info exists ar(type)]} { - set ar(type) 1 - } - _push licount $_licount - if [info exists ar(start)] { - set _licount $ar(start) - } else { - set _licount 1 - } - _push left $_left - _push left2 $_left2 - if {$_left2 == $_left } { - incr _left2 [expr $_indentincr+3] - } else { - incr _left2 $_indentincr - } - incr _left $_indentincr - _push listyle $_listyle - set _listyle $ar(type) - _set_tag -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_/ol -# -# end ordered list -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_/ol {} { - set _left [_pop left] - set _left2 [_pop left2] - set _listyle [_pop listyle] - set _licount [_pop licount] - _set_tag - _entity_p -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_p -# -# paragraph break -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_p {{args {}}} { - _parse_fields ar $args - if [info exists ar(align)] { - _set_align $ar(align) - } else { - set _justify L - } - _set_tag - if [info exists ar(id)] { - set _anchor($ar(id)) [$itk_component(text) index end] - } - set x [$_hottext get end-3c] - set y [$_hottext get end-2c] - if {$x == "" && $y == ""} return - if {$y == ""} { - $_hottext insert end "\n\n" - return - } - if {$x == "\n" && $y == "\n"} return - if {$y == "\n"} { - $_hottext insert end "\n" - return - } - $_hottext insert end "\n\n" -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_pre -# -# display preformatted text -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_pre {{args {}}} { - _entity_tt - _entity_br - incr _pre -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_/pre -# -# change state back from preformatted text -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_/pre {} { - _entity_/tt - set _pre 0 - _entity_p -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_samp -# -# display sample text. -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_samp {} { - _entity_kbd -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_/samp -# -# switch back to non-sample text -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_/samp {} { - _entity_/kbd -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_small -# -# Change current font to a smaller size -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_small {} { - _push pointsndx $_pointsndx - if {[incr _pointsndx -2] < 0} { - set _pointsndx 0 - } - _set_tag -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_/small -# -# change current font back from smaller size -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_/small {} { - set _pointsndx [_pop pointsndx] - _set_tag -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_sub -# -# display subscript -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_sub {} { - _push offset $_offset - incr _offset -2 - _entity_small -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_/sub -# -# switch back to non-subscript -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_/sub {} { - set _offset [_pop offset] - _entity_/small -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_sup -# -# display superscript -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_sup {} { - _push offset $_offset - incr _offset 4 - _entity_small -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_/sup -# -# switch back to non-superscript -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_/sup {} { - set _offset [_pop offset] - _entity_/small -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_strong -# -# display strong text. (i.e. make font bold) -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_strong {} { - incr _textweight - _set_tag -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_/strong -# -# switch back to non-strong text -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_/strong {} { - incr _textweight -1 - _set_tag -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_table -# -# display a table. -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_table {{args {}}} { - _parse_fields ar $args - _entity_p - set _intable 1 - - _push row -1 - _push column 0 - _push hottext $_hottext - _push justify $_justify - _push justify L - # push color information for master of table, then push info for table - _push color $_color - _push bgcolor $_bgcolor - _push link $_link - _push alink $_alink - if [info exists ar(bgcolor)] { - set _bgcolor $ar(bgcolor) - } - if [info exists ar(text)] { - set _color $ar(text) - } - if [info exists ar(link)] { - set _link $ar(link) - } - if [info exists ar(alink)] { - set _alink $ar(alink) - } - _push color $_color - _push bgcolor $_bgcolor - _push link $_link - _push alink $_alink - # push fake first row to avoid using optional /tr tag - # (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 {} - - if {[info exists ar(align)]} { - _set_align $ar(align) - _set_tag - _append_text " " - } - set _justify L - - if [info exists ar(id)] { - set _anchor($ar(id)) [$itk_component(text) index end] - } - if [info exists ar(cellpadding)] { - _push cellpadding $ar(cellpadding) - } else { - _push cellpadding 0 - } - if [info exists ar(cellspacing)] { - _push cellspacing $ar(cellspacing) - } else { - _push cellspacing 0 - } - if {[info exists ar(border)]} { - _push tableborder 1 - set relief raised - if {$ar(border)==""} { - set ar(border) 2 - } - } else { - _push tableborder 0 - set relief flat - set ar(border) 2 - } - _push table [set table $_hottext.table[incr _counter]] - iwidgets::labeledwidget $table -foreground $_color -background $_bgcolor -labelpos n - if {[info exists ar(title)]} { - $table configure -labeltext $ar(title) - } - # - # create window in text to display table - # - $_hottext window create end -window $table - - set table [$table childsite] - set _anchor($table) [$_hottext index "end - 1 line"] - $table configure -borderwidth $ar(border) -relief $relief - - if {[info exists ar(width)]} { - _push tablewidth $ar(width) - } else { - _push tablewidth 0 - } -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_/table -# -# end table -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_/table {} { - if {$_intable} { - _pop tableborder - set table [[_pop table] childsite] - _pop row - _pop column - _pop cellspacing - _pop cellpadding - # pop last row's defaults - _pop color - _pop bgcolor - _pop link - _pop alink - # pop table defaults - _pop color - _pop bgcolor - _pop link - _pop alink - # restore table master defaults - set _color [_pop color] - set _bgcolor [_pop bgcolor] - set _link [_pop link] - set _alink [_pop alink] - 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 - if {[set tablewidth [_pop tablewidth]]!="0"} { - if {[string index $tablewidth \ - [expr [string length $tablewidth] -1]] == "%"} { - set multiplier [expr [string trimright $tablewidth "%"] / 100.0] - set idletask [after idle [code "$this _fixtablewidth $_hottext $table $multiplier"]] - } else { - $table configure -width $tablewidth - grid propagate $table 0 - } - } - _pop justify - set _justify [_pop justify] - _entity_br - } -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_td -# -# start table data cell -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_td {{args {}}} { - if $_intable { - _parse_fields ar $args - set table [[_peek table] childsite] - if {![info exists ar(colspan)]} { - set ar(colspan) 1 - } - if {![info exists ar(rowspan)]} { - set ar(rowspan) 1 - } - if {![info exists ar(width)]} { - set ar(width) 10 - } - if {![info exists ar(height)]} { - set ar(height) 0 - } - if [info exists ar(bgcolor)] { - set _bgcolor $ar(bgcolor) - } else { - set _bgcolor [_peek bgcolor] - } - if [info exists ar(text)] { - set _color $ar(text) - } else { - set _color [_peek color] - } - if [info exists ar(link)] { - set _link $ar(link) - } else { - set _link [_peek link] - } - if [info exists ar(alink)] { - set _alink $ar(alink) - } else { - set _alink [_peek alink] - } - $_hottext configure -state disabled - set cellpadding [_peek cellpadding] - set cellspacing [_peek cellspacing] - set _hottext $table.cell[incr _counter] - text $_hottext -relief flat -width $ar(width) -height $ar(height) \ - -highlightthickness 0 -wrap word -cursor $itk_option(-cursor) \ - -wrap word -cursor $itk_option(-cursor) \ - -padx $cellpadding -pady $cellpadding - 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 - } - grid $_hottext -sticky nsew -row $row -column $column \ - -columnspan $ar(colspan) -rowspan $ar(rowspan) \ - -padx $cellspacing -pady $cellspacing - grid columnconfigure $table $column -weight 1 - _push column [expr $column + $ar(colspan)] - if [info exists ar(align)] { - _set_align $ar(align) - } else { - set _justify [_peek justify] - } - _set_tag - } -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_/td -# -# end table data cell -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_/td {} { -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_th -# -# start table header -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_th {{args {}}} { - if $_intable { - _parse_fields ar $args - if [info exists ar(align)] { - _entity_td $args - } else { - _entity_td align=center $args - } - _entity_b - } -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_/th -# -# end table data cell -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_/th {} { - _entity_/td -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_title -# -# begin title of document -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_title {} { - set _intitle 1 -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_/title -# -# end title -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_/title {} { - set _intitle 0 -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_tr -# -# start table row -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_tr {{args {}}} { - if $_intable { - _parse_fields ar $args - _pop justify - if [info exists ar(align)] { - _set_align $ar(align) - _push justify $_justify - } else { - _push justify L - } - # pop last row's colors - _pop color - _pop bgcolor - _pop link - _pop alink - if [info exists ar(bgcolor)] { - set _bgcolor $ar(bgcolor) - } else { - set _bgcolor [_peek bgcolor] - } - if [info exists ar(text)] { - set _color $ar(text) - } else { - set _color [_peek color] - } - if [info exists ar(link)] { - set _link $ar(link) - } else { - set _link [_peek link] - } - if [info exists ar(alink)] { - set _alink $ar(alink) - } else { - set _alink [_peek alink] - } - # push this row's defaults - _push color $_color - _push bgcolor $_bgcolor - _push link $_link - _push alink $_alink - $_hottext configure -state disabled - _push row [expr [_pop row] + 1] - _pop column - _push column 0 - } -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_/tr -# -# end table row -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_/tr {} { -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_tt -# -# Show typewriter text, using the font given by -fixedfont -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_tt {} { - _push font $_font - set _font $itk_option(-fixedfont) - set _verbatim 1 - _set_tag -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_/tt -# -# Change back to non-typewriter mode to display text -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_/tt {} { - set _font [_pop font] - set _verbatim 0 - _set_tag -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_u -# -# display underlined text -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_u {} { - incr _underline - _set_tag -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_/u -# -# change back from underlined text -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_/u {} { - incr _underline -1 - _set_tag -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_ul -# -# begin unordered list -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_ul {{args {}}} { - _parse_fields ar $args - if $_left { - _entity_br - } else { - _entity_p - } - if [info exists ar(id)] { - set _anchor($ar(id)) [$itk_component(text) index end] - } - _push left $_left - _push left2 $_left2 - if {$_left2 == $_left } { - incr _left2 [expr $_indentincr+3] - } else { - incr _left2 $_indentincr - } - incr _left $_indentincr - _push listyle $_listyle - _push licount $_licount - if [info exists ar(plain)] { - set _listyle none - } { - set _listyle bullet - } - if [info exists ar(dingbat)] { - set ar(src) $ar(dingbat) - } - _push lipic $_lipic - if [info exists ar(src)] { - set _listyle picture - set _lipic $ar(src) - } - _set_tag -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_/ul -# -# end unordered list -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_/ul {} { - set _left [_pop left] - set _left2 [_pop left2] - set _listyle [_pop listyle] - set _licount [_pop licount] - set _lipic [_pop lipic] - _set_tag - _entity_p -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_var -# -# Display variable -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_var {} { - _entity_i -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _entity_/var -# -# change state back from variable display -# ------------------------------------------------------------------ -body iwidgets::Scrolledhtml::_entity_/var {} { - _entity_/i -} - -namespace eval iwidgets { - variable romand - set romand(val) {1000 900 500 400 100 90 50 40 10 9 5 4 1} - set romand(upper) { M CM D CD C XC L XL X IX V IV I} - set romand(lower) { m cm d cd c xc l xl x ix v iv i} - - proc roman2 {n {case upper}} { - variable romand - set r "" - foreach val $romand(val) sym $romand($case) { - while {$n >= $val} { - set r "$r$sym" - incr n -$val - } - } - return $r - } - - proc roman {n {case upper}} { - variable romand - set r "" - foreach val $romand(val) sym $romand($case) { - for {} {$n >= $val} {incr n -$val} { - set r "$r$sym" - } - } - return $r - } -} diff --git a/itcl/iwidgets3.0.0/generic/scrolledlistbox.itk b/itcl/iwidgets3.0.0/generic/scrolledlistbox.itk deleted file mode 100644 index 87f371a2e58..00000000000 --- a/itcl/iwidgets3.0.0/generic/scrolledlistbox.itk +++ /dev/null @@ -1,733 +0,0 @@ -# -# Scrolledlistbox -# ---------------------------------------------------------------------- -# Implements a scrolled listbox with additional options to manage -# horizontal and vertical scrollbars. This includes options to control -# which scrollbars are displayed and the method, i.e. statically, -# dynamically, or none at all. -# -# ---------------------------------------------------------------------- -# AUTHOR: Mark L. Ulferts EMAIL: mulferts@austin.dsccc.com -# -# @(#) $Id$ -# ---------------------------------------------------------------------- -# Copyright (c) 1995 DSC Technologies Corporation -# ====================================================================== -# Permission to use, copy, modify, distribute and license this software -# and its documentation for any purpose, and without fee or written -# agreement with DSC, is hereby granted, provided that the above copyright -# notice appears in all copies and that both the copyright notice and -# warranty disclaimer below appear in supporting documentation, and that -# the names of DSC Technologies Corporation or DSC Communications -# Corporation not be used in advertising or publicity pertaining to the -# software without specific, written prior permission. -# -# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING -# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- -# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE -# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, -# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL -# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR -# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, -# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, -# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS -# SOFTWARE. -# ====================================================================== - -# -# Usual options. -# -itk::usual Scrolledlistbox { - keep -activebackground -activerelief -background -borderwidth -cursor \ - -elementborderwidth -foreground -highlightcolor -highlightthickness \ - -jump -labelfont -selectbackground -selectborderwidth \ - -selectforeground -textbackground -textfont -troughcolor -} - -# ------------------------------------------------------------------ -# SCROLLEDLISTBOX -# ------------------------------------------------------------------ -class iwidgets::Scrolledlistbox { - inherit iwidgets::Scrolledwidget - - constructor {args} {} - destructor {} - - itk_option define -dblclickcommand dblClickCommand Command {} - itk_option define -selectioncommand selectionCommand Command {} - itk_option define -width width Width 0 - itk_option define -height height Height 0 - itk_option define -visibleitems visibleItems VisibleItems 20x10 - itk_option define -state state State normal - - public method curselection {} - public method activate {index} - public method bbox {index} - public method clear {} - public method see {index} - public method index {index} - public method delete {first {last {}}} - public method get {first {last {}}} - public method getcurselection {} - public method insert {index string args} - public method nearest {y} - public method scan {option args} - public method selection {option first {last {}}} - public method size {} - public method selecteditemcount {} - public method justify {direction} - public method sort {{mode ascending}} - public method xview {args} - public method yview {args} - public method itemconfigure {args} - - protected method _makeSelection {} - protected method _dblclick {} - protected method _fixIndex {index} - - # - # List the event sequences that invoke single and double selection. - # Should these change in the underlying Tk listbox, then they must - # change here too. - # - common doubleSelectSeq { \ - <Double-1> - } - - common singleSelectSeq { \ - <Control-Key-backslash> \ - <Control-Key-slash> \ - <Key-Escape> \ - <Shift-Key-Select> \ - <Control-Shift-Key-space> \ - <Key-Select> \ - <Key-space> \ - <Control-Shift-Key-End> \ - <Control-Key-End> \ - <Control-Shift-Key-Home> \ - <Control-Key-Home> \ - <Key-Down> \ - <Key-Up> \ - <Shift-Key-Down> \ - <Shift-Key-Up> \ - <Control-Button-1> \ - <Shift-Button-1> \ - <ButtonRelease-1> \ - <B1-Motion> - } -} - -# -# Provide a lowercased access method for the Scrolledlistbox class. -# -proc ::iwidgets::scrolledlistbox {pathName args} { - uplevel ::iwidgets::Scrolledlistbox $pathName $args -} - -# -# Use option database to override default resources of base classes. -# -option add *Scrolledlistbox.labelPos n widgetDefault - -# ------------------------------------------------------------------ -# CONSTRUCTOR -# ------------------------------------------------------------------ -body iwidgets::Scrolledlistbox::constructor {args} { - # - # Our -width and -height options are slightly different than - # those implemented by our base class, so we're going to - # remove them and redefine our own. - # - itk_option remove iwidgets::Scrolledwidget::width - itk_option remove iwidgets::Scrolledwidget::height - - # - # Create the listbox. - # - itk_component add listbox { - listbox $itk_interior.listbox \ - -width 1 -height 1 \ - -xscrollcommand \ - [code $this _scrollWidget $itk_interior.horizsb] \ - -yscrollcommand \ - [code $this _scrollWidget $itk_interior.vertsb] - } { - 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 - rename -highlightbackground -background background Background - } - grid $itk_component(listbox) -row 1 -column 1 -sticky nsew - grid rowconfigure $_interior 1 -weight 1 - grid columnconfigure $_interior 1 -weight 1 - - # - # Configure the command on the vertical scroll bar in the base class. - # - $itk_component(vertsb) configure \ - -command [code $itk_component(listbox) yview] - - # - # Configure the command on the horizontal scroll bar in the base class. - # - $itk_component(horizsb) configure \ - -command [code $itk_component(listbox) xview] - - # - # Create a set of bindings for monitoring the selection and install - # them on the listbox component. - # - foreach seq $singleSelectSeq { - bind SLBSelect$this $seq [code $this _makeSelection] - } - - foreach seq $doubleSelectSeq { - bind SLBSelect$this $seq [code $this _dblclick] - } - - bindtags $itk_component(listbox) \ - [linsert [bindtags $itk_component(listbox)] end SLBSelect$this] - - # - # Also create a set of bindings for disabling the scrolledlistbox. - # Since the command for it is "break", we can drop the $this since - # they don't need to be unique to the object level. - # - if {[bind SLBDisabled] == {}} { - foreach seq $singleSelectSeq { - bind SLBDisabled $seq break - } - - bind SLBDisabled <Button-1> break - - foreach seq $doubleSelectSeq { - bind SLBDisabled $seq break - } - } - - # - # Initialize the widget based on the command line options. - # - eval itk_initialize $args -} - -# ------------------------------------------------------------------ -# DESTURCTOR -# ------------------------------------------------------------------ -body iwidgets::Scrolledlistbox::destructor {} { -} - -# ------------------------------------------------------------------ -# OPTIONS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# OPTION: -dblclickcommand -# -# Specify a command to be executed upon double click of a listbox -# item. Also, create a couple of bindings used for specific -# selection modes -# ------------------------------------------------------------------ -configbody iwidgets::Scrolledlistbox::dblclickcommand {} - -# ------------------------------------------------------------------ -# OPTION: -selectioncommand -# -# Specifies a command to be executed upon selection of a listbox -# item. The command will be called upon each selection regardless -# of selection mode.. -# ------------------------------------------------------------------ -configbody iwidgets::Scrolledlistbox::selectioncommand {} - -# ------------------------------------------------------------------ -# OPTION: -width -# -# Specifies the width of the scrolled list box as an entire unit. -# The value may be specified in any of the forms acceptable to -# Tk_GetPixels. Any additional space needed to display the other -# components such as margins and scrollbars force the listbox -# to be compressed. A value of zero along with the same value for -# the height causes the value given for the visibleitems option -# to be applied which administers geometry constraints in a different -# manner. -# ------------------------------------------------------------------ -configbody iwidgets::Scrolledlistbox::width { - if {$itk_option(-width) != 0} { - set shell [lindex [grid info $itk_component(listbox)] 1] - - # - # Due to a bug in the tk4.2 grid, we have to check the - # propagation before setting it. Setting it to the same - # value it already is will cause it to toggle. - # - if {[grid propagate $shell]} { - grid propagate $shell no - } - - $itk_component(listbox) configure -width 1 - $shell configure \ - -width [winfo pixels $shell $itk_option(-width)] - } else { - configure -visibleitems $itk_option(-visibleitems) - } -} - -# ------------------------------------------------------------------ -# OPTION: -height -# -# Specifies the height of the scrolled list box as an entire unit. -# The value may be specified in any of the forms acceptable to -# Tk_GetPixels. Any additional space needed to display the other -# components such as margins and scrollbars force the listbox -# to be compressed. A value of zero along with the same value for -# the width causes the value given for the visibleitems option -# to be applied which administers geometry constraints in a different -# manner. -# ------------------------------------------------------------------ -configbody iwidgets::Scrolledlistbox::height { - if {$itk_option(-height) != 0} { - set shell [lindex [grid info $itk_component(listbox)] 1] - - # - # Due to a bug in the tk4.2 grid, we have to check the - # propagation before setting it. Setting it to the same - # value it already is will cause it to toggle. - # - if {[grid propagate $shell]} { - grid propagate $shell no - } - - $itk_component(listbox) configure -height 1 - $shell configure \ - -height [winfo pixels $shell $itk_option(-height)] - } else { - configure -visibleitems $itk_option(-visibleitems) - } -} - -# ------------------------------------------------------------------ -# OPTION: -visibleitems -# -# Specified the widthxheight in characters and lines for the listbox. -# This option is only administered if the width and height options -# are both set to zero, otherwise they take precedence. With the -# visibleitems option engaged, geometry constraints are maintained -# only on the listbox. The size of the other components such as -# labels, margins, and scrollbars, are additive and independent, -# effecting the overall size of the scrolled list box. In contrast, -# should the width and height options have non zero values, they -# are applied to the scrolled list box as a whole. The listbox -# is compressed or expanded to maintain the geometry constraints. -# ------------------------------------------------------------------ -configbody iwidgets::Scrolledlistbox::visibleitems { - if {[regexp {^[0-9]+x[0-9]+$} $itk_option(-visibleitems)]} { - if {($itk_option(-width) == 0) && \ - ($itk_option(-height) == 0)} { - set chars [lindex [split $itk_option(-visibleitems) x] 0] - set lines [lindex [split $itk_option(-visibleitems) x] 1] - - set shell [lindex [grid info $itk_component(listbox)] 1] - - # - # Due to a bug in the tk4.2 grid, we have to check the - # propagation before setting it. Setting it to the same - # value it already is will cause it to toggle. - # - if {! [grid propagate $shell]} { - grid propagate $shell yes - } - - $itk_component(listbox) configure -width $chars -height $lines - } - - } else { - error "bad visibleitems option\ - \"$itk_option(-visibleitems)\": should be\ - widthxheight" - } -} - -# ------------------------------------------------------------------ -# OPTION: -state -# -# Specifies the state of the scrolledlistbox which may be either -# disabled or normal. In a disabled state, the scrolledlistbox -# does not accept user selection. The default is normal. -# ------------------------------------------------------------------ -configbody iwidgets::Scrolledlistbox::state { - set tags [bindtags $itk_component(listbox)] - - # - # If the state is normal, then we need to remove the disabled - # bindings if they exist. If the state is disabled, then we need - # to install the disabled bindings if they haven't been already. - # - switch -- $itk_option(-state) { - normal { - if {[set index [lsearch $tags SLBDisabled]] != -1} { - bindtags $itk_component(listbox) \ - [lreplace $tags $index $index] - } - } - - disabled { - if {[set index [lsearch $tags SLBDisabled]] == -1} { - bindtags $itk_component(listbox) \ - [linsert $tags 1 SLBDisabled] - } - } - default { - error "bad state value \"$itk_option(-state)\":\ - must be normal or disabled" - } - } -} - -# ------------------------------------------------------------------ -# METHODS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# METHOD: curselection -# -# Returns a list containing the indices of all the elements in the -# listbox that are currently selected. -# ------------------------------------------------------------------ -body iwidgets::Scrolledlistbox::curselection {} { - return [$itk_component(listbox) curselection] -} - -# ------------------------------------------------------------------ -# METHOD: activate index -# -# Sets the active element to the one indicated by index. -# ------------------------------------------------------------------ -body iwidgets::Scrolledlistbox::activate {index} { - return [$itk_component(listbox) activate [_fixIndex $index]] -} - -# ------------------------------------------------------------------ -# METHOD: bbox index -# -# Returns four element list describing the bounding box for the list -# item at index -# ------------------------------------------------------------------ -body iwidgets::Scrolledlistbox::bbox {index} { - return [$itk_component(listbox) bbox [_fixIndex $index]] -} - -# ------------------------------------------------------------------ -# METHOD clear -# -# Clear the listbox area of all items. -# ------------------------------------------------------------------ -body iwidgets::Scrolledlistbox::clear {} { - delete 0 end -} - -# ------------------------------------------------------------------ -# METHOD: see index -# -# Adjusts the view such that the element given by index is visible. -# ------------------------------------------------------------------ -body iwidgets::Scrolledlistbox::see {index} { - $itk_component(listbox) see [_fixIndex $index] -} - -# ------------------------------------------------------------------ -# METHOD: index index -# -# Returns the decimal string giving the integer index corresponding -# to index. The index value may be a integer number, active, -# anchor, end, @x,y, or a pattern. -# ------------------------------------------------------------------ -body iwidgets::Scrolledlistbox::index {index} { - if {[regexp {(^[0-9]+$)|(active)|(anchor)|(end)|(^@-?[0-9]+,-?[0-9]+$)} $index]} { - return [$itk_component(listbox) index $index] - - } else { - set indexValue [lsearch -glob [get 0 end] $index] - - if {$indexValue == -1} { - error "bad Scrolledlistbox index \"$index\": must be active, anchor, end, @x,y, number, or a pattern" - } - - return $indexValue - } -} - -# ------------------------------------------------------------------ -# METHOD: _fixIndex index -# -# Similar to the regular "index" method, but it only converts -# the index to a numerical value if it is a string pattern. If -# the index is in the proper form to be used with the listbox, -# it is left alone. This fixes problems associated with converting -# an index such as "end" to a numerical value. -# ------------------------------------------------------------------ -body iwidgets::Scrolledlistbox::_fixIndex {index} { - if {[regexp {(^[0-9]+$)|(active)|(anchor)|(end)|(^@[0-9]+,[0-9]+$)} $index]} { - return $index - - } else { - set indexValue [lsearch -glob [get 0 end] $index] - - if {$indexValue == -1} { - error "bad Scrolledlistbox index \"$index\": must be active, anchor, end, @x,y, number, or a pattern" - } - - return $indexValue - } -} - -# ------------------------------------------------------------------ -# METHOD: delete first ?last? -# -# Delete one or more elements from list box based on the first and -# last index values. Indexes may be a number, active, anchor, end, -# @x,y, or a pattern. -# ------------------------------------------------------------------ -body iwidgets::Scrolledlistbox::delete {first {last {}}} { - set first [_fixIndex $first] - - if {$last != {}} { - set last [_fixIndex $last] - } else { - set last $first - } - - eval $itk_component(listbox) delete $first $last -} - -# ------------------------------------------------------------------ -# METHOD: get first ?last? -# -# Returns the elements of the listbox indicated by the indexes. -# Indexes may be a number, active, anchor, end, @x,y, ora pattern. -# ------------------------------------------------------------------ -body iwidgets::Scrolledlistbox::get {first {last {}}} { - set first [_fixIndex $first] - - if {$last != {}} { - set last [_fixIndex $last] - } - - if {$last == {}} { - return [$itk_component(listbox) get $first] - } else { - return [$itk_component(listbox) get $first $last] - } -} - -# ------------------------------------------------------------------ -# METHOD: getcurselection -# -# Returns the contents of the listbox element indicated by the current -# selection indexes. Short cut version of get and curselection -# command combination. -# ------------------------------------------------------------------ -body iwidgets::Scrolledlistbox::getcurselection {} { - set rlist {} - - if {[selecteditemcount] > 0} { - set cursels [$itk_component(listbox) curselection] - - switch $itk_option(-selectmode) { - single - - browse { - set rlist [$itk_component(listbox) get $cursels] - } - - multiple - - extended { - foreach sel $cursels { - lappend rlist [$itk_component(listbox) get $sel] - } - } - } - } - - return $rlist -} - -# ------------------------------------------------------------------ -# METHOD: insert index string ?string ...? -# -# Insert zero or more elements in the list just before the element -# given by index. -# ------------------------------------------------------------------ -body iwidgets::Scrolledlistbox::insert {index string args} { - set index [_fixIndex $index] - set args [linsert $args 0 $string] - - eval $itk_component(listbox) insert $index $args -} - -# ------------------------------------------------------------------ -# METHOD: nearest y -# -# Given a y-coordinate within the listbox, this command returns the -# index of the visible listbox element nearest to that y-coordinate. -# ------------------------------------------------------------------ -body iwidgets::Scrolledlistbox::nearest {y} { - $itk_component(listbox) nearest $y -} - -# ------------------------------------------------------------------ -# METHOD: scan option args -# -# Implements scanning on listboxes. -# ------------------------------------------------------------------ -body iwidgets::Scrolledlistbox::scan {option args} { - eval $itk_component(listbox) scan $option $args -} - -# ------------------------------------------------------------------ -# METHOD: selection option first ?last? -# -# Adjusts the selection within the listbox. The index value may be -# a integer number, active, anchor, end, @x,y, or a pattern. -# ------------------------------------------------------------------ -body iwidgets::Scrolledlistbox::selection {option first {last {}}} { - set first [_fixIndex $first] - - if {$last != {}} { - set last [_fixIndex $last] - $itk_component(listbox) selection $option $first $last - } else { - $itk_component(listbox) selection $option $first - } -} - -# ------------------------------------------------------------------ -# METHOD: size -# -# Returns a decimal string indicating the total number of elements -# in the listbox. -# ------------------------------------------------------------------ -body iwidgets::Scrolledlistbox::size {} { - return [$itk_component(listbox) size] -} - -# ------------------------------------------------------------------ -# METHOD: selecteditemcount -# -# Returns a decimal string indicating the total number of selected -# elements in the listbox. -# ------------------------------------------------------------------ -body iwidgets::Scrolledlistbox::selecteditemcount {} { - return [llength [$itk_component(listbox) curselection]] -} - -# ------------------------------------------------------------------ -# METHOD: justify direction -# -# Justifies the list scrolled region in one of four directions: top, -# bottom, left, or right. -# ------------------------------------------------------------------ -body iwidgets::Scrolledlistbox::justify {direction} { - switch $direction { - left { - $itk_component(listbox) xview moveto 0 - } - right { - $itk_component(listbox) xview moveto 1 - } - top { - $itk_component(listbox) yview moveto 0 - } - bottom { - $itk_component(listbox) yview moveto 1 - } - default { - error "bad justify argument \"$direction\": should\ - be left, right, top, or bottom" - } - } -} - -# ------------------------------------------------------------------ -# METHOD: sort mode -# -# Sort the current list in either "ascending/increasing" or -# "descending/decreasing" order. -# ------------------------------------------------------------------ -body iwidgets::Scrolledlistbox::sort {{mode ascending}} { - switch $mode { - ascending - - increasing { - set vals [$itk_component(listbox) get 0 end] - if {[llength $vals] != 0} { - $itk_component(listbox) delete 0 end - eval $itk_component(listbox) insert end \ - [lsort -increasing $vals] - } - } - descending - - decreasing { - set vals [$itk_component(listbox) get 0 end] - if {[llength $vals] != 0} { - $itk_component(listbox) delete 0 end - eval $itk_component(listbox) insert end \ - [lsort -decreasing $vals] - } - } - default { - error "bad sort argument \"$mode\": should be\ - ascending, descending, increasing, or decreasing" - } - } -} - -# ------------------------------------------------------------------ -# METHOD: xview args -# -# Change or query the vertical position of the text in the list box. -# ------------------------------------------------------------------ -body iwidgets::Scrolledlistbox::xview {args} { - return [eval $itk_component(listbox) xview $args] -} - -# ------------------------------------------------------------------ -# METHOD: yview args -# -# Change or query the horizontal position of the text in the list box. -# ------------------------------------------------------------------ -body iwidgets::Scrolledlistbox::yview {args} { - return [eval $itk_component(listbox) 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. -# ------------------------------------------------------------------ -body iwidgets::Scrolledlistbox::_makeSelection {} { - uplevel #0 $itk_option(-selectioncommand) -} - -# ------------------------------------------------------------------ -# PROTECTED METHOD: _dblclick -# -# Evaluate the double click command option if not empty. -# ------------------------------------------------------------------ -body iwidgets::Scrolledlistbox::_dblclick {} { - uplevel #0 $itk_option(-dblclickcommand) -} - diff --git a/itcl/iwidgets3.0.0/generic/scrolledtext.itk b/itcl/iwidgets3.0.0/generic/scrolledtext.itk deleted file mode 100644 index 86fc7f362d4..00000000000 --- a/itcl/iwidgets3.0.0/generic/scrolledtext.itk +++ /dev/null @@ -1,503 +0,0 @@ -# -# Scrolledtext -# ---------------------------------------------------------------------- -# Implements a scrolled text widget with additional options to manage -# the vertical scrollbar. This includes options to control the method -# in which the scrollbar is displayed, i.e. statically or dynamically. -# Options also exist for adding a label to the scrolled text area and -# controlling its position. Import/export of methods are provided for -# file I/O. -# -# ---------------------------------------------------------------------- -# AUTHOR: Mark L. Ulferts EMAIL: mulferts@austin.dsccc.com -# -# @(#) $Id$ -# ---------------------------------------------------------------------- -# Copyright (c) 1995 DSC Technologies Corporation -# ====================================================================== -# Permission to use, copy, modify, distribute and license this software -# and its documentation for any purpose, and without fee or written -# agreement with DSC, is hereby granted, provided that the above copyright -# notice appears in all copies and that both the copyright notice and -# warranty disclaimer below appear in supporting documentation, and that -# the names of DSC Technologies Corporation or DSC Communications -# Corporation not be used in advertising or publicity pertaining to the -# software without specific, written prior permission. -# -# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING -# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- -# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE -# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, -# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL -# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR -# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, -# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, -# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS -# SOFTWARE. -# ====================================================================== - -# -# Usual options. -# -itk::usual Scrolledtext { - keep -activebackground -activerelief -background -borderwidth -cursor \ - -elementborderwidth -foreground -highlightcolor -highlightthickness \ - -insertbackground -insertborderwidth -insertofftime -insertontime \ - -insertwidth -jump -labelfont -selectbackground -selectborderwidth \ - -selectforeground -textbackground -textfont -troughcolor -} - -# -# The default case is to have no label, so we set the default spacings -# to reflect this... -# - -option add *Scrolledtext.labelMargin 0 widgetDefault -option add *Scrolledtext.labelFont \ - "-Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*" widgetDefault -option add *Scrolledtext.labelPos n widgetDefault -option add *Scrolledtext.labelBorderWidth 0 widgetDefault -option add *Scrolledtext.labelRelief groove widgetDefault - -# ------------------------------------------------------------------ -# SCROLLEDTEXT -# ------------------------------------------------------------------ -class iwidgets::Scrolledtext { - inherit iwidgets::Scrolledwidget - - constructor {args} {} - destructor {} - - itk_option define -width width Width 0 - itk_option define -height height Height 0 - itk_option define -visibleitems visibleItems VisibleItems 80x24 - - public method bbox {index} - public method clear {} - public method import {filename {index end}} - public method export {filename} - public method compare {index1 op index2} - public method debug {args} - 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} - public method scan {option args} - public method search {args} - public method see {index} - public method tag {option args} - public method window {option args} - public method xview {args} - public method yview {args} -} - -# -# Provide a lowercased access method for the Scrolledtext class. -# -proc ::iwidgets::scrolledtext {pathName args} { - uplevel ::iwidgets::Scrolledtext $pathName $args -} - -# -# Use option database to override default resources of base classes. -# -option add *Scrolledtext.labelPos n widgetDefault - -# ------------------------------------------------------------------ -# CONSTRUCTOR -# ------------------------------------------------------------------ -body iwidgets::Scrolledtext::constructor {args} { - # - # Our -width and -height options are slightly different than - # those implemented by our base class, so we're going to - # remove them and redefine our own. - # - itk_option remove iwidgets::Scrolledwidget::width - itk_option remove iwidgets::Scrolledwidget::height - - # - # Create a clipping frame which will provide the border for - # relief display. - # - itk_component add clipper { - frame $itk_interior.clipper - } { - usual - - keep -borderwidth -relief -highlightthickness -highlightcolor - rename -highlightbackground -background background Background - } - grid $itk_component(clipper) -row 1 -column 1 -sticky nsew - grid rowconfigure $_interior 1 -weight 1 - grid columnconfigure $_interior 1 -weight 1 - - # - # Create the text area. - # - itk_component add text { - text $itk_component(clipper).text \ - -width 1 -height 1 \ - -xscrollcommand \ - [code $this _scrollWidget $itk_interior.horizsb] \ - -yscrollcommand \ - [code $this _scrollWidget $itk_interior.vertsb] \ - -borderwidth 0 -highlightthickness 0 - } { - usual - - ignore -highlightthickness -highlightcolor -borderwidth - - keep -exportselection -padx -pady -setgrid \ - -spacing1 -spacing2 -spacing3 -state -wrap - - rename -font -textfont textFont Font - rename -background -textbackground textBackground Background - } - grid $itk_component(text) -row 0 -column 0 -sticky nsew - grid rowconfigure $itk_component(clipper) 0 -weight 1 - grid columnconfigure $itk_component(clipper) 0 -weight 1 - - # - # Configure the command on the vertical scroll bar in the base class. - # - $itk_component(vertsb) configure \ - -command [code $itk_component(text) yview] - - # - # Configure the command on the horizontal scroll bar in the base class. - # - $itk_component(horizsb) configure \ - -command [code $itk_component(text) xview] - - # - # Initialize the widget based on the command line options. - # - eval itk_initialize $args -} - -# ------------------------------------------------------------------ -# DESTURCTOR -# ------------------------------------------------------------------ -body iwidgets::Scrolledtext::destructor {} { -} - -# ------------------------------------------------------------------ -# OPTIONS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# OPTION: -width -# -# Specifies the width of the scrolled text as an entire unit. -# The value may be specified in any of the forms acceptable to -# Tk_GetPixels. Any additional space needed to display the other -# components such as labels, margins, and scrollbars force the text -# to be compressed. A value of zero along with the same value for -# the height causes the value given for the visibleitems option -# to be applied which administers geometry constraints in a different -# manner. -# ------------------------------------------------------------------ -configbody iwidgets::Scrolledtext::width { - if {$itk_option(-width) != 0} { - set shell [lindex [grid info $itk_component(clipper)] 1] - - # - # Due to a bug in the tk4.2 grid, we have to check the - # propagation before setting it. Setting it to the same - # value it already is will cause it to toggle. - # - if {[grid propagate $shell]} { - grid propagate $shell no - } - - $itk_component(text) configure -width 1 - $shell configure \ - -width [winfo pixels $shell $itk_option(-width)] - } else { - configure -visibleitems $itk_option(-visibleitems) - } -} - -# ------------------------------------------------------------------ -# OPTION: -height -# -# Specifies the height of the scrolled text as an entire unit. -# The value may be specified in any of the forms acceptable to -# Tk_GetPixels. Any additional space needed to display the other -# components such as labels, margins, and scrollbars force the text -# to be compressed. A value of zero along with the same value for -# the width causes the value given for the visibleitems option -# to be applied which administers geometry constraints in a different -# manner. -# ------------------------------------------------------------------ -configbody iwidgets::Scrolledtext::height { - if {$itk_option(-height) != 0} { - set shell [lindex [grid info $itk_component(clipper)] 1] - - # - # Due to a bug in the tk4.2 grid, we have to check the - # propagation before setting it. Setting it to the same - # value it already is will cause it to toggle. - # - if {[grid propagate $shell]} { - grid propagate $shell no - } - - $itk_component(text) configure -height 1 - $shell configure \ - -height [winfo pixels $shell $itk_option(-height)] - } else { - configure -visibleitems $itk_option(-visibleitems) - } -} - -# ------------------------------------------------------------------ -# OPTION: -visibleitems -# -# Specified the widthxheight in characters and lines for the text. -# This option is only administered if the width and height options -# are both set to zero, otherwise they take precedence. With the -# visibleitems option engaged, geometry constraints are maintained -# only on the text. The size of the other components such as -# labels, margins, and scroll bars, are additive and independent, -# effecting the overall size of the scrolled text. In contrast, -# should the width and height options have non zero values, they -# are applied to the scrolled text as a whole. The text is -# compressed or expanded to maintain the geometry constraints. -# ------------------------------------------------------------------ -configbody iwidgets::Scrolledtext::visibleitems { - if {[regexp {^[0-9]+x[0-9]+$} $itk_option(-visibleitems)]} { - if {($itk_option(-width) == 0) && \ - ($itk_option(-height) == 0)} { - set chars [lindex [split $itk_option(-visibleitems) x] 0] - set lines [lindex [split $itk_option(-visibleitems) x] 1] - - set shell [lindex [grid info $itk_component(clipper)] 1] - - # - # Due to a bug in the tk4.2 grid, we have to check the - # propagation before setting it. Setting it to the same - # value it already is will cause it to toggle. - # - if {! [grid propagate $shell]} { - grid propagate $shell yes - } - - $itk_component(text) configure -width $chars -height $lines - } - - } else { - error "bad visibleitems option\ - \"$itk_option(-visibleitems)\": should be\ - widthxheight" - } -} - -# ------------------------------------------------------------------ -# METHODS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# METHOD: bbox index -# -# Returns four element list describing the bounding box for the list -# item at index -# ------------------------------------------------------------------ -body iwidgets::Scrolledtext::bbox {index} { - return [$itk_component(text) bbox $index] -} - -# ------------------------------------------------------------------ -# METHOD clear -# -# Clear the text area. -# ------------------------------------------------------------------ -body iwidgets::Scrolledtext::clear {} { - $itk_component(text) delete 1.0 end -} - -# ------------------------------------------------------------------ -# METHOD import filename -# -# Load text from an existing file (import filename) -# ------------------------------------------------------------------ -body iwidgets::Scrolledtext::import {filename {index end}} { - set f [open $filename r] - insert $index [read $f] - close $f -} - -# ------------------------------------------------------------------ -# METHOD export filename -# -# write text to a file (export filename) -# ------------------------------------------------------------------ -body iwidgets::Scrolledtext::export {filename} { - set f [open $filename w] - - set txt [$itk_component(text) get 1.0 end] - puts $f $txt - - flush $f - close $f -} - -# ------------------------------------------------------------------ -# METHOD compare index1 op index2 -# -# Compare indices according to relational operator. -# ------------------------------------------------------------------ -body iwidgets::Scrolledtext::compare {index1 op index2} { - return [$itk_component(text) compare $index1 $op $index2] -} - -# ------------------------------------------------------------------ -# METHOD debug ?boolean? -# -# Activates consistency checks in B-tree code associated with text -# widgets. -# ------------------------------------------------------------------ -body iwidgets::Scrolledtext::debug {args} { - eval $itk_component(text) debug $args -} - -# ------------------------------------------------------------------ -# METHOD delete first ?last? -# -# Delete a range of characters from the text. -# ------------------------------------------------------------------ -body iwidgets::Scrolledtext::delete {first {last {}}} { - $itk_component(text) delete $first $last -} - -# ------------------------------------------------------------------ -# METHOD dlineinfo index -# -# Returns a five element list describing the area occupied by the -# display line containing index. -# ------------------------------------------------------------------ -body iwidgets::Scrolledtext::dlineinfo {index} { - return [$itk_component(text) dlineinfo $index] -} - -# ------------------------------------------------------------------ -# METHOD get index1 ?index2? -# -# Return text from start index to end index. -# ------------------------------------------------------------------ -body iwidgets::Scrolledtext::get {index1 {index2 {}}} { - return [$itk_component(text) 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. -# ------------------------------------------------------------------ -body iwidgets::Scrolledtext::index {index} { - return [$itk_component(text) index $index] -} - -# ------------------------------------------------------------------ -# METHOD insert index chars ?tagList? -# -# Insert text at index. -# ------------------------------------------------------------------ -body iwidgets::Scrolledtext::insert {args} { - eval $itk_component(text) insert $args -} - -# ------------------------------------------------------------------ -# METHOD mark option ?arg arg ...? -# -# Manipulate marks dependent on options. -# ------------------------------------------------------------------ -body iwidgets::Scrolledtext::mark {option args} { - return [eval $itk_component(text) mark $option $args] -} - -# ------------------------------------------------------------------ -# METHOD scan option args -# -# Implements scanning on texts. -# ------------------------------------------------------------------ -body iwidgets::Scrolledtext::scan {option args} { - eval $itk_component(text) scan $option $args -} - -# ------------------------------------------------------------------ -# METHOD search ?switches? pattern index ?varName? -# -# Searches the text for characters matching a pattern. -# ------------------------------------------------------------------ -body iwidgets::Scrolledtext::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] -} - -# ------------------------------------------------------------------ -# METHOD see index -# -# Adjusts the view in the window so the character at index is -# visible. -# ------------------------------------------------------------------ -body iwidgets::Scrolledtext::see {index} { - $itk_component(text) see $index -} - -# ------------------------------------------------------------------ -# METHOD tag option ?arg arg ...? -# -# Manipulate tags dependent on options. -# ------------------------------------------------------------------ -body iwidgets::Scrolledtext::tag {option args} { - return [eval $itk_component(text) tag $option $args] -} - -# ------------------------------------------------------------------ -# METHOD window option ?arg arg ...? -# -# Manipulate embedded windows. -# ------------------------------------------------------------------ -body iwidgets::Scrolledtext::window {option args} { - return [eval $itk_component(text) window $option $args] -} - -# ------------------------------------------------------------------ -# METHOD xview -# -# Changes x view in widget's window. -# ------------------------------------------------------------------ -body iwidgets::Scrolledtext::xview {args} { - return [eval $itk_component(text) xview $args] -} - -# ------------------------------------------------------------------ -# METHOD yview -# -# Changes y view in widget's window. -# ------------------------------------------------------------------ -body iwidgets::Scrolledtext::yview {args} { - return [eval $itk_component(text) yview $args] -} - diff --git a/itcl/iwidgets3.0.0/generic/scrolledwidget.itk b/itcl/iwidgets3.0.0/generic/scrolledwidget.itk deleted file mode 100644 index 7b685436cfe..00000000000 --- a/itcl/iwidgets3.0.0/generic/scrolledwidget.itk +++ /dev/null @@ -1,434 +0,0 @@ -# -# Scrolledwidget -# ---------------------------------------------------------------------- -# Implements a general purpose base class for scrolled widgets, by -# creating the necessary horizontal and vertical scrollbars and -# providing protected methods for controlling their display. The -# derived class needs to take advantage of the fact that the grid -# is used and the vertical scrollbar is in row 0, column 2 and the -# horizontal scrollbar in row 2, column 0. -# -# ---------------------------------------------------------------------- -# AUTHOR: Mark Ulferts mulferts@austin.dsccc.com -# -# @(#) $Id$ -# ---------------------------------------------------------------------- -# Copyright (c) 1997 DSC Technologies Corporation -# ====================================================================== -# Permission to use, copy, modify, distribute and license this software -# and its documentation for any purpose, and without fee or written -# agreement with DSC, is hereby granted, provided that the above copyright -# notice appears in all copies and that both the copyright notice and -# warranty disclaimer below appear in supporting documentation, and that -# the names of DSC Technologies Corporation or DSC Communications -# Corporation not be used in advertising or publicity pertaining to the -# software without specific, written prior permission. -# -# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING -# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- -# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE -# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, -# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL -# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR -# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, -# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, -# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS -# SOFTWARE. -# ====================================================================== - -# -# Usual options. -# -itk::usual Scrolledwidget { - keep -background -borderwidth -cursor -highlightcolor -highlightthickness - keep -activebackground -activerelief -jump -troughcolor - keep -labelfont -foreground -} - -# ------------------------------------------------------------------ -# SCROLLEDWIDGET -# ------------------------------------------------------------------ -class iwidgets::Scrolledwidget { - inherit iwidgets::Labeledframe - - constructor {args} {} - destructor {} - method childsite {} - - itk_option define -childsitepos childSitePos Position e - itk_option define -sbwidth sbWidth Width "" - itk_option define -scrollmargin scrollMargin ScrollMargin 3 - itk_option define -vscrollmode vscrollMode VScrollMode static - itk_option define -hscrollmode hscrollMode HScrollMode static - itk_option define -width width Width 30 - itk_option define -height height Height 30 - - protected { - method _scrollWidget {wid first last} - method _vertScrollbarDisplay {mode} - method _horizScrollbarDisplay {mode} - method _configureEvent {} - - variable _vmode off ;# Vertical scroll mode - variable _hmode off ;# Vertical scroll mode - variable _recheckHoriz 1 ;# Flag to check need for - ;# horizontal scrollbar - variable _recheckVert 1 ;# Flag to check need for - ;# vertical scrollbar - - variable _interior {} - } -} - -# -# Provide a lowercased access method for the Scrolledwidget class. -# -proc ::iwidgets::scrolledwidget {pathName args} { - uplevel ::iwidgets::Scrolledwidget $pathName $args -} - -# -# Use option database to override default resources of base classes. -# -option add *Scrolledwidget.labelPos n widgetDefault - -# ------------------------------------------------------------------ -# CONSTRUCTOR -# ------------------------------------------------------------------ -body iwidgets::Scrolledwidget::constructor {args} { - - # - # Turn off the borderwidth on the hull and save off the - # interior for later use. - # - component hull configure -borderwidth 0 - set _interior [iwidgets::Labeledframe::childsite] - set itk_interior $_interior - - # - # Check if the scrollbars need mapping upon a configure event. - # - bind $_interior <Configure> [code $this _configureEvent] - - # - # Turn off propagation in the containing shell. - # - # Due to a bug in the tk4.2 grid, we have to check the - # propagation before setting it. Setting it to the same - # value it already is will cause it to toggle. - # - if {[grid propagate $_interior]} { - grid propagate $_interior no - } - - # - # Create the vertical scroll bar - # - itk_component add vertsb { - scrollbar $_interior.vertsb -orient vertical - } { - usual - keep -elementborderwidth -jump - rename -highlightbackground -background background Background - } - - # - # Create the horizontal scrollbar - # - itk_component add horizsb { - scrollbar $_interior.horizsb -orient horizontal - } { - usual - keep -elementborderwidth -jump - rename -highlightbackground -background background Background - } - - # - # Create the childsite frame - # - itk_component add swchildsite { - frame $_interior.cs - } - - # - # Initialize the widget based on the command line options. - # - eval itk_initialize $args -} - -# ------------------------------------------------------------------ -# DESTURCTOR -# ------------------------------------------------------------------ -body iwidgets::Scrolledwidget::destructor {} { -} - -# ------------------------------------------------------------------ -# OPTIONS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# OPTION: -sbwidth -# -# Set the width of the scrollbars. -# ------------------------------------------------------------------ -configbody iwidgets::Scrolledwidget::sbwidth { - if {$itk_option(-sbwidth) != ""} { - $itk_component(vertsb) configure -width $itk_option(-sbwidth) - $itk_component(horizsb) configure -width $itk_option(-sbwidth) - } -} - -# ------------------------------------------------------------------ -# OPTION: -scrollmargin -# -# Set the distance between the scrollbars and the list box. -# ------------------------------------------------------------------ -configbody iwidgets::Scrolledwidget::scrollmargin { - set pixels [winfo pixels $_interior $itk_option(-scrollmargin)] - - if {$_hmode == "on"} { - grid rowconfigure $_interior 2 -minsize $pixels - } - - if {$_vmode == "on"} { - grid columnconfigure $_interior 2 -minsize $pixels - } -} - -# ------------------------------------------------------------------ -# OPTION: -vscrollmode -# -# Enable/disable display and mode of veritcal scrollbars. -# ------------------------------------------------------------------ -configbody iwidgets::Scrolledwidget::vscrollmode { - switch $itk_option(-vscrollmode) { - static { - _vertScrollbarDisplay on - } - - dynamic - - none { - _vertScrollbarDisplay off - } - - default { - error "bad vscrollmode option\ - \"$itk_option(-vscrollmode)\": should be\ - static, dynamic, or none" - } - } -} - -# ------------------------------------------------------------------ -# OPTION: -hscrollmode -# -# Enable/disable display and mode of horizontal scrollbars. -# ------------------------------------------------------------------ -configbody iwidgets::Scrolledwidget::hscrollmode { - switch $itk_option(-hscrollmode) { - static { - _horizScrollbarDisplay on - } - - dynamic - - none { - _horizScrollbarDisplay off - } - - default { - error "bad hscrollmode option\ - \"$itk_option(-hscrollmode)\": should be\ - static, dynamic, or none" - } - } -} - -# ------------------------------------------------------------------ -# OPTION: -width -# -# Specifies the width of the scrolled widget. The value may be -# specified in any of the forms acceptable to Tk_GetPixels. -# ------------------------------------------------------------------ -configbody iwidgets::Scrolledwidget::width { - $_interior configure -width \ - [winfo pixels $_interior $itk_option(-width)] -} - -# ------------------------------------------------------------------ -# OPTION: -height -# -# Specifies the height of the scrolled widget. The value may be -# specified in any of the forms acceptable to Tk_GetPixels. -# ------------------------------------------------------------------ -configbody iwidgets::Scrolledwidget::height { - $_interior configure -height \ - [winfo pixels $_interior $itk_option(-height)] -} - -# ------------------------------------------------------------------ -# OPTION: -childsitepos -# -# Specifies the position of the child site in the widget. -# ------------------------------------------------------------------ -configbody iwidgets::Scrolledwidget::childsitepos { - - # First reset all the other child sites to weight 0 so - # they do not take any of the space... - - switch $itk_option(-childsitepos) { - n { - grid $itk_component(swchildsite) -row 0 -column 1 -columnspan 3 -sticky nsew - } - - s { - grid $itk_component(swchildsite) -row 4 -column 1 -columnspan 3 -sticky nsew - } - - e { - grid $itk_component(swchildsite) -row 1 -column 4 -rowspan 3 -sticky nsew - } - - w { - grid $itk_component(swchildsite) -row 1 -column 0 -rowspan 3 -sticky nsew - } - - default { - error "bad childsite option\ - \"$itk_option(-childsitepos)\":\ - should be n, e, s, or w" - } - } -} - -# ------------------------------------------------------------------ -# METHODS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# METHOD: childsite -# -# Returns the path name of the child site widget. -# ------------------------------------------------------------------ -body iwidgets::Scrolledwidget::childsite {} { - return $itk_component(swchildsite) -} - -# ------------------------------------------------------------------ -# PROTECTED METHOD: _vertScrollbarDisplay mode -# -# Displays the vertical scrollbar based on the input mode. -# ------------------------------------------------------------------ -body iwidgets::Scrolledwidget::_vertScrollbarDisplay {mode} { - switch $mode { - on { - set _vmode on - - grid columnconfigure $_interior 2 -minsize \ - [winfo pixels $_interior $itk_option(-scrollmargin)] - grid $itk_component(vertsb) -row 1 -column 3 -sticky ns - } - - off { - set _vmode off - - grid columnconfigure $_interior 2 -minsize 0 - grid forget $itk_component(vertsb) - } - - default { - error "invalid argument \"$mode\": should be on or off" - } - } -} - -# ------------------------------------------------------------------ -# PROTECTED METHOD: _horizScrollbarDisplay mode -# -# Displays the horizontal scrollbar based on the input mode. -# ------------------------------------------------------------------ -body iwidgets::Scrolledwidget::_horizScrollbarDisplay {mode} { - switch $mode { - on { - set _hmode on - - grid rowconfigure $_interior 2 -minsize \ - [winfo pixels $_interior $itk_option(-scrollmargin)] - grid $itk_component(horizsb) -row 3 -column 1 -sticky ew - } - - off { - set _hmode off - - grid rowconfigure $_interior 2 -minsize 0 - grid forget $itk_component(horizsb) - } - - default { - error "invalid argument \"$mode\": should be on or off" - } - } -} - -# ------------------------------------------------------------------ -# PROTECTED METHOD: _scrollWidget wid first last -# -# Performs scrolling and display of scrollbars based on the total -# and maximum frame size as well as the current -vscrollmode and -# -hscrollmode settings. Parameters are automatic scroll parameters. -# ------------------------------------------------------------------ -body iwidgets::Scrolledwidget::_scrollWidget {wid first last} { - $wid set $first $last - - if {$wid == $itk_component(vertsb)} { - if {$itk_option(-vscrollmode) == "dynamic"} { - if {($_recheckVert != 1) && ($_vmode == "on")} { - return - } else { - set _recheckVert 0 - } - - if {($first == 0) && ($last == 1)} { - if {$_vmode != "off"} { - _vertScrollbarDisplay off - } - - } else { - if {$_vmode != "on"} { - _vertScrollbarDisplay on - } - } - } - - } elseif {$wid == $itk_component(horizsb)} { - if {$itk_option(-hscrollmode) == "dynamic"} { - if {($_recheckHoriz != 1) && ($_hmode == "on")} { - return - } else { - set _recheckHoriz 0 - } - - if {($first == 0) && ($last == 1)} { - if {$_hmode != "off"} { - _horizScrollbarDisplay off - } - - } else { - if {$_hmode != "on"} { - _horizScrollbarDisplay on - } - } - } - } -} - -# ------------------------------------------------------------------ -# PROTECTED METHOD: _configureEvent -# -# Resets the recheck flags which determine if we'll try and map -# the scrollbars in dynamic mode. -# ------------------------------------------------------------------ -body iwidgets::Scrolledwidget::_configureEvent {} { - update idletasks - set _recheckVert 1 - set _recheckHoriz 1 -} diff --git a/itcl/iwidgets3.0.0/generic/selectionbox.itk b/itcl/iwidgets3.0.0/generic/selectionbox.itk deleted file mode 100644 index 4e6d1fe5c4f..00000000000 --- a/itcl/iwidgets3.0.0/generic/selectionbox.itk +++ /dev/null @@ -1,560 +0,0 @@ -# -# Selectionbox -# ---------------------------------------------------------------------- -# Implements a selection box composed of a scrolled list of items and -# a selection entry field. The user may choose any of the items displayed -# in the scrolled list of alternatives and the selection field will be -# filled with the choice. The user is also free to enter a new value in -# the selection entry field. Both the list and entry areas have labels. -# A child site is also provided in which the user may create other widgets -# to be used in conjunction with the selection box. -# -# ---------------------------------------------------------------------- -# AUTHOR: Mark L. Ulferts EMAIL: mulferts@austin.dsccc.com -# -# @(#) $Id$ -# ---------------------------------------------------------------------- -# Copyright (c) 1995 DSC Technologies Corporation -# ====================================================================== -# Permission to use, copy, modify, distribute and license this software -# and its documentation for any purpose, and without fee or written -# agreement with DSC, is hereby granted, provided that the above copyright -# notice appears in all copies and that both the copyright notice and -# warranty disclaimer below appear in supporting documentation, and that -# the names of DSC Technologies Corporation or DSC Communications -# Corporation not be used in advertising or publicity pertaining to the -# software without specific, written prior permission. -# -# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING -# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- -# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE -# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, -# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL -# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR -# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, -# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, -# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS -# SOFTWARE. -# ====================================================================== - -# -# Usual options. -# -itk::usual Selectionbox { - keep -activebackground -activerelief -background -borderwidth -cursor \ - -elementborderwidth -foreground -highlightcolor -highlightthickness \ - -insertbackground -insertborderwidth -insertofftime -insertontime \ - -insertwidth -jump -labelfont -selectbackground -selectborderwidth \ - -selectforeground -textbackground -textfont -troughcolor -} - -# ------------------------------------------------------------------ -# SELECTIONBOX -# ------------------------------------------------------------------ -class iwidgets::Selectionbox { - inherit itk::Widget - - constructor {args} {} - destructor {} - - itk_option define -childsitepos childSitePos Position center - itk_option define -margin margin Margin 7 - itk_option define -itemson itemsOn ItemsOn true - itk_option define -selectionon selectionOn SelectionOn true - itk_option define -width width Width 260 - itk_option define -height height Height 320 - - public method childsite {} - public method get {} - public method curselection {} - public method clear {component} - public method insert {component index args} - public method delete {first {last {}}} - public method size {} - public method scan {option args} - public method nearest {y} - public method index {index} - public method selection {option args} - public method selectitem {} - - private method _packComponents {{when later}} - - private variable _repacking {} ;# non-null => _packComponents pending -} - -# -# Provide a lowercased access method for the Selectionbox class. -# -proc ::iwidgets::selectionbox {pathName args} { - uplevel ::iwidgets::Selectionbox $pathName $args -} - -# -# Use option database to override default resources of base classes. -# -option add *Selectionbox.itemsLabel Items widgetDefault -option add *Selectionbox.selectionLabel Selection widgetDefault -option add *Selectionbox.width 260 widgetDefault -option add *Selectionbox.height 320 widgetDefault - -# ------------------------------------------------------------------ -# CONSTRUCTOR -# ------------------------------------------------------------------ -body iwidgets::Selectionbox::constructor {args} { - # - # Set the borderwidth to zero and add width and height options - # back to the hull. - # - component hull configure -borderwidth 0 - itk_option add hull.width hull.height - - # - # Create the child site widget. - # - itk_component add -protected sbchildsite { - frame $itk_interior.sbchildsite - } - - # - # Create the items list. - # - itk_component add items { - iwidgets::Scrolledlistbox $itk_interior.items -selectmode single \ - -visibleitems 20x10 -labelpos nw -vscrollmode static \ - -hscrollmode none - } { - usual - keep -dblclickcommand -exportselection - - rename -labeltext -itemslabel itemsLabel Text - rename -selectioncommand -itemscommand itemsCommand Command - } - configure -itemscommand [code $this selectitem] - - # - # Create the selection entry. - # - itk_component add selection { - iwidgets::Entryfield $itk_interior.selection -labelpos nw - } { - usual - - keep -exportselection - - rename -labeltext -selectionlabel selectionLabel Text - rename -command -selectioncommand selectionCommand Command - } - - # - # Set the interior to the childsite for derived classes. - # - set itk_interior $itk_component(sbchildsite) - - # - # Initialize the widget based on the command line options. - # - eval itk_initialize $args - - # - # When idle, pack the components. - # - _packComponents -} - -# ------------------------------------------------------------------ -# DESTRUCTOR -# ------------------------------------------------------------------ -body iwidgets::Selectionbox::destructor {} { - if {$_repacking != ""} {after cancel $_repacking} -} - -# ------------------------------------------------------------------ -# OPTIONS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# OPTION: -childsitepos -# -# Specifies the position of the child site in the selection box. -# ------------------------------------------------------------------ -configbody iwidgets::Selectionbox::childsitepos { - _packComponents -} - -# ------------------------------------------------------------------ -# OPTION: -margin -# -# Specifies distance between the items list and selection entry. -# ------------------------------------------------------------------ -configbody iwidgets::Selectionbox::margin { - _packComponents -} - -# ------------------------------------------------------------------ -# OPTION: -itemson -# -# Specifies whether or not to display the items list. -# ------------------------------------------------------------------ -configbody iwidgets::Selectionbox::itemson { - _packComponents -} - -# ------------------------------------------------------------------ -# OPTION: -selectionon -# -# Specifies whether or not to display the selection entry widget. -# ------------------------------------------------------------------ -configbody iwidgets::Selectionbox::selectionon { - _packComponents -} - -# ------------------------------------------------------------------ -# OPTION: -width -# -# Specifies the width of the hull. The value may be specified in -# any of the forms acceptable to Tk_GetPixels. A value of zero -# causes the width to be adjusted to the required value based on -# the size requests of the components. Otherwise, the width is -# fixed. -# ------------------------------------------------------------------ -configbody iwidgets::Selectionbox::width { - # - # The width option was added to the hull in the constructor. - # So, any width value given is passed automatically to the - # hull. All we have to do is play with the propagation. - # - if {$itk_option(-width) != 0} { - set propagate 0 - } else { - set propagate 1 - } - - # - # Due to a bug in the tk4.2 grid, we have to check the - # propagation before setting it. Setting it to the same - # value it already is will cause it to toggle. - # - if {[grid propagate $itk_component(hull)] != $propagate} { - grid propagate $itk_component(hull) $propagate - } -} - -# ------------------------------------------------------------------ -# OPTION: -height -# -# Specifies the height of the hull. The value may be specified in -# any of the forms acceptable to Tk_GetPixels. A value of zero -# causes the height to be adjusted to the required value based on -# the size requests of the components. Otherwise, the height is -# fixed. -# ------------------------------------------------------------------ -configbody iwidgets::Selectionbox::height { - # - # The height option was added to the hull in the constructor. - # So, any height value given is passed automatically to the - # hull. All we have to do is play with the propagation. - # - if {$itk_option(-height) != 0} { - set propagate 0 - } else { - set propagate 1 - } - - # - # Due to a bug in the tk4.2 grid, we have to check the - # propagation before setting it. Setting it to the same - # value it already is will cause it to toggle. - # - if {[grid propagate $itk_component(hull)] != $propagate} { - grid propagate $itk_component(hull) $propagate - } -} - -# ------------------------------------------------------------------ -# METHODS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# METHOD: childsite -# -# Returns the path name of the child site widget. -# ------------------------------------------------------------------ -body iwidgets::Selectionbox::childsite {} { - return $itk_component(sbchildsite) -} - -# ------------------------------------------------------------------ -# METHOD: get -# -# Returns the current selection. -# ------------------------------------------------------------------ -body iwidgets::Selectionbox::get {} { - return [$itk_component(selection) get] -} - -# ------------------------------------------------------------------ -# METHOD: curselection -# -# Returns the current selection index. -# ------------------------------------------------------------------ -body iwidgets::Selectionbox::curselection {} { - return [$itk_component(items) curselection] -} - -# ------------------------------------------------------------------ -# METHOD: clear component -# -# Delete the contents of either the selection entry widget or items -# list. -# ------------------------------------------------------------------ -body iwidgets::Selectionbox::clear {component} { - switch $component { - selection { - $itk_component(selection) clear - } - - items { - delete 0 end - } - - default { - error "bad clear argument \"$component\": should be\ - selection or items" - } - } -} - -# ------------------------------------------------------------------ -# METHOD: insert component index args -# -# Insert element(s) into either the selection or items list widget. -# ------------------------------------------------------------------ -body iwidgets::Selectionbox::insert {component index args} { - switch $component { - selection { - eval $itk_component(selection) insert $index $args - } - - items { - eval $itk_component(items) insert $index $args - } - - default { - error "bad insert argument \"$component\": should be\ - selection or items" - } - } -} - -# ------------------------------------------------------------------ -# METHOD: delete first ?last? -# -# Delete one or more elements from the items list box. The default -# is to delete by indexed range. If an item is to be removed by name, -# it must be preceeded by the keyword "item". Only index numbers can -# be used to delete a range of items. -# ------------------------------------------------------------------ -body iwidgets::Selectionbox::delete {first {last {}}} { - set first [index $first] - - if {$last != {}} { - set last [index $last] - } else { - set last $first - } - - if {$first <= $last} { - eval $itk_component(items) delete $first $last - } else { - error "first index must not be greater than second" - } -} - -# ------------------------------------------------------------------ -# METHOD: size -# -# Returns a decimal string indicating the total number of elements -# in the items list. -# ------------------------------------------------------------------ -body iwidgets::Selectionbox::size {} { - return [$itk_component(items) size] -} - -# ------------------------------------------------------------------ -# METHOD: scan option args -# -# Implements scanning on items list. -# ------------------------------------------------------------------ -body iwidgets::Selectionbox::scan {option args} { - eval $itk_component(items) scan $option $args -} - -# ------------------------------------------------------------------ -# METHOD: nearest y -# -# Returns the index to the nearest listbox item given a y coordinate. -# ------------------------------------------------------------------ -body iwidgets::Selectionbox::nearest {y} { - return [$itk_component(items) nearest $y] -} - -# ------------------------------------------------------------------ -# METHOD: index index -# -# Returns the decimal string giving the integer index corresponding -# to index. -# ------------------------------------------------------------------ -body iwidgets::Selectionbox::index {index} { - return [$itk_component(items) index $index] -} - -# ------------------------------------------------------------------ -# METHOD: selection option args -# -# Adjusts the selection within the items list. -# ------------------------------------------------------------------ -body iwidgets::Selectionbox::selection {option args} { - eval $itk_component(items) selection $option $args - - selectitem -} - -# ------------------------------------------------------------------ -# METHOD: selectitem -# -# Replace the selection entry field contents with the currently -# selected items value. -# ------------------------------------------------------------------ -body iwidgets::Selectionbox::selectitem {} { - $itk_component(selection) clear - set numSelected [$itk_component(items) selecteditemcount] - - if {$numSelected == 1} { - $itk_component(selection) insert end \ - [$itk_component(items) getcurselection] - } elseif {$numSelected > 1} { - $itk_component(selection) insert end \ - [lindex [$itk_component(items) getcurselection] 0] - } - - $itk_component(selection) icursor end -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _packComponents ?when? -# -# Pack the selection, items, and child site widgets based on options. -# If "when" is "now", the change is applied immediately. If it is -# "later" or it is not specified, then the change is applied later, -# when the application is idle. -# ------------------------------------------------------------------ -body iwidgets::Selectionbox::_packComponents {{when later}} { - if {$when == "later"} { - if {$_repacking == ""} { - set _repacking [after idle [code $this _packComponents now]] - } - return - } elseif {$when != "now"} { - error "bad option \"$when\": should be now or later" - } - - set _repacking "" - - set parent [winfo parent $itk_component(sbchildsite)] - set margin [winfo pixels $itk_component(hull) $itk_option(-margin)] - - switch $itk_option(-childsitepos) { - n { - grid $itk_component(sbchildsite) -row 0 -column 0 \ - -sticky nsew -rowspan 1 - grid $itk_component(items) -row 1 -column 0 -sticky nsew - grid $itk_component(selection) -row 3 -column 0 -sticky ew - - grid rowconfigure $parent 0 -weight 0 -minsize 0 - grid rowconfigure $parent 1 -weight 1 -minsize 0 - grid rowconfigure $parent 2 -weight 0 -minsize $margin - grid rowconfigure $parent 3 -weight 0 -minsize 0 - - grid columnconfigure $parent 0 -weight 1 -minsize 0 - grid columnconfigure $parent 1 -weight 0 -minsize 0 - } - - w { - grid $itk_component(sbchildsite) -row 0 -column 0 \ - -sticky nsew -rowspan 3 - grid $itk_component(items) -row 0 -column 1 -sticky nsew - grid $itk_component(selection) -row 2 -column 1 -sticky ew - - grid rowconfigure $parent 0 -weight 1 -minsize 0 - grid rowconfigure $parent 1 -weight 0 -minsize $margin - grid rowconfigure $parent 2 -weight 0 -minsize 0 - grid rowconfigure $parent 3 -weight 0 -minsize 0 - - grid columnconfigure $parent 0 -weight 0 -minsize 0 - grid columnconfigure $parent 1 -weight 1 -minsize 0 - } - - s { - grid $itk_component(items) -row 0 -column 0 -sticky nsew - grid $itk_component(selection) -row 2 -column 0 -sticky ew - grid $itk_component(sbchildsite) -row 3 -column 0 \ - -sticky nsew -rowspan 1 - - grid rowconfigure $parent 0 -weight 1 -minsize 0 - grid rowconfigure $parent 1 -weight 0 -minsize $margin - grid rowconfigure $parent 2 -weight 0 -minsize 0 - grid rowconfigure $parent 3 -weight 0 -minsize 0 - - grid columnconfigure $parent 0 -weight 1 -minsize 0 - grid columnconfigure $parent 1 -weight 0 -minsize 0 - } - - e { - grid $itk_component(items) -row 0 -column 0 -sticky nsew - grid $itk_component(selection) -row 2 -column 0 -sticky ew - grid $itk_component(sbchildsite) -row 0 -column 1 \ - -sticky nsew -rowspan 3 - - grid rowconfigure $parent 0 -weight 1 -minsize 0 - grid rowconfigure $parent 1 -weight 0 -minsize $margin - grid rowconfigure $parent 2 -weight 0 -minsize 0 - grid rowconfigure $parent 3 -weight 0 -minsize 0 - - grid columnconfigure $parent 0 -weight 1 -minsize 0 - grid columnconfigure $parent 1 -weight 0 -minsize 0 - } - - center { - grid $itk_component(items) -row 0 -column 0 -sticky nsew - grid $itk_component(sbchildsite) -row 1 -column 0 \ - -sticky nsew -rowspan 1 - grid $itk_component(selection) -row 3 -column 0 -sticky ew - - grid rowconfigure $parent 0 -weight 1 -minsize 0 - grid rowconfigure $parent 1 -weight 0 -minsize 0 - grid rowconfigure $parent 2 -weight 0 -minsize $margin - grid rowconfigure $parent 3 -weight 0 -minsize 0 - - grid columnconfigure $parent 0 -weight 1 -minsize 0 - grid columnconfigure $parent 1 -weight 0 -minsize 0 - } - - default { - error "bad childsitepos option \"$itk_option(-childsitepos)\":\ - should be n, e, s, w, or center" - } - } - - if {$itk_option(-itemson)} { - } else { - grid forget $itk_component(items) - } - - if {$itk_option(-selectionon)} { - } else { - grid forget $itk_component(selection) - } - - raise $itk_component(sbchildsite) -} - diff --git a/itcl/iwidgets3.0.0/generic/selectiondialog.itk b/itcl/iwidgets3.0.0/generic/selectiondialog.itk deleted file mode 100644 index d99e801feaf..00000000000 --- a/itcl/iwidgets3.0.0/generic/selectiondialog.itk +++ /dev/null @@ -1,233 +0,0 @@ -# -# Selectiondialog -# ---------------------------------------------------------------------- -# Implements a selection box similar to the OSF/Motif standard selection -# dialog composite widget. The Selectiondialog is derived from the -# Dialog class and is composed of a SelectionBox with attributes to -# manipulate the dialog buttons. -# -# ---------------------------------------------------------------------- -# AUTHOR: Mark L. Ulferts EMAIL: mulferts@austin.dsccc.com -# -# @(#) $Id$ -# ---------------------------------------------------------------------- -# Copyright (c) 1995 DSC Technologies Corporation -# ====================================================================== -# Permission to use, copy, modify, distribute and license this software -# and its documentation for any purpose, and without fee or written -# agreement with DSC, is hereby granted, provided that the above copyright -# notice appears in all copies and that both the copyright notice and -# warranty disclaimer below appear in supporting documentation, and that -# the names of DSC Technologies Corporation or DSC Communications -# Corporation not be used in advertising or publicity pertaining to the -# software without specific, written prior permission. -# -# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING -# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- -# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE -# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, -# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL -# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR -# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, -# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, -# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS -# SOFTWARE. -# ====================================================================== - -# -# Usual options. -# -itk::usual Selectiondialog { - keep -activebackground -activerelief -background -borderwidth -cursor \ - -elementborderwidth -foreground -highlightcolor -highlightthickness \ - -insertbackground -insertborderwidth -insertofftime -insertontime \ - -insertwidth -jump -labelfont -modality -selectbackground \ - -selectborderwidth -selectforeground -textbackground -textfont \ - -troughcolor -} - -# ------------------------------------------------------------------ -# SELECTIONDIALOG -# ------------------------------------------------------------------ -class iwidgets::Selectiondialog { - inherit iwidgets::Dialog - - constructor {args} {} - - public method childsite {} - public method get {} - public method curselection {} - public method clear {component} - public method insert {component index args} - public method delete {first {last {}}} - public method size {} - public method scan {option args} - public method nearest {y} - public method index {index} - public method selection {option args} - public method selectitem {} -} - -# -# Provide a lowercased access method for the Selectiondialog class. -# -proc ::iwidgets::selectiondialog {pathName args} { - uplevel ::iwidgets::Selectiondialog $pathName $args -} - -# -# Use option database to override default resources of base classes. -# -option add *Selectiondialog.title "Selection Dialog" widgetDefault -option add *Selectiondialog.master "." widgetDefault - -# ------------------------------------------------------------------ -# CONSTRUCTOR -# ------------------------------------------------------------------ -body iwidgets::Selectiondialog::constructor {args} { - # - # Set the borderwidth to zero. - # - component hull configure -borderwidth 0 - - # - # Instantiate a selection box widget. - # - itk_component add selectionbox { - iwidgets::Selectionbox $itk_interior.selectionbox \ - -dblclickcommand [code $this invoke] - } { - usual - - keep -childsitepos -exportselection -itemscommand -itemslabel \ - -itemson -selectionlabel -selectionon -selectioncommand - } - configure -itemscommand [code $this selectitem] - - pack $itk_component(selectionbox) -fill both -expand yes - set itk_interior [$itk_component(selectionbox) childsite] - - hide Help - - eval itk_initialize $args -} - -# ------------------------------------------------------------------ -# METHODS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# METHOD: childsite -# -# Thinwrapped method of selection box class. -# ------------------------------------------------------------------ -body iwidgets::Selectiondialog::childsite {} { - return [$itk_component(selectionbox) childsite] -} - -# ------------------------------------------------------------------ -# METHOD: get -# -# Thinwrapped method of selection box class. -# ------------------------------------------------------------------ -body iwidgets::Selectiondialog::get {} { - return [$itk_component(selectionbox) get] -} - -# ------------------------------------------------------------------ -# METHOD: curselection -# -# Thinwrapped method of selection box class. -# ------------------------------------------------------------------ -body iwidgets::Selectiondialog::curselection {} { - return [$itk_component(selectionbox) curselection] -} - -# ------------------------------------------------------------------ -# METHOD: clear component -# -# Thinwrapped method of selection box class. -# ------------------------------------------------------------------ -body iwidgets::Selectiondialog::clear {component} { - $itk_component(selectionbox) clear $component - - return -} - -# ------------------------------------------------------------------ -# METHOD: insert component index args -# -# Thinwrapped method of selection box class. -# ------------------------------------------------------------------ -body iwidgets::Selectiondialog::insert {component index args} { - eval $itk_component(selectionbox) insert $component $index $args - - return -} - -# ------------------------------------------------------------------ -# METHOD: delete first ?last? -# -# Thinwrapped method of selection box class. -# ------------------------------------------------------------------ -body iwidgets::Selectiondialog::delete {first {last {}}} { - $itk_component(selectionbox) delete $first $last - - return -} - -# ------------------------------------------------------------------ -# METHOD: size -# -# Thinwrapped method of selection box class. -# ------------------------------------------------------------------ -body iwidgets::Selectiondialog::size {} { - return [$itk_component(selectionbox) size] -} - -# ------------------------------------------------------------------ -# METHOD: scan option args -# -# Thinwrapped method of selection box class. -# ------------------------------------------------------------------ -body iwidgets::Selectiondialog::scan {option args} { - return [eval $itk_component(selectionbox) scan $option $args] -} - -# ------------------------------------------------------------------ -# METHOD: nearest y -# -# Thinwrapped method of selection box class. -# ------------------------------------------------------------------ -body iwidgets::Selectiondialog::nearest {y} { - return [$itk_component(selectionbox) nearest $y] -} - -# ------------------------------------------------------------------ -# METHOD: index index -# -# Thinwrapped method of selection box class. -# ------------------------------------------------------------------ -body iwidgets::Selectiondialog::index {index} { - return [$itk_component(selectionbox) index $index] -} - -# ------------------------------------------------------------------ -# METHOD: selection option args -# -# Thinwrapped method of selection box class. -# ------------------------------------------------------------------ -body iwidgets::Selectiondialog::selection {option args} { - eval $itk_component(selectionbox) selection $option $args -} - -# ------------------------------------------------------------------ -# METHOD: selectitem -# -# Set the default button to ok and select the item. -# ------------------------------------------------------------------ -body iwidgets::Selectiondialog::selectitem {} { - default OK - $itk_component(selectionbox) selectitem -} - diff --git a/itcl/iwidgets3.0.0/generic/shell.itk b/itcl/iwidgets3.0.0/generic/shell.itk deleted file mode 100644 index 78ef19c53f9..00000000000 --- a/itcl/iwidgets3.0.0/generic/shell.itk +++ /dev/null @@ -1,371 +0,0 @@ -# Shell -# ---------------------------------------------------------------------- -# This class is implements a shell which is a top level widget -# giving a childsite and providing activate, deactivate, and center -# methods. -# -# ---------------------------------------------------------------------- -# AUTHOR: Mark L. Ulferts EMAIL: mulferts@austin.dsccc.com -# Kris Raney EMAIL: kraney@spd.dsccc.com -# -# @(#) $Id$ -# ---------------------------------------------------------------------- -# Copyright (c) 1996 DSC Technologies Corporation -# ====================================================================== -# Permission to use, copy, modify, distribute and license this software -# and its documentation for any purpose, and without fee or written -# agreement with DSC, is hereby granted, provided that the above copyright -# notice appears in all copies and that both the copyright notice and -# warranty disclaimer below appear in supporting documentation, and that -# the names of DSC Technologies Corporation or DSC Communications -# Corporation not be used in advertising or publicity pertaining to the -# software without specific, written prior permission. -# -# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING -# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- -# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE -# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, -# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL -# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR -# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, -# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, -# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS -# SOFTWARE. -# ====================================================================== - -# -# Usual options. -# -itk::usual Shell { - keep -background -cursor -modality -} - -# ------------------------------------------------------------------ -# SHELL -# ------------------------------------------------------------------ -class iwidgets::Shell { - inherit itk::Toplevel - - constructor {args} {} - - itk_option define -master master Window "" - itk_option define -modality modality Modality none - itk_option define -padx padX Pad 0 - itk_option define -pady padY Pad 0 - itk_option define -width width Width 0 - itk_option define -height height Height 0 - - public method childsite {} - public method activate {} - public method deactivate {args} - public method center {{widget {}}} - - private variable _result {} ;# Resultant value for modal activation. - private variable _busied {} ;# List of busied top level widgets. - - common grabstack {} - common _wait -} - -# -# Provide a lowercased access method for the Shell class. -# -proc ::iwidgets::shell {pathName args} { - uplevel ::iwidgets::Shell $pathName $args -} - -# ------------------------------------------------------------------ -# CONSTRUCTOR -# ------------------------------------------------------------------ -body iwidgets::Shell::constructor {args} { - itk_option add hull.width hull.height - - # - # Maintain a withdrawn state until activated. - # - wm withdraw $itk_component(hull) - - # - # Create the user child site - # - itk_component add -protected shellchildsite { - frame $itk_interior.shellchildsite - } - pack $itk_component(shellchildsite) -fill both -expand yes - - # - # Set the itk_interior variable to be the childsite for derived - # classes. - # - set itk_interior $itk_component(shellchildsite) - - # - # Bind the window manager delete protocol to deactivation of the - # widget. This can be overridden by the user via the execution - # of a similar command outside the class. - # - wm protocol $itk_component(hull) WM_DELETE_WINDOW [code $this deactivate] - - # - # Initialize the widget based on the command line options. - # - eval itk_initialize $args -} - -# ------------------------------------------------------------------ -# OPTIONS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# OPTION: -master -# -# Specifies the master window for the shell. The window manager is -# informed that the shell is a transient window whose master is -# -masterwindow. -# ------------------------------------------------------------------ -configbody iwidgets::Shell::master {} - -# ------------------------------------------------------------------ -# OPTION: -modality -# -# Specify the modality of the dialog. -# ------------------------------------------------------------------ -configbody iwidgets::Shell::modality { - switch $itk_option(-modality) { - none - - application - - global { - } - - default { - error "bad modality option \"$itk_option(-modality)\":\ - should be none, application, or global" - } - } -} - -# ------------------------------------------------------------------ -# OPTION: -padx -# -# Specifies a padding distance for the childsite in the X-direction. -# ------------------------------------------------------------------ -configbody iwidgets::Shell::padx { - pack config $itk_component(shellchildsite) -padx $itk_option(-padx) -} - -# ------------------------------------------------------------------ -# OPTION: -pady -# -# Specifies a padding distance for the childsite in the Y-direction. -# ------------------------------------------------------------------ -configbody iwidgets::Shell::pady { - pack config $itk_component(shellchildsite) -pady $itk_option(-pady) -} - -# ------------------------------------------------------------------ -# OPTION: -width -# -# Specifies the width of the shell. The value may be specified in -# any of the forms acceptable to Tk_GetPixels. A value of zero -# causes the width to be adjusted to the required value based on -# the size requests of the components placed in the childsite. -# Otherwise, the width is fixed. -# ------------------------------------------------------------------ -configbody iwidgets::Shell::width { - # - # The width option was added to the hull in the constructor. - # So, any width value given is passed automatically to the - # hull. All we have to do is play with the propagation. - # - if {$itk_option(-width) != 0} { - pack propagate $itk_component(hull) no - } else { - pack propagate $itk_component(hull) yes - } -} - -# ------------------------------------------------------------------ -# OPTION: -height -# -# Specifies the height of the shell. The value may be specified in -# any of the forms acceptable to Tk_GetPixels. A value of zero -# causes the height to be adjusted to the required value based on -# the size requests of the components placed in the childsite. -# Otherwise, the height is fixed. -# ------------------------------------------------------------------ -configbody iwidgets::Shell::height { - # - # The height option was added to the hull in the constructor. - # So, any height value given is passed automatically to the - # hull. All we have to do is play with the propagation. - # - if {$itk_option(-height) != 0} { - pack propagate $itk_component(hull) no - } else { - pack propagate $itk_component(hull) yes - } -} - -# ------------------------------------------------------------------ -# METHODS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# METHOD: childsite -# -# Return the pathname of the user accessible area. -# ------------------------------------------------------------------ -body iwidgets::Shell::childsite {} { - return $itk_component(shellchildsite) -} - -# ------------------------------------------------------------------ -# METHOD: activate -# -# Display the dialog and wait based on the modality. For application -# and global modal activations, perform a grab operation, and wait -# for the result. The result may be returned via an argument to the -# "deactivate" method. -# ------------------------------------------------------------------ -body iwidgets::Shell::activate {} { - - if {[winfo ismapped $itk_component(hull)]} { - raise $itk_component(hull) - return - } - - if {($itk_option(-master) != {}) && \ - [winfo exists $itk_option(-master)]} { - wm transient $itk_component(hull) $itk_option(-master) - } - - set _wait($this) 0 - raise $itk_component(hull) - wm deiconify $itk_component(hull) - tkwait visibility $itk_component(hull) - - if {$itk_option(-modality) == "application"} { - if {$grabstack != {}} { - grab release [lindex $grabstack end] - } - - set err 1 - while {$err == 1} { - set err [catch [list grab $itk_component(hull)]] - if {$err == 1} { - after 1000 - } - } - - lappend grabstack [list grab $itk_component(hull)] - - tkwait variable [scope _wait($this)] - return $_result - - } elseif {$itk_option(-modality) == "global" } { - if {$grabstack != {}} { - grab release [lindex $grabstack end] - } - - set err 1 - while {$err == 1} { - set err [catch [list grab -global $itk_component(hull)]] - if {$err == 1} { - after 1000 - } - } - - lappend grabstack [list grab -global $itk_component(hull)] - - tkwait variable [scope _wait($this)] - return $_result - } -} - -# ------------------------------------------------------------------ -# METHOD: deactivate -# -# Deactivate the display of the dialog. The method takes an optional -# argument to passed to the "activate" method which returns the value. -# This is only effective for application and global modal dialogs. -# ------------------------------------------------------------------ -body iwidgets::Shell::deactivate {args} { - - if {! [winfo ismapped $itk_component(hull)]} { - return - } - - if {$itk_option(-modality) == "none"} { - wm withdraw $itk_component(hull) - } elseif {$itk_option(-modality) == "application"} { - grab release $itk_component(hull) - if {$grabstack != {}} { - if {[set grabstack [lreplace $grabstack end end]] != {}} { - eval [lindex $grabstack end] - } - } - - wm withdraw $itk_component(hull) - - } elseif {$itk_option(-modality) == "global"} { - grab release $itk_component(hull) - if {$grabstack != {}} { - if {[set grabstack [lreplace $grabstack end end]] != {}} { - eval [lindex $grabstack end] - } - } - - wm withdraw $itk_component(hull) - } - - if {[llength $args]} { - set _result $args - } else { - set _result {} - } - - set _wait($this) 1 - return -} - -# ------------------------------------------------------------------ -# METHOD: center -# -# Centers the dialog with respect to another widget or the screen -# as a whole. -# ------------------------------------------------------------------ -body iwidgets::Shell::center {{widget {}}} { - update idletasks - - set hull $itk_component(hull) - set w [winfo reqwidth $hull] - set h [winfo reqheight $hull] - set sh [winfo screenheight $hull] ;# display screen's height/width - set sw [winfo screenwidth $hull] - - # - # User can request it centered with respect to root by passing in '{}' - # - if { $widget == "" } { - set reqX [expr {($sw-$w)/2}] - set reqY [expr {($sh-$h)/2}] - } else { - set wfudge 5 ;# wm width fudge factor - set hfudge 20 ;# wm height fudge factor - set widgetW [winfo width $widget] - set widgetH [winfo height $widget] - set reqX [expr [winfo rootx $widget]+($widgetW-($widgetW/2))-($w/2)] - set reqY [expr [winfo rooty $widget]+($widgetH-($widgetH/2))-($h/2)] - - # - # Adjust for errors - if too long or too tall - # - if { [expr $reqX+$w+$wfudge] > $sw } { set reqX [expr $sw-$w-$wfudge] } - if { $reqX < $wfudge } { set reqX $wfudge } - if { [expr $reqY+$h+$hfudge] > $sh } { set reqY [expr $sh-$h-$hfudge] } - if { $reqY < $hfudge } { set reqY $hfudge } - } - - wm geometry $hull +$reqX+$reqY -} - diff --git a/itcl/iwidgets3.0.0/generic/spindate.itk b/itcl/iwidgets3.0.0/generic/spindate.itk deleted file mode 100644 index 215c031b0b8..00000000000 --- a/itcl/iwidgets3.0.0/generic/spindate.itk +++ /dev/null @@ -1,692 +0,0 @@ -# Spindate -# ---------------------------------------------------------------------- -# Implements a Date spinner widget. A date spinner contains three -# Spinner widgets: one Spinner for months, one SpinInt for days, -# and one SpinInt for years. Months can be specified as abbreviated -# strings, integers or a user-defined list. Options exist to manage to -# behavior, appearance, and format of each component spinner. -# -# ---------------------------------------------------------------------- -# AUTHOR: Sue Yockey EMAIL: yockey@actc.com -# Mark L. Ulferts mulferts@austin.dsccc.com -# -# @(#) $Id$ -# ---------------------------------------------------------------------- -# Copyright (c) 1997 DSC Technologies Corporation -# ====================================================================== -# Permission to use, copy, modify, distribute and license this software -# and its documentation for any purpose, and without fee or written -# agreement with DSC, is hereby granted, provided that the above copyright -# notice appears in all copies and that both the copyright notice and -# warranty disclaimer below appear in supporting documentation, and that -# the names of DSC Technologies Corporation or DSC Communications -# Corporation not be used in advertising or publicity pertaining to the -# software without specific, written prior permission. -# -# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING -# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- -# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE -# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, -# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL -# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR -# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, -# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, -# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS -# SOFTWARE. -# ====================================================================== - -# -# Default resources. -# -option add *Spindate.monthLabel "Month" widgetDefault -option add *Spindate.dayLabel "Day" widgetDefault -option add *Spindate.yearLabel "Year" widgetDefault -option add *Spindate.monthWidth 4 widgetDefault -option add *Spindate.dayWidth 4 widgetDefault -option add *Spindate.yearWidth 4 widgetDefault - -# -# Usual options. -# -itk::usual Spindate { - keep -background -cursor -foreground -labelfont -textbackground -textfont -} - -# ------------------------------------------------------------------ -# SPINDATE -# ------------------------------------------------------------------ -class iwidgets::Spindate { - inherit itk::Widget - - constructor {args} {} - destructor {} - - itk_option define -labelpos labelPos Position w - itk_option define -orient orient Orient vertical - itk_option define -monthon monthOn MonthOn true - itk_option define -dayon dayOn DayOn true - itk_option define -yearon yearOn YearOn true - itk_option define -datemargin dateMargin Margin 1 - itk_option define -yeardigits yearDigits YearDigits 4 - itk_option define -monthformat monthFormat MonthFormat integer - - public { - method get {{format "-string"}} - method show {{date now}} - } - - protected { - method _packDate {{when later}} - variable _repack {} ;# Reconfiguration flag. - } - - private { - method _lastDay {month year} - method _spinMonth {direction} - method _spinDay {direction} - - variable _monthFormatStr "%m" - variable _yearFormatStr "%Y" - variable _interior - } -} - -# -# Provide a lowercased access method for the Spindate class. -# -proc ::iwidgets::spindate {pathName args} { - uplevel ::iwidgets::Spindate $pathName $args -} - -# ------------------------------------------------------------------ -# CONSTRUCTOR -# ------------------------------------------------------------------ -body iwidgets::Spindate::constructor {args} { - set _interior $itk_interior - - set clicks [clock seconds] - - # - # Create Month Spinner - # - itk_component add month { - iwidgets::Spinner $itk_interior.month -fixed 2 -justify right \ - -decrement [code $this _spinMonth -1] \ - -increment [code $this _spinMonth 1] - } { - keep -background -cursor -arroworient -foreground \ - -labelfont -labelmargin -relief -textbackground \ - -textfont -repeatdelay -repeatinterval - - rename -labeltext -monthlabel monthLabel Text - rename -width -monthwidth monthWidth Width - } - - # - # Take off the default bindings for selction and motion. - # - bind [$itk_component(month) component entry] <1> {break} - bind [$itk_component(month) component entry] <Button1-Motion> {break} - - # - # Create Day Spinner - # - itk_component add day { - iwidgets::Spinint $itk_interior.day -fixed 2 -justify right \ - -decrement [code $this _spinDay -1] \ - -increment [code $this _spinDay 1] - } { - keep -background -cursor -arroworient -foreground \ - -labelfont -labelmargin -relief -textbackground \ - -textfont -repeatdelay -repeatinterval - - rename -labeltext -daylabel dayLabel Text - rename -width -daywidth dayWidth Width - } - - # - # Take off the default bindings for selction and motion. - # - bind [$itk_component(day) component entry] <1> {break} - bind [$itk_component(day) component entry] <Button1-Motion> {break} - - # - # Create Year Spinner - # - itk_component add year { - iwidgets::Spinint $itk_interior.year -fixed 2 -justify right \ - -range {1900 3000} - } { - keep -background -cursor -arroworient -foreground \ - -labelfont -labelmargin -relief -textbackground \ - -textfont -repeatdelay -repeatinterval - - rename -labeltext -yearlabel yearLabel Text - rename -width -yearwidth yearWidth Width - } - - # - # Take off the default bindings for selction and motion. - # - bind [$itk_component(year) component entry] <1> {break} - bind [$itk_component(year) component entry] <Button1-Motion> {break} - - # - # Initialize the widget based on the command line options. - # - eval itk_initialize $args - - # - # Show the current date. - # - show now -} - -# ------------------------------------------------------------------ -# DESTRUCTOR -# ------------------------------------------------------------------ -body iwidgets::Spindate::destructor {} { - if {$_repack != ""} {after cancel $_repack} -} - -# ------------------------------------------------------------------ -# OPTIONS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# OPTION: -labelpos -# -# Specifies the location of all 3 spinners' labels. -# ------------------------------------------------------------------ -configbody iwidgets::Spindate::labelpos { - switch $itk_option(-labelpos) { - n { - $itk_component(month) configure -labelpos n - $itk_component(day) configure -labelpos n - $itk_component(year) configure -labelpos n - - # - # Un-align labels - # - $itk_component(month) configure -labelmargin 1 - $itk_component(day) configure -labelmargin 1 - $itk_component(year) configure -labelmargin 1 - } - - s { - $itk_component(month) configure -labelpos s - $itk_component(day) configure -labelpos s - $itk_component(year) configure -labelpos s - - # - # Un-align labels - # - $itk_component(month) configure -labelmargin 1 - $itk_component(day) configure -labelmargin 1 - $itk_component(year) configure -labelmargin 1 - } - - w { - $itk_component(month) configure -labelpos w - $itk_component(day) configure -labelpos w - $itk_component(year) configure -labelpos w - } - - e { - $itk_component(month) configure -labelpos e - $itk_component(day) configure -labelpos e - $itk_component(year) configure -labelpos e - - # - # Un-align labels - # - $itk_component(month) configure -labelmargin 1 - $itk_component(day) configure -labelmargin 1 - $itk_component(year) configure -labelmargin 1 - } - - default { - error "bad labelpos option \"$itk_option(-labelpos)\",\ - should be n, s, w or e" - } - } - - _packDate -} - -# ------------------------------------------------------------------ -# OPTION: -orient -# -# Specifies the orientation of the 3 spinners for Month, Day -# and year. -# ------------------------------------------------------------------ -configbody iwidgets::Spindate::orient { - _packDate -} - -# ------------------------------------------------------------------ -# OPTION: -monthon -# -# Specifies whether or not to display the month spinner. -# ------------------------------------------------------------------ -configbody iwidgets::Spindate::monthon { - _packDate -} - -# ------------------------------------------------------------------ -# OPTION: -dayon -# -# Specifies whether or not to display the day spinner. -# ------------------------------------------------------------------ -configbody iwidgets::Spindate::dayon { - _packDate -} - -# ------------------------------------------------------------------ -# OPTION: -yearon -# -# Specifies whether or not to display the year spinner. -# ------------------------------------------------------------------ -configbody iwidgets::Spindate::yearon { - _packDate -} - -# ------------------------------------------------------------------ -# OPTION: -datemargin -# -# Specifies the margin space between the month and day spinners -# and the day and year spinners. -# ------------------------------------------------------------------ -configbody iwidgets::Spindate::datemargin { - _packDate -} - -# ------------------------------------------------------------------ -# OPTION: -yeardigits -# -# Number of digits for year display, 2 or 4 -# ------------------------------------------------------------------ -configbody iwidgets::Spindate::yeardigits { - set clicks [clock seconds] - - switch $itk_option(-yeardigits) { - "2" { - $itk_component(year) configure -width 2 -fixed 2 - $itk_component(year) clear - $itk_component(year) insert 0 [clock format $clicks -format "%y"] - set _yearFormatStr "%y" - } - - "4" { - $itk_component(year) configure -width 4 -fixed 4 - $itk_component(year) clear - $itk_component(year) insert 0 [clock format $clicks -format "%Y"] - set _yearFormatStr "%Y" - } - - default { - error "bad yeardigits option \"$itk_option(-yeardigits)\",\ - should be 2 or 4" - } - } -} - -# ------------------------------------------------------------------ -# OPTION: -monthformat -# -# Format of month display, integers (1-12) or brief strings (Jan - -# Dec), or full strings (January - December). -# ------------------------------------------------------------------ -configbody iwidgets::Spindate::monthformat { - set clicks [clock seconds] - - if {$itk_option(-monthformat) == "brief"} { - $itk_component(month) configure -width 3 -fixed 3 - $itk_component(month) delete 0 end - $itk_component(month) insert 0 [clock format $clicks -format "%b"] - set _monthFormatStr "%b" - - } elseif {$itk_option(-monthformat) == "full"} { - $itk_component(month) configure -width 9 -fixed 9 - $itk_component(month) delete 0 end - $itk_component(month) insert 0 [clock format $clicks -format "%B"] - set _monthFormatStr "%B" - - } elseif {$itk_option(-monthformat) == "integer"} { - $itk_component(month) configure -width 2 -fixed 2 - $itk_component(month) delete 0 end - $itk_component(month) insert 0 [clock format $clicks -format "%m"] - set _monthFormatStr "%m" - - } else { - error "bad monthformat option\ - \"$itk_option(-monthformat)\", should be\ - \"integer\", \"brief\" or \"full\"" - } -} - -# ------------------------------------------------------------------ -# METHODS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# METHOD: get ?format? -# -# Return the current contents of the spindate widget in one of -# two formats string or as an integer clock value using the -string -# and -clicks options respectively. The default is by string. -# Reference the clock command for more information on obtaining dates -# and their formats. -# ------------------------------------------------------------------ -body iwidgets::Spindate::get {{format "-string"}} { - set month [$itk_component(month) get] - set day [$itk_component(day) get] - set year [$itk_component(year) get] - - if {[regexp {[0-9]+} $month]} { - set datestr "$month/$day/$year" - } else { - set datestr "$day $month $year" - } - - switch -- $format { - "-string" { - return $datestr - } - "-clicks" { - return [clock scan $datestr] - } - default { - error "bad format option \"$format\":\ - should be -string or -clicks" - } - } -} - -# ------------------------------------------------------------------ -# PUBLIC METHOD: show date -# -# Changes the currently displayed date to be that of the date -# argument. The date may be specified either as a string or an -# integer clock value. Reference the clock command for more -# information on obtaining dates and their formats. -# ------------------------------------------------------------------ -body iwidgets::Spindate::show {{date "now"}} { - # - # Convert the date to a clock clicks value. - # - if {$date == "now"} { - set seconds [clock seconds] - } else { - if {[catch {clock format $date}] == 0} { - set seconds $date - } elseif {[catch {set seconds [clock scan $date]}] != 0} { - error "bad date: \"$date\", must be a valid date\ - string, clock clicks value or the keyword now" - } - } - - # - # Display the month based on the -monthformat option. - # - switch $itk_option(-monthformat) { - "brief" { - $itk_component(month) delete 0 end - $itk_component(month) insert 0 [clock format $seconds -format "%b"] - } - "full" { - $itk_component(month) delete 0 end - $itk_component(month) insert 0 [clock format $seconds -format "%B"] - } - "integer" { - $itk_component(month) delete 0 end - $itk_component(month) insert 0 [clock format $seconds -format "%m"] - } - } - - # - # Display the day. - # - $itk_component(day) delete 0 end - $itk_component(day) insert end [clock format $seconds -format "%d"] - - # - # Display the year based on the -yeardigits option. - # - switch $itk_option(-yeardigits) { - "2" { - $itk_component(year) delete 0 end - $itk_component(year) insert 0 [clock format $seconds -format "%y"] - } - - "4" { - $itk_component(year) delete 0 end - $itk_component(year) insert 0 [clock format $seconds -format "%Y"] - } - } - - return -} - -# ---------------------------------------------------------------- -# PRIVATE METHOD: _spinMonth direction -# -# Increment or decrement month value. We need to get the values -# for all three fields so we can make sure the day agrees with -# the month. Should the current day be greater than the day for -# the spun month, then the day is set to the last day for the -# new month. -# ---------------------------------------------------------------- -body iwidgets::Spindate::_spinMonth {direction} { - set month [$itk_component(month) get] - set day [$itk_component(day) get] - set year [$itk_component(year) get] - - # - # There appears to be a bug in the Tcl clock command in that it - # can't scan a date like "12/31/1999 1 month" or any other date with - # a year above 2000, but it has no problem scanning "07/01/1998 1 month". - # So, we're going to play a game and increment by days until this - # is fixed in Tcl. - # - if {$direction == 1} { - set incrdays 32 - set day 01 - } else { - set incrdays -28 - set day 28 - } - - if {[regexp {[0-9]+} $month]} { - set clicks [clock scan "$month/$day/$year $incrdays day"] - } else { - set clicks [clock scan "$day $month $year $incrdays day"] - } - - $itk_component(month) clear - $itk_component(month) insert 0 \ - [clock format $clicks -format $_monthFormatStr] - - set lastday [_lastDay [$itk_component(month) get] $year] - - if {$day > $lastday} { - $itk_component(day) clear - $itk_component(day) insert end $lastday - } -} - -# ---------------------------------------------------------------- -# PRIVATE METHOD: _spinDay direction -# -# Increment or decrement day value. If the previous day was the -# first, then set the new day to the last day for the current -# month. If it was the last day of the month, change it to the -# first. Otherwise, spin it to the next day. -# ---------------------------------------------------------------- -body iwidgets::Spindate::_spinDay {direction} { - set month [$itk_component(month) get] - set day [$itk_component(day) get] - set year [$itk_component(year) get] - set lastday [_lastDay $month $year] - set currclicks [get -clicks] - - $itk_component(day) delete 0 end - - if {(($day == "01") || ($day == "1")) && ($direction == -1)} { - $itk_component(day) insert 0 $lastday - return - } - - if {($day == $lastday) && ($direction == 1)} { - $itk_component(day) insert 0 "01" - return - } - - set clicks [clock scan "$direction day" -base $currclicks] - $itk_component(day) insert 0 [clock format $clicks -format "%d"] -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _packDate when -# -# Pack the components of the date spinner. If "when" is "now", the -# change is applied immediately. If it is "later" or it is not -# specified, then the change is applied later, when the application -# is idle. -# ------------------------------------------------------------------ -body iwidgets::Spindate::_packDate {{when later}} { - if {$when == "later"} { - if {$_repack == ""} { - set _repack [after idle [code $this _packDate now]] - } - return - } elseif {$when != "now"} { - error "bad option \"$when\": should be now or later" - } - - # - # Turn off the minsizes for all the rows and columns. - # - for {set i 0} {$i < 5} {incr i} { - grid rowconfigure $_interior $i -minsize 0 - grid columnconfigure $_interior $i -minsize 0 - } - - set _repack "" - - # - # Based on the orientation, use the grid to place the components into - # the proper rows and columns. - # - switch $itk_option(-orient) { - vertical { - set row -1 - - if {$itk_option(-monthon)} { - grid $itk_component(month) -row [incr row] -column 0 \ - -sticky nsew - } else { - grid forget $itk_component(month) - } - - if {$itk_option(-dayon)} { - if {$itk_option(-dayon)} { - grid rowconfigure $_interior [incr row] \ - -minsize $itk_option(-datemargin) - } - - grid $itk_component(day) -row [incr row] -column 0 \ - -sticky nsew - } else { - grid forget $itk_component(day) - } - - if {$itk_option(-yearon)} { - if {$itk_option(-monthon) || $itk_option(-dayon)} { - grid rowconfigure $_interior [incr row] \ - -minsize $itk_option(-datemargin) - } - - grid $itk_component(year) -row [incr row] -column 0 \ - -sticky nsew - } else { - grid forget $itk_component(year) - } - - if {$itk_option(-labelpos) == "w"} { - iwidgets::Labeledwidget::alignlabels $itk_component(month) \ - $itk_component(day) $itk_component(year) - } - } - - horizontal { - set column -1 - - if {$itk_option(-monthon)} { - grid $itk_component(month) -row 0 -column [incr column] \ - -sticky nsew - } else { - grid forget $itk_component(month) - } - - if {$itk_option(-dayon)} { - if {$itk_option(-monthon)} { - grid columnconfigure $_interior [incr column] \ - -minsize $itk_option(-datemargin) - } - - grid $itk_component(day) -row 0 -column [incr column] \ - -sticky nsew - } else { - grid forget $itk_component(day) - } - - if {$itk_option(-yearon)} { - if {$itk_option(-monthon) || $itk_option(-dayon)} { - grid columnconfigure $_interior [incr column] \ - -minsize $itk_option(-datemargin) - } - - grid $itk_component(year) -row 0 -column [incr column] \ - -sticky nsew - } else { - grid forget $itk_component(year) - } - - # - # Un-align labels. - # - $itk_component(month) configure -labelmargin 1 - $itk_component(day) configure -labelmargin 1 - $itk_component(year) configure -labelmargin 1 - } - - default { - error "bad orient option \"$itk_option(-orient)\", should\ - be \"vertical\" or \"horizontal\"" - } - } -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _lastDay month year -# -# Internal method which determines the last day of the month for -# the given month and year. We start at 28 and go forward till -# we fail. Crude but effective. -# ------------------------------------------------------------------ -body iwidgets::Spindate::_lastDay {month year} { - set lastone 28 - - for {set lastone 28} {$lastone < 32} {incr lastone} { - if {[regexp {[0-9]+} $month]} { - if {[catch {clock scan "$month/[expr $lastone + 1]/$year"}] != 0} { - return $lastone - } - } else { - if {[catch {clock scan "[expr $lastone + 1] $month $year"}] != 0} { - return $lastone - } - } - } -} diff --git a/itcl/iwidgets3.0.0/generic/spinint.itk b/itcl/iwidgets3.0.0/generic/spinint.itk deleted file mode 100644 index 9dc819ce999..00000000000 --- a/itcl/iwidgets3.0.0/generic/spinint.itk +++ /dev/null @@ -1,237 +0,0 @@ -# Spinint -# ---------------------------------------------------------------------- -# Implements an integer spinner widget. It inherits basic spinner -# functionality from Spinner and adds specific features to create -# an integer-only spinner. -# Arrows may be placed horizontally or vertically. -# User may specify an integer range and step value. -# Spinner may be configured to wrap when min or max value is reached. -# -# NOTE: -# Spinint integer values should not exceed the size of a long integer. -# For a 32 bit long the integer range is -2147483648 to 2147483647. -# -# ---------------------------------------------------------------------- -# AUTHOR: Sue Yockey Phone: (214) 519-2517 -# E-mail: syockey@spd.dsccc.com -# yockey@acm.org -# -# @(#) $Id$ -# ---------------------------------------------------------------------- -# Copyright (c) 1995 DSC Technologies Corporation -# ====================================================================== -# Permission to use, copy, modify, distribute and license this software -# and its documentation for any purpose, and without fee or written -# agreement with DSC, is hereby granted, provided that the above copyright -# notice appears in all copies and that both the copyright notice and -# warranty disclaimer below appear in supporting documentation, and that -# the names of DSC Technologies Corporation or DSC Communications -# Corporation not be used in advertising or publicity pertaining to the -# software without specific, written prior permission. -# -# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING -# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- -# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE -# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, -# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL -# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR -# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, -# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, -# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS -# SOFTWARE. -# ====================================================================== - -# -# Usual options. -# -itk::usual Spinint { - keep -background -borderwidth -cursor -foreground -highlightcolor \ - -highlightthickness -insertbackground -insertborderwidth \ - -insertofftime -insertontime -insertwidth -labelfont \ - -selectbackground -selectborderwidth -selectforeground \ - -textbackground -textfont -} - -# ------------------------------------------------------------------ -# SPININT -# ------------------------------------------------------------------ -class iwidgets::Spinint { - inherit iwidgets::Spinner - - constructor {args} { - Spinner::constructor -validate numeric - } {} - - itk_option define -range range Range "" - itk_option define -step step Step 1 - itk_option define -wrap wrap Wrap true - - public method up {} - public method down {} -} - -# -# Provide a lowercased access method for the Spinint class. -# -proc ::iwidgets::spinint {pathName args} { - uplevel ::iwidgets::Spinint $pathName $args -} - -# ------------------------------------------------------------------ -# CONSTRUCTOR -# ------------------------------------------------------------------ -body iwidgets::Spinint::constructor {args} { - eval itk_initialize $args - - $itk_component(entry) delete 0 end - - if {[lindex $itk_option(-range) 0] == ""} { - $itk_component(entry) insert 0 "0" - } else { - $itk_component(entry) insert 0 [lindex $itk_option(-range) 0] - } -} - -# ------------------------------------------------------------------ -# OPTIONS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# OPTION: -range -# -# Set min and max values for spinner. -# ------------------------------------------------------------------ -configbody iwidgets::Spinint::range { - if {$itk_option(-range) != ""} { - if {[llength $itk_option(-range)] != 2} { - error "wrong # args: should be\ - \"$itk_component(hull) configure -range {begin end}\"" - } - - set min [lindex $itk_option(-range) 0] - set max [lindex $itk_option(-range) 1] - - if {![regexp {^-?[0-9]+$} $min]} { - error "bad range option \"$min\": begin value must be\ - an integer" - } - if {![regexp {^-?[0-9]+$} $max]} { - error "bad range option \"$max\": end value must be\ - an integer" - } - if {$min > $max} { - error "bad option starting range \"$min\": must be less\ - than ending: \"$max\"" - } - } -} - -# ------------------------------------------------------------------ -# OPTION: -step -# -# Increment spinner by step value. -# ------------------------------------------------------------------ -configbody iwidgets::Spinint::step { -} - -# ------------------------------------------------------------------ -# OPTION: -wrap -# -# Specify whether spinner should wrap value if at min or max. -# ------------------------------------------------------------------ -configbody iwidgets::Spinint::wrap { -} - -# ------------------------------------------------------------------ -# METHODS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# METHOD: up -# -# Up arrow button press event. Increment value in entry. -# ------------------------------------------------------------------ -body iwidgets::Spinint::up {} { - set min_range [lindex $itk_option(-range) 0] - set max_range [lindex $itk_option(-range) 1] - - set val [$itk_component(entry) get] - if {[lindex $itk_option(-range) 0] != ""} { - - # - # Check boundaries. - # - if {$val >= $min_range && $val < $max_range} { - incr val $itk_option(-step) - $itk_component(entry) delete 0 end - $itk_component(entry) insert 0 $val - } else { - if {$itk_option(-wrap)} { - 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 { - uplevel #0 $itk_option(-invalid) - } - } else { - uplevel #0 $itk_option(-invalid) - } - } - } else { - - # - # No boundaries. - # - incr val $itk_option(-step) - $itk_component(entry) delete 0 end - $itk_component(entry) insert 0 $val - } -} - -# ------------------------------------------------------------------ -# METHOD: down -# -# Down arrow button press event. Decrement value in entry. -# ------------------------------------------------------------------ -body iwidgets::Spinint::down {} { - set min_range [lindex $itk_option(-range) 0] - set max_range [lindex $itk_option(-range) 1] - - set val [$itk_component(entry) get] - if {[lindex $itk_option(-range) 0] != ""} { - - # - # Check boundaries. - # - if {$val > $min_range && $val <= $max_range} { - incr val -$itk_option(-step) - $itk_component(entry) delete 0 end - $itk_component(entry) insert 0 $val - } else { - if {$itk_option(-wrap)} { - 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 { - uplevel #0 $itk_option(-invalid) - } - } else { - uplevel #0 $itk_option(-invalid) - } - } - } else { - - # - # No boundaries. - # - incr val -$itk_option(-step) - $itk_component(entry) delete 0 end - $itk_component(entry) insert 0 $val - } -} diff --git a/itcl/iwidgets3.0.0/generic/spinner.itk b/itcl/iwidgets3.0.0/generic/spinner.itk deleted file mode 100644 index 2072a794ca4..00000000000 --- a/itcl/iwidgets3.0.0/generic/spinner.itk +++ /dev/null @@ -1,448 +0,0 @@ -# Spinner -# ---------------------------------------------------------------------- -# Implements a spinner widget. The Spinner is comprised of an -# EntryField plus up and down arrow buttons. -# Spinner is meant to be used as a base class for creating more -# specific spinners such as SpinInt.itk -# Arrows may be drawn horizontally or vertically. -# User may define arrow behavior or accept the default arrow behavior. -# -# ---------------------------------------------------------------------- -# AUTHOR: Sue Yockey Phone: (214) 519-2517 -# E-mail: syockey@spd.dsccc.com -# yockey@acm.org -# -# @(#) $Id$ -# ---------------------------------------------------------------------- -# Copyright (c) 1995 DSC Technologies Corporation -# ====================================================================== -# Permission to use, copy, modify, distribute and license this software -# and its documentation for any purpose, and without fee or written -# agreement with DSC, is hereby granted, provided that the above copyright -# notice appears in all copies and that both the copyright notice and -# warranty disclaimer below appear in supporting documentation, and that -# the names of DSC Technologies Corporation or DSC Communications -# Corporation not be used in advertising or publicity pertaining to the -# software without specific, written prior permission. -# -# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING -# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- -# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE -# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, -# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL -# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR -# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, -# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, -# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS -# SOFTWARE. -# ====================================================================== - -# -# Usual options. -# -itk::usual Spinner { - keep -background -borderwidth -cursor -foreground -highlightcolor \ - -highlightthickness -insertbackground -insertborderwidth \ - -insertofftime -insertontime -insertwidth -labelfont \ - -selectbackground -selectborderwidth -selectforeground \ - -textbackground -textfont -} - -# ------------------------------------------------------------------ -# SPINNER -# ------------------------------------------------------------------ -class iwidgets::Spinner { - inherit iwidgets::Entryfield - - constructor {args} {} - destructor {} - - itk_option define -arroworient arrowOrient Orient vertical - itk_option define -textfont textFont \ - Font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* - itk_option define -borderwidth borderWidth BorderWidth 2 - itk_option define -highlightthickness highlightThickness \ - HighlightThickness 2 - itk_option define -increment increment Command {} - itk_option define -decrement decrement Command {} - itk_option define -repeatdelay repeatDelay RepeatDelay 300 - itk_option define -repeatinterval repeatInterval RepeatInterval 100 - itk_option define -foreground foreground Foreground black - - public method down {} - public method up {} - - protected method _pushup {} - protected method _pushdown {} - protected method _relup {} - protected method _reldown {} - protected method _doup {rate} - protected method _dodown {rate} - protected method _up {} - protected method _down {} - - protected method _positionArrows {{when later}} - - protected variable _interior {} - protected variable _reposition "" ;# non-null => _positionArrows pending - protected variable _uptimer "" ;# non-null => _uptimer pending - protected variable _downtimer "" ;# non-null => _downtimer pending -} - -# -# Provide a lowercased access method for the Spinner class. -# -proc ::iwidgets::spinner {pathName args} { - uplevel ::iwidgets::Spinner $pathName $args -} - -# ------------------------------------------------------------------ -# CONSTRUCTOR -# ------------------------------------------------------------------ -body iwidgets::Spinner::constructor {args} { - # - # Save off the interior for later use. - # - set _interior $itk_interior - - # - # Create up arrow button. - # - itk_component add uparrow { - canvas $itk_interior.uparrow -height 10 -width 10 \ - -relief raised -highlightthickness 0 - } { - keep -background -borderwidth - } - - # - # Create down arrow button. - # - itk_component add downarrow { - canvas $itk_interior.downarrow -height 10 -width 10 \ - -relief raised -highlightthickness 0 - } { - keep -background -borderwidth - } - - # - # Add bindings for button press events on the up and down buttons. - # - bind $itk_component(uparrow) <ButtonPress-1> [code $this _pushup] - bind $itk_component(uparrow) <ButtonRelease-1> [code $this _relup] - - bind $itk_component(downarrow) <ButtonPress-1> [code $this _pushdown] - bind $itk_component(downarrow) <ButtonRelease-1> [code $this _reldown] - - eval itk_initialize $args - - # - # When idle, position the arrows. - # - _positionArrows -} - -# ------------------------------------------------------------------ -# DESTRUCTOR -# ------------------------------------------------------------------ - -body iwidgets::Spinner::destructor {} { - if {$_reposition != ""} {after cancel $_reposition} - if {$_uptimer != ""} {after cancel $_uptimer} - if {$_downtimer != ""} {after cancel $_downtimer} -} - -# ------------------------------------------------------------------ -# OPTIONS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# OPTION: -arroworient -# -# Place arrows vertically or horizontally . -# ------------------------------------------------------------------ -configbody iwidgets::Spinner::arroworient { - _positionArrows -} - -# ------------------------------------------------------------------ -# OPTION: -textfont -# -# Change font, resize arrow buttons. -# ------------------------------------------------------------------ -configbody iwidgets::Spinner::textfont { - _positionArrows -} - -# ------------------------------------------------------------------ -# OPTION: -highlightthickness -# -# Change highlightthickness, resize arrow buttons. -# ------------------------------------------------------------------ -configbody iwidgets::Spinner::highlightthickness { - _positionArrows -} - -# ------------------------------------------------------------------ -# OPTION: -borderwidth -# -# Change borderwidth, resize arrow buttons. -# ------------------------------------------------------------------ -configbody iwidgets::Spinner::borderwidth { - _positionArrows -} - -# ------------------------------------------------------------------ -# OPTION: -increment -# -# Up arrow callback. -# ------------------------------------------------------------------ -configbody iwidgets::Spinner::increment { - if {$itk_option(-increment) == {}} { - set itk_option(-increment) [code $this up] - } -} - -# ------------------------------------------------------------------ -# OPTION: -decrement -# -# Down arrow callback. -# ------------------------------------------------------------------ -configbody iwidgets::Spinner::decrement { - if {$itk_option(-decrement) == {}} { - set itk_option(-decrement) [code $this down] - } -} - -# ------------------------------------------------------------------ -# OPTION: -repeatinterval -# -# Arrow repeat rate in milliseconds. A repeatinterval of 0 disables -# button repeat. -# ------------------------------------------------------------------ -configbody iwidgets::Spinner::repeatinterval { - if {$itk_option(-repeatinterval) < 0} { - set itk_option(-repeatinterval) 0 - } -} - -# ------------------------------------------------------------------ -# OPTION: -repeatdelay -# -# Arrow repeat delay in milliseconds. -# ------------------------------------------------------------------ -configbody iwidgets::Spinner::repeatdelay { - if {$itk_option(-repeatdelay) < 0} { - set itk_option(-repeatdelay) 0 - } -} - -# ------------------------------------------------------------------ -# OPTION: -foreground -# -# Set the foreground color of the up and down arrows. Remember -# to make sure the "tag" exists before setting them... -# ------------------------------------------------------------------ -configbody iwidgets::Spinner::foreground { - - if { [$itk_component(uparrow) gettags up] != "" } { - $itk_component(uparrow) itemconfigure up \ - -fill $itk_option(-foreground) - } - - if { [$itk_component(downarrow) gettags down] != "" } { - $itk_component(downarrow) itemconfigure down \ - -fill $itk_option(-foreground) - } -} - -# ------------------------------------------------------------------ -# METHODS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# METHOD: up -# -# Up arrow command. Meant to be overloaded by derived class. -# ------------------------------------------------------------------ -body iwidgets::Spinner::up {} { -} - -# ------------------------------------------------------------------ -# METHOD: down -# -# Down arrow command. Meant to be overloaded by derived class. -# ------------------------------------------------------------------ -body iwidgets::Spinner::down {} { -} - -# ------------------------------------------------------------------ -# PROTECTED METHOD: _positionArrows ?when? -# -# Draw Arrows for spinner. If "when" is "now", the change is applied -# immediately. If it is "later" or it is not specified, then the -# change is applied later, when the application is idle. -# ------------------------------------------------------------------ -body iwidgets::Spinner::_positionArrows {{when later}} { - if {$when == "later"} { - if {$_reposition == ""} { - set _reposition [after idle [code $this _positionArrows now]] - } - return - } elseif {$when != "now"} { - error "bad option \"$when\": should be now or later" - } - - set _reposition "" - - set bdw [cget -borderwidth] - - # - # Based on the orientation of the arrows, pack them accordingly and - # determine the width and height of the spinners. For vertical - # orientation, it is really tight in the y direction, so we'll take - # advantage of the highlightthickness. Horizontal alignment has - # plenty of space vertically, thus we'll ignore the thickness. - # - switch $itk_option(-arroworient) { - vertical { - grid $itk_component(uparrow) -row 0 -column 0 - grid $itk_component(downarrow) -row 1 -column 0 - - set totalHgt [winfo reqheight $itk_component(entry)] - set spinHgt [expr $totalHgt / 2] - set spinWid [expr round ($spinHgt * 1.6)] - } - horizontal { - grid $itk_component(uparrow) -row 0 -column 0 - grid $itk_component(downarrow) -row 0 -column 1 - - set spinHgt [expr [winfo reqheight $itk_component(entry)] - \ - (2 * [$itk_component(entry) cget -highlightthickness])] - set spinWid $spinHgt - } - default { - error "bad orientation option \"$itk_option(-arroworient)\",\ - should be horizontal or vertical" - } - } - - # - # Configure the width and height of the spinners minus the borderwidth. - # Next delete the previous spinner polygons and create new ones. - # - $itk_component(uparrow) config \ - -height [expr $spinHgt - (2 * $bdw)] \ - -width [expr $spinWid - (2 * $bdw)] - $itk_component(uparrow) delete up - $itk_component(uparrow) create polygon \ - [expr $spinWid / 2] $bdw \ - [expr $spinWid - $bdw - 1] [expr $spinHgt - $bdw -1] \ - [expr $bdw + 1] [expr $spinHgt - $bdw - 1] \ - -fill $itk_option(-foreground) -tags up - - $itk_component(downarrow) config \ - -height [expr $spinHgt - (2 * $bdw)] \ - -width [expr $spinWid - (2 * $bdw)] - $itk_component(downarrow) delete down - $itk_component(downarrow) create polygon \ - [expr $spinWid / 2] [expr ($spinHgt - $bdw) - 1] \ - [expr $bdw + 2] [expr $bdw + 1] \ - [expr $spinWid - $bdw - 2] [expr $bdw + 1] \ - -fill $itk_option(-foreground) -tags down -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _pushup -# -# Up arrow button press event. Call _doup with repeatdelay. -# ------------------------------------------------------------------ -body iwidgets::Spinner::_pushup {} { - $itk_component(uparrow) config -relief sunken - _doup $itk_option(-repeatdelay) -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _pushdown -# -# Down arrow button press event. Call _dodown with repeatdelay. -# ------------------------------------------------------------------ -body iwidgets::Spinner::_pushdown {} { - $itk_component(downarrow) config -relief sunken - _dodown $itk_option(-repeatdelay) -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _doup -# -# Call _up and post to do another one after "rate" milliseconds if -# repeatinterval > 0. -# ------------------------------------------------------------------ -body iwidgets::Spinner::_doup {rate} { - _up - - if {$itk_option(-repeatinterval) > 0} { - set _uptimer [after $rate [code $this _doup $itk_option(-repeatinterval)]] - } -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _dodown -# -# Call _down and post to do another one after "rate" milliseconds if -# repeatinterval > 0. -# ------------------------------------------------------------------ -body iwidgets::Spinner::_dodown {rate} { - _down - - if {$itk_option(-repeatinterval) > 0} { - set _downtimer \ - [after $rate [code $this _dodown $itk_option(-repeatinterval)]] - } -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _relup -# -# Up arrow button release event. Cancel pending up timer. -# ------------------------------------------------------------------ -body iwidgets::Spinner::_relup {} { - $itk_component(uparrow) config -relief raised - - if {$_uptimer != ""} { - after cancel $_uptimer - set _uptimer "" - } -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _reldown -# -# Up arrow button release event. Cancel pending down timer. -# ------------------------------------------------------------------ -body iwidgets::Spinner::_reldown {} { - $itk_component(downarrow) config -relief raised - - if {$_downtimer != ""} { - after cancel $_downtimer - set _downtimer "" - } -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _up -# -# Up arrow button press event. Call defined increment command. -# ------------------------------------------------------------------ -body iwidgets::Spinner::_up {} { - uplevel #0 $itk_option(-increment) -} - -# ------------------------------------------------------------------ -# PRIVATE METHOD: _down -# -# Down arrow button press event. Call defined decrement command. -# ------------------------------------------------------------------ -body iwidgets::Spinner::_down {} { - uplevel #0 $itk_option(-decrement) -} diff --git a/itcl/iwidgets3.0.0/generic/spintime.itk b/itcl/iwidgets3.0.0/generic/spintime.itk deleted file mode 100644 index 5a8d325367a..00000000000 --- a/itcl/iwidgets3.0.0/generic/spintime.itk +++ /dev/null @@ -1,527 +0,0 @@ -# Spintime -# ---------------------------------------------------------------------- -# Implements a Time spinner widget. A time spinner contains three -# integer spinners: one for hours, one for minutes and one for -# seconds. Options exist to manage to behavior, appearance, and -# format of each component spinner. -# -# ---------------------------------------------------------------------- -# AUTHOR: Sue Yockey EMAIL: yockey@actc.com -# Mark L. Ulferts mulferts@austin.dsccc.com -# -# @(#) $Id$ -# ---------------------------------------------------------------------- -# Copyright (c) 1997 DSC Technologies Corporation -# ====================================================================== -# Permission to use, copy, modify, distribute and license this software -# and its documentation for any purpose, and without fee or written -# agreement with DSC, is hereby granted, provided that the above copyright -# notice appears in all copies and that both the copyright notice and -# warranty disclaimer below appear in supporting documentation, and that -# the names of DSC Technologies Corporation or DSC Communications -# Corporation not be used in advertising or publicity pertaining to the -# software without specific, written prior permission. -# -# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING -# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- -# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE -# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, -# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL -# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR -# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, -# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, -# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS -# SOFTWARE. -# ====================================================================== - -# -# Default resources. -# -option add *Spintime.hourLabel "Hour" widgetDefault -option add *Spintime.minuteLabel "Minute" widgetDefault -option add *Spintime.secondLabel "Second" widgetDefault -option add *Spintime.hourWidth 3 widgetDefault -option add *Spintime.minuteWidth 3 widgetDefault -option add *Spintime.secondWidth 3 widgetDefault - -# -# Usual options. -# -itk::usual Spintime { - keep -background -cursor -foreground -labelfont -textbackground -textfont -} - -# ------------------------------------------------------------------ -# SPINTIME -# ------------------------------------------------------------------ -class iwidgets::Spintime { - inherit itk::Widget - - constructor {args} {} - destructor {} - - itk_option define -orient orient Orient vertical - itk_option define -labelpos labelPos Position w - itk_option define -houron hourOn HourOn true - itk_option define -minuteon minuteOn MinuteOn true - itk_option define -secondon secondOn SecondOn true - itk_option define -timemargin timeMargin Margin 1 - itk_option define -militaryon militaryOn MilitaryOn true - - public { - method get {{format "-string"}} - method show {{date now}} - } - - protected { - method _packTime {{when later}} - method _down60 {comp} - - variable _repack {} ;# Reconfiguration flag. - variable _interior - } -} - -# -# Provide a lowercased access method for the Spintime class. -# -proc ::iwidgets::spintime {pathName args} { - uplevel ::iwidgets::Spintime $pathName $args -} - -# ------------------------------------------------------------------ -# CONSTRUCTOR -# ------------------------------------------------------------------ -body iwidgets::Spintime::constructor {args} { - set _interior $itk_interior - set clicks [clock seconds] - - # - # Create Hour Spinner - # - itk_component add hour { - iwidgets::Spinint $itk_interior.hour -fixed 2 -range {0 23} -justify right - } { - keep -background -cursor -arroworient -foreground \ - -labelfont -labelmargin -relief -textbackground \ - -textfont -repeatdelay -repeatinterval - - rename -labeltext -hourlabel hourLabel Text - rename -width -hourwidth hourWidth Width - } - - # - # Take off the default bindings for selction and motion. - # - bind [$itk_component(hour) component entry] <1> {break} - bind [$itk_component(hour) component entry] <Button1-Motion> {break} - - # - # Create Minute Spinner - # - itk_component add minute { - iwidgets::Spinint $itk_interior.minute \ - -decrement [code $this _down60 minute] \ - -fixed 2 -range {0 59} -justify right - } { - keep -background -cursor -arroworient -foreground \ - -labelfont -labelmargin -relief -textbackground \ - -textfont -repeatdelay -repeatinterval - - rename -labeltext -minutelabel minuteLabel Text - rename -width -minutewidth minuteWidth Width - } - - # - # Take off the default bindings for selction and motion. - # - bind [$itk_component(minute) component entry] <1> {break} - bind [$itk_component(minute) component entry] <Button1-Motion> {break} - - # - # Create Second Spinner - # - itk_component add second { - iwidgets::Spinint $itk_interior.second \ - -decrement [code $this _down60 second] \ - -fixed 2 -range {0 59} -justify right - } { - keep -background -cursor -arroworient -foreground \ - -labelfont -labelmargin -relief -textbackground \ - -textfont -repeatdelay -repeatinterval - - rename -labeltext -secondlabel secondLabel Text - rename -width -secondwidth secondWidth Width - } - - # - # Take off the default bindings for selction and motion. - # - bind [$itk_component(second) component entry] <1> {break} - bind [$itk_component(second) component entry] <Button1-Motion> {break} - - # - # Initialize the widget based on the command line options. - # - eval itk_initialize $args - - # - # Show the current time. - # - show now -} - -# ------------------------------------------------------------------ -# DESTRUCTOR -# ------------------------------------------------------------------ -body iwidgets::Spintime::destructor {} { - if {$_repack != ""} {after cancel $_repack} -} - -# ------------------------------------------------------------------ -# OPTIONS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# OPTION: -orient -# -# Specifies the orientation of the 3 spinners for Hour, Minute -# and second. -# ------------------------------------------------------------------ -configbody iwidgets::Spintime::orient { - _packTime -} - -# ------------------------------------------------------------------ -# OPTION: -labelpos -# -# Specifies the location of all 3 spinners' labels. -# Overloaded -# ------------------------------------------------------------------ -configbody iwidgets::Spintime::labelpos { - switch $itk_option(-labelpos) { - n { - $itk_component(hour) configure -labelpos n - $itk_component(minute) configure -labelpos n - $itk_component(second) configure -labelpos n - - # - # Un-align labels - # - $itk_component(hour) configure -labelmargin 1 - $itk_component(minute) configure -labelmargin 1 - $itk_component(second) configure -labelmargin 1 - } - - s { - $itk_component(hour) configure -labelpos s - $itk_component(minute) configure -labelpos s - $itk_component(second) configure -labelpos s - - # - # Un-align labels - # - $itk_component(hour) configure -labelmargin 1 - $itk_component(minute) configure -labelmargin 1 - $itk_component(second) configure -labelmargin 1 - } - - w { - $itk_component(hour) configure -labelpos w - $itk_component(minute) configure -labelpos w - $itk_component(second) configure -labelpos w - } - - e { - $itk_component(hour) configure -labelpos e - $itk_component(minute) configure -labelpos e - $itk_component(second) configure -labelpos e - - # - # Un-align labels - # - $itk_component(hour) configure -labelmargin 1 - $itk_component(minute) configure -labelmargin 1 - $itk_component(second) configure -labelmargin 1 - } - - default { - error "bad labelpos option \"$itk_option(-labelpos)\",\ - should be n, s, w or e" - } - } - - _packTime -} - -# ------------------------------------------------------------------ -# OPTION: -houron -# -# Specifies whether or not to display the hour spinner. -# ------------------------------------------------------------------ -configbody iwidgets::Spintime::houron { - _packTime -} - -# ------------------------------------------------------------------ -# OPTION: -minuteon -# -# Specifies whether or not to display the minute spinner. -# ------------------------------------------------------------------ -configbody iwidgets::Spintime::minuteon { - _packTime -} - -# ------------------------------------------------------------------ -# OPTION: -secondon -# -# Specifies whether or not to display the second spinner. -# ------------------------------------------------------------------ -configbody iwidgets::Spintime::secondon { - _packTime -} - - -# ------------------------------------------------------------------ -# OPTION: -timemargin -# -# Specifies the margin space between the hour and minute spinners -# and the minute and second spinners. -# ------------------------------------------------------------------ -configbody iwidgets::Spintime::timemargin { - _packTime -} - -# ------------------------------------------------------------------ -# OPTION: -militaryon -# -# Specifies 24-hour clock or 12-hour. -# ------------------------------------------------------------------ -configbody iwidgets::Spintime::militaryon { - set clicks [clock seconds] - - if {$itk_option(-militaryon)} { - $itk_component(hour) configure -range {0 23} - $itk_component(hour) delete 0 end - $itk_component(hour) insert end [clock format $clicks -format "%H"] - } else { - $itk_component(hour) configure -range {1 12} - $itk_component(hour) delete 0 end - $itk_component(hour) insert end [clock format $clicks -format "%I"] - } -} - -# ------------------------------------------------------------------ -# METHODS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# METHOD: get ?format? -# -# Get the value of the time spinner in one of two formats string or -# as an integer clock value using the -string and -clicks options -# respectively. The default is by string. Reference the clock -# command for more information on obtaining time and its formats. -# ------------------------------------------------------------------ -body iwidgets::Spintime::get {{format "-string"}} { - set hour [$itk_component(hour) get] - set minute [$itk_component(minute) get] - set second [$itk_component(second) get] - - switch -- $format { - "-string" { - return "$hour:$minute:$second" - } - "-clicks" { - return [clock scan "$hour:$minute:$second"] - } - default { - error "bad format option \"$format\":\ - should be -string or -clicks" - } - } -} - -# ------------------------------------------------------------------ -# PUBLIC METHOD: show time -# -# Changes the currently displayed time to be that of the time -# argument. The time may be specified either as a string or an -# integer clock value. Reference the clock command for more -# information on obtaining time and its format. -# ------------------------------------------------------------------ -body iwidgets::Spintime::show {{time "now"}} { - if {$time == "now"} { - set seconds [clock seconds] - } else { - if {[catch {clock format $time}] == 0} { - set seconds $time - } elseif {[catch {set seconds [clock scan $time]}] != 0} { - error "bad time: \"$time\", must be a valid time\ - string, clock clicks value or the keyword now" - } - } - - $itk_component(hour) delete 0 end - - if {$itk_option(-militaryon)} { - scan [clock format $seconds -format "%H"] "%d" hour - } else { - scan hour [clock format $seconds -format "%I"] "%d" hour - } - - $itk_component(hour) insert end $hour - - $itk_component(minute) delete 0 end - scan [clock format $seconds -format "%M"] "%d" minute - $itk_component(minute) insert end $minute - - $itk_component(second) delete 0 end - scan [clock format $seconds -format "%S"] "%d" seconds - $itk_component(second) insert end $seconds - - return -} - -# ------------------------------------------------------------------ -# PROTECTED METHOD: _packTime ?when? -# -# Pack components of time spinner. If "when" is "now", the change -# is applied immediately. If it is "later" or it is not specified, -# then the change is applied later, when the application is idle. -# ------------------------------------------------------------------ -body iwidgets::Spintime::_packTime {{when later}} { - if {$when == "later"} { - if {$_repack == ""} { - set _repack [after idle [code $this _packTime now]] - } - return - } elseif {$when != "now"} { - error "bad option \"$when\": should be now or later" - } - - for {set i 0} {$i < 5} {incr i} { - grid rowconfigure $_interior $i -minsize 0 - grid columnconfigure $_interior $i -minsize 0 - } - - if {$itk_option(-minuteon)} { - set minuteon 1 - } else { - set minuteon 0 - } - if {$itk_option(-secondon)} { - set secondon 1 - } else { - set secondon 0 - } - - set _repack "" - - switch $itk_option(-orient) { - vertical { - set row -1 - - if {$itk_option(-houron)} { - grid $itk_component(hour) -row [incr row] -column 0 \ - -sticky nsew - } else { - grid forget $itk_component(hour) - } - - if {$itk_option(-minuteon)} { - if {$itk_option(-houron)} { - grid rowconfigure $_interior [incr row] \ - -minsize $itk_option(-timemargin) - } - - grid $itk_component(minute) -row [incr row] -column 0 \ - -sticky nsew - } else { - grid forget $itk_component(minute) - } - - if {$itk_option(-secondon)} { - if {$minuteon || $secondon} { - grid rowconfigure $_interior [incr row] \ - -minsize $itk_option(-timemargin) - } - - grid $itk_component(second) -row [incr row] -column 0 \ - -sticky nsew - } else { - grid forget $itk_component(second) - } - - if {$itk_option(-labelpos) == "w"} { - iwidgets::Labeledwidget::alignlabels $itk_component(hour) \ - $itk_component(minute) $itk_component(second) - } - } - - horizontal { - set column -1 - - if {$itk_option(-houron)} { - grid $itk_component(hour) -row 0 -column [incr column] \ - -sticky nsew - } else { - grid forget $itk_component(hour) - } - - if {$itk_option(-minuteon)} { - if {$itk_option(-houron)} { - grid columnconfigure $_interior [incr column] \ - -minsize $itk_option(-timemargin) - } - - grid $itk_component(minute) -row 0 -column [incr column] \ - -sticky nsew - } else { - grid forget $itk_component(minute) - } - - if {$itk_option(-secondon)} { - if {$minuteon || $secondon} { - grid columnconfigure $_interior [incr column] \ - -minsize $itk_option(-timemargin) - } - - grid $itk_component(second) -row 0 -column [incr column] \ - -sticky nsew - } else { - grid forget $itk_component(second) - } - - # - # Un-align labels - # - $itk_component(hour) configure -labelmargin 1 - $itk_component(minute) configure -labelmargin 1 - $itk_component(second) configure -labelmargin 1 - } - - default { - error "bad orient option \"$itk_option(-orient)\", should\ - be \"vertical\" or \"horizontal\"" - } - } -} - -# ------------------------------------------------------------------ -# METHOD: down60 -# -# Down arrow button press event. Decrement value in the minute -# or second entry. -# ------------------------------------------------------------------ -body iwidgets::Spintime::_down60 {comp} { - set step [$itk_component($comp) cget -step] - set val [$itk_component($comp) get] - - incr val -$step - if {$val < 0} { - set val [expr 60-$step] - } - $itk_component($comp) delete 0 end - $itk_component($comp) insert 0 $val -} diff --git a/itcl/iwidgets3.0.0/generic/tabnotebook.itk b/itcl/iwidgets3.0.0/generic/tabnotebook.itk deleted file mode 100644 index c9d17264143..00000000000 --- a/itcl/iwidgets3.0.0/generic/tabnotebook.itk +++ /dev/null @@ -1,1075 +0,0 @@ -# -# Tabnotebook Widget -# ---------------------------------------------------------------------- -# The Tabnotebook command creates a new window (given by the pathName -# argument) and makes it into a Tabnotebook widget. Additional options, -# described above may be specified on the command line or in the option -# database to configure aspects of the Tabnotebook such as its colors, -# font, and text. The Tabnotebook command returns its pathName argument. -# At the time this command is invoked, there must not exist a window -# named pathName, but pathName's parent must exist. -# -# A Tabnotebook is a widget that contains a set of tabbed pages. It -# displays one page from the set as the selected page. A Tab displays -# the label for the page to which it is attached and serves as a page -# selector. When a page's tab is selected, the page's contents are -# displayed in the page area. The selected tab has a three-dimensional -# effect to make it appear to float above the other tabs. The tabs are -# displayed as a group along either the left, top, right, or bottom -# edge. When first created a Tabnotebook has no pages. Pages may be -# added or deleted using widget commands described below. -# -# A special option may be provided to the Tabnotebook. The -auto -# option specifies whether the Tabnotebook will automatically handle -# the unpacking and packing of pages when pages are selected. A value -# of true sig nifies that the notebook will automatically manage it. This -# is the default value. A value of false signifies the notebook will not -# perform automatic switching of pages. -# -# ---------------------------------------------------------------------- -# AUTHOR: Bill W. Scott EMAIL: bscott@spd.dsccc.com -# -# @(#) $Id$ -# ---------------------------------------------------------------------- -# Copyright (c) 1995 DSC Technologies Corporation -# ====================================================================== -# Permission to use, copy, modify, distribute and license this software -# and its documentation for any purpose, and without fee or written -# agreement with DSC, is hereby granted, provided that the above copyright -# notice appears in all copies and that both the copyright notice and -# warranty disclaimer below appear in supporting documentation, and that -# the names of DSC Technologies Corporation or DSC Communications -# Corporation not be used in advertising or publicity pertaining to the -# software without specific, written prior permission. -# -# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING -# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- -# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE -# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, -# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL -# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR -# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, -# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, -# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS -# SOFTWARE. -# ====================================================================== - -# -# Default resources. -# -option add *Tabnotebook.borderWidth 2 widgetDefault -option add *Tabnotebook.state normal widgetDefault -option add *Tabnotebook.disabledForeground #a3a3a3 widgetDefault -option add *Tabnotebook.scrollCommand {} widgetDefault -option add *Tabnotebook.equalTabs true widgetDefault -option add *Tabnotebook.font \ - -Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-* widgetDefault -option add *Tabnotebook.width 300 widgetDefault -option add *Tabnotebook.height 150 widgetDefault -option add *Tabnotebook.foreground Black widgetDefault -option add *Tabnotebook.background #d9d9d9 widgetDefault -option add *Tabnotebook.tabForeground Black widgetDefault -option add *Tabnotebook.tabBackground #d9d9d9 widgetDefault -option add *Tabnotebook.backdrop #d9d9d9 widgetDefault -option add *Tabnotebook.margin 4 widgetDefault -option add *Tabnotebook.tabBorders true widgetDefault -option add *Tabnotebook.bevelAmount 0 widgetDefault -option add *Tabnotebook.raiseSelect false widgetDefault -option add *Tabnotebook.auto true widgetDefault -option add *Tabnotebook.start 4 widgetDefault -option add *Tabnotebook.padX 4 widgetDefault -option add *Tabnotebook.padY 4 widgetDefault -option add *Tabnotebook.gap overlap widgetDefault -option add *Tabnotebook.angle 15 widgetDefault -option add *Tabnotebook.tabPos s widgetDefault - -# -# Usual options. -# -itk::usual Tabnotebook { - keep -backdrop -background -borderwidth -cursor -disabledforeground \ - -font -foreground -tabbackground -tabforeground -} - -# ------------------------------------------------------------------ -# TABNOTEBOOK -# ------------------------------------------------------------------ -class iwidgets::Tabnotebook { - inherit itk::Widget - - constructor {args} {} - destructor {} - - itk_option define -borderwidth borderWidth BorderWidth 2 - itk_option define -state state State normal - itk_option define \ - -disabledforeground disabledForeground DisabledForeground #a3a3a3 - itk_option define -scrollcommand scrollCommand ScrollCommand {} - itk_option define -equaltabs equalTabs EqualTabs true - itk_option define -font font Font \ - -Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-* - itk_option define -width width Width 300 - itk_option define -height height Height 150 - itk_option define -foreground foreground Foreground Black - itk_option define -background background Background #d9d9d9 - itk_option define -tabforeground tabForeground TabForeground Black - itk_option define -tabbackground tabBackground TabBackground #d9d9d9 - itk_option define -backdrop backdrop Backdrop #d9d9d9 - itk_option define -margin margin Margin 4 - itk_option define -tabborders tabBorders TabBorders true - itk_option define -bevelamount bevelAmount BevelAmount 0 - itk_option define -raiseselect raiseSelect RaiseSelect false - itk_option define -auto auto Auto true - itk_option define -start start Start 4 - itk_option define -padx padX PadX 4 - itk_option define -pady padY PadY 4 - itk_option define -gap gap Gap overlap - itk_option define -angle angle Angle 15 - itk_option define -tabpos tabPos TabPos s - - public method add { args } - public method configure { args } - public method childsite { args } - public method delete { args } - public method index { args } - public method insert { index args } - public method prev { } - public method next { } - public method pageconfigure { index args } - public method select { index } - public method view { args } - - protected method _reconfigureTabset { } - protected method _canvasReconfigure { wid hgt } - protected method _pageReconfigure { pageName page wid hgt } - - private method _getArgs { optList args } - private method _redrawBorder { wid hgt } - private method _recomputeBorder { } - private method _pack { tabPos } - - private variable _canvasWidth 0 ;# currently tabnote canvas width - private variable _canvasHeight 0 ;# currently tabnote canvas height - private variable _nbOptList {} ;# list of notebook options available - private variable _tsOptList {} ;# list of tabset options available - - private variable _tabPos s ;# holds -tabPos, because of ordering - - private variable _borderRecompute false ;# did we dirty border after cfg? - private variable _tabsetReconfigure false ;# did we dirty tabsets after cfg? - -} - -# ---------------------------------------------------------------------- -# CONSTRUCTOR -# ---------------------------------------------------------------------- -body iwidgets::Tabnotebook::constructor {args} { - component hull configure -borderwidth 0 - - # - # Create the outermost canvas to maintain geometry. - # - itk_component add canvas { - canvas $itk_interior.canvas -highlightthickness 0 - } { - keep -cursor -background -width -height - } - bind $itk_component(canvas) <Configure> \ - [code $this _canvasReconfigure %w %h] - - - # ....................... - # Create the NOTEBOOK - # - itk_component add notebook { - iwidgets::Notebook $itk_interior.canvas.notebook - } { - keep -cursor -background - } - - # - # Ouch, create a dummy page, go pageconfigure to get its options - # and munge them into a list for later doling by pageconfigure - # - $itk_component(notebook) add - set nbConfigList [$itk_component(notebook) pageconfigure 0] - foreach config $nbConfigList { - lappend _nbOptList [lindex $config 0] - } - $itk_component(notebook) delete 0 - - # - # Create the tabset. - # - itk_component add tabset { - iwidgets::Tabset $itk_interior.canvas.tabset \ - -command [code $this component notebook select] - } { - keep -cursor - } - - eval itk_initialize $args - - # - # Ouch, create a dummy tab, go tabconfigure to get its options - # and munge them into a list for later doling by pageconfigure - # - $itk_component(tabset) add - set tsConfigList [$itk_component(tabset) tabconfigure 0] - foreach config $tsConfigList { - lappend _tsOptList [lindex $config 0] - } - $itk_component(tabset) delete 0 - - bind $itk_component(tabset) <Configure> \ - [code $this _reconfigureTabset] - - _pack $_tabPos - -} - -proc ::iwidgets::tabnotebook {pathName args} { - uplevel ::iwidgets::Tabnotebook $pathName $args -} - - -# ------------------------------------------------------------- -# DESTRUCTOR: destroy the Tabnotebook -# ------------------------------------------------------------- -body iwidgets::Tabnotebook::destructor {} { -} - -# ---------------------------------------------------------------------- -# OPTION -borderwidth -# -# Thickness of Notebook Border -# ---------------------------------------------------------------------- -configbody iwidgets::Tabnotebook::borderwidth { - if {$itk_option(-borderwidth) != {}} { - #_recomputeBorder - set _borderRecompute true - } -} - -# ---------------------------------------------------------------------- -# OPTION -state -# -# State of the tabs in the tab notebook: normal or disabled -# ---------------------------------------------------------------------- -configbody iwidgets::Tabnotebook::state { - if {$itk_option(-state) != {}} { - $itk_component(tabset) configure -state $itk_option(-state) - #_reconfigureTabset - set _tabsetReconfigure true - - } -} - -# ---------------------------------------------------------------------- -# OPTION -disabledforeground -# -# Specifies a foreground color to use for displaying a -# tab's label when its state is disabled. -# ---------------------------------------------------------------------- -configbody iwidgets::Tabnotebook::disabledforeground { - - if {$itk_option(-disabledforeground) != {}} { - $itk_component(tabset) configure \ - -disabledforeground $itk_option(-disabledforeground) - #_reconfigureTabset - set _tabsetReconfigure true - } -} - -# ---------------------------------------------------------------------- -# OPTION -scrollcommand -# -# Standard option. See options man pages. -# ---------------------------------------------------------------------- -configbody iwidgets::Tabnotebook::scrollcommand { - - if {$itk_option(-scrollcommand) != {}} { - $itk_component(notebook) \ - configure -scrollcommand $itk_option(-scrollcommand) - } -} - -# ---------------------------------------------------------------------- -# OPTION -equaltabs -# -# Specifies whether to force tabs to be equal sized or not. -# A value of true means constrain tabs to be equal sized. -# A value of false allows each tab to size based on the text -# label size. The value may have any of the forms accepted by -# the Tcl_GetBoolean, such as true, false, 0, 1, yes, or no. -# ---------------------------------------------------------------------- -configbody iwidgets::Tabnotebook::equaltabs { - - if {$itk_option(-equaltabs) != {}} { - $itk_component(tabset) \ - configure -equaltabs $itk_option(-equaltabs) - #_reconfigureTabset - set _tabsetReconfigure true - } -} - -# ---------------------------------------------------------------------- -# OPTION -font -# -# Font for tab labels when they are set to text (-label set) -# ---------------------------------------------------------------------- -configbody iwidgets::Tabnotebook::font { - - if {$itk_option(-font) != {}} { - $itk_component(tabset) configure -font $itk_option(-font) - #_reconfigureTabset - set _tabsetReconfigure true - } -} - -# ---------------------------------------------------------------------- -# OPTION -width -# -# Width of the Tabnotebook -# ---------------------------------------------------------------------- -configbody iwidgets::Tabnotebook::width { - if {$itk_option(-width) != {}} { - $itk_component(canvas) configure -width $itk_option(-width) - #_recomputeBorder - set _borderRecompute true - } -} - -# ---------------------------------------------------------------------- -# OPTION -height -# -# Height of the Tabnotebook -# ---------------------------------------------------------------------- -configbody iwidgets::Tabnotebook::height { - if {$itk_option(-height) != {}} { - $itk_component(canvas) configure -height $itk_option(-height) - #_recomputeBorder - set _borderRecompute true - } -} - -# ---------------------------------------------------------------------- -# OPTION -foreground -# -# Specifies a foreground color to use for displaying a page -# and its associated tab label (this is the selected state). -# ---------------------------------------------------------------------- -configbody iwidgets::Tabnotebook::foreground { - - if {$itk_option(-foreground) != {}} { - $itk_component(tabset) configure \ - -selectforeground $itk_option(-foreground) - } -} - -# ---------------------------------------------------------------------- -# OPTION -background -# -# Specifies a background color to use for displaying a page -# and its associated tab bg (this is the selected state). -# ---------------------------------------------------------------------- -configbody iwidgets::Tabnotebook::background { - - if {$itk_option(-background) != {}} { - $itk_component(tabset) configure \ - -selectbackground $itk_option(-background) - #_recomputeBorder - set _borderRecompute true - } -} - -# ---------------------------------------------------------------------- -# OPTION -tabforeground -# -# Specifies a foreground color to use for displaying tab labels -# when they are in their unselected state. -# ---------------------------------------------------------------------- -configbody iwidgets::Tabnotebook::tabforeground { - - if {$itk_option(-tabforeground) != {}} { - $itk_component(tabset) configure \ - -foreground $itk_option(-tabforeground) - } -} - -# ---------------------------------------------------------------------- -# OPTION -tabbackground -# -# Specifies a background color to use for displaying tab backgrounds -# when they are in their unselected state. -# ---------------------------------------------------------------------- -configbody iwidgets::Tabnotebook::tabbackground { - - if {$itk_option(-tabbackground) != {}} { - $itk_component(tabset) configure \ - -background $itk_option(-tabbackground) - } -} - -# ---------------------------------------------------------------------- -# OPTION -backdrop -# -# Specifies a background color to use when filling in the -# area behind the tabs. -# ---------------------------------------------------------------------- -configbody iwidgets::Tabnotebook::backdrop { - - if {$itk_option(-backdrop) != {}} { - $itk_component(tabset) configure \ - -backdrop $itk_option(-backdrop) - } -} - -# ---------------------------------------------------------------------- -# OPTION -margin -# -# Sets the backdrop margin between tab edge and backdrop edge -# ---------------------------------------------------------------------- -configbody iwidgets::Tabnotebook::margin { - if {$itk_option(-margin) != {}} { - $itk_component(tabset) configure -margin $itk_option(-margin) - } -} - -# ---------------------------------------------------------------------- -# OPTION -tabborders -# -# Boolean that specifies whether to draw the borders of -# the unselected tabs (tabs in background) -# ---------------------------------------------------------------------- -configbody iwidgets::Tabnotebook::tabborders { - if {$itk_option(-tabborders) != {}} { - $itk_component(tabset) \ - configure -tabborders $itk_option(-tabborders) - #_reconfigureTabset - set _tabsetReconfigure true - } -} - -# ---------------------------------------------------------------------- -# OPTION -bevelamount -# -# Specifies pixel size of tab corners. 0 means no corners. -# ---------------------------------------------------------------------- -configbody iwidgets::Tabnotebook::bevelamount { - if {$itk_option(-bevelamount) != {}} { - $itk_component(tabset) \ - configure -bevelamount $itk_option(-bevelamount) - #_reconfigureTabset - set _tabsetReconfigure true - } -} - -# ---------------------------------------------------------------------- -# OPTION -raiseselect -# -# Sets whether to raise selected tabs -# ---------------------------------------------------------------------- -configbody iwidgets::Tabnotebook::raiseselect { - if {$itk_option(-raiseselect) != {}} { - $itk_component(tabset) \ - configure -raiseselect $itk_option(-raiseselect) - #_reconfigureTabset - set _tabsetReconfigure true - } -} - -# ---------------------------------------------------------------------- -# OPTION -auto -# -# Determines whether pages are automatically unpacked and -# packed when pages get selected. -# ---------------------------------------------------------------------- -configbody iwidgets::Tabnotebook::auto { - if {$itk_option(-auto) != {}} { - $itk_component(notebook) configure -auto $itk_option(-auto) - } -} - -# ---------------------------------------------------------------------- -# OPTION -start -# ---------------------------------------------------------------------- -configbody iwidgets::Tabnotebook::start { - - if {$itk_option(-start) != {}} { - $itk_component(tabset) configure \ - -start $itk_option(-start) - #_reconfigureTabset - set _tabsetReconfigure true - } -} - -# ---------------------------------------------------------------------- -# OPTION -padx -# -# Specifies a non-negative value indicating how much extra space -# to request for a tab around its label in the X-direction. -# When computing how large a window it needs, the tab will add -# this amount to the width it would normally need The tab will -# end up with extra internal space to the left and right of its -# text label. This value may have any of the forms acceptable -# to Tk_GetPixels. -# ---------------------------------------------------------------------- -configbody iwidgets::Tabnotebook::padx { - - if {$itk_option(-padx) != {}} { - $itk_component(tabset) configure -padx $itk_option(-padx) - #_reconfigureTabset - set _tabsetReconfigure true - } -} - -# ---------------------------------------------------------------------- -# OPTION -pady -# -# Specifies a non-negative value indicating how much extra space to -# request for a tab around its label in the Y-direction. When computing -# how large a window it needs, the tab will add this amount to the -# height it would normally need The tab will end up with extra internal -# space to the top and bot tom of its text label. This value may have -# any of the forms acceptable to Tk_GetPixels. -# ---------------------------------------------------------------------- -configbody iwidgets::Tabnotebook::pady { - - if {$itk_option(-pady) != {}} { - $itk_component(tabset) configure -pady $itk_option(-pady) - #_reconfigureTabset - set _tabsetReconfigure true - } -} - -# ---------------------------------------------------------------------- -# OPTION -gap -# -# Specifies the amount of pixel space to place between each tab. -# Value may be any pixel offset value. In addition, a special keyword -# 'overlap' can be used as the value to achieve a standard overlap of -# tabs. This value may have any of the forms acceptable to Tk_GetPixels. -# ---------------------------------------------------------------------- -configbody iwidgets::Tabnotebook::gap { - - if {$itk_option(-gap) != {}} { - $itk_component(tabset) configure -gap $itk_option(-gap) - #_reconfigureTabset - set _tabsetReconfigure true - } -} - -# ---------------------------------------------------------------------- -# OPTION -angle -# -# Specifes the angle of slope from the inner edge to the outer edge -# of the tab. An angle of 0 specifies square tabs. Valid ranges are -# 0 to 45 degrees inclusive. Default is 15 degrees. If tabPos is -# e or w, this option is ignored. -# ---------------------------------------------------------------------- -configbody iwidgets::Tabnotebook::angle { - - if {$itk_option(-angle) != {}} { - $itk_component(tabset) configure -angle $itk_option(-angle) - #_reconfigureTabset - set _tabsetReconfigure true - } -} - -# ---------------------------------------------------------------------- -# OPTION -tabpos -# -# Specifies the location of the set of tabs in relation to the -# Notebook area. Must be n, s, e, or w. Defaults to s. -# ---------------------------------------------------------------------- -configbody iwidgets::Tabnotebook::tabpos { - - if {$itk_option(-tabpos) != {}} { - set _tabPos $itk_option(-tabpos) - $itk_component(tabset) configure \ - -tabpos $itk_option(-tabpos) - pack forget $itk_component(canvas) - pack forget $itk_component(tabset) - pack forget $itk_component(notebook) - _pack $_tabPos - } -} - -# ------------------------------------------------------------- -# METHOD: configure ?<option>? ?<value> <option> <value>...? -# -# Acts as an addendum to the itk::Widget::configure method. -# -# Checks the _recomputeBorder flag and the _tabsetReconfigure to -# determine what work has been batched to after the configure -# ------------------------------------------------------------- -body iwidgets::Tabnotebook::configure { args } { - set result [eval itk::Archetype::configure $args] - - # check for flags then do update... - if { $_borderRecompute == "true" } { - _recomputeBorder - set _borderRecompute false - } - - if { $_tabsetReconfigure == "true" } { - _reconfigureTabset - set _tabsetReconfigure false - } - - return $result - -} - -# ------------------------------------------------------------- -# METHOD: add ?<option> <value>...? -# -# Creates a page and appends it to the list of pages. -# processes pageconfigure for the page added. -# -# Returns the page's childsite frame -# ------------------------------------------------------------- -body iwidgets::Tabnotebook::add { args } { - - # The args list should be an even # of params, if not then - # prob missing value for last item in args list. Signal error. - set len [llength $args] - if { [expr $len % 2] } { - error "value for \"[lindex $args [expr $len - 1]]\" missing" - } - - # pick out the notebook args - set nbArgs [eval _getArgs [list $_nbOptList] $args] - set pageName [eval $itk_component(notebook) add $nbArgs] - - # pick out the tabset args - set tsArgs [eval _getArgs [list $_tsOptList] $args] - eval $itk_component(tabset) add $tsArgs - - set page [index end] - bind $pageName <Configure> \ - [code $this _pageReconfigure $pageName $page %w %h] - return $pageName -} - -# ------------------------------------------------------------- -# METHOD: childsite ?<index>? -# -# If index is supplied, returns the child site widget -# corresponding to the page index. If called with no arguments, -# returns a list of all child sites -# ------------------------------------------------------------- -body iwidgets::Tabnotebook::childsite { args } { - return [eval $itk_component(notebook) childsite $args] -} - -# ------------------------------------------------------------- -# METHOD: delete <index1> ?<index2>? -# -# Deletes a page or range of pages from the notebook -# ------------------------------------------------------------- -body iwidgets::Tabnotebook::delete { args } { - eval $itk_component(notebook) delete $args - eval $itk_component(tabset) delete $args -} - - -# ------------------------------------------------------------- -# METHOD: index <index> -# -# Given an index identifier returns the numeric index of the page -# ------------------------------------------------------------- -body iwidgets::Tabnotebook::index { args } { - return [eval $itk_component(notebook) index $args] -} - -# ------------------------------------------------------------- -# METHOD: insert <index> ?<option> <value>...? -# -# Inserts a page before a index. The before page may -# be specified as a label or a page position. -# -# Note that since we use eval to preserve the $args list, -# we must use list around $index to keep it together as a unit -# -# Returns the name of the page's child site -# ------------------------------------------------------------- -body iwidgets::Tabnotebook::insert { index args } { - - # pick out the notebook args - set nbArgs [eval _getArgs [list $_nbOptList] $args] - set pageName [eval $itk_component(notebook) insert [list $index] $nbArgs] - - # pick out the tabset args - set tsArgs [eval _getArgs [list $_tsOptList] $args] - eval $itk_component(tabset) insert [list $index] $tsArgs - - return $pageName - -} - -# ------------------------------------------------------------- -# METHOD: prev -# -# Selects the previous page. Wraps at first back to last page. -# ------------------------------------------------------------- -body iwidgets::Tabnotebook::prev { } { - eval $itk_component(notebook) prev - eval $itk_component(tabset) prev -} - -# ------------------------------------------------------------- -# METHOD: next -# -# Selects the next page. Wraps at last back to first page. -# ------------------------------------------------------------- -body iwidgets::Tabnotebook::next { } { - eval $itk_component(notebook) next - eval $itk_component(tabset) next -} - -# ------------------------------------------------------------- -# METHOD: pageconfigure <index> ?<option> <value>...? -# -# Performs configure on a given page denoted by index. -# Index may be a page number or a pattern matching the label -# associated with a page. -# ------------------------------------------------------------- -body iwidgets::Tabnotebook::pageconfigure { index args } { - - set nbArgs [eval _getArgs [list $_nbOptList] $args] - set tsArgs [eval _getArgs [list $_tsOptList] $args] - - set len [llength $args] - switch $len { - 0 { - # Here is the case where they just want to query options - set nbConfig \ - [eval $itk_component(notebook) pageconfigure $index $nbArgs] - set tsConfig \ - [eval $itk_component(tabset) tabconfigure $index $tsArgs] - # - # BUG: this currently just concatenates a page and a tab's - # config lists together... We should bias to the Page - # since this is what we are using as primary when both?? - # - # a pageconfigure index -background will return something like: - # -background background Background #9D008FF583C1 gray70 \ - # -background background background white gray 70 - # - return [concat $nbConfig $tsConfig] - } - 1 { - # Here is the case where they are asking for only one - # one options value... need to figure out which one - # (page or tab) can service this. Then only return - # that one's result. - - if { [llength $nbArgs] != 0 } { - return [eval $itk_component(notebook) \ - pageconfigure $index $nbArgs] - } elseif { [llength $tsArgs] != 0 } { - return [eval $itk_component(tabset) \ - tabconfigure $index $tsArgs] - } else { - error "unknown option \"$args\"" - } - - } - default { - - # pick out the notebook args - set nbConfig \ - [eval $itk_component(notebook) \ - pageconfigure [list $index] $nbArgs] - - # pick out the tabset args - set tsConfig \ - [eval $itk_component(tabset) \ - tabconfigure [list $index] $tsArgs] - - return "" - #return [concat $nbConfig $tsConfig] - - } - } -} - -# ------------------------------------------------------------- -# METHOD: select index -# -# Select a page by index -# ------------------------------------------------------------- -body iwidgets::Tabnotebook::select { index } { - $itk_component(notebook) select $index - $itk_component(tabset) select $index -} - -# ------------------------------------------------------------- -# METHOD: view -# -# Return the current page -# -# view index -# -# Selects the page denoted by index to be current page -# -# view 'moveto' fraction -# -# Selects the page by using fraction amount -# -# view 'scroll' num what -# -# Selects the page by using num as indicator of next or -# previous -# -# ------------------------------------------------------------- -body iwidgets::Tabnotebook::view { args } { - eval $itk_component(notebook) view $args - $itk_component(tabset) select [index select] -} - -# ------------------------------------------------------------- -# PRIVATE METHOD: _getArgs -# -# Given an optList returned from a configure on an object and -# given a candidate argument list, peruse throught the optList -# and build a new argument list with only those options found -# in optList. -# -# This is used by the add, insert, and pageconfigure methods. -# It is useful for a container kind of class like Tabnotebook -# to be smart about args it gets for its concept of a "page" -# which is actually a Notebook Page and a Tabset Tab. -# -# ------------------------------------------------------------- -body iwidgets::Tabnotebook::_getArgs { optList args } { - - set len [llength $args] - - set retArgs {} - - for {set i 0} {$i < $len} {incr i} { - # get the option for this pair - set opt [lindex $args $i] - - # move ahead to the value - incr i - - # option exists! - if { [lsearch -exact $optList $opt] != -1} { - lappend retArgs $opt - if {$i < [llength $args]} { - lappend retArgs [lindex $args $i] - } - # option does not exist - } - } - - return $retArgs -} - -# ------------------------------------------------------------- -# PROTECTED METHOD: _reconfigureTabset -# -# bound to the tabset reconfigure... We call our canvas -# reconfigure as if the canvas resized, it then configures -# the tabset correctly. -# ------------------------------------------------------------- -body iwidgets::Tabnotebook::_reconfigureTabset { } { - - _canvasReconfigure $_canvasWidth $_canvasHeight - -} - -# ------------------------------------------------------------- -# PROTECTED METHOD: _canvasReconfigure -# -# bound to window Reconfigure event of the canvas -# keeps the tabset area stretched in its major dimension. -# ------------------------------------------------------------- -body iwidgets::Tabnotebook::_canvasReconfigure { wid hgt } { - - if { $_tabPos == "n" || $_tabPos == "s" } { - $itk_component(tabset) configure -width $wid - } else { - $itk_component(tabset) configure -height $hgt - } - - set _canvasWidth $wid - set _canvasHeight $hgt - - _redrawBorder $wid $hgt - -} - -# ------------------------------------------------------------- -# PRIVATE METHOD: _redrawBorder -# -# called by methods when the packing changes, borderwidths, etc. -# and height -# ------------------------------------------------------------- -body iwidgets::Tabnotebook::_redrawBorder { wid hgt } { - - # Get the top of the Notebook area... - - set nbTop [winfo y $itk_component(notebook)] - set canTop [expr $nbTop - $itk_option(-borderwidth)] - - $itk_component(canvas) delete BORDER - if { $itk_option(-borderwidth) > 0 } { - - # For south, east, and west -- draw the top/north edge - if { $_tabPos != "n" } { - $itk_component(canvas) create line \ - [expr floor(0 + ($itk_option(-borderwidth)/2.0))] \ - [expr floor(0 + ($itk_option(-borderwidth)/2.0))] \ - $wid \ - [expr floor(0 + ($itk_option(-borderwidth)/2.0))] \ - -width $itk_option(-borderwidth) \ - -fill [iwidgets::colors::topShadow $itk_option(-background)] \ - -tags BORDER - } - - # For north, east, and west -- draw the bottom/south edge - if { $_tabPos != "s" } { - $itk_component(canvas) create line \ - [expr floor(0 + ($itk_option(-borderwidth)/2.0))] \ - [expr floor($hgt - ($itk_option(-borderwidth)/2.0))] \ - [expr floor($wid - ($itk_option(-borderwidth)/2.0))] \ - [expr floor($hgt - ($itk_option(-borderwidth)/2.0))] \ - -width $itk_option(-borderwidth) \ - -fill [iwidgets::colors::bottomShadow $itk_option(-background)] \ - -tags BORDER - } - - # For north, south, and east -- draw the left/west edge - if { $_tabPos != "w" } { - $itk_component(canvas) create line \ - [expr floor(0 + ($itk_option(-borderwidth)/2.0))] \ - 0 \ - [expr floor(0 + ($itk_option(-borderwidth)/2.0))] \ - $hgt \ - -width $itk_option(-borderwidth) \ - -fill [iwidgets::colors::topShadow $itk_option(-background)] \ - -tags BORDER - } - - # For north, south, and west -- draw the right/east edge - if { $_tabPos != "e" } { - $itk_component(canvas) create line \ - [expr floor($wid - ($itk_option(-borderwidth)/2.0))] \ - [expr floor(0 + ($itk_option(-borderwidth)/2.0))] \ - [expr floor($wid - ($itk_option(-borderwidth)/2.0))] \ - $hgt \ - -width $itk_option(-borderwidth) \ - -fill [iwidgets::colors::bottomShadow $itk_option(-background)] \ - -tags BORDER - } - } - -} - -# ------------------------------------------------------------- -# PRIVATE METHOD: _recomputeBorder -# -# Based on current width and height of our canvas, repacks -# the notebook with padding for borderwidth, and calls -# redraw border method -# ------------------------------------------------------------- -body iwidgets::Tabnotebook::_recomputeBorder { } { - - set wid [winfo width $itk_component(canvas)] - set hgt [winfo height $itk_component(canvas)] - - _pack $_tabPos - _redrawBorder $wid $hgt -} - -# ------------------------------------------------------------- -# PROTECTED METHOD: _pageReconfigure -# -# This method will eventually reconfigure the tab notebook's -# notebook area to contain the resized child site -# ------------------------------------------------------------- -body iwidgets::Tabnotebook::_pageReconfigure { pageName page wid hgt } { - -} - -# ------------------------------------------------------------- -# PRIVATE METHOD: _pack -# -# This method packs the notebook and tabset correctly according -# to the current $tabPos -# ------------------------------------------------------------- -body iwidgets::Tabnotebook::_pack { tabPos } { - - pack $itk_component(canvas) -fill both -expand yes - pack propagate $itk_component(canvas) no - - switch $tabPos { - n { - # north - pack $itk_component(tabset) \ - -anchor nw \ - -fill x \ - -expand no - pack $itk_component(notebook) \ - -fill both \ - -expand yes \ - -padx $itk_option(-borderwidth) \ - -pady $itk_option(-borderwidth) \ - -side bottom - } - s { - # south - pack $itk_component(notebook) \ - -anchor nw \ - -fill both \ - -expand yes \ - -padx $itk_option(-borderwidth) \ - -pady $itk_option(-borderwidth) - - pack $itk_component(tabset) \ - -side left \ - -fill x \ - -expand yes - } - w { - # west - pack $itk_component(tabset) \ - -anchor nw \ - -side left \ - -fill y \ - -expand no - pack $itk_component(notebook) \ - -anchor nw \ - -side left \ - -fill both \ - -expand yes \ - -padx $itk_option(-borderwidth) \ - -pady $itk_option(-borderwidth) - - } - e { - # east - pack $itk_component(notebook) \ - -side left \ - -anchor nw \ - -fill both \ - -expand yes \ - -padx $itk_option(-borderwidth) \ - -pady $itk_option(-borderwidth) - - pack $itk_component(tabset) \ - -fill y \ - -expand yes - } - } - - set wid [winfo width $itk_component(canvas)] - set hgt [winfo height $itk_component(canvas)] - - _redrawBorder $wid $hgt -} diff --git a/itcl/iwidgets3.0.0/generic/tabset.itk b/itcl/iwidgets3.0.0/generic/tabset.itk deleted file mode 100644 index f26d66a42de..00000000000 --- a/itcl/iwidgets3.0.0/generic/tabset.itk +++ /dev/null @@ -1,2747 +0,0 @@ -# -# Tabset Widget and the Tab Class -# ---------------------------------------------------------------------- -# A Tabset is a widget that contains a set of Tab buttons. -# It displays these tabs in a row or column depending on it tabpos. -# When a tab is clicked on, it becomes the only tab in the tab set that -# is selected. All other tabs are deselected. The Tcl command prefix -# associated with this tab (through the command tab configure option) -# is invoked with the tab index number appended to its argument list. -# This allows the Tabset to control another widget such as a Notebook. -# -# A Tab class is an [incr Tcl] class that displays either an image, -# bitmap, or label in a graphic object on a canvas. This graphic object -# can have a wide variety of appearances depending on the options set. -# -# WISH LIST: -# This section lists possible future enhancements. -# -# 1) When too many tabs appear, a small scrollbar should appear to -# move the tabs over. -# -# ---------------------------------------------------------------------- -# AUTHOR: Bill W. Scott EMAIL: bscott@spd.dsccc.com -# -# @(#) $Id$ -# ---------------------------------------------------------------------- -# Copyright (c) 1995 DSC Technologies Corporation -# ====================================================================== -# Permission to use, copy, modify, distribute and license this software -# and its documentation for any purpose, and without fee or written -# agreement with DSC, is hereby granted, provided that the above copyright -# notice appears in all copies and that both the copyright notice and -# warranty disclaimer below appear in supporting documentation, and that -# the names of DSC Technologies Corporation or DSC Communications -# Corporation not be used in advertising or publicity pertaining to the -# software without specific, written prior permission. -# -# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING -# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- -# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE -# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, -# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL -# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR -# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, -# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, -# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS -# SOFTWARE. -# ====================================================================== - -# -# Default resources. -# -option add *Tabset.width 0 widgetDefault -option add *Tabset.height 0 widgetDefault -option add *Tabset.equalTabs true widgetDefault -option add *Tabset.tabPos s widgetDefault -option add *Tabset.raiseSelect false widgetDefault -option add *Tabset.start 4 widgetDefault -option add *Tabset.margin 5 widgetDefault -option add *Tabset.tabBorders true widgetDefault -option add *Tabset.bevelAmount 0 widgetDefault -option add *Tabset.padX 4 widgetDefault -option add *Tabset.padY 4 widgetDefault -option add *Tabset.gap overlap widgetDefault -option add *Tabset.angle 20 widgetDefault -option add *Tabset.font fixed widgetDefault -option add *Tabset.state normal widgetDefault -option add *Tabset.disabledForeground #a3a3a3 widgetDefault -option add *Tabset.foreground black widgetDefault -option add *Tabset.background #d9d9d9 widgetDefault -option add *Tabset.selectForeground black widgetDefault -option add *Tabset.selectBackground #ececec widgetDefault - -# -# Usual options. -# -itk::usual Tabset { - keep -backdrop -background -cursor -disabledforeground -font -foreground \ - -selectbackground -selectforeground -} - -# ------------------------------------------------------------------ -# TABSET -# ------------------------------------------------------------------ -class iwidgets::Tabset { - inherit itk::Widget - - constructor {args} {} - destructor {} - - itk_option define -width width Width 0 - itk_option define -equaltabs equalTabs EqualTabs true - itk_option define -height height Height 0 - itk_option define -tabpos tabPos TabPos s - itk_option define -raiseselect raiseSelect RaiseSelect false - itk_option define -start start Start 4 - itk_option define -margin margin Margin 5 - itk_option define -tabborders tabBorders TabBorders true - itk_option define -bevelamount bevelAmount BevelAmount 0 - itk_option define -padx padX PadX 4 - itk_option define -pady padY PadY 4 - itk_option define -gap gap Gap overlap - itk_option define -angle angle Angle 20 - itk_option define -font font Font fixed - itk_option define -state state State normal - itk_option define \ - -disabledforeground disabledForeground DisabledForeground #a3a3a3 - itk_option define -foreground foreground Foreground black - itk_option define -background background Background #d9d9d9 - itk_option define -selectforeground selectForeground Background black - itk_option define -backdrop backdrop Backdrop white - itk_option define -selectbackground selectBackground Foreground #ececec - itk_option define -command command Command {} - - public method configure {args} - public method add {args} - public method delete {args} - public method index {index} - public method insert {index args} - public method prev {} - public method next {} - public method select {index} - public method tabcget {index args} - public method tabconfigure {index args} - - protected method _selectName {tabName} - - private method _createTab {args} - private method _deleteTabs {fromTab toTab} - private method _index {pathList index select} - private method _tabConfigure {args} - private method _relayoutTabs {} - private method _drawBevelBorder {} - private method _calcNextTabOffset {tabName} - private method _tabBounds {} - private method _recalcCanvasGeom {} - private method _canvasReconfigure {width height} - private method _startMove {x y} - private method _moveTabs {x y} - private method _endMove {x y} - private method _configRelayout {} - - private variable _width 0 ;# Width of the canvas in screen units - private variable _height 0 ;# Height of the canvas in screen units - private variable _selectedTop 0 ;# top edge of tab + a margin - private variable _deselectedTop 0 ;# top edge of tab + a margin&raiseamt - private variable _selectedLeft 0 ;# left edge of tab + a margin - private variable _deselectedLeft 0 ;# left edge of tab + a margin&raiseamt - private variable _tabs {} ;# our internal list of tabs - private variable _currTab -1 ;# numerical index # of selected tab - private variable _uniqueID 0 ;# used to create unique names - private variable _cmdStr {} ;# holds value of itk_option(-command) - ;# do not know why I need this! - private variable _canvasWidth 0 ;# set by canvasReconfigure, is can wid - private variable _canvasHeight 0 ;# set by canvasReconfigure, is can hgt - - private variable _anchorX 0 ;# used by mouse scrolling methods - private variable _anchorY 0 ;# used by mouse scrolling methods - - private variable _margin 0 ;# -margin in screen units - private variable _start 0 ;# -start in screen units - private variable _gap overlap ;# -gap in screen units - - private variable _relayout false ;# flag tripped to tell whether to - ;# relayout tabs after the configure - private variable _skipRelayout false ;# flag that tells whether to skip - ;# relayouting out the tabs. used by - ;# _endMove. -} - -# -# Provide a lowercase access method for the Tabset class -# -proc ::iwidgets::tabset {pathName args} { - uplevel ::iwidgets::Tabset $pathName $args -} - -# ---------------------------------------------------------------------- -# CONSTRUCTOR -# ---------------------------------------------------------------------- -body iwidgets::Tabset::constructor {args} { - global tcl_platform - - # - # Create the canvas that holds the tabs - # - itk_component add canvas { - canvas $itk_interior.canvas -highlightthickness 0 - } { - keep -cursor -width -height - } - pack $itk_component(canvas) -fill both -expand yes -anchor nw - - # ... This gives us a chance to redraw our bevel borders, etc when - # the size of our canvas changes... - bind $itk_component(canvas) <Configure> \ - [code $this _canvasReconfigure %w %h] - - # ... Allow button 2 scrolling as in label widget. - if {$tcl_platform(os) != "HP-UX"} { - bind $itk_component(canvas) <2> \ - [code $this _startMove %x %y] - bind $itk_component(canvas) <B2-Motion> \ - [code $this _moveTabs %x %y] - bind $itk_component(canvas) <ButtonRelease-2> \ - [code $this _endMove %x %y] - } - - # @@@ - # @@@ Is there a better way? - # @@@ - bind $itk_component(hull) <Any-Enter> "focus $itk_component(hull)" - bind $itk_component(hull) <Tab> [code $this next] - bind $itk_component(hull) <Shift-Tab> [code $this prev] - - eval itk_initialize $args - - _configRelayout - - _recalcCanvasGeom - -} - -body iwidgets::Tabset::destructor {} { - foreach tab $_tabs { - itcl::delete object $tab - } -} - -# ---------------------------------------------------------------------- -# OPTIONS -# ---------------------------------------------------------------------- - -# ---------------------------------------------------------------------- -# OPTION -width -# -# Sets the width explicitly for the canvas of the tabset -# ---------------------------------------------------------------------- -configbody iwidgets::Tabset::width { - if {$itk_option(-width) != {}} { - } - set _width [winfo pixels $itk_interior $itk_option(-width)] -} - -# ---------------------------------------------------------------------- -# OPTION -equaltabs -# -# If set to true, causes horizontal tabs to be equal in -# in width and vertical tabs to equal in height. -# ---------------------------------------------------------------------- -configbody iwidgets::Tabset::equaltabs { - if {$itk_option(-equaltabs) != {}} { - set _relayout true - } -} - -# ---------------------------------------------------------------------- -# OPTION -height -# -# Sets the height explicitly for the canvas of the tabset -# ---------------------------------------------------------------------- -configbody iwidgets::Tabset::height { - set _height [winfo pixels $itk_interior $itk_option(-height)] -} - -# ---------------------------------------------------------------------- -# OPTION -tabpos -# -# Sets the tab position of tabs, n, s, e, w -# ---------------------------------------------------------------------- -configbody iwidgets::Tabset::tabpos { - if {$itk_option(-tabpos) != {}} { - switch $itk_option(-tabpos) { - n { - _tabConfigure -invert true -orient horizontal - } - s { - _tabConfigure -invert false -orient horizontal - } - w { - _tabConfigure -invert false -orient vertical - } - e { - _tabConfigure -invert true -orient vertical - } - default { - error "bad anchor position\ - \"$itk_option(-tabpos)\" must be n, s, e, or w" - } - } - } -} - -# ---------------------------------------------------------------------- -# OPTION -raiseselect -# -# Sets whether to raise selected tabs slightly -# ---------------------------------------------------------------------- -configbody iwidgets::Tabset::raiseselect { - if {$itk_option(-raiseselect) != {}} { - set _relayout true - } -} - -# ---------------------------------------------------------------------- -# OPTION -start -# -# Sets the offset to start of tab set -# ---------------------------------------------------------------------- -configbody iwidgets::Tabset::start { - if {$itk_option(-start) != {}} { - set _start [winfo pixels $itk_interior $itk_option(-start)] - set _relayout true - } else { - set _start 4 - } -} - -# ---------------------------------------------------------------------- -# OPTION -margin -# -# Sets the margin used above n tabs, below s tabs, left of e -# tabs, right of w tabs -# ---------------------------------------------------------------------- -configbody iwidgets::Tabset::margin { - if {$itk_option(-margin) != {}} { - set _margin [winfo pixels $itk_interior $itk_option(-margin)] - set _relayout true - } else { - set _margin 5 - } -} - -# ---------------------------------------------------------------------- -# OPTION -tabborders -# -# Boolean that specifies whether to draw the borders of -# the unselected tabs (tabs in background) -# ---------------------------------------------------------------------- -configbody iwidgets::Tabset::tabborders { - if {$itk_option(-tabborders) != {}} { - _tabConfigure -tabborders $itk_option(-tabborders) - } -} - -# ---------------------------------------------------------------------- -# OPTION -bevelamount -# -# Specifies pixel size of tab corners. 0 means no corners. -# ---------------------------------------------------------------------- -configbody iwidgets::Tabset::bevelamount { - if {$itk_option(-bevelamount) != {}} { - _tabConfigure -bevelamount $itk_option(-bevelamount) - } -} - -# ---------------------------------------------------------------------- -# OPTION -padx -# -# Sets the padding in each tab to the left and right of label -# I don't convert for fpixels, since Tab does it for me. -# ---------------------------------------------------------------------- -configbody iwidgets::Tabset::padx { - if {$itk_option(-padx) != {}} { - _tabConfigure -padx $itk_option(-padx) - } -} - -# ---------------------------------------------------------------------- -# OPTION -pady -# -# Sets the padding in each tab to the left and right of label -# I don't convert for fpixels, since Tab does it for me. -# ---------------------------------------------------------------------- -configbody iwidgets::Tabset::pady { - if {$itk_option(-pady) != {}} { - _tabConfigure -pady $itk_option(-pady) - } -} - -# ---------------------------------------------------------------------- -# OPTION -gap -# -# Sets the amount of spacing between tabs in pixels -# ---------------------------------------------------------------------- -configbody iwidgets::Tabset::gap { - if {$itk_option(-gap) != {}} { - if {$itk_option(-gap) != "overlap"} { - set _gap [winfo pixels $itk_interior $itk_option(-gap)] - } else { - set _gap overlap - } - set _relayout true - } else { - set _gap overlap - } -} - -# ---------------------------------------------------------------------- -# OPTION -angle -# -# Sets the angle of the tab's sides -# ---------------------------------------------------------------------- -configbody iwidgets::Tabset::angle { - if {$itk_option(-angle) != {}} { - _tabConfigure -angle $itk_option(-angle) - } -} - -# ---------------------------------------------------------------------- -# OPTION -font -# -# Sets the font of the tab (SELECTED and UNSELECTED) -# ---------------------------------------------------------------------- -configbody iwidgets::Tabset::font { - if {$itk_option(-font) != {}} { - _tabConfigure -font $itk_option(-font) - } -} - -# ---------------------------------------------------------------------- -# OPTION -state -# ---------------------------------------------------------------------- -configbody iwidgets::Tabset::state { - if {$itk_option(-state) != {}} { - _tabConfigure -state $itk_option(-state) - } -} - -# ---------------------------------------------------------------------- -# OPTION -disabledforeground -# ---------------------------------------------------------------------- -configbody iwidgets::Tabset::disabledforeground { - if {$itk_option(-disabledforeground) != {}} { - _tabConfigure \ - -disabledforeground $itk_option(-disabledforeground) - } -} - -# ---------------------------------------------------------------------- -# OPTION -foreground -# -# Sets the foreground label color of UNSELECTED tabs -# ---------------------------------------------------------------------- -configbody iwidgets::Tabset::foreground { - _tabConfigure -foreground $itk_option(-foreground) -} - -# ---------------------------------------------------------------------- -# OPTION -background -# -# Sets the background color of UNSELECTED tabs -# ---------------------------------------------------------------------- -configbody iwidgets::Tabset::background { - if {$itk_option(-background) != {}} { - _tabConfigure -background $itk_option(-background) - } else { - _tabConfigure -background \ - [$itk_component(canvas) cget -background] - } -} - -# ---------------------------------------------------------------------- -# OPTION -selectforeground -# -# Sets the foreground label color of SELECTED tabs -# ---------------------------------------------------------------------- -configbody iwidgets::Tabset::selectforeground { - _tabConfigure -selectforeground $itk_option(-selectforeground) -} - -# ---------------------------------------------------------------------- -# OPTION -backdrop -# -# Sets the background color of the Tabset backdrop (behind the tabs) -# ---------------------------------------------------------------------- -configbody iwidgets::Tabset::backdrop { - if {$itk_option(-backdrop) != {}} { - $itk_component(canvas) configure \ - -background $itk_option(-backdrop) - } -} - -# ---------------------------------------------------------------------- -# OPTION -selectbackground -# -# Sets the background color of SELECTED tabs -# ---------------------------------------------------------------------- -configbody iwidgets::Tabset::selectbackground { - if {$itk_option(-selectbackground) != {}} { - } else { - #set _selectBackground \ - [$itk_component(canvas) cget -background] - } - _tabConfigure -selectbackground $itk_option(-selectbackground) -} - -# ---------------------------------------------------------------------- -# OPTION -command -# -# The command to invoke when a tab is hit. -# ---------------------------------------------------------------------- -configbody iwidgets::Tabset::command { - if {$itk_option(-command) != {}} { - set _cmdStr $itk_option(-command) - } -} - -# ---------------------------------------------------------------------- -# METHOD: add ?option value...? -# -# Creates a tab and appends it to the list of tabs. -# processes tabconfigure for the tab added. -# ---------------------------------------------------------------------- -body iwidgets::Tabset::add {args} { - set tabName [eval _createTab $args] - lappend _tabs $tabName - - _relayoutTabs - - return $tabName -} - -# ---------------------------------------------------------------------- -# METHOD: configure ?option? ?value option value...? -# -# Acts as an addendum to the itk::Widget::configure method. -# -# Checks the _relayout flag to see if after configures are done -# we need to relayout the tabs. -# -# _skipRelayout is set in the MB2 scroll methods, to avoid constant -# relayout of tabs while dragging the mouse. -# ---------------------------------------------------------------------- -body iwidgets::Tabset::configure {args} { - set result [eval itk::Archetype::configure $args] - - _configRelayout - - return $result -} - -body iwidgets::Tabset::_configRelayout {} { - # then relayout tabs if necessary - if { $_relayout } { - if { $_skipRelayout } { - } else { - _relayoutTabs - } - set _relayout false - } -} - -# ---------------------------------------------------------------------- -# METHOD: delete index1 ?index2? -# -# Deletes a tab or range of tabs from the tabset -# ---------------------------------------------------------------------- -body iwidgets::Tabset::delete {args} { - if { $_tabs == {} } { - error "can't delete tabs,\ - no tabs in the tabset named $itk_component(hull)" - } - - set len [llength $args] - switch $len { - 0 { - error "wrong # args: should be\ - \"$itk_component(hull) delete index1 ?index2?\"" - } - - 1 { - set fromTab [index [lindex $args 0]] - if { $fromTab == -1 } { - error "bad value for index1:\ - [lindex $args 0] in call to delete" - } - set toTab $fromTab - _deleteTabs $fromTab $toTab - } - - 2 { - set fromTab [index [lindex $args 0]] - if { $fromTab == -1 } { - error "bad value for index1:\ - [lindex $args 0] in call to delete" - } - set toTab [index [lindex $args 1]] - - if { $toTab == -1 } { - error "bad value for index2:\ - [lindex $args 1] in call to delete" - } - _deleteTabs $fromTab $toTab - } - - default { - error "wrong # args: should be\ - \"$itk_component(hull) delete index1 ?index2?\"" - } - } -} - -# ---------------------------------------------------------------------- -# METHOD: index index -# -# Given an index identifier returns the numeric index of the tab -# ---------------------------------------------------------------------- -body iwidgets::Tabset::index {index} { - return [_index $_tabs $index $_currTab] -} - -# ---------------------------------------------------------------------- -# METHOD: insert index ?option value...? -# -# Inserts a tab before a index. The before tab may -# be specified as a label or a tab position. -# ---------------------------------------------------------------------- -body iwidgets::Tabset::insert {index args} { - if { $_tabs == {} } { - error "no tab to insert before,\ - tabset '$itk_component(hull)' is empty" - } - - # get the tab - set tab [index $index] - - # catch bad value for before tab. - if { $tab < 0 || $tab >= [llength $_tabs] } { - error "bad value $tab for index:\ - should be between 0 and [expr [llength $_tabs] - 1]" - } - - # create the new tab and get its name... - set tabName [eval _createTab $args] - - # grab the name of the tab currently selected. (to keep in sync) - set currTabName [lindex $_tabs $_currTab] - - # insert tabName before $tab - set _tabs [linsert $_tabs $tab $tabName] - - # keep the _currTab in sync with the insert. - set _currTab [lsearch -exact $_tabs $currTabName] - - _relayoutTabs - - return $tabName -} - -# ---------------------------------------------------------------------- -# METHOD: prev -# -# Selects the prev tab. Wraps at first back to last tab. -# ---------------------------------------------------------------------- -body iwidgets::Tabset::prev {} { - if { $_tabs == {} } { - error "can't goto previous tab,\ - no tabs in the tabset: $itk_component(hull)" - } - - # bump to the previous tab and wrap if necessary - set prev [expr $_currTab - 1] - if { $prev < 0 } { - set prev [expr [llength $_tabs] - 1] - } - - select $prev - -} - -# ---------------------------------------------------------------------- -# METHOD: next -# -# Selects the next tab. Wraps at last back to first tab. -# ---------------------------------------------------------------------- -body iwidgets::Tabset::next {} { - if { $_tabs == {} } { - error "can't goto next tab,\ - no tabs in the tabset: $itk_component(hull)" - } - - # bump to the next tab and wrap if necessary - set next [expr $_currTab + 1] - if { $next >= [llength $_tabs] } { - set next 0 - } - - select $next -} - -# ---------------------------------------------------------------------- -# METHOD: select index -# -# Select a tab by index -# -# Lowers the last _currTab if it existed. -# Then raises the new one if it exists. -# -# Returns numeric index of selection, -1 if failed. -# ------------------------------------------------------------- -body iwidgets::Tabset::select {index} { - if { $_tabs == {} } { - error "can't activate a tab,\ - no tabs in the tabset: $itk_component(hull)" - } - - # if there is not current selection just ignore trying this selection - if { $index == "select" && $_currTab == -1 } { - return -1 - } - - # is selection request in range ? - set reqTab [index $index] - if { $reqTab == -1 } { - error "bad value $index for index:\ - should be from 0 to [expr [llength $_tabs] - 1]" - } - - # If already selected then ignore and return... - if { $reqTab == $_currTab } { - return $reqTab - } - - # ---- Deselect - if { $_currTab != -1 } { - set currTabName [lindex $_tabs $_currTab] - $currTabName deselect - - # handle different orientations... - if { $itk_option(-tabpos) == "n" || $itk_option(-tabpos) == "s"} { - $currTabName configure -top $_deselectedTop - } else { - $currTabName configure -left $_deselectedLeft - } - } - - # get the stacking order correct... - foreach tab $_tabs { - $tab lower - } - - # set this now so that the -command cmd can do an 'index select' - # to operate on this tab. - set _currTab $reqTab - - # ---- Select - set reqTabName [lindex $_tabs $reqTab] - $reqTabName select - if { $itk_option(-tabpos) == "n" || $itk_option(-tabpos) == "s"} { - $reqTabName configure -top $_selectedTop - } else { - $reqTabName configure -left $_selectedLeft - } - - set _currTab $reqTab - - # invoke any user command string, appended with tab index number - if { $_cmdStr != {} } { - set newCmd $_cmdStr - eval [lappend newCmd $reqTab] - } - - return $reqTab -} - -# ---------------------------------------------------------------------- -# METHOD: tabcget index ?option? -# -# Returns the value for the option setting of the tab at index $index. -# ---------------------------------------------------------------------- -body iwidgets::Tabset::tabcget {index args} { - return [lindex [eval tabconfigure $index $args] 2] -} - -# ---------------------------------------------------------------------- -# METHOD: tabconfigure index ?option? ?value option value? -# -# tabconfigure index : returns configuration list -# tabconfigure index -option : returns option values -# tabconfigure index ?option value option value ...? sets options -# and returns empty string. -# -# Performs configure on a given tab denoted by index. -# -# Index may be a tab number or a pattern matching the label -# associated with a tab. -# ---------------------------------------------------------------------- -body iwidgets::Tabset::tabconfigure {index args} { - # convert index to numeric - set tab [index $index] - - if { $tab == -1 } { - error "bad index value:\ - $index for $itk_component(hull) tabconfigure" - } - - set tabName [lindex $_tabs $tab] - - set len [llength $args] - switch $len { - 0 { - return [eval $tabName configure] - } - 1 { - return [eval $tabName configure $args] - } - default { - eval $tabName configure $args - _relayoutTabs - select select - } - } - return "" -} - -# ---------------------------------------------------------------------- -# PROTECTED METHOD: _selectName -# -# internal method to allow selection by internal tab name -# rather than index. This is used by the bind methods -# ---------------------------------------------------------------------- -body iwidgets::Tabset::_selectName {tabName} { - # if the tab is disabled, then ignore this selection... - if { [$tabName cget -state] == "disabled" } { - return - } - - set tab [lsearch -exact $_tabs $tabName] - select $tab -} - -# ---------------------------------------------------------------------- -# PRIVATE METHOD: _createTab -# -# Creates a tab, using unique tab naming, propagates background -# and keeps unique id up to date. -# ---------------------------------------------------------------------- -body iwidgets::Tabset::_createTab {args} { - # - # create an internal name for the tab: tab0, tab1, etc. - # these are one-up numbers they do not - # correspond to the position the tab is located in. - # - set tabName $this-tab$_uniqueID - - switch $itk_option(-tabpos) { - n { - set invert true - set orient horizontal - set x 0 - set y [expr $_margin + 1] - } - s { - set invert false - set orient horizontal - set x 0 - set y 0 - } - w { - set invert false - set orient vertical - set x 0 - set y 0 - } - e { - set invert true - set orient vertical - set x [expr $_margin + 1] - set y 0 - } - default { - error "bad anchor position\ - \"$itk_option(-tabpos)\" must be n, s, e, or w" - } - } - - eval iwidgets::Tab $tabName $itk_component(canvas) \ - -left $x \ - -top $y \ - -font [list $itk_option(-font)] \ - -background $itk_option(-background) \ - -foreground $itk_option(-foreground) \ - -selectforeground $itk_option(-selectforeground) \ - -disabledforeground $itk_option(-disabledforeground) \ - -selectbackground $itk_option(-selectbackground) \ - -angle $itk_option(-angle) \ - -padx $itk_option(-padx) \ - -pady $itk_option(-pady) \ - -bevelamount $itk_option(-bevelamount) \ - -state $itk_option(-state) \ - -tabborders $itk_option(-tabborders) \ - -invert $invert \ - -orient $orient \ - $args - - $tabName lower - - $itk_component(canvas) \ - bind $tabName <Button-1> [code $this _selectName $tabName] - - incr _uniqueID - - return $tabName -} - -# ---------------------------------------------------------------------- -# PRIVATE METHOD: _deleteTabs -# -# Deletes tabs from $fromTab to $toTab. -# -# Operates in two passes, destroys all the widgets -# Then removes the pathName from the tab list -# -# Also keeps the current selection in bounds. -# ---------------------------------------------------------------------- -body iwidgets::Tabset::_deleteTabs {fromTab toTab} { - for { set tab $fromTab } { $tab <= $toTab } { incr tab } { - set tabName [lindex $_tabs $tab] - - # unbind Button-1 from this window name - $itk_component(canvas) bind $tabName <Button-1> {} - - # Destroy the Tab class... - itcl::delete object $tabName - } - - # physically remove the tab - set _tabs [lreplace $_tabs $fromTab $toTab] - - # If we deleted a selected tab set our selection to none - if { $_currTab >= $fromTab && $_currTab <= $toTab } { - set _currTab -1 - _drawBevelBorder - } - - # make sure _currTab stays in sync with new numbering... - if { $_tabs == {} } { - # if deleted only remaining tab, - # reset current tab to undefined - set _currTab -1 - - # or if the current tab was the last tab, it needs come back - } elseif { $_currTab >= [llength $_tabs] } { - incr _currTab -1 - if { $_currTab < 0 } { - # but only to zero - set _currTab 0 - } - } - - _relayoutTabs -} - -# ---------------------------------------------------------------------- -# PRIVATE METHOD: _index -# -# pathList : list of path names to search thru if index is a label -# index : either number, 'select', 'end', or pattern -# select : current selection -# -# _index takes takes the value $index converts it to -# a numeric identifier. If the value is not already -# an integer it looks it up in the $pathList array. -# If it fails it returns -1 -# ---------------------------------------------------------------------- -body iwidgets::Tabset::_index {pathList index select} { - switch $index { - select { - set number $select - } - end { - set number [expr [llength $pathList] -1] - } - default { - # is it an number already? - if { [regexp {^[0-9]+$} $index] } { - set number $index - if { $number < 0 || $number >= [llength $pathList] } { - set number -1 - } - - # otherwise it is a label - } else { - # look thru the pathList of pathNames and - # get each label and compare with index. - # if we get a match then set number to postion in $pathList - # and break out. - # otherwise number is still -1 - set i 0 - set number -1 - foreach pathName $pathList { - set label [$pathName cget -label] - if { $label == $index } { - set number $i - break - } - incr i - } - } - } - } - - return $number -} - -# ---------------------------------------------------------------------- -# PRIVATE METHOD: _tabConfigure -# ---------------------------------------------------------------------- -body iwidgets::Tabset::_tabConfigure {args} { - foreach tab $_tabs { - eval $tab configure $args - } - - set _relayout true - - if { $_tabs != {} } { - select select - } -} - -# ---------------------------------------------------------------------- -# PRIVATE METHOD: _relayoutTabs -# -# relays out the tabs with correct spacing... -# ---------------------------------------------------------------------- -body iwidgets::Tabset::_relayoutTabs {} { - if { [llength $_tabs] == 0 } { - return - } - - # get the max width for fixed width tabs... - set maxWidth 0 - foreach tab $_tabs { - set width [$tab labelwidth] - if { $width > $maxWidth } { - set maxWidth $width - } - } - - # get the max height for fixed height tabs... - set maxHeight 0 - foreach tab $_tabs { - set height [$tab labelheight] - if { $height > $maxHeight } { - set maxHeight $height - } - } - - # get curr tab's name - set currTabName [lindex $_tabs $_currTab] - - # Start with our margin offset in pixels... - set tabStart $_start - - if { $itk_option(-raiseselect) } { - set raiseAmt 2 - } else { - set raiseAmt 0 - } - - # - # Depending on the tab layout: n, s, e, or w place the tabs - # according to orientation, raise, margins, etc. - # - switch $itk_option(-tabpos) { - n { - set _selectedTop [expr $_margin + 1] - set _deselectedTop [expr $_selectedTop + $raiseAmt] - - if { $itk_option(-equaltabs) } { - set tabWidth $maxWidth - } else { - set tabWidth 0 - } - - foreach tab $_tabs { - if { $tab == $currTabName } { - $tab configure -left $tabStart -top $_selectedTop \ - -height $maxHeight -width $tabWidth -anchor c - } else { - $tab configure -left $tabStart -top $_deselectedTop \ - -height $maxHeight -width $tabWidth -anchor c - } - set tabStart [expr $tabStart + [_calcNextTabOffset $tab]] - } - - } - s { - set _selectedTop 0 - set _deselectedTop [expr $_selectedTop - $raiseAmt] - - if { $itk_option(-equaltabs) } { - set tabWidth $maxWidth - } else { - set tabWidth 0 - } - - foreach tab $_tabs { - if { $tab == $currTabName } { - $tab configure -left $tabStart -top $_selectedTop \ - -height $maxHeight -width $tabWidth -anchor c - } else { - $tab configure -left $tabStart -top $_deselectedTop \ - -height $maxHeight -width $tabWidth -anchor c - } - set tabStart [expr $tabStart + [_calcNextTabOffset $tab]] - } - - } - w { - set _selectedLeft [expr $_margin + 1] - set _deselectedLeft [expr $_selectedLeft + $raiseAmt] - - if { $itk_option(-equaltabs) } { - set tabHeight $maxHeight - } else { - set tabHeight 0 - } - - foreach tab $_tabs { - # selected - if { $tab == $currTabName } { - $tab configure -top $tabStart -left $_selectedLeft \ - -height $tabHeight -width $maxWidth -anchor e - # deselected - } else { - $tab configure -top $tabStart -left $_deselectedLeft \ - -height $tabHeight -width $maxWidth -anchor e - } - set tabStart [expr $tabStart + [_calcNextTabOffset $tab]] - } - - } - e { - set _selectedLeft 0 - set _deselectedLeft [expr $_selectedLeft - $raiseAmt] - - if { $itk_option(-equaltabs) } { - set tabHeight $maxHeight - } else { - set tabHeight 0 - } - - foreach tab $_tabs { - # selected - if { $tab == $currTabName } { - $tab configure -top $tabStart -left $_selectedLeft \ - -height $tabHeight -width $maxWidth -anchor w - # deselected - } else { - $tab configure -top $tabStart -left $_deselectedLeft \ - -height $tabHeight -width $maxWidth -anchor w - } - set tabStart [expr $tabStart + [_calcNextTabOffset $tab]] - } - - } - default { - error "bad anchor position\ - \"$itk_option(-tabpos)\" must be n, s, e, or w" - } - } - - # put border on & calc our new canvas size... - _drawBevelBorder - _recalcCanvasGeom - -} - -# ---------------------------------------------------------------------- -# PRIVATE METHOD: _drawBevelBorder -# -# draws the bevel border along tab edge (below selected tab) -# ---------------------------------------------------------------------- -body iwidgets::Tabset::_drawBevelBorder {} { - $itk_component(canvas) delete bevelBorder - - switch $itk_option(-tabpos) { - n { - $itk_component(canvas) create line \ - 0 [expr $_canvasHeight - 1] \ - $_canvasWidth [expr $_canvasHeight - 1] \ - -fill [iwidgets::colors::topShadow $itk_option(-selectbackground)] \ - -tags bevelBorder - $itk_component(canvas) create line \ - 0 $_canvasHeight \ - $_canvasWidth $_canvasHeight \ - -fill [iwidgets::colors::topShadow $itk_option(-selectbackground)] \ - -tags bevelBorder - } - s { - $itk_component(canvas) create line \ - 0 0 \ - $_canvasWidth 0 \ - -fill [iwidgets::colors::bottomShadow $itk_option(-selectbackground)] \ - -tags bevelBorder - $itk_component(canvas) create line \ - 0 1 \ - $_canvasWidth 1 \ - -fill black \ - -tags bevelBorder - } - w { - $itk_component(canvas) create line \ - $_canvasWidth 0 \ - $_canvasWidth [expr $_canvasHeight - 1] \ - -fill [iwidgets::colors::topShadow $itk_option(-selectbackground)] \ - -tags bevelBorder - $itk_component(canvas) create line \ - [expr $_canvasWidth - 1] 0 \ - [expr $_canvasWidth - 1] [expr $_canvasHeight - 1] \ - -fill [iwidgets::colors::topShadow $itk_option(-selectbackground)] \ - -tags bevelBorder - - } - e { - $itk_component(canvas) create line \ - 0 0 \ - 0 [expr $_canvasHeight - 1] \ - -fill black \ - -tags bevelBorder - $itk_component(canvas) create line \ - 1 0 \ - 1 [expr $_canvasHeight - 1] \ - -fill [iwidgets::colors::bottomShadow $itk_option(-selectbackground)] \ - -tags bevelBorder - - } - } - - $itk_component(canvas) raise bevelBorder - if { $_currTab != -1 } { - set currTabName [lindex $_tabs $_currTab] - $currTabName raise - } -} - -# ---------------------------------------------------------------------- -# PRIVATE METHOD: _calcNextTabOffset -# -# given $tabName, determines the offset in pixels to place -# the next tab's start edge at. -# ---------------------------------------------------------------------- -body iwidgets::Tabset::_calcNextTabOffset {tabName} { - if { $_gap == "overlap" } { - return [$tabName offset] - } else { - return [expr [$tabName majordim] + $_gap] - } -} - -# ---------------------------------------------------------------------- -# PRIVATE METHOD: _tabBounds -# -# calculates the bounding box that will completely enclose -# all the tabs. -# ---------------------------------------------------------------------- -body iwidgets::Tabset::_tabBounds {} { - set bbox { 100000 100000 -10000 -10000 } - foreach tab $_tabs { - set tabBBox [$tab bbox] - # if this left is less use it - if { [lindex $tabBBox 0] < [lindex $bbox 0] } { - set bbox [lreplace $bbox 0 0 [lindex $tabBBox 0]] - } - # if this top is greater use it - if { [lindex $tabBBox 1] < [lindex $bbox 1] } { - set bbox [lreplace $bbox 1 1 [lindex $tabBBox 1]] - } - # if this right is less use it - if { [lindex $tabBBox 2] > [lindex $bbox 2] } { - set bbox [lreplace $bbox 2 2 [lindex $tabBBox 2]] - } - # if this bottom is greater use it - if { [lindex $tabBBox 3] > [lindex $bbox 3] } { - set bbox [lreplace $bbox 3 3 [lindex $tabBBox 3]] - } - - } - return $bbox -} - -# ---------------------------------------------------------------------- -# PRIVATE METHOD: _recalcCanvasGeom -# -# Based on size of tabs, recalculates the canvas geometry that -# will hold the tabs. -# ---------------------------------------------------------------------- -body iwidgets::Tabset::_recalcCanvasGeom {} { - if { [llength $_tabs] == 0 } { - return - } - - set bbox [_tabBounds] - - set width [lindex [_tabBounds] 2] - set height [lindex [_tabBounds] 3] - - # now we have the dimensions of all the tabs in the canvas. - - - switch $itk_option(-tabpos) { - n { - # height already includes margin - $itk_component(canvas) configure \ - -width $width \ - -height $height - } - s { - $itk_component(canvas) configure \ - -width $width \ - -height [expr $height + $_margin] - } - w { - # width already includes margin - $itk_component(canvas) configure \ - -width $width \ - -height [expr $height + 1] - } - e { - $itk_component(canvas) configure \ - -width [expr $width + $_margin] \ - -height [expr $height + 1] - } - default { - } - } -} - -# ---------------------------------------------------------------------- -# PRIVATE METHOD: _canvasReconfigure -# -# Bound to the reconfigure notify event of a canvas, this -# method resets canvas's correct width (since we are fill x) -# and redraws the beveled edge border. -# will hold the tabs. -# ---------------------------------------------------------------------- -body iwidgets::Tabset::_canvasReconfigure {width height} { - set _canvasWidth $width - set _canvasHeight $height - - if { [llength $_tabs] > 0 } { - _drawBevelBorder - } -} - -# ---------------------------------------------------------------------- -# PRIVATE METHOD: _startMove -# -# This method is bound to the MB2 down in the canvas area of the -# tab set. This starts animated scrolling of the tabs along their -# major axis. -# ---------------------------------------------------------------------- -body iwidgets::Tabset::_startMove {x y} { - if { $itk_option(-tabpos) == "n" || $itk_option(-tabpos) == "s" } { - set _anchorX $x - } else { - set _anchorY $y - } -} - -# ---------------------------------------------------------------------- -# PRIVATE METHOD: _moveTabs -# -# This method is bound to the MB2 motion in the canvas area of the -# tab set. This causes the tabset to move with the mouse. -# ---------------------------------------------------------------------- -body iwidgets::Tabset::_moveTabs {x y} { - if { $itk_option(-tabpos) == "n" || $itk_option(-tabpos) == "s" } { - set startX [expr $_start + $x - $_anchorX] - foreach tab $_tabs { - $tab configure -left $startX - set startX [expr $startX + [_calcNextTabOffset $tab]] - } - } else { - set startY [expr $_start + $y - $_anchorY] - foreach tab $_tabs { - $tab configure -top $startY - set startY [expr $startY + [_calcNextTabOffset $tab]] - } - } -} - -# ---------------------------------------------------------------------- -# PRIVATE METHOD: _endMove -# -# This method is bound to the MB2 release in the canvas area of the -# tab set. This causes the tabset to end moving tabs. -# ---------------------------------------------------------------------- -body iwidgets::Tabset::_endMove {x y} { - if { $itk_option(-tabpos) == "n" || $itk_option(-tabpos) == "s" } { - set startX [expr $_start + $x - $_anchorX] - set _skipRelayout true - configure -start $startX - set _skipRelayout false - } else { - set startY [expr $_start + $y - $_anchorY] - set _skipRelayout true - configure -start $startY - set _skipRelayout false - } -} - - -#============================================================== -# CLASS: Tab -#============================================================== - -class iwidgets::Tab { - constructor {args} {} - - destructor {} - - public variable bevelamount 0 {} - public variable state normal {} - public variable height 0 {} - public variable width 0 {} - public variable anchor c {} - public variable left 0 {} - public variable top 0 {} - public variable image {} {} - public variable bitmap {} {} - public variable label {} {} - public variable padx 4 {} - public variable pady 4 {} - public variable selectbackground "gray70" {} - public variable selectforeground "black" {} - public variable disabledforeground "gray" {} - public variable background "white" {} - public variable foreground "black" {} - public variable orient vertical {} - public variable invert false {} - public variable angle 20 {} - public variable font \ - "-adobe-helvetica-bold-r-normal--34-240-100-100-p-182-iso8859-1" {} - public variable tabborders true {} - - public method configure {args} - public method bbox {} - public method deselect {} - public method lower {} - public method majordim {} - public method minordim {} - public method offset {} - public method raise {} - public method select {} - public method labelheight {} - public method labelwidth {} - - private method _makeTab {} - private method _createLabel {canvas tagList} - private method _makeEastTab {canvas} - private method _makeWestTab {canvas} - private method _makeNorthTab {canvas} - private method _makeSouthTab {canvas} - private method _calcLabelDim {labelItem} - private method _itk_config {args} @itcl-builtin-configure - private method _selectNoRaise {} - private method _deselectNoLower {} - - private variable _selected false - private variable _padX 0 - private variable _padY 0 - - private variable _canvas - - # these are in pixels - private variable _left 0 - private variable _width 0 - private variable _height 0 - private variable _oldLeft 0 - private variable _top 0 - private variable _oldTop 0 - - private variable _right - private variable _bottom - - private variable _offset - private variable _majorDim - private variable _minorDim - - private variable _darkShadow - private variable _lightShadow - - # - # graphic components that make up a tab - # - private variable _gRegion - private variable _gLabel - private variable _gLightOutline {} - private variable _gBlackOutline {} - private variable _gTopLine - private variable _gTopLineShadow - private variable _gLightShadow - private variable _gDarkShadow - - private variable _labelWidth 0 - private variable _labelHeight 0 - - private variable _labelXOrigin 0 - private variable _labelYOrigin 0 - - private variable _just left - - private variable _configTripped true - - common _tan - - set _tan(0) 0.0 - set _tan(1) 0.0175 - set _tan(2) 0.0349 - set _tan(3) 0.0524 - set _tan(4) 0.0699 - set _tan(5) 0.0875 - set _tan(6) 0.1051 - set _tan(7) 0.1228 - set _tan(8) 0.1405 - set _tan(9) 0.1584 - set _tan(10) 0.1763 - set _tan(11) 0.1944 - set _tan(12) 0.2126 - set _tan(13) 0.2309 - set _tan(14) 0.2493 - set _tan(15) 0.2679 - set _tan(16) 0.2867 - set _tan(17) 0.3057 - set _tan(18) 0.3249 - set _tan(19) 0.3443 - set _tan(20) 0.3640 - set _tan(21) 0.3839 - set _tan(22) 0.4040 - set _tan(23) 0.4245 - set _tan(24) 0.4452 - set _tan(25) 0.4663 - set _tan(26) 0.4877 - set _tan(27) 0.5095 - set _tan(28) 0.5317 - set _tan(29) 0.5543 - set _tan(30) 0.5774 - set _tan(31) 0.6009 - set _tan(32) 0.6294 - set _tan(33) 0.6494 - set _tan(34) 0.6745 - set _tan(35) 0.7002 - set _tan(36) 0.7265 - set _tan(37) 0.7536 - set _tan(38) 0.7813 - set _tan(39) 0.8098 - set _tan(40) 0.8391 - set _tan(41) 0.8693 - set _tan(42) 0.9004 - set _tan(43) 0.9325 - set _tan(44) 0.9657 - set _tan(45) 1.0 -} - -# ---------------------------------------------------------------------- -# CONSTRUCTOR -# ---------------------------------------------------------------------- -body iwidgets::Tab::constructor {args} { - - set _canvas [lindex $args 0] - set args [lrange $args 1 [llength $args]] - - set _darkShadow [iwidgets::colors::bottomShadow $selectbackground] - set _lightShadow [iwidgets::colors::topShadow $selectbackground] - - if { $args != "" } { - eval configure $args - } -} - -# ---------------------------------------------------------------------- -# DESTRUCTOR -# ---------------------------------------------------------------------- -body iwidgets::Tab::destructor {} { - if { [winfo exists $_canvas] } { - $_canvas delete $this - } -} - -# ---------------------------------------------------------------------- -# OPTIONS -# ---------------------------------------------------------------------- -# -# Note, we trip _configTripped for every option that requires the tab -# to be remade. -# -# ---------------------------------------------------------------------- -# OPTION -bevelamount -# -# Specifies the size of tab corners. A value of 0 with angle set -# to 0 results in square tabs. A bevelAmount of 4, means that the -# tab will be drawn with angled corners that cut in 4 pixels from -# the edge of the tab. The default is 0. -# ---------------------------------------------------------------------- -configbody iwidgets::Tab::bevelamount { -} - -# ---------------------------------------------------------------------- -# OPTION -state -# -# sets the active state of the tab. specifying normal allows -# the tab to be selectable. Specifying disabled disables the tab, -# causing its image, bitmap, or label to be drawn with the -# disabledForeground color. -# ---------------------------------------------------------------------- -configbody iwidgets::Tab::state { -} - -# ---------------------------------------------------------------------- -# OPTION -height -# -# the height of the tab. if 0, uses the font label height. -# ---------------------------------------------------------------------- -configbody iwidgets::Tab::height { - set _height [winfo pixels $_canvas $height] - set _configTripped true -} - -# ---------------------------------------------------------------------- -# OPTION -width -# -# The width of the tab. If 0, uses the font label width. -# ---------------------------------------------------------------------- -configbody iwidgets::Tab::width { - set _width [winfo pixels $_canvas $width] - set _configTripped true -} - -# ---------------------------------------------------------------------- -# OPTION -anchor -# -# Where the text in the tab will be anchored: n,nw,ne,s,sw,se,e,w,center -# ---------------------------------------------------------------------- -configbody iwidgets::Tab::anchor { -} - -# ---------------------------------------------------------------------- -# OPTION -left -# -# Specifies the left edge of the tab's bounding box. This value -# may have any of the forms acceptable to Tk_GetPixels. -# ---------------------------------------------------------------------- -configbody iwidgets::Tab::left { - - # get into pixels - set _left [winfo pixels $_canvas $left] - - # move by offset from last setting - $_canvas move $this [expr $_left - $_oldLeft] 0 - - # update old for next time - set _oldLeft $_left -} - -# ---------------------------------------------------------------------- -# OPTION -top -# -# Specifies the topedge of the tab's bounding box. This value may -# have any of the forms acceptable to Tk_GetPixels. -# ---------------------------------------------------------------------- -configbody iwidgets::Tab::top { - - # get into pixels - set _top [winfo pixels $_canvas $top] - - # move by offset from last setting - $_canvas move $this 0 [expr $_top - $_oldTop] - - # update old for next time - set _oldTop $_top -} - -# ---------------------------------------------------------------------- -# OPTION -image -# -# Specifies the imageto display in the tab. -# Images are created with the image create command. -# ---------------------------------------------------------------------- -configbody iwidgets::Tab::image { - set _configTripped true -} - -# ---------------------------------------------------------------------- -# OPTION -bitmap -# -# If bitmap is an empty string, specifies the bitmap to display in -# the tab. Bitmap may be of any of the forms accepted by Tk_GetBitmap. -# ---------------------------------------------------------------------- -configbody iwidgets::Tab::bitmap { - set _configTripped true -} - -# ---------------------------------------------------------------------- -# OPTION -label -# -# If image is an empty string and bitmap is an empty string, -# it specifies a text string to be placed in the tab's label. -# This label serves as an additional identifier used to reference -# the tab. Label may be used for the index value in widget commands. -# ---------------------------------------------------------------------- -configbody iwidgets::Tab::label { - set _configTripped true -} - -# ---------------------------------------------------------------------- -# OPTION -padx -# -# Horizontal padding around the label (text, image, or bitmap). -# ---------------------------------------------------------------------- -configbody iwidgets::Tab::padx { - set _configTripped true - set _padX [winfo pixels $_canvas $padx] -} - -# ---------------------------------------------------------------------- -# OPTION -pady -# -# Vertical padding around the label (text, image, or bitmap). -# ---------------------------------------------------------------------- -configbody iwidgets::Tab::pady { - set _configTripped true - set _padY [winfo pixels $_canvas $pady] -} - -# ---------------------------------------------------------------------- -# OPTION -selectbackground -# ---------------------------------------------------------------------- -configbody iwidgets::Tab::selectbackground { - set _darkShadow [iwidgets::colors::bottomShadow $selectbackground] - set _lightShadow [iwidgets::colors::topShadow $selectbackground] - - if { $_selected } { - _selectNoRaise - } else { - _deselectNoLower - } -} - -# ---------------------------------------------------------------------- -# OPTION -selectforeground -# -# Foreground of tab when selected -# ---------------------------------------------------------------------- -configbody iwidgets::Tab::selectforeground { - if { $_selected } { - _selectNoRaise - } else { - _deselectNoLower - } -} - -# ---------------------------------------------------------------------- -# OPTION -disabledforeground -# -# Background of tab when -state is disabled -# ---------------------------------------------------------------------- -configbody iwidgets::Tab::disabledforeground { - if { $_selected } { - _selectNoRaise - } else { - _deselectNoLower - } -} - -# ---------------------------------------------------------------------- -# OPTION -background -# -# Normal background of tab. -# ---------------------------------------------------------------------- -configbody iwidgets::Tab::background { - - if { $_selected } { - _selectNoRaise - } else { - _deselectNoLower - } - -} - -# ---------------------------------------------------------------------- -# OPTION -foreground -# -# Foreground of tabs when in normal unselected state -# ---------------------------------------------------------------------- -configbody iwidgets::Tab::foreground { - if { $_selected } { - _selectNoRaise - } else { - _deselectNoLower - } -} - -# ---------------------------------------------------------------------- -# OPTION -orient -# -# Specifies the orientation of the tab. Orient can be either -# horizontal or vertical. -# ---------------------------------------------------------------------- -configbody iwidgets::Tab::orient { - set _configTripped true -} - -# ---------------------------------------------------------------------- -# OPTION -invert -# -# Specifies the direction to draw the tab. If invert is true, -# it draws horizontal tabs upside down and vertical tabs opening -# to the left (pointing right). The value may have any of the -# forms accepted by the Tcl_GetBoolean, such as true, -# false, 0, 1, yes, or no. -# ---------------------------------------------------------------------- -configbody iwidgets::Tab::invert { - set _configTripped true -} - -# ---------------------------------------------------------------------- -# OPTION -angle -# -# Specifes the angle of slope from the inner edge to the outer edge -# of the tab. An angle of 0 specifies square tabs. Valid ranges are -# 0 to 45 degrees inclusive. Default is 15 degrees. If this option -# is specified as an empty string (the default), then the angle -# option for the overall Tabset is used. -# ---------------------------------------------------------------------- -configbody iwidgets::Tab::angle { - if {$angle < 0 || $angle > 45 } { - error "bad angle: must be between 0 and 45" - } - set _configTripped true -} - -# ---------------------------------------------------------------------- -# OPTION -font -# -# Font for tab text. -# ---------------------------------------------------------------------- -configbody iwidgets::Tab::font { -} - - -# ---------------------------------------------------------------------- -# OPTION -tabborders -# -# Specifies whether to draw the borders of a deselected tab. -# Specifying true (the default) draws these borders, -# specifying false disables this drawing. If the tab is in -# its selected state this option has no effect. -# The value may have any of the forms accepted by the -# Tcl_GetBoolean, such as true, false, 0, 1, yes, or no. -# ---------------------------------------------------------------------- -configbody iwidgets::Tab::tabborders { - set _configTripped true -} - -# ---------------------------------------------------------------------- -# METHOD: configure ?option value? -# -# Configures the Tab, checks a configTripped flag to see if the tab -# needs to be remade. We take the easy way since it is so inexpensive -# to delete canvas items and remake them. -# ---------------------------------------------------------------------- -body iwidgets::Tab::configure {args} { - set len [llength $args] - - switch $len { - 0 { - set result [_itk_config] - return $result - } - 1 { - set result [eval _itk_config $args] - return $result - } - default { - eval _itk_config $args - if { $_configTripped } { - _makeTab - set _configTripped false - } - return "" - } - } -} - -# ---------------------------------------------------------------------- -# METHOD: bbox -# -# Returns the bounding box of the tab -# ---------------------------------------------------------------------- -body iwidgets::Tab::bbox {} { - return [lappend bbox $_left $_top $_right $_bottom] -} -# ---------------------------------------------------------------------- -# METHOD: deselect -# -# Causes the given tab to be drawn as deselected and lowered -# ---------------------------------------------------------------------- -body iwidgets::Tab::deselect {} { - global tcl_platform - $_canvas lower $this - - if {$tcl_platform(os) == "HP-UX"} { - update idletasks - } - - _deselectNoLower -} - -# ---------------------------------------------------------------------- -# METHOD: lower -# -# Lowers the tab below all others in the canvas. -# -# This is used as our tag name on the canvas. -# ---------------------------------------------------------------------- -body iwidgets::Tab::lower {} { - $_canvas lower $this -} - -# ---------------------------------------------------------------------- -# METHOD: majordim -# -# Returns the width for horizontal tabs and the height for -# vertical tabs. -# ---------------------------------------------------------------------- -body iwidgets::Tab::majordim {} { - return $_majorDim -} - -# ---------------------------------------------------------------------- -# METHOD: minordim -# -# Returns the height for horizontal tabs and the width for -# vertical tabs. -# ---------------------------------------------------------------------- -body iwidgets::Tab::minordim {} { - return $_minorDim -} - -# ---------------------------------------------------------------------- -# METHOD: offset -# -# Returns the width less the angle offset. This allows a -# geometry manager to ask where to place a sibling tab. -# ---------------------------------------------------------------------- -body iwidgets::Tab::offset {} { - return $_offset -} - -# ---------------------------------------------------------------------- -# METHOD: raise -# -# Raises the tab above all others in the canvas. -# -# This is used as our tag name on the canvas. -# ---------------------------------------------------------------------- -body iwidgets::Tab::raise {} { - $_canvas raise $this -} - -# ---------------------------------------------------------------------- -# METHOD: select -# -# Causes the given tab to be drawn as selected. 3d shadows are -# turned on and top line and top line shadow are drawn in sel -# bg color to hide them. -# ---------------------------------------------------------------------- -body iwidgets::Tab::select {} { - global tcl_platform - $_canvas raise $this - - if {$tcl_platform(os) == "HP-UX"} { - update idletasks - } - - _selectNoRaise -} - -# ---------------------------------------------------------------------- -# METHOD: labelheight -# -# Returns the height of the tab's label in its current font. -# ---------------------------------------------------------------------- -body iwidgets::Tab::labelheight {} { - if {$_gLabel != 0} { - set labelBBox [$_canvas bbox $_gLabel] - set labelHeight [expr [lindex $labelBBox 3] - [lindex $labelBBox 1]] - } else { - set labelHeight 0 - } - return $labelHeight -} - -# ---------------------------------------------------------------------- -# METHOD: labelwidth -# -# Returns the width of the tab's label in its current font. -# ---------------------------------------------------------------------- -body iwidgets::Tab::labelwidth {} { - if {$_gLabel != 0} { - set labelBBox [$_canvas bbox $_gLabel] - set labelWidth [expr [lindex $labelBBox 2] - [lindex $labelBBox 0]] - } else { - set labelWidth 0 - } - return $labelWidth -} - -# ---------------------------------------------------------------------- -# PRIVATE METHOD: _selectNoRaise -# -# Draws tab as selected without raising it. -# ---------------------------------------------------------------------- -body iwidgets::Tab::_selectNoRaise {} { - if { ! [info exists _gRegion] } { - return - } - - $_canvas itemconfigure $_gRegion -fill $selectbackground - $_canvas itemconfigure $_gTopLine -fill $selectbackground - $_canvas itemconfigure $_gTopLineShadow -fill $selectbackground - $_canvas itemconfigure $_gLightShadow -fill $_lightShadow - $_canvas itemconfigure $_gDarkShadow -fill $_darkShadow - - if { $_gLightOutline != {} } { - $_canvas itemconfigure $_gLightOutline -fill $_lightShadow - } - if { $_gBlackOutline != {} } { - $_canvas itemconfigure $_gBlackOutline -fill black - } - - if { $state == "normal" } { - if { $image != {}} { - # do nothing for now - } elseif { $bitmap != {}} { - $_canvas itemconfigure $_gLabel \ - -foreground $selectforeground \ - -background $selectbackground - } else { - $_canvas itemconfigure $_gLabel -fill $selectforeground - } - } else { - if { $image != {}} { - # do nothing for now - } elseif { $bitmap != {}} { - $_canvas itemconfigure $_gLabel \ - -foreground $disabledforeground \ - -background $selectbackground - } else { - $_canvas itemconfigure $_gLabel -fill $disabledforeground - } - } - - set _selected true -} - -# ---------------------------------------------------------------------- -# PRIVATE METHOD: _deselectNoLower -# -# Causes the given tab to be drawn as deselected. 3d shadows are -# removed and top line and top line shadow are drawn in visible -# colors to reveal them. -# ---------------------------------------------------------------------- -body iwidgets::Tab::_deselectNoLower {} { - if { ! [info exists _gRegion] } { - return - } - - $_canvas itemconfigure $_gRegion -fill $background - $_canvas itemconfigure $_gTopLine -fill black - $_canvas itemconfigure $_gTopLineShadow -fill $_darkShadow - $_canvas itemconfigure $_gLightShadow -fill $background - $_canvas itemconfigure $_gDarkShadow -fill $background - - if { $tabborders } { - if { $_gLightOutline != {} } { - $_canvas itemconfigure $_gLightOutline -fill $_lightShadow - } - if { $_gBlackOutline != {} } { - $_canvas itemconfigure $_gBlackOutline -fill black - } - } else { - if { $_gLightOutline != {} } { - $_canvas itemconfigure $_gLightOutline -fill $background - } - if { $_gBlackOutline != {} } { - $_canvas itemconfigure $_gBlackOutline -fill $background - } - } - - - if { $state == "normal" } { - if { $image != {}} { - # do nothing for now - } elseif { $bitmap != {}} { - $_canvas itemconfigure $_gLabel \ - -foreground $foreground \ - -background $background - } else { - $_canvas itemconfigure $_gLabel -fill $foreground - } - } else { - if { $image != {}} { - # do nothing for now - } elseif { $bitmap != {}} { - $_canvas itemconfigure $_gLabel \ - -foreground $disabledforeground \ - -background $background - } else { - $_canvas itemconfigure $_gLabel -fill $disabledforeground - } - } - - set _selected false -} - -# ---------------------------------------------------------------------- -# PRIVATE METHOD: _makeTab -# ---------------------------------------------------------------------- -body iwidgets::Tab::_makeTab {} { - if { $orient == "horizontal" } { - if { $invert } { - _makeNorthTab $_canvas - } else { - _makeSouthTab $_canvas - } - } elseif { $orient == "vertical" } { - if { $invert } { - _makeEastTab $_canvas - } else { - _makeWestTab $_canvas - } - } else { - error "bad value for option -orient" - } -} - -# ---------------------------------------------------------------------- -# PRIVATE METHOD: _createLabel -# -# Creates the label for the tab. Can be either a text label -# or a bitmap label. -# ---------------------------------------------------------------------- -body iwidgets::Tab::_createLabel {canvas tagList} { - if { $image != {}} { - set _gLabel [$canvas create image \ - 0 0 \ - -image $image \ - -anchor nw \ - -tags $tagList \ - ] - } elseif { $bitmap != {}} { - set _gLabel [$canvas create bitmap \ - 0 0 \ - -bitmap $bitmap \ - -anchor nw \ - -tags $tagList \ - ] - } else { - set _gLabel [$canvas create text \ - 0 0 \ - -text $label \ - -font $font \ - -anchor nw \ - -tags $tagList \ - ] - } -} - -# ---------------------------------------------------------------------- -# PRIVATE METHOD: _makeEastTab -# -# Makes a tab that hangs to the east and opens to the west. -# ---------------------------------------------------------------------- -body iwidgets::Tab::_makeEastTab {canvas} { - $canvas delete $this - set _gLightOutline {} - set _gBlackOutline {} - - lappend tagList $this TAB - - _createLabel $canvas $tagList - - _calcLabelDim $_gLabel - - - set right [expr $_left + $_labelWidth] - # now have _left, _top, right... - - # Turn off calculating angle tabs on Vertical orientations - #set angleOffset [expr $_labelHeight * $_tan($angle)] - set angleOffset 0 - - set outerTop $_top - set outerBottom \ - [expr $outerTop + $angleOffset + $_labelHeight + $angleOffset] - set innerTop [expr $outerTop + $angleOffset] - set innerBottom [expr $outerTop + $angleOffset + $_labelHeight] - - # now have _left, _top, right, outerTop, innerTop, - # innerBottom, outerBottom, width, height - - set bottom $innerBottom - # tab area... gets filled either white or selected - # done - set _gRegion [$canvas create polygon \ - $_left $outerTop \ - [expr $right - $bevelamount] $innerTop \ - $right [expr $innerTop + $bevelamount] \ - $right [expr $innerBottom - $bevelamount] \ - [expr $right - $bevelamount] $innerBottom \ - $_left $outerBottom \ - $_left $outerTop \ - -tags $tagList \ - ] - - # lighter shadow (left edge) - set _gLightShadow [$canvas create line \ - [expr $_left - 3] [expr $outerTop + 1] \ - [expr $right - $bevelamount] [expr $innerTop + 1] \ - -tags $tagList \ - ] - - # darker shadow (bottom and right edges) - set _gDarkShadow [$canvas create line \ - [expr $right - $bevelamount] [expr $innerTop + 1] \ - [expr $right - 1] [expr $innerTop + $bevelamount] \ - [expr $right - 1] [expr $innerBottom - $bevelamount] \ - [expr $right - $bevelamount] [expr $innerBottom - 1] \ - [expr $_left - 3] [expr $outerBottom - 1] \ - -tags $tagList \ - ] - - # outline of tab - set _gLightOutline [$canvas create line \ - $_left $outerTop \ - [expr $right - $bevelamount] $innerTop \ - -tags $tagList \ - ] - # outline of tab - set _gBlackOutline [$canvas create line \ - [expr $right - $bevelamount] $innerTop \ - $right [expr $innerTop + $bevelamount] \ - $right [expr $innerBottom - $bevelamount] \ - [expr $right - $bevelamount] $innerBottom \ - $_left $outerBottom \ - $_left $outerTop \ - -tags $tagList \ - ] - - # line closest to the edge - set _gTopLineShadow [$canvas create line \ - $_left $outerTop \ - $_left $outerBottom \ - -tags $tagList \ - ] - - # next line down - set _gTopLine [$canvas create line \ - [expr $_left + 1] [expr $outerTop + 2] \ - [expr $_left + 1] [expr $outerBottom - 1] \ - -tags $tagList \ - ] - - $canvas coords $_gLabel [expr $_left + $_labelXOrigin] \ - [expr $innerTop + $_labelYOrigin] - - if { $image != {} || $bitmap != {} } { - $canvas itemconfigure $_gLabel -anchor $anchor - } else { - $canvas itemconfigure $_gLabel -anchor $anchor -justify $_just - } - - $canvas raise $_gLabel $_gRegion - - - set _offset [expr $innerBottom - $outerTop] - # height - set _majorDim [expr $outerBottom - $outerTop] - # width - set _minorDim [expr $right - $_left] - - set _right $right - set _bottom $outerBottom - - # draw in correct state... - if { $_selected } { - select - } else { - deselect - } -} - -# ---------------------------------------------------------------------- -# PRIVATE METHOD: _makeWestTab -# -# Makes a tab that hangs to the west and opens to the east. -# ---------------------------------------------------------------------- -body iwidgets::Tab::_makeWestTab {canvas} { - $canvas delete $this - set _gLightOutline {} - set _gBlackOutline {} - - lappend tagList $this TAB - - _createLabel $canvas $tagList - _calcLabelDim $_gLabel - - set right [expr $_left + $_labelWidth] - # now have _left, _top, right... - - # Turn off calculating angle tabs on Vertical orientations - #set angleOffset [expr $_labelHeight * $_tan($angle)] - set angleOffset 0 - - set outerTop $_top - set outerBottom \ - [expr $outerTop + $angleOffset + $_labelHeight + $angleOffset] - set innerTop [expr $outerTop + $angleOffset] - set innerBottom [expr $outerTop + $angleOffset + $_labelHeight] - - # now have _left, _top, right, outerTop, innerTop, - # innerBottom, outerBottom, width, height - - # tab area... gets filled either white or selected - # done - set _gRegion [$canvas create polygon \ - $right $outerTop \ - [expr $_left + $bevelamount] $innerTop \ - $_left [expr $innerTop + $bevelamount] \ - $_left [expr $innerBottom - $bevelamount]\ - [expr $_left + $bevelamount] $innerBottom \ - $right $outerBottom \ - $right $outerTop \ - -tags $tagList \ - ] - # lighter shadow (left edge) - set _gLightShadow [$canvas create line \ - $right [expr $outerTop+1] \ - [expr $_left + $bevelamount] [expr $innerTop + 1] \ - [expr $_left + 1] [expr $innerTop + $bevelamount] \ - [expr $_left + 1] [expr $innerBottom - $bevelamount] \ - -tags $tagList \ - ] - - # darker shadow (bottom and right edges) - set _gDarkShadow [$canvas create line \ - [expr $_left + 1] [expr $innerBottom - $bevelamount] \ - [expr $_left + $bevelamount] [expr $innerBottom - 1] \ - $right [expr $outerBottom - 1] \ - -tags $tagList \ - ] - - # outline of tab -- lighter top left sides - set _gLightOutline [$canvas create line \ - $right $outerTop \ - [expr $_left + $bevelamount] $innerTop \ - $_left [expr $innerTop + $bevelamount] \ - $_left [expr $innerBottom - $bevelamount]\ - -tags $tagList \ - ] - # outline of tab -- darker bottom side - set _gBlackOutline [$canvas create line \ - $_left [expr $innerBottom - $bevelamount]\ - [expr $_left + $bevelamount] $innerBottom \ - $right $outerBottom \ - $right $outerTop \ - -tags $tagList \ - ] - - # top of tab - set _gTopLine [$canvas create line \ - [expr $right + 1] $outerTop \ - [expr $right + 1] $outerBottom \ - -tags $tagList \ - ] - - # line below top of tab - set _gTopLineShadow [$canvas create line \ - $right $outerTop \ - $right $outerBottom \ - -tags $tagList \ - ] - - $canvas coords $_gLabel [expr $_left + $_labelXOrigin] \ - [expr $innerTop + $_labelYOrigin] - if { $image != {} || $bitmap != {} } { - $canvas itemconfigure $_gLabel -anchor $anchor - } else { - $canvas itemconfigure $_gLabel -anchor $anchor -justify $_just - } - - $canvas raise $_gLabel $_gRegion - - - set _offset [expr $innerBottom - $outerTop] - # height - set _majorDim [expr $outerBottom - $outerTop] - # width - set _minorDim [expr $right - $_left] - - set _right $right - set _bottom $outerBottom - - # draw in correct state... - if { $_selected } { - select - } else { - deselect - } - -} - -# ---------------------------------------------------------------------- -# PRIVATE METHOD: _makeNorthTab -# -# Makes a tab that hangs to the north and opens to the south. -# ---------------------------------------------------------------------- -body iwidgets::Tab::_makeNorthTab {canvas} { - $canvas delete $this - set _gLightOutline {} - set _gBlackOutline {} - - lappend tagList $this TAB - - _createLabel $canvas $tagList - - # first get the label width and height - _calcLabelDim $_gLabel - - set bottom [expr $_top + $_labelHeight] - - set angleOffset [expr $_labelHeight * $_tan($angle)] - - set outerLeft $_left - set outerRight \ - [expr $outerLeft + $angleOffset + $_labelWidth + $angleOffset] - set innerLeft [expr $outerLeft + $angleOffset] - set innerRight [expr $outerLeft + $angleOffset + $_labelWidth] - - # tab area... gets filled either white or selected - set _gRegion [$canvas create polygon \ - $outerLeft [expr $bottom + 3] \ - $innerLeft [expr $_top + $bevelamount] \ - [expr $innerLeft + $bevelamount] $_top \ - [expr $innerRight - $bevelamount] $_top \ - $innerRight [expr $_top + $bevelamount]\ - $outerRight [expr $bottom + 3] \ - $outerLeft [expr $bottom + 3] \ - -tags $tagList \ - ] - - # lighter shadow (left edge) - set _gLightShadow [$canvas create line \ - [expr $outerLeft + 1] [expr $bottom + 3] \ - [expr $innerLeft + 1] [expr $_top + $bevelamount] \ - [expr $innerLeft + $bevelamount] [expr $_top + 1]\ - [expr $innerRight - $bevelamount] [expr $_top + 1]\ - -tags $tagList \ - ] - - # darker shadow (bottom and right edges) - set _gDarkShadow [$canvas create line \ - [expr $innerRight - $bevelamount] [expr $_top + 1]\ - [expr $innerRight - 1] [expr $_top + $bevelamount]\ - [expr $outerRight - 1] [expr $bottom + 3]\ - -tags $tagList \ - ] - - set _gLightOutline [$canvas create line \ - $outerLeft [expr $bottom + 3] \ - $innerLeft [expr $_top + $bevelamount] \ - [expr $innerLeft + $bevelamount] $_top \ - [expr $innerRight - $bevelamount] $_top \ - -tags $tagList \ - ] - - set _gBlackOutline [$canvas create line \ - [expr $innerRight - $bevelamount] $_top \ - $innerRight [expr $_top + $bevelamount]\ - $outerRight [expr $bottom + 3] \ - $outerLeft [expr $bottom + 3] \ - -tags $tagList \ - ] - - # top of tab... to make it closed off - set _gTopLine [$canvas create line \ - 0 0 0 0\ - -tags $tagList \ - ] - #[expr $outerLeft + 2] [expr $_top + 1] \ - [expr $outerRight - 2] [expr $_top + 1] - - # top of tab... to make it closed off - set _gTopLineShadow [$canvas create line \ - 0 0 0 0 \ - -tags $tagList \ - ] - #$outerLeft $_top \ - $outerRight $_top - - $canvas coords $_gLabel [expr $innerLeft + $_labelXOrigin] \ - [expr $_top + $_labelYOrigin] - - if { $image != {} || $bitmap != {} } { - $canvas itemconfigure $_gLabel -anchor $anchor - } else { - $canvas itemconfigure $_gLabel -anchor $anchor -justify $_just - } - - $canvas raise $_gLabel $_gRegion - - - set _offset [expr $innerRight - $outerLeft] - # width - set _majorDim [expr $outerRight - $outerLeft] - # height - set _minorDim [expr $bottom - $_top] - - set _right $outerRight - set _bottom $bottom - - # draw in correct state... - if { $_selected } { - select - } else { - deselect - } -} - -# ---------------------------------------------------------------------- -# PRIVATE METHOD: _makeSouthTab -# -# Makes a tab that hangs to the south and opens to the north. -# ---------------------------------------------------------------------- -body iwidgets::Tab::_makeSouthTab {canvas} { - $canvas delete $this - set _gLightOutline {} - set _gBlackOutline {} - - lappend tagList $this TAB - - _createLabel $canvas $tagList - - # first get the label width and height - _calcLabelDim $_gLabel - - set bottom [expr $_top + $_labelHeight] - - set angleOffset [expr $_labelHeight * $_tan($angle)] - - set outerLeft $_left - set outerRight \ - [expr $outerLeft + $angleOffset + $_labelWidth + $angleOffset] - set innerLeft [expr $outerLeft + $angleOffset] - set innerRight [expr $outerLeft + $angleOffset + $_labelWidth] - - # tab area... gets filled either white or selected - set _gRegion [$canvas create polygon \ - $outerLeft [expr $_top + 1] \ - $innerLeft [expr $bottom - $bevelamount]\ - [expr $innerLeft + $bevelamount] $bottom \ - [expr $innerRight - $bevelamount] $bottom \ - $innerRight [expr $bottom - $bevelamount]\ - $outerRight [expr $_top + 1] \ - $outerLeft [expr $_top + 1] \ - -tags $tagList \ - ] - - - # lighter shadow (left edge) - set _gLightShadow [$canvas create line \ - [expr $outerLeft+1] $_top \ - [expr $innerLeft+1] [expr $bottom-$bevelamount] \ - -tags $tagList \ - ] - - # darker shadow (bottom and right edges) - set _gDarkShadow [$canvas create line \ - [expr $innerLeft+1] [expr $bottom-$bevelamount] \ - [expr $innerLeft+$bevelamount] [expr $bottom-1] \ - [expr $innerRight-$bevelamount] [expr $bottom-1] \ - [expr $innerRight-1] [expr $bottom-$bevelamount] \ - [expr $outerRight-1] [expr $_top + 1] \ - -tags $tagList \ - ] - # outline of tab - set _gBlackOutline [$canvas create line \ - $outerLeft [expr $_top + 1] \ - $innerLeft [expr $bottom -$bevelamount]\ - [expr $innerLeft + $bevelamount] $bottom \ - [expr $innerRight - $bevelamount] $bottom \ - $innerRight [expr $bottom - $bevelamount]\ - $outerRight [expr $_top + 1] \ - -tags $tagList \ - ] - - # top of tab... to make it closed off - set _gTopLine [$canvas create line \ - $outerLeft [expr $_top + 1] \ - $outerRight [expr $_top + 1] \ - -tags $tagList \ - ] - - # top of tab... to make it closed off - set _gTopLineShadow [$canvas create line \ - $outerLeft $_top \ - $outerRight $_top \ - -tags $tagList \ - ] - - #$canvas coords $_gLabel [expr $innerLeft + $_padX + 2] \ - [expr $_top + $_padY] - $canvas coords $_gLabel [expr $innerLeft + $_labelXOrigin] \ - [expr $_top + $_labelYOrigin] - - if { $image != {} || $bitmap != {} } { - $canvas itemconfigure $_gLabel -anchor $anchor - } else { - $canvas itemconfigure $_gLabel -anchor $anchor -justify $_just - } - $canvas raise $_gLabel $_gRegion - - - set _offset [expr $innerRight - $outerLeft] - - # width - set _majorDim [expr $outerRight - $outerLeft] - - # height - set _minorDim [expr $bottom - $_top] - - set _right $outerRight - set _bottom $bottom - - # draw in correct state... - if { $_selected } { - select - } else { - deselect - } -} - -# ---------------------------------------------------------------------- -# PRIVATE METHOD: _calcLabelDim -# -# Calculate the width and height of the label bbox of labelItem -# can be either text or bitmap (in future also an image) -# -# There are two ways to calculate the label bbox. -# -# First, if the $_width and/or $_height is specified, we will use -# it to determine that dimension(s) width and/or height. For -# a width/height of 0 we use the labels bbox to -# give us a base width/height. -# Then we add in the padx/pady to determine final bounds. -# -# Uses the following option or option derived variables: -# -padx ($_padX - converted to pixels) -# -pady ($_padY - converted to pixels) -# -anchor ($anchor) -# -width ($_width) This is the width for inside tab (label area) -# -height ($_height) This is the width for inside tab (label area) -# -# Side Effects: -# _labelWidth will be set -# _labelHeight will be set -# _labelXOrigin will be set -# _labelYOrigin will be set -# ---------------------------------------------------------------------- -body iwidgets::Tab::_calcLabelDim {labelItem} { - # ... calculate the label width and height - set labelBBox [$_canvas bbox $labelItem] - - if { $_width > 0 } { - set _labelWidth [expr $_width + ($_padX * 2)] - } else { - set _labelWidth [expr \ - ([lindex $labelBBox 2] - [lindex $labelBBox 0]) + ($_padX * 2)] - } - - if { $_height > 0 } { - set _labelHeight [expr $_height + ($_padY * 2)] - } else { - set _labelHeight [expr \ - ([lindex $labelBBox 3] - [lindex $labelBBox 1]) + ($_padY * 2)] - } - - # ... calculate the label anchor point - set centerX [expr $_labelWidth/2.0] - set centerY [expr $_labelHeight/2.0 - 1] - - switch $anchor { - n { - set _labelXOrigin $centerX - set _labelYOrigin $_padY - set _just center - } - s { - set _labelXOrigin $centerX - set _labelYOrigin [expr $_labelHeight - $_padY] - set _just center - } - e { - set _labelXOrigin [expr $_labelWidth - $_padX - 1] - set _labelYOrigin $centerY - set _just right - } - w { - set _labelXOrigin [expr $_padX + 2] - set _labelYOrigin $centerY - set _just left - } - c { - set _labelXOrigin $centerX - set _labelYOrigin $centerY - set _just center - } - ne { - set _labelXOrigin [expr $_labelWidth - $_padX - 1] - set _labelYOrigin $_padY - set _just right - } - nw { - set _labelXOrigin [expr $_padX + 2] - set _labelYOrigin $_padY - set _just left - } - se { - set _labelXOrigin [expr $_labelWidth - $_padX - 1] - set _labelYOrigin [expr $_labelHeight - $_padY] - set _just right - } - sw { - set _labelXOrigin [expr $_padX + 2] - set _labelYOrigin [expr $_labelHeight - $_padY] - set _just left - } - default { - error "bad anchor position: \ - \"$tabpos\" must be n, ne, nw, s, sw, se, e, w, or center" - } - } -} diff --git a/itcl/iwidgets3.0.0/generic/tclIndex b/itcl/iwidgets3.0.0/generic/tclIndex deleted file mode 100644 index 5c684710f11..00000000000 --- a/itcl/iwidgets3.0.0/generic/tclIndex +++ /dev/null @@ -1,1336 +0,0 @@ -# Tcl autoload index file, version 2.0 -# This file is generated by the "auto_mkindex" command -# and sourced to set up indexing information for one or -# more commands. Typically each line is a command that -# sets an element in the auto_index array, where the -# element name is the name of a command and the value is -# a script that loads the command. - -set auto_index(::iwidgets::Buttonbox) [list source [file join $dir buttonbox.itk]] -set auto_index(::iwidgets::buttonbox) [list source [file join $dir buttonbox.itk]] -set auto_index(::iwidgets::Buttonbox::constructor) [list source [file join $dir buttonbox.itk]] -set auto_index(::iwidgets::Buttonbox::destructor) [list source [file join $dir buttonbox.itk]] -set auto_index(::iwidgets::Buttonbox::pady) [list source [file join $dir buttonbox.itk]] -set auto_index(::iwidgets::Buttonbox::padx) [list source [file join $dir buttonbox.itk]] -set auto_index(::iwidgets::Buttonbox::orient) [list source [file join $dir buttonbox.itk]] -set auto_index(::iwidgets::Buttonbox::index) [list source [file join $dir buttonbox.itk]] -set auto_index(::iwidgets::Buttonbox::add) [list source [file join $dir buttonbox.itk]] -set auto_index(::iwidgets::Buttonbox::insert) [list source [file join $dir buttonbox.itk]] -set auto_index(::iwidgets::Buttonbox::delete) [list source [file join $dir buttonbox.itk]] -set auto_index(::iwidgets::Buttonbox::default) [list source [file join $dir buttonbox.itk]] -set auto_index(::iwidgets::Buttonbox::hide) [list source [file join $dir buttonbox.itk]] -set auto_index(::iwidgets::Buttonbox::show) [list source [file join $dir buttonbox.itk]] -set auto_index(::iwidgets::Buttonbox::invoke) [list source [file join $dir buttonbox.itk]] -set auto_index(::iwidgets::Buttonbox::buttonconfigure) [list source [file join $dir buttonbox.itk]] -set auto_index(::iwidgets::Buttonbox::buttoncget) [list source [file join $dir buttonbox.itk]] -set auto_index(::iwidgets::Buttonbox::_getMaxWidth) [list source [file join $dir buttonbox.itk]] -set auto_index(::iwidgets::Buttonbox::_getMaxHeight) [list source [file join $dir buttonbox.itk]] -set auto_index(::iwidgets::Buttonbox::_setBoxSize) [list source [file join $dir buttonbox.itk]] -set auto_index(::iwidgets::Buttonbox::_positionButtons) [list source [file join $dir buttonbox.itk]] -set auto_index(::iwidgets::Canvasprintbox) [list source [file join $dir canvasprintbox.itk]] -set auto_index(::iwidgets::Canvasprintbox::ezPaperInfo) [list source [file join $dir canvasprintbox.itk]] -set auto_index(::iwidgets::canvasprintbox) [list source [file join $dir canvasprintbox.itk]] -set auto_index(::iwidgets::Canvasprintbox::printregion) [list source [file join $dir canvasprintbox.itk]] -set auto_index(::iwidgets::Canvasprintbox::output) [list source [file join $dir canvasprintbox.itk]] -set auto_index(::iwidgets::Canvasprintbox::printcmd) [list source [file join $dir canvasprintbox.itk]] -set auto_index(::iwidgets::Canvasprintbox::filename) [list source [file join $dir canvasprintbox.itk]] -set auto_index(::iwidgets::Canvasprintbox::pagesize) [list source [file join $dir canvasprintbox.itk]] -set auto_index(::iwidgets::Canvasprintbox::orient) [list source [file join $dir canvasprintbox.itk]] -set auto_index(::iwidgets::Canvasprintbox::stretch) [list source [file join $dir canvasprintbox.itk]] -set auto_index(::iwidgets::Canvasprintbox::posterize) [list source [file join $dir canvasprintbox.itk]] -set auto_index(::iwidgets::Canvasprintbox::hpagecnt) [list source [file join $dir canvasprintbox.itk]] -set auto_index(::iwidgets::Canvasprintbox::vpagecnt) [list source [file join $dir canvasprintbox.itk]] -set auto_index(::iwidgets::Canvasprintbox::constructor) [list source [file join $dir canvasprintbox.itk]] -set auto_index(::iwidgets::Canvasprintbox::setcanvas) [list source [file join $dir canvasprintbox.itk]] -set auto_index(::iwidgets::Canvasprintbox::getoutput) [list source [file join $dir canvasprintbox.itk]] -set auto_index(::iwidgets::Canvasprintbox::print) [list source [file join $dir canvasprintbox.itk]] -set auto_index(::iwidgets::Canvasprintbox::refresh) [list source [file join $dir canvasprintbox.itk]] -set auto_index(::iwidgets::Canvasprintbox::stop) [list source [file join $dir canvasprintbox.itk]] -set auto_index(::iwidgets::Canvasprintbox::_calc_poster_size) [list source [file join $dir canvasprintbox.itk]] -set auto_index(::iwidgets::Canvasprintbox::_calc_print_region) [list source [file join $dir canvasprintbox.itk]] -set auto_index(::iwidgets::Canvasprintbox::_calc_print_scale) [list source [file join $dir canvasprintbox.itk]] -set auto_index(::iwidgets::Canvasprintbox::_update_canvas) [list source [file join $dir canvasprintbox.itk]] -set auto_index(::iwidgets::Canvasprintbox::_update_attr) [list source [file join $dir canvasprintbox.itk]] -set auto_index(::iwidgets::Canvasprintbox::_mapEventHandler) [list source [file join $dir canvasprintbox.itk]] -set auto_index(::iwidgets::Canvasprintbox::destructor) [list source [file join $dir canvasprintbox.itk]] -set auto_index(::iwidgets::Canvasprintbox::ezPaperInfo) [list source [file join $dir canvasprintbox.itk]] -set auto_index(::iwidgets::Dialog) [list source [file join $dir dialog.itk]] -set auto_index(::iwidgets::dialog) [list source [file join $dir dialog.itk]] -set auto_index(::iwidgets::Dialog::constructor) [list source [file join $dir dialog.itk]] -set auto_index(::iwidgets::Combobox) [list source [file join $dir combobox.itk]] -set auto_index(::iwidgets::combobox) [list source [file join $dir combobox.itk]] -set auto_index(::iwidgets::Combobox::constructor) [list source [file join $dir combobox.itk]] -set auto_index(::iwidgets::Combobox::destructor) [list source [file join $dir combobox.itk]] -set auto_index(::iwidgets::Combobox::arrowrelief) [list source [file join $dir combobox.itk]] -set auto_index(::iwidgets::Combobox::completion) [list source [file join $dir combobox.itk]] -set auto_index(::iwidgets::Combobox::dropdown) [list source [file join $dir combobox.itk]] -set auto_index(::iwidgets::Combobox::editable) [list source [file join $dir combobox.itk]] -set auto_index(::iwidgets::Combobox::grab) [list source [file join $dir combobox.itk]] -set auto_index(::iwidgets::Combobox::labelpos) [list source [file join $dir combobox.itk]] -set auto_index(::iwidgets::Combobox::listheight) [list source [file join $dir combobox.itk]] -set auto_index(::iwidgets::Combobox::margin) [list source [file join $dir combobox.itk]] -set auto_index(::iwidgets::Combobox::popupcursor) [list source [file join $dir combobox.itk]] -set auto_index(::iwidgets::Combobox::selectioncommand) [list source [file join $dir combobox.itk]] -set auto_index(::iwidgets::Combobox::state) [list source [file join $dir combobox.itk]] -set auto_index(::iwidgets::Combobox::unique) [list source [file join $dir combobox.itk]] -set auto_index(::iwidgets::Combobox::clear) [list source [file join $dir combobox.itk]] -set auto_index(::iwidgets::Combobox::curselection) [list source [file join $dir combobox.itk]] -set auto_index(::iwidgets::Combobox::delete) [list source [file join $dir combobox.itk]] -set auto_index(::iwidgets::Combobox::get) [list source [file join $dir combobox.itk]] -set auto_index(::iwidgets::Combobox::getcurselection) [list source [file join $dir combobox.itk]] -set auto_index(::iwidgets::Combobox::invoke) [list source [file join $dir combobox.itk]] -set auto_index(::iwidgets::Combobox::insert) [list source [file join $dir combobox.itk]] -set auto_index(::iwidgets::Combobox::justify) [list source [file join $dir combobox.itk]] -set auto_index(::iwidgets::Combobox::see) [list source [file join $dir combobox.itk]] -set auto_index(::iwidgets::Combobox::selection) [list source [file join $dir combobox.itk]] -set auto_index(::iwidgets::Combobox::size) [list source [file join $dir combobox.itk]] -set auto_index(::iwidgets::Combobox::sort) [list source [file join $dir combobox.itk]] -set auto_index(::iwidgets::Combobox::xview) [list source [file join $dir combobox.itk]] -set auto_index(::iwidgets::Combobox::yview) [list source [file join $dir combobox.itk]] -set auto_index(::iwidgets::Combobox::_addToList) [list source [file join $dir combobox.itk]] -set auto_index(::iwidgets::Combobox::_createComponents) [list source [file join $dir combobox.itk]] -set auto_index(::iwidgets::Combobox::_deleteList) [list source [file join $dir combobox.itk]] -set auto_index(::iwidgets::Combobox::_deleteText) [list source [file join $dir combobox.itk]] -set auto_index(::iwidgets::Combobox::_doLayout) [list source [file join $dir combobox.itk]] -set auto_index(::iwidgets::Combobox::_drawArrow) [list source [file join $dir combobox.itk]] -set auto_index(::iwidgets::Combobox::_dropdownBtnRelease) [list source [file join $dir combobox.itk]] -set auto_index(::iwidgets::Combobox::_ignoreNextBtnRelease) [list source [file join $dir combobox.itk]] -set auto_index(::iwidgets::Combobox::_next) [list source [file join $dir combobox.itk]] -set auto_index(::iwidgets::Combobox::_packComponents) [list source [file join $dir combobox.itk]] -set auto_index(::iwidgets::Combobox::_positionList) [list source [file join $dir combobox.itk]] -set auto_index(::iwidgets::Combobox::_postList) [list source [file join $dir combobox.itk]] -set auto_index(::iwidgets::Combobox::_previous) [list source [file join $dir combobox.itk]] -set auto_index(::iwidgets::Combobox::_resizeArrow) [list source [file join $dir combobox.itk]] -set auto_index(::iwidgets::Combobox::_selectCmd) [list source [file join $dir combobox.itk]] -set auto_index(::iwidgets::Combobox::_toggleList) [list source [file join $dir combobox.itk]] -set auto_index(::iwidgets::Combobox::_unpostList) [list source [file join $dir combobox.itk]] -set auto_index(::iwidgets::Combobox::_commonBindings) [list source [file join $dir combobox.itk]] -set auto_index(::iwidgets::Combobox::_dropdownBindings) [list source [file join $dir combobox.itk]] -set auto_index(::iwidgets::Combobox::_simpleBindings) [list source [file join $dir combobox.itk]] -set auto_index(::iwidgets::Combobox::_listShowing) [list source [file join $dir combobox.itk]] -set auto_index(::iwidgets::Combobox::_slbListbox) [list source [file join $dir combobox.itk]] -set auto_index(::iwidgets::Combobox::_stateSelect) [list source [file join $dir combobox.itk]] -set auto_index(::iwidgets::Combobox::_bs) [list source [file join $dir combobox.itk]] -set auto_index(::iwidgets::Combobox::_lookup) [list source [file join $dir combobox.itk]] -set auto_index(::iwidgets::Dialogshell) [list source [file join $dir dialogshell.itk]] -set auto_index(::iwidgets::dialogshell) [list source [file join $dir dialogshell.itk]] -set auto_index(::iwidgets::Dialogshell::constructor) [list source [file join $dir dialogshell.itk]] -set auto_index(::iwidgets::Dialogshell::thickness) [list source [file join $dir dialogshell.itk]] -set auto_index(::iwidgets::Dialogshell::buttonboxpos) [list source [file join $dir dialogshell.itk]] -set auto_index(::iwidgets::Dialogshell::separator) [list source [file join $dir dialogshell.itk]] -set auto_index(::iwidgets::Dialogshell::padx) [list source [file join $dir dialogshell.itk]] -set auto_index(::iwidgets::Dialogshell::pady) [list source [file join $dir dialogshell.itk]] -set auto_index(::iwidgets::Dialogshell::childsite) [list source [file join $dir dialogshell.itk]] -set auto_index(::iwidgets::Dialogshell::index) [list source [file join $dir dialogshell.itk]] -set auto_index(::iwidgets::Dialogshell::add) [list source [file join $dir dialogshell.itk]] -set auto_index(::iwidgets::Dialogshell::insert) [list source [file join $dir dialogshell.itk]] -set auto_index(::iwidgets::Dialogshell::delete) [list source [file join $dir dialogshell.itk]] -set auto_index(::iwidgets::Dialogshell::hide) [list source [file join $dir dialogshell.itk]] -set auto_index(::iwidgets::Dialogshell::show) [list source [file join $dir dialogshell.itk]] -set auto_index(::iwidgets::Dialogshell::default) [list source [file join $dir dialogshell.itk]] -set auto_index(::iwidgets::Dialogshell::invoke) [list source [file join $dir dialogshell.itk]] -set auto_index(::iwidgets::Dialogshell::buttonconfigure) [list source [file join $dir dialogshell.itk]] -set auto_index(::iwidgets::Dialogshell::buttoncget) [list source [file join $dir dialogshell.itk]] -set auto_index(::iwidgets::Feedback) [list source [file join $dir feedback.itk]] -set auto_index(::iwidgets::feedback) [list source [file join $dir feedback.itk]] -set auto_index(::iwidgets::Feedback::constructor) [list source [file join $dir feedback.itk]] -set auto_index(::iwidgets::Feedback::destructor) [list source [file join $dir feedback.itk]] -set auto_index(::iwidgets::Feedback::steps) [list source [file join $dir feedback.itk]] -set auto_index(::iwidgets::Feedback::_display) [list source [file join $dir feedback.itk]] -set auto_index(::iwidgets::Feedback::reset) [list source [file join $dir feedback.itk]] -set auto_index(::iwidgets::Feedback::step) [list source [file join $dir feedback.itk]] -set auto_index(::iwidgets::Labeledwidget) [list source [file join $dir labeledwidget.itk]] -set auto_index(::iwidgets::Labeledwidget::alignlabels) [list source [file join $dir labeledwidget.itk]] -set auto_index(::iwidgets::labeledwidget) [list source [file join $dir labeledwidget.itk]] -set auto_index(::iwidgets::Labeledwidget::constructor) [list source [file join $dir labeledwidget.itk]] -set auto_index(::iwidgets::Labeledwidget::destructor) [list source [file join $dir labeledwidget.itk]] -set auto_index(::iwidgets::Labeledwidget::disabledforeground) [list source [file join $dir labeledwidget.itk]] -set auto_index(::iwidgets::Labeledwidget::labelpos) [list source [file join $dir labeledwidget.itk]] -set auto_index(::iwidgets::Labeledwidget::labelmargin) [list source [file join $dir labeledwidget.itk]] -set auto_index(::iwidgets::Labeledwidget::labeltext) [list source [file join $dir labeledwidget.itk]] -set auto_index(::iwidgets::Labeledwidget::labelvariable) [list source [file join $dir labeledwidget.itk]] -set auto_index(::iwidgets::Labeledwidget::labelbitmap) [list source [file join $dir labeledwidget.itk]] -set auto_index(::iwidgets::Labeledwidget::labelimage) [list source [file join $dir labeledwidget.itk]] -set auto_index(::iwidgets::Labeledwidget::state) [list source [file join $dir labeledwidget.itk]] -set auto_index(::iwidgets::Labeledwidget::childsite) [list source [file join $dir labeledwidget.itk]] -set auto_index(::iwidgets::Labeledwidget::alignlabels) [list source [file join $dir labeledwidget.itk]] -set auto_index(::iwidgets::Labeledwidget::_positionLabel) [list source [file join $dir labeledwidget.itk]] -set auto_index(::iwidgets::Menubar) [list source [file join $dir menubar.itk]] -set auto_index(::iwidgets::menubar) [list source [file join $dir menubar.itk]] -set auto_index(::iwidgets::Menubar::constructor) [list source [file join $dir menubar.itk]] -set auto_index(::iwidgets::Menubar::foreground) [list source [file join $dir menubar.itk]] -set auto_index(::iwidgets::Menubar::activebackground) [list source [file join $dir menubar.itk]] -set auto_index(::iwidgets::Menubar::activeborderwidth) [list source [file join $dir menubar.itk]] -set auto_index(::iwidgets::Menubar::activeforeground) [list source [file join $dir menubar.itk]] -set auto_index(::iwidgets::Menubar::anchor) [list source [file join $dir menubar.itk]] -set auto_index(::iwidgets::Menubar::borderwidth) [list source [file join $dir menubar.itk]] -set auto_index(::iwidgets::Menubar::disabledforeground) [list source [file join $dir menubar.itk]] -set auto_index(::iwidgets::Menubar::font) [list source [file join $dir menubar.itk]] -set auto_index(::iwidgets::Menubar::highlightbackground) [list source [file join $dir menubar.itk]] -set auto_index(::iwidgets::Menubar::highlightcolor) [list source [file join $dir menubar.itk]] -set auto_index(::iwidgets::Menubar::highlightthickness) [list source [file join $dir menubar.itk]] -set auto_index(::iwidgets::Menubar::justify) [list source [file join $dir menubar.itk]] -set auto_index(::iwidgets::Menubar::padx) [list source [file join $dir menubar.itk]] -set auto_index(::iwidgets::Menubar::pady) [list source [file join $dir menubar.itk]] -set auto_index(::iwidgets::Menubar::wraplength) [list source [file join $dir menubar.itk]] -set auto_index(::iwidgets::Menubar::menubuttons) [list source [file join $dir menubar.itk]] -set auto_index(::iwidgets::Menubar::helpvariable) [list source [file join $dir menubar.itk]] -set auto_index(::iwidgets::Menubar::add) [list source [file join $dir menubar.itk]] -set auto_index(::iwidgets::Menubar::delete) [list source [file join $dir menubar.itk]] -set auto_index(::iwidgets::Menubar::index) [list source [file join $dir menubar.itk]] -set auto_index(::iwidgets::Menubar::insert) [list source [file join $dir menubar.itk]] -set auto_index(::iwidgets::Menubar::invoke) [list source [file join $dir menubar.itk]] -set auto_index(::iwidgets::Menubar::menucget) [list source [file join $dir menubar.itk]] -set auto_index(::iwidgets::Menubar::menuconfigure) [list source [file join $dir menubar.itk]] -set auto_index(::iwidgets::Menubar::path) [list source [file join $dir menubar.itk]] -set auto_index(::iwidgets::Menubar::type) [list source [file join $dir menubar.itk]] -set auto_index(::iwidgets::Menubar::yposition) [list source [file join $dir menubar.itk]] -set auto_index(::iwidgets::Menubar::menubutton) [list source [file join $dir menubar.itk]] -set auto_index(::iwidgets::Menubar::options) [list source [file join $dir menubar.itk]] -set auto_index(::iwidgets::Menubar::command) [list source [file join $dir menubar.itk]] -set auto_index(::iwidgets::Menubar::checkbutton) [list source [file join $dir menubar.itk]] -set auto_index(::iwidgets::Menubar::radiobutton) [list source [file join $dir menubar.itk]] -set auto_index(::iwidgets::Menubar::separator) [list source [file join $dir menubar.itk]] -set auto_index(::iwidgets::Menubar::cascade) [list source [file join $dir menubar.itk]] -set auto_index(::iwidgets::Menubar::_addMenuButton) [list source [file join $dir menubar.itk]] -set auto_index(::iwidgets::Menubar::_insertMenuButton) [list source [file join $dir menubar.itk]] -set auto_index(::iwidgets::Menubar::_makeMenuButton) [list source [file join $dir menubar.itk]] -set auto_index(::iwidgets::Menubar::_makeMenu) [list source [file join $dir menubar.itk]] -set auto_index(::iwidgets::Menubar::_substEvalStr) [list source [file join $dir menubar.itk]] -set auto_index(::iwidgets::Menubar::_deleteMenu) [list source [file join $dir menubar.itk]] -set auto_index(::iwidgets::Menubar::_deleteAMenu) [list source [file join $dir menubar.itk]] -set auto_index(::iwidgets::Menubar::_addEntry) [list source [file join $dir menubar.itk]] -set auto_index(::iwidgets::Menubar::_addCascade) [list source [file join $dir menubar.itk]] -set auto_index(::iwidgets::Menubar::_insertEntry) [list source [file join $dir menubar.itk]] -set auto_index(::iwidgets::Menubar::_insertCascade) [list source [file join $dir menubar.itk]] -set auto_index(::iwidgets::Menubar::_deleteEntry) [list source [file join $dir menubar.itk]] -set auto_index(::iwidgets::Menubar::_configureMenu) [list source [file join $dir menubar.itk]] -set auto_index(::iwidgets::Menubar::_configureMenuOption) [list source [file join $dir menubar.itk]] -set auto_index(::iwidgets::Menubar::_configureMenuEntry) [list source [file join $dir menubar.itk]] -set auto_index(::iwidgets::Menubar::_unsetPaths) [list source [file join $dir menubar.itk]] -set auto_index(::iwidgets::Menubar::_entryPathToTkMenuPath) [list source [file join $dir menubar.itk]] -set auto_index(::iwidgets::Menubar::_getTkIndex) [list source [file join $dir menubar.itk]] -set auto_index(::iwidgets::Menubar::_getPdIndex) [list source [file join $dir menubar.itk]] -set auto_index(::iwidgets::Menubar::_getMenuList) [list source [file join $dir menubar.itk]] -set auto_index(::iwidgets::Menubar::_getEntryList) [list source [file join $dir menubar.itk]] -set auto_index(::iwidgets::Menubar::_parsePath) [list source [file join $dir menubar.itk]] -set auto_index(::iwidgets::Menubar::_getSymbolicPath) [list source [file join $dir menubar.itk]] -set auto_index(::iwidgets::Menubar::_leaveHandler) [list source [file join $dir menubar.itk]] -set auto_index(::iwidgets::Menubar::_helpHandler) [list source [file join $dir menubar.itk]] -set auto_index(::Menubar::_getCallerLevel) [list source [file join $dir menubar.itk]] -set auto_index(::tkMenuFind) [list source [file join $dir menubar.itk]] -set auto_index(::iwidgets::Messagedialog) [list source [file join $dir messagedialog.itk]] -set auto_index(::iwidgets::messagedialog) [list source [file join $dir messagedialog.itk]] -set auto_index(::iwidgets::Messagedialog::constructor) [list source [file join $dir messagedialog.itk]] -set auto_index(::iwidgets::Messagedialog::imagepos) [list source [file join $dir messagedialog.itk]] -set auto_index(::iwidgets::Notebook) [list source [file join $dir notebook.itk]] -set auto_index(::iwidgets::notebook) [list source [file join $dir notebook.itk]] -set auto_index(::iwidgets::Notebook::constructor) [list source [file join $dir notebook.itk]] -set auto_index(::iwidgets::Notebook::background) [list source [file join $dir notebook.itk]] -set auto_index(::iwidgets::Notebook::auto) [list source [file join $dir notebook.itk]] -set auto_index(::iwidgets::Notebook::scrollcommand) [list source [file join $dir notebook.itk]] -set auto_index(::iwidgets::Notebook::add) [list source [file join $dir notebook.itk]] -set auto_index(::iwidgets::Notebook::childsite) [list source [file join $dir notebook.itk]] -set auto_index(::iwidgets::Notebook::delete) [list source [file join $dir notebook.itk]] -set auto_index(::iwidgets::Notebook::index) [list source [file join $dir notebook.itk]] -set auto_index(::iwidgets::Notebook::insert) [list source [file join $dir notebook.itk]] -set auto_index(::iwidgets::Notebook::prev) [list source [file join $dir notebook.itk]] -set auto_index(::iwidgets::Notebook::next) [list source [file join $dir notebook.itk]] -set auto_index(::iwidgets::Notebook::pageconfigure) [list source [file join $dir notebook.itk]] -set auto_index(::iwidgets::Notebook::pagecget) [list source [file join $dir notebook.itk]] -set auto_index(::iwidgets::Notebook::select) [list source [file join $dir notebook.itk]] -set auto_index(::iwidgets::Notebook::view) [list source [file join $dir notebook.itk]] -set auto_index(::iwidgets::Notebook::_childSites) [list source [file join $dir notebook.itk]] -set auto_index(::iwidgets::Notebook::_scrollCommand) [list source [file join $dir notebook.itk]] -set auto_index(::iwidgets::Notebook::_index) [list source [file join $dir notebook.itk]] -set auto_index(::iwidgets::Notebook::_createPage) [list source [file join $dir notebook.itk]] -set auto_index(::iwidgets::Notebook::_deletePages) [list source [file join $dir notebook.itk]] -set auto_index(::iwidgets::Notebook::_configurePages) [list source [file join $dir notebook.itk]] -set auto_index(::iwidgets::Notebook::_tabCommand) [list source [file join $dir notebook.itk]] -set auto_index(::iwidgets::Page) [list source [file join $dir notebook.itk]] -set auto_index(::iwidgets::Page::constructor) [list source [file join $dir notebook.itk]] -set auto_index(::iwidgets::Page::disabledforeground) [list source [file join $dir notebook.itk]] -set auto_index(::iwidgets::Page::label) [list source [file join $dir notebook.itk]] -set auto_index(::iwidgets::Page::command) [list source [file join $dir notebook.itk]] -set auto_index(::iwidgets::Page::childsite) [list source [file join $dir notebook.itk]] -set auto_index(::iwidgets::Optionmenu) [list source [file join $dir optionmenu.itk]] -set auto_index(::iwidgets::optionmenu) [list source [file join $dir optionmenu.itk]] -set auto_index(::iwidgets::Optionmenu::constructor) [list source [file join $dir optionmenu.itk]] -set auto_index(::iwidgets::Optionmenu::destructor) [list source [file join $dir optionmenu.itk]] -set auto_index(::iwidgets::Optionmenu::clicktime) [list source [file join $dir optionmenu.itk]] -set auto_index(::iwidgets::Optionmenu::command) [list source [file join $dir optionmenu.itk]] -set auto_index(::iwidgets::Optionmenu::cyclicon) [list source [file join $dir optionmenu.itk]] -set auto_index(::iwidgets::Optionmenu::width) [list source [file join $dir optionmenu.itk]] -set auto_index(::iwidgets::Optionmenu::font) [list source [file join $dir optionmenu.itk]] -set auto_index(::iwidgets::Optionmenu::state) [list source [file join $dir optionmenu.itk]] -set auto_index(::iwidgets::Optionmenu::index) [list source [file join $dir optionmenu.itk]] -set auto_index(::iwidgets::Optionmenu::delete) [list source [file join $dir optionmenu.itk]] -set auto_index(::iwidgets::Optionmenu::disable) [list source [file join $dir optionmenu.itk]] -set auto_index(::iwidgets::Optionmenu::enable) [list source [file join $dir optionmenu.itk]] -set auto_index(::iwidgets::Optionmenu::get) [list source [file join $dir optionmenu.itk]] -set auto_index(::iwidgets::Optionmenu::insert) [list source [file join $dir optionmenu.itk]] -set auto_index(::iwidgets::Optionmenu::select) [list source [file join $dir optionmenu.itk]] -set auto_index(::iwidgets::Optionmenu::popupMenu) [list source [file join $dir optionmenu.itk]] -set auto_index(::iwidgets::Optionmenu::sort) [list source [file join $dir optionmenu.itk]] -set auto_index(::iwidgets::Optionmenu::_buttonRelease) [list source [file join $dir optionmenu.itk]] -set auto_index(::iwidgets::Optionmenu::_getNextItem) [list source [file join $dir optionmenu.itk]] -set auto_index(::iwidgets::Optionmenu::_next) [list source [file join $dir optionmenu.itk]] -set auto_index(::iwidgets::Optionmenu::_previous) [list source [file join $dir optionmenu.itk]] -set auto_index(::iwidgets::Optionmenu::_postMenu) [list source [file join $dir optionmenu.itk]] -set auto_index(::iwidgets::Optionmenu::_setItem) [list source [file join $dir optionmenu.itk]] -set auto_index(::iwidgets::Optionmenu::_unpostMenu) [list source [file join $dir optionmenu.itk]] -set auto_index(::iwidgets::Optionmenu::_setitems) [list source [file join $dir optionmenu.itk]] -set auto_index(::iwidgets::Optionmenu::_setSize) [list source [file join $dir optionmenu.itk]] -set auto_index(::iwidgets::Pane) [list source [file join $dir pane.itk]] -set auto_index(::iwidgets::pane) [list source [file join $dir pane.itk]] -set auto_index(::iwidgets::Pane::constructor) [list source [file join $dir pane.itk]] -set auto_index(::iwidgets::Pane::minimum) [list source [file join $dir pane.itk]] -set auto_index(::iwidgets::Pane::margin) [list source [file join $dir pane.itk]] -set auto_index(::iwidgets::Pane::childSite) [list source [file join $dir pane.itk]] -set auto_index(::iwidgets::Panedwindow) [list source [file join $dir panedwindow.itk]] -set auto_index(::iwidgets::panedwindow) [list source [file join $dir panedwindow.itk]] -set auto_index(::iwidgets::Panedwindow::constructor) [list source [file join $dir panedwindow.itk]] -set auto_index(::iwidgets::Panedwindow::orient) [list source [file join $dir panedwindow.itk]] -set auto_index(::iwidgets::Panedwindow::sashborderwidth) [list source [file join $dir panedwindow.itk]] -set auto_index(::iwidgets::Panedwindow::sashcursor) [list source [file join $dir panedwindow.itk]] -set auto_index(::iwidgets::Panedwindow::sashwidth) [list source [file join $dir panedwindow.itk]] -set auto_index(::iwidgets::Panedwindow::sashheight) [list source [file join $dir panedwindow.itk]] -set auto_index(::iwidgets::Panedwindow::thickness) [list source [file join $dir panedwindow.itk]] -set auto_index(::iwidgets::Panedwindow::sashindent) [list source [file join $dir panedwindow.itk]] -set auto_index(::iwidgets::Panedwindow::index) [list source [file join $dir panedwindow.itk]] -set auto_index(::iwidgets::Panedwindow::childsite) [list source [file join $dir panedwindow.itk]] -set auto_index(::iwidgets::Panedwindow::fraction) [list source [file join $dir panedwindow.itk]] -set auto_index(::iwidgets::Panedwindow::add) [list source [file join $dir panedwindow.itk]] -set auto_index(::iwidgets::Panedwindow::insert) [list source [file join $dir panedwindow.itk]] -set auto_index(::iwidgets::Panedwindow::delete) [list source [file join $dir panedwindow.itk]] -set auto_index(::iwidgets::Panedwindow::hide) [list source [file join $dir panedwindow.itk]] -set auto_index(::iwidgets::Panedwindow::show) [list source [file join $dir panedwindow.itk]] -set auto_index(::iwidgets::Panedwindow::paneconfigure) [list source [file join $dir panedwindow.itk]] -set auto_index(::iwidgets::Panedwindow::reset) [list source [file join $dir panedwindow.itk]] -set auto_index(::iwidgets::Panedwindow::_pwConfigureEventHandler) [list source [file join $dir panedwindow.itk]] -set auto_index(::iwidgets::Panedwindow::_startGrip) [list source [file join $dir panedwindow.itk]] -set auto_index(::iwidgets::Panedwindow::_endGrip) [list source [file join $dir panedwindow.itk]] -set auto_index(::iwidgets::Panedwindow::_configGrip) [list source [file join $dir panedwindow.itk]] -set auto_index(::iwidgets::Panedwindow::_handleGrip) [list source [file join $dir panedwindow.itk]] -set auto_index(::iwidgets::Panedwindow::_moveSash) [list source [file join $dir panedwindow.itk]] -set auto_index(::iwidgets::Panedwindow::_setFracArray) [list source [file join $dir panedwindow.itk]] -set auto_index(::iwidgets::Panedwindow::_setActivePanes) [list source [file join $dir panedwindow.itk]] -set auto_index(::iwidgets::Panedwindow::_calcFraction) [list source [file join $dir panedwindow.itk]] -set auto_index(::iwidgets::Panedwindow::_makeSashes) [list source [file join $dir panedwindow.itk]] -set auto_index(::iwidgets::Panedwindow::_placeSash) [list source [file join $dir panedwindow.itk]] -set auto_index(::iwidgets::Panedwindow::_placePanes) [list source [file join $dir panedwindow.itk]] -set auto_index(::iwidgets::Shell) [list source [file join $dir shell.itk]] -set auto_index(::iwidgets::shell) [list source [file join $dir shell.itk]] -set auto_index(::iwidgets::Shell::constructor) [list source [file join $dir shell.itk]] -set auto_index(::iwidgets::Shell::master) [list source [file join $dir shell.itk]] -set auto_index(::iwidgets::Shell::modality) [list source [file join $dir shell.itk]] -set auto_index(::iwidgets::Shell::padx) [list source [file join $dir shell.itk]] -set auto_index(::iwidgets::Shell::pady) [list source [file join $dir shell.itk]] -set auto_index(::iwidgets::Shell::width) [list source [file join $dir shell.itk]] -set auto_index(::iwidgets::Shell::height) [list source [file join $dir shell.itk]] -set auto_index(::iwidgets::Shell::childsite) [list source [file join $dir shell.itk]] -set auto_index(::iwidgets::Shell::activate) [list source [file join $dir shell.itk]] -set auto_index(::iwidgets::Shell::deactivate) [list source [file join $dir shell.itk]] -set auto_index(::iwidgets::Shell::center) [list source [file join $dir shell.itk]] -set auto_index(::iwidgets::Promptdialog) [list source [file join $dir promptdialog.itk]] -set auto_index(::iwidgets::promptdialog) [list source [file join $dir promptdialog.itk]] -set auto_index(::iwidgets::Promptdialog::constructor) [list source [file join $dir promptdialog.itk]] -set auto_index(::iwidgets::Promptdialog::get) [list source [file join $dir promptdialog.itk]] -set auto_index(::iwidgets::Promptdialog::clear) [list source [file join $dir promptdialog.itk]] -set auto_index(::iwidgets::Promptdialog::insert) [list source [file join $dir promptdialog.itk]] -set auto_index(::iwidgets::Promptdialog::delete) [list source [file join $dir promptdialog.itk]] -set auto_index(::iwidgets::Promptdialog::icursor) [list source [file join $dir promptdialog.itk]] -set auto_index(::iwidgets::Promptdialog::index) [list source [file join $dir promptdialog.itk]] -set auto_index(::iwidgets::Promptdialog::scan) [list source [file join $dir promptdialog.itk]] -set auto_index(::iwidgets::Promptdialog::selection) [list source [file join $dir promptdialog.itk]] -set auto_index(::iwidgets::Promptdialog::xview) [list source [file join $dir promptdialog.itk]] -set auto_index(::iwidgets::Radiobox) [list source [file join $dir radiobox.itk]] -set auto_index(::iwidgets::radiobox) [list source [file join $dir radiobox.itk]] -set auto_index(::iwidgets::Radiobox::constructor) [list source [file join $dir radiobox.itk]] -set auto_index(::iwidgets::Radiobox::command) [list source [file join $dir radiobox.itk]] -set auto_index(::iwidgets::Radiobox::index) [list source [file join $dir radiobox.itk]] -set auto_index(::iwidgets::Radiobox::add) [list source [file join $dir radiobox.itk]] -set auto_index(::iwidgets::Radiobox::insert) [list source [file join $dir radiobox.itk]] -set auto_index(::iwidgets::Radiobox::_rearrange) [list source [file join $dir radiobox.itk]] -set auto_index(::iwidgets::Radiobox::delete) [list source [file join $dir radiobox.itk]] -set auto_index(::iwidgets::Radiobox::select) [list source [file join $dir radiobox.itk]] -set auto_index(::iwidgets::Radiobox::get) [list source [file join $dir radiobox.itk]] -set auto_index(::iwidgets::Radiobox::deselect) [list source [file join $dir radiobox.itk]] -set auto_index(::iwidgets::Radiobox::flash) [list source [file join $dir radiobox.itk]] -set auto_index(::iwidgets::Radiobox::buttonconfigure) [list source [file join $dir radiobox.itk]] -set auto_index(::iwidgets::Radiobox::_command) [list source [file join $dir radiobox.itk]] -set auto_index(::iwidgets::Radiobox::gettag) [list source [file join $dir radiobox.itk]] -set auto_index(::iwidgets::Scrolledcanvas) [list source [file join $dir scrolledcanvas.itk]] -set auto_index(::iwidgets::scrolledcanvas) [list source [file join $dir scrolledcanvas.itk]] -set auto_index(::iwidgets::Scrolledcanvas::constructor) [list source [file join $dir scrolledcanvas.itk]] -set auto_index(::iwidgets::Scrolledcanvas::destructor) [list source [file join $dir scrolledcanvas.itk]] -set auto_index(::iwidgets::Scrolledcanvas::autoresize) [list source [file join $dir scrolledcanvas.itk]] -set auto_index(::iwidgets::Scrolledcanvas::childsite) [list source [file join $dir scrolledcanvas.itk]] -set auto_index(::iwidgets::Scrolledcanvas::justify) [list source [file join $dir scrolledcanvas.itk]] -set auto_index(::iwidgets::Scrolledcanvas::addtag) [list source [file join $dir scrolledcanvas.itk]] -set auto_index(::iwidgets::Scrolledcanvas::bbox) [list source [file join $dir scrolledcanvas.itk]] -set auto_index(::iwidgets::Scrolledcanvas::bind) [list source [file join $dir scrolledcanvas.itk]] -set auto_index(::iwidgets::Scrolledcanvas::canvasx) [list source [file join $dir scrolledcanvas.itk]] -set auto_index(::iwidgets::Scrolledcanvas::canvasy) [list source [file join $dir scrolledcanvas.itk]] -set auto_index(::iwidgets::Scrolledcanvas::coords) [list source [file join $dir scrolledcanvas.itk]] -set auto_index(::iwidgets::Scrolledcanvas::create) [list source [file join $dir scrolledcanvas.itk]] -set auto_index(::iwidgets::Scrolledcanvas::dchars) [list source [file join $dir scrolledcanvas.itk]] -set auto_index(::iwidgets::Scrolledcanvas::delete) [list source [file join $dir scrolledcanvas.itk]] -set auto_index(::iwidgets::Scrolledcanvas::dtag) [list source [file join $dir scrolledcanvas.itk]] -set auto_index(::iwidgets::Scrolledcanvas::find) [list source [file join $dir scrolledcanvas.itk]] -set auto_index(::iwidgets::Scrolledcanvas::focus) [list source [file join $dir scrolledcanvas.itk]] -set auto_index(::iwidgets::Scrolledcanvas::gettags) [list source [file join $dir scrolledcanvas.itk]] -set auto_index(::iwidgets::Scrolledcanvas::icursor) [list source [file join $dir scrolledcanvas.itk]] -set auto_index(::iwidgets::Scrolledcanvas::index) [list source [file join $dir scrolledcanvas.itk]] -set auto_index(::iwidgets::Scrolledcanvas::insert) [list source [file join $dir scrolledcanvas.itk]] -set auto_index(::iwidgets::Scrolledcanvas::itemconfigure) [list source [file join $dir scrolledcanvas.itk]] -set auto_index(::iwidgets::Scrolledcanvas::itemcget) [list source [file join $dir scrolledcanvas.itk]] -set auto_index(::iwidgets::Scrolledcanvas::lower) [list source [file join $dir scrolledcanvas.itk]] -set auto_index(::iwidgets::Scrolledcanvas::move) [list source [file join $dir scrolledcanvas.itk]] -set auto_index(::iwidgets::Scrolledcanvas::postscript) [list source [file join $dir scrolledcanvas.itk]] -set auto_index(::iwidgets::Scrolledcanvas::raise) [list source [file join $dir scrolledcanvas.itk]] -set auto_index(::iwidgets::Scrolledcanvas::scale) [list source [file join $dir scrolledcanvas.itk]] -set auto_index(::iwidgets::Scrolledcanvas::scan) [list source [file join $dir scrolledcanvas.itk]] -set auto_index(::iwidgets::Scrolledcanvas::select) [list source [file join $dir scrolledcanvas.itk]] -set auto_index(::iwidgets::Scrolledcanvas::type) [list source [file join $dir scrolledcanvas.itk]] -set auto_index(::iwidgets::Scrolledcanvas::xview) [list source [file join $dir scrolledcanvas.itk]] -set auto_index(::iwidgets::Scrolledcanvas::yview) [list source [file join $dir scrolledcanvas.itk]] -set auto_index(::iwidgets::Scrolledframe) [list source [file join $dir scrolledframe.itk]] -set auto_index(::iwidgets::scrolledframe) [list source [file join $dir scrolledframe.itk]] -set auto_index(::iwidgets::Scrolledframe::constructor) [list source [file join $dir scrolledframe.itk]] -set auto_index(::iwidgets::Scrolledframe::destructor) [list source [file join $dir scrolledframe.itk]] -set auto_index(::iwidgets::Scrolledframe::childsite) [list source [file join $dir scrolledframe.itk]] -set auto_index(::iwidgets::Scrolledframe::justify) [list source [file join $dir scrolledframe.itk]] -set auto_index(::iwidgets::Scrolledframe::xview) [list source [file join $dir scrolledframe.itk]] -set auto_index(::iwidgets::Scrolledframe::yview) [list source [file join $dir scrolledframe.itk]] -set auto_index(::iwidgets::Scrolledframe::_configureCanvas) [list source [file join $dir scrolledframe.itk]] -set auto_index(::iwidgets::Scrolledframe::_configureFrame) [list source [file join $dir scrolledframe.itk]] -set auto_index(::iwidgets::Hyperhelp) [list source [file join $dir hyperhelp.itk]] -set auto_index(::iwidgets::hyperhelp) [list source [file join $dir hyperhelp.itk]] -set auto_index(::iwidgets::Hyperhelp::constructor) [list source [file join $dir hyperhelp.itk]] -set auto_index(::iwidgets::Hyperhelp::topics) [list source [file join $dir hyperhelp.itk]] -set auto_index(::iwidgets::Hyperhelp::title) [list source [file join $dir hyperhelp.itk]] -set auto_index(::iwidgets::Hyperhelp::helpdir) [list source [file join $dir hyperhelp.itk]] -set auto_index(::iwidgets::Hyperhelp::closecmd) [list source [file join $dir hyperhelp.itk]] -set auto_index(::iwidgets::Hyperhelp::showtopic) [list source [file join $dir hyperhelp.itk]] -set auto_index(::iwidgets::Hyperhelp::followlink) [list source [file join $dir hyperhelp.itk]] -set auto_index(::iwidgets::Hyperhelp::forward) [list source [file join $dir hyperhelp.itk]] -set auto_index(::iwidgets::Hyperhelp::back) [list source [file join $dir hyperhelp.itk]] -set auto_index(::iwidgets::Hyperhelp::updatefeedback) [list source [file join $dir hyperhelp.itk]] -set auto_index(::iwidgets::Hyperhelp::_readtopic) [list source [file join $dir hyperhelp.itk]] -set auto_index(::iwidgets::Hyperhelp::_fill_go_menu) [list source [file join $dir hyperhelp.itk]] -set auto_index(::iwidgets::Hyperhelp::_pageforward) [list source [file join $dir hyperhelp.itk]] -set auto_index(::iwidgets::Hyperhelp::_pageback) [list source [file join $dir hyperhelp.itk]] -set auto_index(::iwidgets::Hyperhelp::_lineforward) [list source [file join $dir hyperhelp.itk]] -set auto_index(::iwidgets::Hyperhelp::_lineback) [list source [file join $dir hyperhelp.itk]] -set auto_index(::iwidgets::Scrolledlistbox) [list source [file join $dir scrolledlistbox.itk]] -set auto_index(::iwidgets::scrolledlistbox) [list source [file join $dir scrolledlistbox.itk]] -set auto_index(::iwidgets::Scrolledlistbox::constructor) [list source [file join $dir scrolledlistbox.itk]] -set auto_index(::iwidgets::Scrolledlistbox::destructor) [list source [file join $dir scrolledlistbox.itk]] -set auto_index(::iwidgets::Scrolledlistbox::dblclickcommand) [list source [file join $dir scrolledlistbox.itk]] -set auto_index(::iwidgets::Scrolledlistbox::selectioncommand) [list source [file join $dir scrolledlistbox.itk]] -set auto_index(::iwidgets::Scrolledlistbox::width) [list source [file join $dir scrolledlistbox.itk]] -set auto_index(::iwidgets::Scrolledlistbox::height) [list source [file join $dir scrolledlistbox.itk]] -set auto_index(::iwidgets::Scrolledlistbox::visibleitems) [list source [file join $dir scrolledlistbox.itk]] -set auto_index(::iwidgets::Scrolledlistbox::state) [list source [file join $dir scrolledlistbox.itk]] -set auto_index(::iwidgets::Scrolledlistbox::curselection) [list source [file join $dir scrolledlistbox.itk]] -set auto_index(::iwidgets::Scrolledlistbox::activate) [list source [file join $dir scrolledlistbox.itk]] -set auto_index(::iwidgets::Scrolledlistbox::bbox) [list source [file join $dir scrolledlistbox.itk]] -set auto_index(::iwidgets::Scrolledlistbox::clear) [list source [file join $dir scrolledlistbox.itk]] -set auto_index(::iwidgets::Scrolledlistbox::see) [list source [file join $dir scrolledlistbox.itk]] -set auto_index(::iwidgets::Scrolledlistbox::index) [list source [file join $dir scrolledlistbox.itk]] -set auto_index(::iwidgets::Scrolledlistbox::delete) [list source [file join $dir scrolledlistbox.itk]] -set auto_index(::iwidgets::Scrolledlistbox::get) [list source [file join $dir scrolledlistbox.itk]] -set auto_index(::iwidgets::Scrolledlistbox::getcurselection) [list source [file join $dir scrolledlistbox.itk]] -set auto_index(::iwidgets::Scrolledlistbox::insert) [list source [file join $dir scrolledlistbox.itk]] -set auto_index(::iwidgets::Scrolledlistbox::nearest) [list source [file join $dir scrolledlistbox.itk]] -set auto_index(::iwidgets::Scrolledlistbox::scan) [list source [file join $dir scrolledlistbox.itk]] -set auto_index(::iwidgets::Scrolledlistbox::selection) [list source [file join $dir scrolledlistbox.itk]] -set auto_index(::iwidgets::Scrolledlistbox::size) [list source [file join $dir scrolledlistbox.itk]] -set auto_index(::iwidgets::Scrolledlistbox::selecteditemcount) [list source [file join $dir scrolledlistbox.itk]] -set auto_index(::iwidgets::Scrolledlistbox::justify) [list source [file join $dir scrolledlistbox.itk]] -set auto_index(::iwidgets::Scrolledlistbox::sort) [list source [file join $dir scrolledlistbox.itk]] -set auto_index(::iwidgets::Scrolledlistbox::xview) [list source [file join $dir scrolledlistbox.itk]] -set auto_index(::iwidgets::Scrolledlistbox::yview) [list source [file join $dir scrolledlistbox.itk]] -set auto_index(::iwidgets::Scrolledlistbox::_makeSelection) [list source [file join $dir scrolledlistbox.itk]] -set auto_index(::iwidgets::Scrolledlistbox::_dblclick) [list source [file join $dir scrolledlistbox.itk]] -set auto_index(::iwidgets::Scrolledtext) [list source [file join $dir scrolledtext.itk]] -set auto_index(::iwidgets::scrolledtext) [list source [file join $dir scrolledtext.itk]] -set auto_index(::iwidgets::Scrolledtext::constructor) [list source [file join $dir scrolledtext.itk]] -set auto_index(::iwidgets::Scrolledtext::destructor) [list source [file join $dir scrolledtext.itk]] -set auto_index(::iwidgets::Scrolledtext::width) [list source [file join $dir scrolledtext.itk]] -set auto_index(::iwidgets::Scrolledtext::height) [list source [file join $dir scrolledtext.itk]] -set auto_index(::iwidgets::Scrolledtext::visibleitems) [list source [file join $dir scrolledtext.itk]] -set auto_index(::iwidgets::Scrolledtext::childsite) [list source [file join $dir scrolledtext.itk]] -set auto_index(::iwidgets::Scrolledtext::bbox) [list source [file join $dir scrolledtext.itk]] -set auto_index(::iwidgets::Scrolledtext::clear) [list source [file join $dir scrolledtext.itk]] -set auto_index(::iwidgets::Scrolledtext::import) [list source [file join $dir scrolledtext.itk]] -set auto_index(::iwidgets::Scrolledtext::export) [list source [file join $dir scrolledtext.itk]] -set auto_index(::iwidgets::Scrolledtext::compare) [list source [file join $dir scrolledtext.itk]] -set auto_index(::iwidgets::Scrolledtext::debug) [list source [file join $dir scrolledtext.itk]] -set auto_index(::iwidgets::Scrolledtext::delete) [list source [file join $dir scrolledtext.itk]] -set auto_index(::iwidgets::Scrolledtext::dlineinfo) [list source [file join $dir scrolledtext.itk]] -set auto_index(::iwidgets::Scrolledtext::get) [list source [file join $dir scrolledtext.itk]] -set auto_index(::iwidgets::Scrolledtext::index) [list source [file join $dir scrolledtext.itk]] -set auto_index(::iwidgets::Scrolledtext::insert) [list source [file join $dir scrolledtext.itk]] -set auto_index(::iwidgets::Scrolledtext::mark) [list source [file join $dir scrolledtext.itk]] -set auto_index(::iwidgets::Scrolledtext::scan) [list source [file join $dir scrolledtext.itk]] -set auto_index(::iwidgets::Scrolledtext::search) [list source [file join $dir scrolledtext.itk]] -set auto_index(::iwidgets::Scrolledtext::see) [list source [file join $dir scrolledtext.itk]] -set auto_index(::iwidgets::Scrolledtext::tag) [list source [file join $dir scrolledtext.itk]] -set auto_index(::iwidgets::Scrolledtext::window) [list source [file join $dir scrolledtext.itk]] -set auto_index(::iwidgets::Scrolledtext::xview) [list source [file join $dir scrolledtext.itk]] -set auto_index(::iwidgets::Scrolledtext::yview) [list source [file join $dir scrolledtext.itk]] -set auto_index(::iwidgets::Selectionbox) [list source [file join $dir selectionbox.itk]] -set auto_index(::iwidgets::selectionbox) [list source [file join $dir selectionbox.itk]] -set auto_index(::iwidgets::Selectionbox::constructor) [list source [file join $dir selectionbox.itk]] -set auto_index(::iwidgets::Selectionbox::destructor) [list source [file join $dir selectionbox.itk]] -set auto_index(::iwidgets::Selectionbox::childsitepos) [list source [file join $dir selectionbox.itk]] -set auto_index(::iwidgets::Selectionbox::margin) [list source [file join $dir selectionbox.itk]] -set auto_index(::iwidgets::Selectionbox::itemson) [list source [file join $dir selectionbox.itk]] -set auto_index(::iwidgets::Selectionbox::selectionon) [list source [file join $dir selectionbox.itk]] -set auto_index(::iwidgets::Selectionbox::width) [list source [file join $dir selectionbox.itk]] -set auto_index(::iwidgets::Selectionbox::height) [list source [file join $dir selectionbox.itk]] -set auto_index(::iwidgets::Selectionbox::childsite) [list source [file join $dir selectionbox.itk]] -set auto_index(::iwidgets::Selectionbox::get) [list source [file join $dir selectionbox.itk]] -set auto_index(::iwidgets::Selectionbox::curselection) [list source [file join $dir selectionbox.itk]] -set auto_index(::iwidgets::Selectionbox::clear) [list source [file join $dir selectionbox.itk]] -set auto_index(::iwidgets::Selectionbox::insert) [list source [file join $dir selectionbox.itk]] -set auto_index(::iwidgets::Selectionbox::delete) [list source [file join $dir selectionbox.itk]] -set auto_index(::iwidgets::Selectionbox::size) [list source [file join $dir selectionbox.itk]] -set auto_index(::iwidgets::Selectionbox::scan) [list source [file join $dir selectionbox.itk]] -set auto_index(::iwidgets::Selectionbox::nearest) [list source [file join $dir selectionbox.itk]] -set auto_index(::iwidgets::Selectionbox::index) [list source [file join $dir selectionbox.itk]] -set auto_index(::iwidgets::Selectionbox::selection) [list source [file join $dir selectionbox.itk]] -set auto_index(::iwidgets::Selectionbox::selectitem) [list source [file join $dir selectionbox.itk]] -set auto_index(::iwidgets::Selectionbox::_packComponents) [list source [file join $dir selectionbox.itk]] -set auto_index(::iwidgets::Selectiondialog) [list source [file join $dir selectiondialog.itk]] -set auto_index(::iwidgets::selectiondialog) [list source [file join $dir selectiondialog.itk]] -set auto_index(::iwidgets::Selectiondialog::constructor) [list source [file join $dir selectiondialog.itk]] -set auto_index(::iwidgets::Selectiondialog::childsite) [list source [file join $dir selectiondialog.itk]] -set auto_index(::iwidgets::Selectiondialog::get) [list source [file join $dir selectiondialog.itk]] -set auto_index(::iwidgets::Selectiondialog::curselection) [list source [file join $dir selectiondialog.itk]] -set auto_index(::iwidgets::Selectiondialog::clear) [list source [file join $dir selectiondialog.itk]] -set auto_index(::iwidgets::Selectiondialog::insert) [list source [file join $dir selectiondialog.itk]] -set auto_index(::iwidgets::Selectiondialog::delete) [list source [file join $dir selectiondialog.itk]] -set auto_index(::iwidgets::Selectiondialog::size) [list source [file join $dir selectiondialog.itk]] -set auto_index(::iwidgets::Selectiondialog::scan) [list source [file join $dir selectiondialog.itk]] -set auto_index(::iwidgets::Selectiondialog::nearest) [list source [file join $dir selectiondialog.itk]] -set auto_index(::iwidgets::Selectiondialog::index) [list source [file join $dir selectiondialog.itk]] -set auto_index(::iwidgets::Selectiondialog::selection) [list source [file join $dir selectiondialog.itk]] -set auto_index(::iwidgets::Selectiondialog::selectitem) [list source [file join $dir selectiondialog.itk]] -set auto_index(::iwidgets::Spindate) [list source [file join $dir spindate.itk]] -set auto_index(::iwidgets::spindate) [list source [file join $dir spindate.itk]] -set auto_index(::iwidgets::Spindate::constructor) [list source [file join $dir spindate.itk]] -set auto_index(::iwidgets::Spindate::destructor) [list source [file join $dir spindate.itk]] -set auto_index(::iwidgets::Spindate::labelpos) [list source [file join $dir spindate.itk]] -set auto_index(::iwidgets::Spindate::orient) [list source [file join $dir spindate.itk]] -set auto_index(::iwidgets::Spindate::monthon) [list source [file join $dir spindate.itk]] -set auto_index(::iwidgets::Spindate::dayon) [list source [file join $dir spindate.itk]] -set auto_index(::iwidgets::Spindate::yearon) [list source [file join $dir spindate.itk]] -set auto_index(::iwidgets::Spindate::datemargin) [list source [file join $dir spindate.itk]] -set auto_index(::iwidgets::Spindate::yeardigits) [list source [file join $dir spindate.itk]] -set auto_index(::iwidgets::Spindate::monthformat) [list source [file join $dir spindate.itk]] -set auto_index(::iwidgets::Spindate::get) [list source [file join $dir spindate.itk]] -set auto_index(::iwidgets::Spindate::show) [list source [file join $dir spindate.itk]] -set auto_index(::iwidgets::Spindate::_spinMonth) [list source [file join $dir spindate.itk]] -set auto_index(::iwidgets::Spindate::_spinDay) [list source [file join $dir spindate.itk]] -set auto_index(::iwidgets::Spindate::_spinYear) [list source [file join $dir spindate.itk]] -set auto_index(::iwidgets::Spindate::_packDate) [list source [file join $dir spindate.itk]] -set auto_index(::iwidgets::Spindate::_lastDay) [list source [file join $dir spindate.itk]] -set auto_index(::iwidgets::Spinint) [list source [file join $dir spinint.itk]] -set auto_index(::iwidgets::spinint) [list source [file join $dir spinint.itk]] -set auto_index(::iwidgets::Spinint::constructor) [list source [file join $dir spinint.itk]] -set auto_index(::iwidgets::Spinint::range) [list source [file join $dir spinint.itk]] -set auto_index(::iwidgets::Spinint::step) [list source [file join $dir spinint.itk]] -set auto_index(::iwidgets::Spinint::wrap) [list source [file join $dir spinint.itk]] -set auto_index(::iwidgets::Spinint::up) [list source [file join $dir spinint.itk]] -set auto_index(::iwidgets::Spinint::down) [list source [file join $dir spinint.itk]] -set auto_index(::iwidgets::Spinner) [list source [file join $dir spinner.itk]] -set auto_index(::iwidgets::spinner) [list source [file join $dir spinner.itk]] -set auto_index(::iwidgets::Spinner::constructor) [list source [file join $dir spinner.itk]] -set auto_index(::iwidgets::Spinner::destructor) [list source [file join $dir spinner.itk]] -set auto_index(::iwidgets::Spinner::arroworient) [list source [file join $dir spinner.itk]] -set auto_index(::iwidgets::Spinner::textfont) [list source [file join $dir spinner.itk]] -set auto_index(::iwidgets::Spinner::highlightthickness) [list source [file join $dir spinner.itk]] -set auto_index(::iwidgets::Spinner::borderwidth) [list source [file join $dir spinner.itk]] -set auto_index(::iwidgets::Spinner::increment) [list source [file join $dir spinner.itk]] -set auto_index(::iwidgets::Spinner::decrement) [list source [file join $dir spinner.itk]] -set auto_index(::iwidgets::Spinner::repeatinterval) [list source [file join $dir spinner.itk]] -set auto_index(::iwidgets::Spinner::repeatdelay) [list source [file join $dir spinner.itk]] -set auto_index(::iwidgets::Spinner::foreground) [list source [file join $dir spinner.itk]] -set auto_index(::iwidgets::Spinner::up) [list source [file join $dir spinner.itk]] -set auto_index(::iwidgets::Spinner::down) [list source [file join $dir spinner.itk]] -set auto_index(::iwidgets::Spinner::_positionArrows) [list source [file join $dir spinner.itk]] -set auto_index(::iwidgets::Spinner::_pushup) [list source [file join $dir spinner.itk]] -set auto_index(::iwidgets::Spinner::_pushdown) [list source [file join $dir spinner.itk]] -set auto_index(::iwidgets::Spinner::_doup) [list source [file join $dir spinner.itk]] -set auto_index(::iwidgets::Spinner::_dodown) [list source [file join $dir spinner.itk]] -set auto_index(::iwidgets::Spinner::_relup) [list source [file join $dir spinner.itk]] -set auto_index(::iwidgets::Spinner::_reldown) [list source [file join $dir spinner.itk]] -set auto_index(::iwidgets::Spinner::_up) [list source [file join $dir spinner.itk]] -set auto_index(::iwidgets::Spinner::_down) [list source [file join $dir spinner.itk]] -set auto_index(::iwidgets::Spintime) [list source [file join $dir spintime.itk]] -set auto_index(::iwidgets::spintime) [list source [file join $dir spintime.itk]] -set auto_index(::iwidgets::Spintime::constructor) [list source [file join $dir spintime.itk]] -set auto_index(::iwidgets::Spintime::destructor) [list source [file join $dir spintime.itk]] -set auto_index(::iwidgets::Spintime::orient) [list source [file join $dir spintime.itk]] -set auto_index(::iwidgets::Spintime::labelpos) [list source [file join $dir spintime.itk]] -set auto_index(::iwidgets::Spintime::houron) [list source [file join $dir spintime.itk]] -set auto_index(::iwidgets::Spintime::minuteon) [list source [file join $dir spintime.itk]] -set auto_index(::iwidgets::Spintime::secondon) [list source [file join $dir spintime.itk]] -set auto_index(::iwidgets::Spintime::timemargin) [list source [file join $dir spintime.itk]] -set auto_index(::iwidgets::Spintime::militaryon) [list source [file join $dir spintime.itk]] -set auto_index(::iwidgets::Spintime::get) [list source [file join $dir spintime.itk]] -set auto_index(::iwidgets::Spintime::show) [list source [file join $dir spintime.itk]] -set auto_index(::iwidgets::Spintime::_packTime) [list source [file join $dir spintime.itk]] -set auto_index(::iwidgets::Spintime::_down60) [list source [file join $dir spintime.itk]] -set auto_index(::iwidgets::Tabnotebook) [list source [file join $dir tabnotebook.itk]] -set auto_index(::iwidgets::Tabnotebook::constructor) [list source [file join $dir tabnotebook.itk]] -set auto_index(::iwidgets::tabnotebook) [list source [file join $dir tabnotebook.itk]] -set auto_index(::iwidgets::Tabnotebook::destructor) [list source [file join $dir tabnotebook.itk]] -set auto_index(::iwidgets::Tabnotebook::borderwidth) [list source [file join $dir tabnotebook.itk]] -set auto_index(::iwidgets::Tabnotebook::state) [list source [file join $dir tabnotebook.itk]] -set auto_index(::iwidgets::Tabnotebook::disabledforeground) [list source [file join $dir tabnotebook.itk]] -set auto_index(::iwidgets::Tabnotebook::scrollcommand) [list source [file join $dir tabnotebook.itk]] -set auto_index(::iwidgets::Tabnotebook::equaltabs) [list source [file join $dir tabnotebook.itk]] -set auto_index(::iwidgets::Tabnotebook::font) [list source [file join $dir tabnotebook.itk]] -set auto_index(::iwidgets::Tabnotebook::width) [list source [file join $dir tabnotebook.itk]] -set auto_index(::iwidgets::Tabnotebook::height) [list source [file join $dir tabnotebook.itk]] -set auto_index(::iwidgets::Tabnotebook::foreground) [list source [file join $dir tabnotebook.itk]] -set auto_index(::iwidgets::Tabnotebook::background) [list source [file join $dir tabnotebook.itk]] -set auto_index(::iwidgets::Tabnotebook::tabforeground) [list source [file join $dir tabnotebook.itk]] -set auto_index(::iwidgets::Tabnotebook::tabbackground) [list source [file join $dir tabnotebook.itk]] -set auto_index(::iwidgets::Tabnotebook::backdrop) [list source [file join $dir tabnotebook.itk]] -set auto_index(::iwidgets::Tabnotebook::margin) [list source [file join $dir tabnotebook.itk]] -set auto_index(::iwidgets::Tabnotebook::tabborders) [list source [file join $dir tabnotebook.itk]] -set auto_index(::iwidgets::Tabnotebook::bevelamount) [list source [file join $dir tabnotebook.itk]] -set auto_index(::iwidgets::Tabnotebook::raiseselect) [list source [file join $dir tabnotebook.itk]] -set auto_index(::iwidgets::Tabnotebook::auto) [list source [file join $dir tabnotebook.itk]] -set auto_index(::iwidgets::Tabnotebook::start) [list source [file join $dir tabnotebook.itk]] -set auto_index(::iwidgets::Tabnotebook::padx) [list source [file join $dir tabnotebook.itk]] -set auto_index(::iwidgets::Tabnotebook::pady) [list source [file join $dir tabnotebook.itk]] -set auto_index(::iwidgets::Tabnotebook::gap) [list source [file join $dir tabnotebook.itk]] -set auto_index(::iwidgets::Tabnotebook::angle) [list source [file join $dir tabnotebook.itk]] -set auto_index(::iwidgets::Tabnotebook::tabpos) [list source [file join $dir tabnotebook.itk]] -set auto_index(::iwidgets::Tabnotebook::configure) [list source [file join $dir tabnotebook.itk]] -set auto_index(::iwidgets::Tabnotebook::add) [list source [file join $dir tabnotebook.itk]] -set auto_index(::iwidgets::Tabnotebook::childsite) [list source [file join $dir tabnotebook.itk]] -set auto_index(::iwidgets::Tabnotebook::delete) [list source [file join $dir tabnotebook.itk]] -set auto_index(::iwidgets::Tabnotebook::index) [list source [file join $dir tabnotebook.itk]] -set auto_index(::iwidgets::Tabnotebook::insert) [list source [file join $dir tabnotebook.itk]] -set auto_index(::iwidgets::Tabnotebook::prev) [list source [file join $dir tabnotebook.itk]] -set auto_index(::iwidgets::Tabnotebook::next) [list source [file join $dir tabnotebook.itk]] -set auto_index(::iwidgets::Tabnotebook::pageconfigure) [list source [file join $dir tabnotebook.itk]] -set auto_index(::iwidgets::Tabnotebook::select) [list source [file join $dir tabnotebook.itk]] -set auto_index(::iwidgets::Tabnotebook::view) [list source [file join $dir tabnotebook.itk]] -set auto_index(::iwidgets::Tabnotebook::_getArgs) [list source [file join $dir tabnotebook.itk]] -set auto_index(::iwidgets::Tabnotebook::_reconfigureTabset) [list source [file join $dir tabnotebook.itk]] -set auto_index(::iwidgets::Tabnotebook::_canvasReconfigure) [list source [file join $dir tabnotebook.itk]] -set auto_index(::iwidgets::Tabnotebook::_redrawBorder) [list source [file join $dir tabnotebook.itk]] -set auto_index(::iwidgets::Tabnotebook::_recomputeBorder) [list source [file join $dir tabnotebook.itk]] -set auto_index(::iwidgets::Tabnotebook::_pageReconfigure) [list source [file join $dir tabnotebook.itk]] -set auto_index(::iwidgets::Tabnotebook::_pack) [list source [file join $dir tabnotebook.itk]] -set auto_index(::iwidgets::Tabset) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::tabset) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tabset::constructor) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tabset::destructor) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tabset::width) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tabset::equaltabs) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tabset::height) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tabset::tabpos) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tabset::raiseselect) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tabset::start) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tabset::margin) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tabset::tabborders) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tabset::bevelamount) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tabset::padx) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tabset::pady) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tabset::gap) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tabset::angle) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tabset::font) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tabset::state) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tabset::disabledforeground) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tabset::foreground) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tabset::background) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tabset::selectforeground) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tabset::backdrop) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tabset::selectbackground) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tabset::command) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tabset::add) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tabset::configure) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tabset::_configRelayout) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tabset::delete) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tabset::index) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tabset::insert) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tabset::prev) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tabset::next) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tabset::select) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tabset::tabcget) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tabset::tabconfigure) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tabset::_selectName) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tabset::_createTab) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tabset::_deleteTabs) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tabset::_index) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tabset::_tabConfigure) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tabset::_relayoutTabs) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tabset::_drawBevelBorder) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tabset::_calcNextTabOffset) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tabset::_tabBounds) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tabset::_recalcCanvasGeom) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tabset::_canvasReconfigure) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tabset::_startMove) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tabset::_moveTabs) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tabset::_endMove) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tab) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tab::constructor) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tab::destructor) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tab::bevelamount) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tab::state) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tab::height) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tab::width) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tab::anchor) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tab::left) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tab::top) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tab::image) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tab::bitmap) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tab::label) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tab::padx) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tab::pady) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tab::selectbackground) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tab::selectforeground) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tab::disabledforeground) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tab::background) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tab::foreground) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tab::orient) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tab::invert) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tab::angle) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tab::font) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tab::tabborders) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tab::configure) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tab::bbox) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tab::deselect) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tab::lower) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tab::majordim) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tab::minordim) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tab::offset) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tab::raise) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tab::select) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tab::labelheight) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tab::labelwidth) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tab::_selectNoRaise) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tab::_deselectNoLower) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tab::_makeTab) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tab::_createLabel) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tab::_makeEastTab) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tab::_makeWestTab) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tab::_makeNorthTab) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tab::_makeSouthTab) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Tab::_calcLabelDim) [list source [file join $dir tabset.itk]] -set auto_index(::iwidgets::Toolbar) [list source [file join $dir toolbar.itk]] -set auto_index(::iwidgets::Toolbar::constructor) [list source [file join $dir toolbar.itk]] -set auto_index(::iwidgets::toolbar) [list source [file join $dir toolbar.itk]] -set auto_index(::iwidgets::Toolbar::destructor) [list source [file join $dir toolbar.itk]] -set auto_index(::iwidgets::Toolbar::balloonbackground) [list source [file join $dir toolbar.itk]] -set auto_index(::iwidgets::Toolbar::balloonforeground) [list source [file join $dir toolbar.itk]] -set auto_index(::iwidgets::Toolbar::balloonfont) [list source [file join $dir toolbar.itk]] -set auto_index(::iwidgets::Toolbar::orient) [list source [file join $dir toolbar.itk]] -set auto_index(::iwidgets::Toolbar::add) [list source [file join $dir toolbar.itk]] -set auto_index(::iwidgets::Toolbar::delete) [list source [file join $dir toolbar.itk]] -set auto_index(::iwidgets::Toolbar::index) [list source [file join $dir toolbar.itk]] -set auto_index(::iwidgets::Toolbar::insert) [list source [file join $dir toolbar.itk]] -set auto_index(::iwidgets::Toolbar::itemcget) [list source [file join $dir toolbar.itk]] -set auto_index(::iwidgets::Toolbar::itemconfigure) [list source [file join $dir toolbar.itk]] -set auto_index(::iwidgets::Toolbar::_resetBalloonTimer) [list source [file join $dir toolbar.itk]] -set auto_index(::iwidgets::Toolbar::_startBalloonDelay) [list source [file join $dir toolbar.itk]] -set auto_index(::iwidgets::Toolbar::_stopBalloonDelay) [list source [file join $dir toolbar.itk]] -set auto_index(::iwidgets::Toolbar::_addWidget) [list source [file join $dir toolbar.itk]] -set auto_index(::iwidgets::Toolbar::_deleteWidgets) [list source [file join $dir toolbar.itk]] -set auto_index(::iwidgets::Toolbar::_index) [list source [file join $dir toolbar.itk]] -set auto_index(::iwidgets::Toolbar::hideHelp) [list source [file join $dir toolbar.itk]] -set auto_index(::iwidgets::Toolbar::showHelp) [list source [file join $dir toolbar.itk]] -set auto_index(::iwidgets::Toolbar::showBalloon) [list source [file join $dir toolbar.itk]] -set auto_index(::iwidgets::Toolbar::hideBalloon) [list source [file join $dir toolbar.itk]] -set auto_index(::iwidgets::Toolbar::_getAttachedOption) [list source [file join $dir toolbar.itk]] -set auto_index(::iwidgets::Toolbar::_setAttachedOption) [list source [file join $dir toolbar.itk]] -set auto_index(::iwidgets::Toolbar::_packToolbar) [list source [file join $dir toolbar.itk]] -set auto_index(::iwidgets::Canvasprintdialog) [list source [file join $dir canvasprintdialog.itk]] -set auto_index(::iwidgets::canvasprintdialog) [list source [file join $dir canvasprintdialog.itk]] -set auto_index(::iwidgets::Canvasprintdialog::constructor) [list source [file join $dir canvasprintdialog.itk]] -set auto_index(::iwidgets::Canvasprintdialog::deactivate) [list source [file join $dir canvasprintdialog.itk]] -set auto_index(::iwidgets::Canvasprintdialog::getoutput) [list source [file join $dir canvasprintdialog.itk]] -set auto_index(::iwidgets::Canvasprintdialog::setcanvas) [list source [file join $dir canvasprintdialog.itk]] -set auto_index(::iwidgets::Canvasprintdialog::refresh) [list source [file join $dir canvasprintdialog.itk]] -set auto_index(::iwidgets::Canvasprintdialog::print) [list source [file join $dir canvasprintdialog.itk]] -set auto_index(::iwidgets::Pushbutton) [list source [file join $dir pushbutton.itk]] -set auto_index(::iwidgets::pushbutton) [list source [file join $dir pushbutton.itk]] -set auto_index(::iwidgets::Pushbutton::constructor) [list source [file join $dir pushbutton.itk]] -set auto_index(::iwidgets::Pushbutton::destructor) [list source [file join $dir pushbutton.itk]] -set auto_index(::iwidgets::Pushbutton::padx) [list source [file join $dir pushbutton.itk]] -set auto_index(::iwidgets::Pushbutton::pady) [list source [file join $dir pushbutton.itk]] -set auto_index(::iwidgets::Pushbutton::font) [list source [file join $dir pushbutton.itk]] -set auto_index(::iwidgets::Pushbutton::text) [list source [file join $dir pushbutton.itk]] -set auto_index(::iwidgets::Pushbutton::bitmap) [list source [file join $dir pushbutton.itk]] -set auto_index(::iwidgets::Pushbutton::image) [list source [file join $dir pushbutton.itk]] -set auto_index(::iwidgets::Pushbutton::highlightthickness) [list source [file join $dir pushbutton.itk]] -set auto_index(::iwidgets::Pushbutton::borderwidth) [list source [file join $dir pushbutton.itk]] -set auto_index(::iwidgets::Pushbutton::defaultring) [list source [file join $dir pushbutton.itk]] -set auto_index(::iwidgets::Pushbutton::defaultringpad) [list source [file join $dir pushbutton.itk]] -set auto_index(::iwidgets::Pushbutton::height) [list source [file join $dir pushbutton.itk]] -set auto_index(::iwidgets::Pushbutton::width) [list source [file join $dir pushbutton.itk]] -set auto_index(::iwidgets::Pushbutton::flash) [list source [file join $dir pushbutton.itk]] -set auto_index(::iwidgets::Pushbutton::invoke) [list source [file join $dir pushbutton.itk]] -set auto_index(::iwidgets::Pushbutton::_relayout) [list source [file join $dir pushbutton.itk]] -set auto_index(::iwidgets::Calendar) [list source [file join $dir calendar.itk]] -set auto_index(::iwidgets::calendar) [list source [file join $dir calendar.itk]] -set auto_index(::iwidgets::Calendar::constructor) [list source [file join $dir calendar.itk]] -set auto_index(::iwidgets::Calendar::command) [list source [file join $dir calendar.itk]] -set auto_index(::iwidgets::Calendar::days) [list source [file join $dir calendar.itk]] -set auto_index(::iwidgets::Calendar::backwardimage) [list source [file join $dir calendar.itk]] -set auto_index(::iwidgets::Calendar::forwardimage) [list source [file join $dir calendar.itk]] -set auto_index(::iwidgets::Calendar::weekdaybackground) [list source [file join $dir calendar.itk]] -set auto_index(::iwidgets::Calendar::weekendbackground) [list source [file join $dir calendar.itk]] -set auto_index(::iwidgets::Calendar::foreground) [list source [file join $dir calendar.itk]] -set auto_index(::iwidgets::Calendar::outline) [list source [file join $dir calendar.itk]] -set auto_index(::iwidgets::Calendar::buttonforeground) [list source [file join $dir calendar.itk]] -set auto_index(::iwidgets::Calendar::selectcolor) [list source [file join $dir calendar.itk]] -set auto_index(::iwidgets::Calendar::selectthickness) [list source [file join $dir calendar.itk]] -set auto_index(::iwidgets::Calendar::titlefont) [list source [file join $dir calendar.itk]] -set auto_index(::iwidgets::Calendar::datefont) [list source [file join $dir calendar.itk]] -set auto_index(::iwidgets::Calendar::currentdatefont) [list source [file join $dir calendar.itk]] -set auto_index(::iwidgets::Calendar::dayfont) [list source [file join $dir calendar.itk]] -set auto_index(::iwidgets::Calendar::startday) [list source [file join $dir calendar.itk]] -set auto_index(::iwidgets::Calendar::get) [list source [file join $dir calendar.itk]] -set auto_index(::iwidgets::Calendar::select) [list source [file join $dir calendar.itk]] -set auto_index(::iwidgets::Calendar::show) [list source [file join $dir calendar.itk]] -set auto_index(::iwidgets::Calendar::_drawtext) [list source [file join $dir calendar.itk]] -set auto_index(::iwidgets::Calendar::_configureHandler) [list source [file join $dir calendar.itk]] -set auto_index(::iwidgets::Calendar::_change) [list source [file join $dir calendar.itk]] -set auto_index(::iwidgets::Calendar::_redraw) [list source [file join $dir calendar.itk]] -set auto_index(::iwidgets::Calendar::_days) [list source [file join $dir calendar.itk]] -set auto_index(::iwidgets::Calendar::_layout) [list source [file join $dir calendar.itk]] -set auto_index(::iwidgets::Calendar::_adjustday) [list source [file join $dir calendar.itk]] -set auto_index(::iwidgets::Calendar::_select) [list source [file join $dir calendar.itk]] -set auto_index(::iwidgets::Calendar::_selectEvent) [list source [file join $dir calendar.itk]] -set auto_index(::iwidgets::Calendar::_percentSubst) [list source [file join $dir calendar.itk]] -set auto_index(::iwidgets::Scrolledhtml) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::scrolledhtml) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::constructor) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::destructor) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::fontsize) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::fixedfont) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::fontname) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::textbackground) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::linkhighlight) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::unknownimage) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::update) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::clear) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::import) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::render) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_setup) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_definefont) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_append_text) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_set_tag) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_reconfig_tags) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_push) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_pop) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_peek) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_parse_fields) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_href_click) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_set_align) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_fixtablewidth) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_header) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_/header) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_a) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_/a) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_address) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_/address) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_b) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_/b) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_base) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_basefont) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_big) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_/big) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_blockquote) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_/blockquote) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_body) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_/body) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_br) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_center) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_/center) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_cite) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_/cite) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_code) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_/code) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_dir) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_/dir) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_div) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_dl) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_/dl) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_dt) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_dd) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_dfn) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_/dfn) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_em) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_/em) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_font) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_/font) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_h1) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_/h1) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_h2) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_/h2) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_h3) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_/h3) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_h4) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_/h4) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_h5) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_/h5) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_h6) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_/h6) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_hr) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_i) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_/i) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_img) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_kbd) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_/kbd) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_li) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_listing) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_/listing) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_menu) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_/menu) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_ol) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_/ol) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_p) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_pre) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_/pre) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_samp) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_/samp) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_small) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_/small) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_sub) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_/sub) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_sup) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_/sup) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_strong) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_/strong) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_table) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_/table) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_td) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_/td) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_th) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_/th) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_title) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_/title) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_tr) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_/tr) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_tt) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_/tt) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_u) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_/u) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_ul) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_/ul) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_var) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Scrolledhtml::_entity_/var) [list source [file join $dir scrolledhtml.itk]] -set auto_index(::iwidgets::Entryfield) [list source [file join $dir entryfield.itk]] -set auto_index(::iwidgets::Entryfield::numeric) [list source [file join $dir entryfield.itk]] -set auto_index(::iwidgets::Entryfield::integer) [list source [file join $dir entryfield.itk]] -set auto_index(::iwidgets::Entryfield::alphabetic) [list source [file join $dir entryfield.itk]] -set auto_index(::iwidgets::Entryfield::alphanumeric) [list source [file join $dir entryfield.itk]] -set auto_index(::iwidgets::Entryfield::hexidecimal) [list source [file join $dir entryfield.itk]] -set auto_index(::iwidgets::Entryfield::real) [list source [file join $dir entryfield.itk]] -set auto_index(::iwidgets::entryfield) [list source [file join $dir entryfield.itk]] -set auto_index(::iwidgets::Entryfield::constructor) [list source [file join $dir entryfield.itk]] -set auto_index(::iwidgets::Entryfield::command) [list source [file join $dir entryfield.itk]] -set auto_index(::iwidgets::Entryfield::focuscommand) [list source [file join $dir entryfield.itk]] -set auto_index(::iwidgets::Entryfield::validate) [list source [file join $dir entryfield.itk]] -set auto_index(::iwidgets::Entryfield::invalid) [list source [file join $dir entryfield.itk]] -set auto_index(::iwidgets::Entryfield::fixed) [list source [file join $dir entryfield.itk]] -set auto_index(::iwidgets::Entryfield::childsitepos) [list source [file join $dir entryfield.itk]] -set auto_index(::iwidgets::Entryfield::childsite) [list source [file join $dir entryfield.itk]] -set auto_index(::iwidgets::Entryfield::get) [list source [file join $dir entryfield.itk]] -set auto_index(::iwidgets::Entryfield::delete) [list source [file join $dir entryfield.itk]] -set auto_index(::iwidgets::Entryfield::icursor) [list source [file join $dir entryfield.itk]] -set auto_index(::iwidgets::Entryfield::index) [list source [file join $dir entryfield.itk]] -set auto_index(::iwidgets::Entryfield::insert) [list source [file join $dir entryfield.itk]] -set auto_index(::iwidgets::Entryfield::scan) [list source [file join $dir entryfield.itk]] -set auto_index(::iwidgets::Entryfield::selection) [list source [file join $dir entryfield.itk]] -set auto_index(::iwidgets::Entryfield::xview) [list source [file join $dir entryfield.itk]] -set auto_index(::iwidgets::Entryfield::clear) [list source [file join $dir entryfield.itk]] -set auto_index(::iwidgets::Entryfield::numeric) [list source [file join $dir entryfield.itk]] -set auto_index(::iwidgets::Entryfield::integer) [list source [file join $dir entryfield.itk]] -set auto_index(::iwidgets::Entryfield::alphabetic) [list source [file join $dir entryfield.itk]] -set auto_index(::iwidgets::Entryfield::alphanumeric) [list source [file join $dir entryfield.itk]] -set auto_index(::iwidgets::Entryfield::hexidecimal) [list source [file join $dir entryfield.itk]] -set auto_index(::iwidgets::Entryfield::real) [list source [file join $dir entryfield.itk]] -set auto_index(::iwidgets::Entryfield::_peek) [list source [file join $dir entryfield.itk]] -set auto_index(::iwidgets::Entryfield::_focusCommand) [list source [file join $dir entryfield.itk]] -set auto_index(::iwidgets::Entryfield::_keyPress) [list source [file join $dir entryfield.itk]] -set auto_index(::iwidgets::Labeledframe) [list source [file join $dir labeledframe.itk]] -set auto_index(::iwidgets::Labeledframe::_initTable) [list source [file join $dir labeledframe.itk]] -set auto_index(::iwidgets::labeledframe) [list source [file join $dir labeledframe.itk]] -set auto_index(::iwidgets::Labeledframe::constructor) [list source [file join $dir labeledframe.itk]] -set auto_index(::iwidgets::Labeledframe::destructor) [list source [file join $dir labeledframe.itk]] -set auto_index(::iwidgets::Labeledframe::ipadx) [list source [file join $dir labeledframe.itk]] -set auto_index(::iwidgets::Labeledframe::ipady) [list source [file join $dir labeledframe.itk]] -set auto_index(::iwidgets::Labeledframe::labelmargin) [list source [file join $dir labeledframe.itk]] -set auto_index(::iwidgets::Labeledframe::labelpos) [list source [file join $dir labeledframe.itk]] -set auto_index(::iwidgets::Labeledframe::_initTable) [list source [file join $dir labeledframe.itk]] -set auto_index(::iwidgets::Labeledframe::childsite) [list source [file join $dir labeledframe.itk]] -set auto_index(::iwidgets::Labeledframe::_positionLabel) [list source [file join $dir labeledframe.itk]] -set auto_index(::iwidgets::Labeledframe::_collapseMargin) [list source [file join $dir labeledframe.itk]] -set auto_index(::iwidgets::Labeledframe::_setMarginThickness) [list source [file join $dir labeledframe.itk]] -set auto_index(::iwidgets::Scrolledwidget) [list source [file join $dir scrolledwidget.itk]] -set auto_index(::iwidgets::scrolledwidget) [list source [file join $dir scrolledwidget.itk]] -set auto_index(::iwidgets::Scrolledwidget::constructor) [list source [file join $dir scrolledwidget.itk]] -set auto_index(::iwidgets::Scrolledwidget::destructor) [list source [file join $dir scrolledwidget.itk]] -set auto_index(::iwidgets::Scrolledwidget::sbwidth) [list source [file join $dir scrolledwidget.itk]] -set auto_index(::iwidgets::Scrolledwidget::scrollmargin) [list source [file join $dir scrolledwidget.itk]] -set auto_index(::iwidgets::Scrolledwidget::vscrollmode) [list source [file join $dir scrolledwidget.itk]] -set auto_index(::iwidgets::Scrolledwidget::hscrollmode) [list source [file join $dir scrolledwidget.itk]] -set auto_index(::iwidgets::Scrolledwidget::width) [list source [file join $dir scrolledwidget.itk]] -set auto_index(::iwidgets::Scrolledwidget::height) [list source [file join $dir scrolledwidget.itk]] -set auto_index(::iwidgets::Scrolledwidget::_vertScrollbarDisplay) [list source [file join $dir scrolledwidget.itk]] -set auto_index(::iwidgets::Scrolledwidget::_horizScrollbarDisplay) [list source [file join $dir scrolledwidget.itk]] -set auto_index(::iwidgets::Scrolledwidget::_scrollWidget) [list source [file join $dir scrolledwidget.itk]] -set auto_index(::iwidgets::Scrolledwidget::_configureEvent) [list source [file join $dir scrolledwidget.itk]] -set auto_index(::iwidgets::Checkbox) [list source [file join $dir checkbox.itk]] -set auto_index(::iwidgets::checkbox) [list source [file join $dir checkbox.itk]] -set auto_index(::iwidgets::Checkbox::constructor) [list source [file join $dir checkbox.itk]] -set auto_index(::iwidgets::Checkbox::command) [list source [file join $dir checkbox.itk]] -set auto_index(::iwidgets::Checkbox::index) [list source [file join $dir checkbox.itk]] -set auto_index(::iwidgets::Checkbox::add) [list source [file join $dir checkbox.itk]] -set auto_index(::iwidgets::Checkbox::insert) [list source [file join $dir checkbox.itk]] -set auto_index(::iwidgets::Checkbox::delete) [list source [file join $dir checkbox.itk]] -set auto_index(::iwidgets::Checkbox::select) [list source [file join $dir checkbox.itk]] -set auto_index(::iwidgets::Checkbox::toggle) [list source [file join $dir checkbox.itk]] -set auto_index(::iwidgets::Checkbox::get) [list source [file join $dir checkbox.itk]] -set auto_index(::iwidgets::Checkbox::deselect) [list source [file join $dir checkbox.itk]] -set auto_index(::iwidgets::Checkbox::flash) [list source [file join $dir checkbox.itk]] -set auto_index(::iwidgets::Checkbox::buttonconfigure) [list source [file join $dir checkbox.itk]] -set auto_index(::iwidgets::Checkbox::gettag) [list source [file join $dir checkbox.itk]] -set auto_index(::iwidgets::Disjointlistbox) [list source [file join $dir disjointlistbox.itk]] -set auto_index(::iwidgets::disjointlistbox) [list source [file join $dir disjointlistbox.itk]] -set auto_index(::iwidgets::Disjointlistbox::constructor) [list source [file join $dir disjointlistbox.itk]] -set auto_index(::iwidgets::Disjointlistbox::listboxClick) [list source [file join $dir disjointlistbox.itk]] -set auto_index(::iwidgets::Disjointlistbox::listboxDblClick) [list source [file join $dir disjointlistbox.itk]] -set auto_index(::iwidgets::Disjointlistbox::transfer) [list source [file join $dir disjointlistbox.itk]] -set auto_index(::iwidgets::Disjointlistbox::getlhs) [list source [file join $dir disjointlistbox.itk]] -set auto_index(::iwidgets::Disjointlistbox::getrhs) [list source [file join $dir disjointlistbox.itk]] -set auto_index(::iwidgets::Disjointlistbox::insertrhs) [list source [file join $dir disjointlistbox.itk]] -set auto_index(::iwidgets::Disjointlistbox::insertlhs) [list source [file join $dir disjointlistbox.itk]] -set auto_index(::iwidgets::Disjointlistbox::clear) [list source [file join $dir disjointlistbox.itk]] -set auto_index(::iwidgets::Disjointlistbox::insert) [list source [file join $dir disjointlistbox.itk]] -set auto_index(::iwidgets::Disjointlistbox::remove) [list source [file join $dir disjointlistbox.itk]] -set auto_index(::iwidgets::Disjointlistbox::showCount) [list source [file join $dir disjointlistbox.itk]] -set auto_index(::iwidgets::Disjointlistbox::setlhs) [list source [file join $dir disjointlistbox.itk]] -set auto_index(::iwidgets::Disjointlistbox::setrhs) [list source [file join $dir disjointlistbox.itk]] -set auto_index(::iwidgets::Disjointlistbox::lhs) [list source [file join $dir disjointlistbox.itk]] -set auto_index(::iwidgets::Disjointlistbox::rhs) [list source [file join $dir disjointlistbox.itk]] -set auto_index(::iwidgets::Disjointlistbox::buttonplacement) [list source [file join $dir disjointlistbox.itk]] -set auto_index(::iwidgets::Hierarchy) [list source [file join $dir hierarchy.itk]] -set auto_index(::iwidgets::hierarchy) [list source [file join $dir hierarchy.itk]] -set auto_index(::iwidgets::Hierarchy::constructor) [list source [file join $dir hierarchy.itk]] -set auto_index(::iwidgets::Hierarchy::destructor) [list source [file join $dir hierarchy.itk]] -set auto_index(::iwidgets::Hierarchy::font) [list source [file join $dir hierarchy.itk]] -set auto_index(::iwidgets::Hierarchy::selectbackground) [list source [file join $dir hierarchy.itk]] -set auto_index(::iwidgets::Hierarchy::selectforeground) [list source [file join $dir hierarchy.itk]] -set auto_index(::iwidgets::Hierarchy::markbackground) [list source [file join $dir hierarchy.itk]] -set auto_index(::iwidgets::Hierarchy::markforeground) [list source [file join $dir hierarchy.itk]] -set auto_index(::iwidgets::Hierarchy::querycommand) [list source [file join $dir hierarchy.itk]] -set auto_index(::iwidgets::Hierarchy::selectcommand) [list source [file join $dir hierarchy.itk]] -set auto_index(::iwidgets::Hierarchy::iconcommand) [list source [file join $dir hierarchy.itk]] -set auto_index(::iwidgets::Hierarchy::alwaysquery) [list source [file join $dir hierarchy.itk]] -set auto_index(::iwidgets::Hierarchy::filter) [list source [file join $dir hierarchy.itk]] -set auto_index(::iwidgets::Hierarchy::expanded) [list source [file join $dir hierarchy.itk]] -set auto_index(::iwidgets::Hierarchy::openicon) [list source [file join $dir hierarchy.itk]] -set auto_index(::iwidgets::Hierarchy::closedicon) [list source [file join $dir hierarchy.itk]] -set auto_index(::iwidgets::Hierarchy::nodeicon) [list source [file join $dir hierarchy.itk]] -set auto_index(::iwidgets::Hierarchy::width) [list source [file join $dir hierarchy.itk]] -set auto_index(::iwidgets::Hierarchy::height) [list source [file join $dir hierarchy.itk]] -set auto_index(::iwidgets::Hierarchy::visibleitems) [list source [file join $dir hierarchy.itk]] -set auto_index(::iwidgets::Hierarchy::clear) [list source [file join $dir hierarchy.itk]] -set auto_index(::iwidgets::Hierarchy::selection) [list source [file join $dir hierarchy.itk]] -set auto_index(::iwidgets::Hierarchy::mark) [list source [file join $dir hierarchy.itk]] -set auto_index(::iwidgets::Hierarchy::current) [list source [file join $dir hierarchy.itk]] -set auto_index(::iwidgets::Hierarchy::expand) [list source [file join $dir hierarchy.itk]] -set auto_index(::iwidgets::Hierarchy::collapse) [list source [file join $dir hierarchy.itk]] -set auto_index(::iwidgets::Hierarchy::toggle) [list source [file join $dir hierarchy.itk]] -set auto_index(::iwidgets::Hierarchy::prune) [list source [file join $dir hierarchy.itk]] -set auto_index(::iwidgets::Hierarchy::draw) [list source [file join $dir hierarchy.itk]] -set auto_index(::iwidgets::Hierarchy::refresh) [list source [file join $dir hierarchy.itk]] -set auto_index(::iwidgets::Hierarchy::bbox) [list source [file join $dir hierarchy.itk]] -set auto_index(::iwidgets::Hierarchy::compare) [list source [file join $dir hierarchy.itk]] -set auto_index(::iwidgets::Hierarchy::delete) [list source [file join $dir hierarchy.itk]] -set auto_index(::iwidgets::Hierarchy::dump) [list source [file join $dir hierarchy.itk]] -set auto_index(::iwidgets::Hierarchy::dlineinfo) [list source [file join $dir hierarchy.itk]] -set auto_index(::iwidgets::Hierarchy::get) [list source [file join $dir hierarchy.itk]] -set auto_index(::iwidgets::Hierarchy::index) [list source [file join $dir hierarchy.itk]] -set auto_index(::iwidgets::Hierarchy::insert) [list source [file join $dir hierarchy.itk]] -set auto_index(::iwidgets::Hierarchy::scan) [list source [file join $dir hierarchy.itk]] -set auto_index(::iwidgets::Hierarchy::search) [list source [file join $dir hierarchy.itk]] -set auto_index(::iwidgets::Hierarchy::see) [list source [file join $dir hierarchy.itk]] -set auto_index(::iwidgets::Hierarchy::tag) [list source [file join $dir hierarchy.itk]] -set auto_index(::iwidgets::Hierarchy::window) [list source [file join $dir hierarchy.itk]] -set auto_index(::iwidgets::Hierarchy::xview) [list source [file join $dir hierarchy.itk]] -set auto_index(::iwidgets::Hierarchy::yview) [list source [file join $dir hierarchy.itk]] -set auto_index(::iwidgets::Hierarchy::_drawLevel) [list source [file join $dir hierarchy.itk]] -set auto_index(::iwidgets::Hierarchy::_contents) [list source [file join $dir hierarchy.itk]] -set auto_index(::iwidgets::Hierarchy::_post) [list source [file join $dir hierarchy.itk]] -set auto_index(::iwidgets::Hierarchy::_select) [list source [file join $dir hierarchy.itk]] -set auto_index(::iwidgets::Hierarchy::_iconSelect) [list source [file join $dir hierarchy.itk]] -set auto_index(::iwidgets::Hierarchy::_deselectSubNodes) [list source [file join $dir hierarchy.itk]] -set auto_index(::iwidgets::Hierarchy::_deleteNodeInfo) [list source [file join $dir hierarchy.itk]] -set auto_index(::iwidgets::Hierarchy::_getParent) [list source [file join $dir hierarchy.itk]] -set auto_index(::iwidgets::Hierarchy::_getHeritage) [list source [file join $dir hierarchy.itk]] -set auto_index(::iwidgets::Datefield) [list source [file join $dir datefield.itk]] -set auto_index(::iwidgets::datefield) [list source [file join $dir datefield.itk]] -set auto_index(::iwidgets::Datefield::constructor) [list source [file join $dir datefield.itk]] -set auto_index(::iwidgets::Datefield::childsitepos) [list source [file join $dir datefield.itk]] -set auto_index(::iwidgets::Datefield::command) [list source [file join $dir datefield.itk]] -set auto_index(::iwidgets::Datefield::iq) [list source [file join $dir datefield.itk]] -set auto_index(::iwidgets::Datefield::get) [list source [file join $dir datefield.itk]] -set auto_index(::iwidgets::Datefield::show) [list source [file join $dir datefield.itk]] -set auto_index(::iwidgets::Datefield::isvalid) [list source [file join $dir datefield.itk]] -set auto_index(::iwidgets::Datefield::_focusIn) [list source [file join $dir datefield.itk]] -set auto_index(::iwidgets::Datefield::_keyPress) [list source [file join $dir datefield.itk]] -set auto_index(::iwidgets::Datefield::_setField) [list source [file join $dir datefield.itk]] -set auto_index(::iwidgets::Datefield::_moveField) [list source [file join $dir datefield.itk]] -set auto_index(::iwidgets::Datefield::_whichField) [list source [file join $dir datefield.itk]] -set auto_index(::iwidgets::Datefield::_forward) [list source [file join $dir datefield.itk]] -set auto_index(::iwidgets::Datefield::_backward) [list source [file join $dir datefield.itk]] -set auto_index(::iwidgets::Datefield::_lastDay) [list source [file join $dir datefield.itk]] -set auto_index(::iwidgets::MsgType) [list source [file join $dir messagebox.itk]] -set auto_index(::iwidgets::Messagebox) [list source [file join $dir messagebox.itk]] -set auto_index(::iwidgets::messagebox) [list source [file join $dir messagebox.itk]] -set auto_index(::iwidgets::Messagebox::constructor) [list source [file join $dir messagebox.itk]] -set auto_index(::iwidgets::Messagebox::destructor) [list source [file join $dir messagebox.itk]] -set auto_index(::iwidgets::Messagebox::clear) [list source [file join $dir messagebox.itk]] -set auto_index(::iwidgets::Messagebox::type) [list source [file join $dir messagebox.itk]] -set auto_index(::iwidgets::Messagebox::issue) [list source [file join $dir messagebox.itk]] -set auto_index(::iwidgets::Messagebox::save) [list source [file join $dir messagebox.itk]] -set auto_index(::iwidgets::Messagebox::find) [list source [file join $dir messagebox.itk]] -set auto_index(::iwidgets::Messagebox::_post) [list source [file join $dir messagebox.itk]] -set auto_index(::iwidgets::Messagebox::export) [list source [file join $dir messagebox.itk]] -set auto_index(::iwidgets::Timefield) [list source [file join $dir timefield.itk]] -set auto_index(::iwidgets::timefield) [list source [file join $dir timefield.itk]] -set auto_index(::iwidgets::Timefield::constructor) [list source [file join $dir timefield.itk]] -set auto_index(::iwidgets::Timefield::childsitepos) [list source [file join $dir timefield.itk]] -set auto_index(::iwidgets::Timefield::command) [list source [file join $dir timefield.itk]] -set auto_index(::iwidgets::Timefield::iq) [list source [file join $dir timefield.itk]] -set auto_index(::iwidgets::Timefield::format) [list source [file join $dir timefield.itk]] -set auto_index(::iwidgets::Timefield::get) [list source [file join $dir timefield.itk]] -set auto_index(::iwidgets::Timefield::show) [list source [file join $dir timefield.itk]] -set auto_index(::iwidgets::Timefield::isvalid) [list source [file join $dir timefield.itk]] -set auto_index(::iwidgets::Timefield::_focusIn) [list source [file join $dir timefield.itk]] -set auto_index(::iwidgets::Timefield::_keyPress) [list source [file join $dir timefield.itk]] -set auto_index(::iwidgets::Timefield::_toggleAmPm) [list source [file join $dir timefield.itk]] -set auto_index(::iwidgets::Timefield::_setField) [list source [file join $dir timefield.itk]] -set auto_index(::iwidgets::Timefield::_moveField) [list source [file join $dir timefield.itk]] -set auto_index(::iwidgets::Timefield::_whichField) [list source [file join $dir timefield.itk]] -set auto_index(::iwidgets::Timefield::_forwardCivilian) [list source [file join $dir timefield.itk]] -set auto_index(::iwidgets::Timefield::_forwardMilitary) [list source [file join $dir timefield.itk]] -set auto_index(::iwidgets::Timefield::_backwardCivilian) [list source [file join $dir timefield.itk]] -set auto_index(::iwidgets::Timefield::_backwardMilitary) [list source [file join $dir timefield.itk]] -set auto_index(::iwidgets::Watch) [list source [file join $dir watch.itk]] -set auto_index(::iwidgets::watch) [list source [file join $dir watch.itk]] -set auto_index(::iwidgets::Watch::constructor) [list source [file join $dir watch.itk]] -set auto_index(::iwidgets::Watch::destructor) [list source [file join $dir watch.itk]] -set auto_index(::iwidgets::Watch::_handReleaseCB) [list source [file join $dir watch.itk]] -set auto_index(::iwidgets::Watch::_handMotionCB) [list source [file join $dir watch.itk]] -set auto_index(::iwidgets::Watch::get) [list source [file join $dir watch.itk]] -set auto_index(::iwidgets::Watch::watch) [list source [file join $dir watch.itk]] -set auto_index(::iwidgets::Watch::_drawHand) [list source [file join $dir watch.itk]] -set auto_index(::iwidgets::Watch::show) [list source [file join $dir watch.itk]] -set auto_index(::iwidgets::Watch::_displayClock) [list source [file join $dir watch.itk]] -set auto_index(::iwidgets::Watch::state) [list source [file join $dir watch.itk]] -set auto_index(::iwidgets::Watch::showampm) [list source [file join $dir watch.itk]] -set auto_index(::iwidgets::Watch::pivotcolor) [list source [file join $dir watch.itk]] -set auto_index(::iwidgets::Watch::clockstipple) [list source [file join $dir watch.itk]] -set auto_index(::iwidgets::Watch::clockcolor) [list source [file join $dir watch.itk]] -set auto_index(::iwidgets::Watch::hourcolor) [list source [file join $dir watch.itk]] -set auto_index(::iwidgets::Watch::minutecolor) [list source [file join $dir watch.itk]] -set auto_index(::iwidgets::Watch::secondcolor) [list source [file join $dir watch.itk]] -set auto_index(::iwidgets::Watch::tickcolor) [list source [file join $dir watch.itk]] -set auto_index(::iwidgets::Watch::hourradius) [list source [file join $dir watch.itk]] -set auto_index(::iwidgets::Watch::minuteradius) [list source [file join $dir watch.itk]] -set auto_index(::iwidgets::Watch::secondradius) [list source [file join $dir watch.itk]] -set auto_index(::iwidgets::Extfileselectionbox) [list source [file join $dir extfileselectionbox.itk]] -set auto_index(::iwidgets::extfileselectionbox) [list source [file join $dir extfileselectionbox.itk]] -set auto_index(::iwidgets::Extfileselectionbox::constructor) [list source [file join $dir extfileselectionbox.itk]] -set auto_index(::iwidgets::Extfileselectionbox::destructor) [list source [file join $dir extfileselectionbox.itk]] -set auto_index(::iwidgets::Extfileselectionbox::childsitepos) [list source [file join $dir extfileselectionbox.itk]] -set auto_index(::iwidgets::Extfileselectionbox::fileson) [list source [file join $dir extfileselectionbox.itk]] -set auto_index(::iwidgets::Extfileselectionbox::dirson) [list source [file join $dir extfileselectionbox.itk]] -set auto_index(::iwidgets::Extfileselectionbox::selectionon) [list source [file join $dir extfileselectionbox.itk]] -set auto_index(::iwidgets::Extfileselectionbox::filteron) [list source [file join $dir extfileselectionbox.itk]] -set auto_index(::iwidgets::Extfileselectionbox::mask) [list source [file join $dir extfileselectionbox.itk]] -set auto_index(::iwidgets::Extfileselectionbox::directory) [list source [file join $dir extfileselectionbox.itk]] -set auto_index(::iwidgets::Extfileselectionbox::nomatchstring) [list source [file join $dir extfileselectionbox.itk]] -set auto_index(::iwidgets::Extfileselectionbox::dirsearchcommand) [list source [file join $dir extfileselectionbox.itk]] -set auto_index(::iwidgets::Extfileselectionbox::filesearchcommand) [list source [file join $dir extfileselectionbox.itk]] -set auto_index(::iwidgets::Extfileselectionbox::selectioncommand) [list source [file join $dir extfileselectionbox.itk]] -set auto_index(::iwidgets::Extfileselectionbox::filtercommand) [list source [file join $dir extfileselectionbox.itk]] -set auto_index(::iwidgets::Extfileselectionbox::selectdircommand) [list source [file join $dir extfileselectionbox.itk]] -set auto_index(::iwidgets::Extfileselectionbox::selectfilecommand) [list source [file join $dir extfileselectionbox.itk]] -set auto_index(::iwidgets::Extfileselectionbox::invalid) [list source [file join $dir extfileselectionbox.itk]] -set auto_index(::iwidgets::Extfileselectionbox::filetype) [list source [file join $dir extfileselectionbox.itk]] -set auto_index(::iwidgets::Extfileselectionbox::width) [list source [file join $dir extfileselectionbox.itk]] -set auto_index(::iwidgets::Extfileselectionbox::height) [list source [file join $dir extfileselectionbox.itk]] -set auto_index(::iwidgets::Extfileselectionbox::childsite) [list source [file join $dir extfileselectionbox.itk]] -set auto_index(::iwidgets::Extfileselectionbox::get) [list source [file join $dir extfileselectionbox.itk]] -set auto_index(::iwidgets::Extfileselectionbox::filter) [list source [file join $dir extfileselectionbox.itk]] -set auto_index(::iwidgets::Extfileselectionbox::_updateLists) [list source [file join $dir extfileselectionbox.itk]] -set auto_index(::iwidgets::Extfileselectionbox::_setFilter) [list source [file join $dir extfileselectionbox.itk]] -set auto_index(::iwidgets::Extfileselectionbox::_setSelection) [list source [file join $dir extfileselectionbox.itk]] -set auto_index(::iwidgets::Extfileselectionbox::_setDirList) [list source [file join $dir extfileselectionbox.itk]] -set auto_index(::iwidgets::Extfileselectionbox::_setFileList) [list source [file join $dir extfileselectionbox.itk]] -set auto_index(::iwidgets::Extfileselectionbox::_selectDir) [list source [file join $dir extfileselectionbox.itk]] -set auto_index(::iwidgets::Extfileselectionbox::_dblSelectDir) [list source [file join $dir extfileselectionbox.itk]] -set auto_index(::iwidgets::Extfileselectionbox::_selectFile) [list source [file join $dir extfileselectionbox.itk]] -set auto_index(::iwidgets::Extfileselectionbox::_selectSelection) [list source [file join $dir extfileselectionbox.itk]] -set auto_index(::iwidgets::Extfileselectionbox::_selectFilter) [list source [file join $dir extfileselectionbox.itk]] -set auto_index(::iwidgets::Extfileselectionbox::_packComponents) [list source [file join $dir extfileselectionbox.itk]] -set auto_index(::iwidgets::Extfileselectionbox::_nPos) [list source [file join $dir extfileselectionbox.itk]] -set auto_index(::iwidgets::Extfileselectionbox::_sPos) [list source [file join $dir extfileselectionbox.itk]] -set auto_index(::iwidgets::Extfileselectionbox::_ePos) [list source [file join $dir extfileselectionbox.itk]] -set auto_index(::iwidgets::Extfileselectionbox::_wPos) [list source [file join $dir extfileselectionbox.itk]] -set auto_index(::iwidgets::Extfileselectionbox::_topPos) [list source [file join $dir extfileselectionbox.itk]] -set auto_index(::iwidgets::Extfileselectionbox::_bottomPos) [list source [file join $dir extfileselectionbox.itk]] -set auto_index(::iwidgets::Fileselectionbox) [list source [file join $dir fileselectionbox.itk]] -set auto_index(::iwidgets::fileselectionbox) [list source [file join $dir fileselectionbox.itk]] -set auto_index(::iwidgets::Fileselectionbox::constructor) [list source [file join $dir fileselectionbox.itk]] -set auto_index(::iwidgets::Fileselectionbox::destructor) [list source [file join $dir fileselectionbox.itk]] -set auto_index(::iwidgets::Fileselectionbox::childsitepos) [list source [file join $dir fileselectionbox.itk]] -set auto_index(::iwidgets::Fileselectionbox::fileson) [list source [file join $dir fileselectionbox.itk]] -set auto_index(::iwidgets::Fileselectionbox::dirson) [list source [file join $dir fileselectionbox.itk]] -set auto_index(::iwidgets::Fileselectionbox::selectionon) [list source [file join $dir fileselectionbox.itk]] -set auto_index(::iwidgets::Fileselectionbox::filteron) [list source [file join $dir fileselectionbox.itk]] -set auto_index(::iwidgets::Fileselectionbox::mask) [list source [file join $dir fileselectionbox.itk]] -set auto_index(::iwidgets::Fileselectionbox::directory) [list source [file join $dir fileselectionbox.itk]] -set auto_index(::iwidgets::Fileselectionbox::nomatchstring) [list source [file join $dir fileselectionbox.itk]] -set auto_index(::iwidgets::Fileselectionbox::dirsearchcommand) [list source [file join $dir fileselectionbox.itk]] -set auto_index(::iwidgets::Fileselectionbox::filesearchcommand) [list source [file join $dir fileselectionbox.itk]] -set auto_index(::iwidgets::Fileselectionbox::selectioncommand) [list source [file join $dir fileselectionbox.itk]] -set auto_index(::iwidgets::Fileselectionbox::filtercommand) [list source [file join $dir fileselectionbox.itk]] -set auto_index(::iwidgets::Fileselectionbox::selectdircommand) [list source [file join $dir fileselectionbox.itk]] -set auto_index(::iwidgets::Fileselectionbox::selectfilecommand) [list source [file join $dir fileselectionbox.itk]] -set auto_index(::iwidgets::Fileselectionbox::invalid) [list source [file join $dir fileselectionbox.itk]] -set auto_index(::iwidgets::Fileselectionbox::filetype) [list source [file join $dir fileselectionbox.itk]] -set auto_index(::iwidgets::Fileselectionbox::width) [list source [file join $dir fileselectionbox.itk]] -set auto_index(::iwidgets::Fileselectionbox::height) [list source [file join $dir fileselectionbox.itk]] -set auto_index(::iwidgets::Fileselectionbox::childsite) [list source [file join $dir fileselectionbox.itk]] -set auto_index(::iwidgets::Fileselectionbox::get) [list source [file join $dir fileselectionbox.itk]] -set auto_index(::iwidgets::Fileselectionbox::filter) [list source [file join $dir fileselectionbox.itk]] -set auto_index(::iwidgets::Fileselectionbox::_updateLists) [list source [file join $dir fileselectionbox.itk]] -set auto_index(::iwidgets::Fileselectionbox::_setFilter) [list source [file join $dir fileselectionbox.itk]] -set auto_index(::iwidgets::Fileselectionbox::_setSelection) [list source [file join $dir fileselectionbox.itk]] -set auto_index(::iwidgets::Fileselectionbox::_setDirList) [list source [file join $dir fileselectionbox.itk]] -set auto_index(::iwidgets::Fileselectionbox::_setFileList) [list source [file join $dir fileselectionbox.itk]] -set auto_index(::iwidgets::Fileselectionbox::_selectDir) [list source [file join $dir fileselectionbox.itk]] -set auto_index(::iwidgets::Fileselectionbox::_dblSelectDir) [list source [file join $dir fileselectionbox.itk]] -set auto_index(::iwidgets::Fileselectionbox::_selectFile) [list source [file join $dir fileselectionbox.itk]] -set auto_index(::iwidgets::Fileselectionbox::_selectSelection) [list source [file join $dir fileselectionbox.itk]] -set auto_index(::iwidgets::Fileselectionbox::_selectFilter) [list source [file join $dir fileselectionbox.itk]] -set auto_index(::iwidgets::Fileselectionbox::_packComponents) [list source [file join $dir fileselectionbox.itk]] -set auto_index(::iwidgets::Fileselectionbox::_nPos) [list source [file join $dir fileselectionbox.itk]] -set auto_index(::iwidgets::Fileselectionbox::_sPos) [list source [file join $dir fileselectionbox.itk]] -set auto_index(::iwidgets::Fileselectionbox::_ePos) [list source [file join $dir fileselectionbox.itk]] -set auto_index(::iwidgets::Fileselectionbox::_wPos) [list source [file join $dir fileselectionbox.itk]] -set auto_index(::iwidgets::Fileselectionbox::_topPos) [list source [file join $dir fileselectionbox.itk]] -set auto_index(::iwidgets::Fileselectionbox::_centerPos) [list source [file join $dir fileselectionbox.itk]] -set auto_index(::iwidgets::Fileselectionbox::_bottomPos) [list source [file join $dir fileselectionbox.itk]] -set auto_index(::iwidgets::Fileselectiondialog) [list source [file join $dir fileselectiondialog.itk]] -set auto_index(::iwidgets::fileselectiondialog) [list source [file join $dir fileselectiondialog.itk]] -set auto_index(::iwidgets::Fileselectiondialog::constructor) [list source [file join $dir fileselectiondialog.itk]] -set auto_index(::iwidgets::Fileselectiondialog::childsite) [list source [file join $dir fileselectiondialog.itk]] -set auto_index(::iwidgets::Fileselectiondialog::get) [list source [file join $dir fileselectiondialog.itk]] -set auto_index(::iwidgets::Fileselectiondialog::filter) [list source [file join $dir fileselectiondialog.itk]] -set auto_index(::iwidgets::Fileselectiondialog::_dbldir) [list source [file join $dir fileselectiondialog.itk]] -set auto_index(::iwidgets::Finddialog) [list source [file join $dir finddialog.itk]] -set auto_index(::iwidgets::finddialog) [list source [file join $dir finddialog.itk]] -set auto_index(::iwidgets::Finddialog::constructor) [list source [file join $dir finddialog.itk]] -set auto_index(::iwidgets::Finddialog::clearcommand) [list source [file join $dir finddialog.itk]] -set auto_index(::iwidgets::Finddialog::matchcommand) [list source [file join $dir finddialog.itk]] -set auto_index(::iwidgets::Finddialog::patternbackground) [list source [file join $dir finddialog.itk]] -set auto_index(::iwidgets::Finddialog::patternforeground) [list source [file join $dir finddialog.itk]] -set auto_index(::iwidgets::Finddialog::searchforeground) [list source [file join $dir finddialog.itk]] -set auto_index(::iwidgets::Finddialog::searchbackground) [list source [file join $dir finddialog.itk]] -set auto_index(::iwidgets::Finddialog::textwidget) [list source [file join $dir finddialog.itk]] -set auto_index(::iwidgets::Finddialog::clear) [list source [file join $dir finddialog.itk]] -set auto_index(::iwidgets::Finddialog::find) [list source [file join $dir finddialog.itk]] -set auto_index(::iwidgets::Finddialog::_get) [list source [file join $dir finddialog.itk]] -set auto_index(::iwidgets::Finddialog::_textExists) [list source [file join $dir finddialog.itk]] -set auto_index(::iwidgets::Mainwindow) [list source [file join $dir mainwindow.itk]] -set auto_index(::iwidgets::mainwindow) [list source [file join $dir mainwindow.itk]] -set auto_index(::iwidgets::Mainwindow::constructor) [list source [file join $dir mainwindow.itk]] -set auto_index(::iwidgets::Mainwindow::helpline) [list source [file join $dir mainwindow.itk]] -set auto_index(::iwidgets::Mainwindow::statusline) [list source [file join $dir mainwindow.itk]] -set auto_index(::iwidgets::Mainwindow::childsite) [list source [file join $dir mainwindow.itk]] -set auto_index(::iwidgets::Mainwindow::menubar) [list source [file join $dir mainwindow.itk]] -set auto_index(::iwidgets::Mainwindow::toolbar) [list source [file join $dir mainwindow.itk]] -set auto_index(::iwidgets::Mainwindow::mousebar) [list source [file join $dir mainwindow.itk]] -set auto_index(::iwidgets::Mainwindow::msgd) [list source [file join $dir mainwindow.itk]] -set auto_index(::iwidgets::Mainwindow::_exitCB) [list source [file join $dir mainwindow.itk]] -set auto_index(::iwidgets::Dateentry) [list source [file join $dir dateentry.itk]] -set auto_index(::iwidgets::dateentry) [list source [file join $dir dateentry.itk]] -set auto_index(::iwidgets::Dateentry::constructor) [list source [file join $dir dateentry.itk]] -set auto_index(::iwidgets::Dateentry::icon) [list source [file join $dir dateentry.itk]] -set auto_index(::iwidgets::Dateentry::grab) [list source [file join $dir dateentry.itk]] -set auto_index(::iwidgets::Dateentry::state) [list source [file join $dir dateentry.itk]] -set auto_index(::iwidgets::Dateentry::_getDefaultIcon) [list source [file join $dir dateentry.itk]] -set auto_index(::iwidgets::Dateentry::_popup) [list source [file join $dir dateentry.itk]] -set auto_index(::iwidgets::Dateentry::_getPopupDate) [list source [file join $dir dateentry.itk]] -set auto_index(::iwidgets::Dateentry::_releaseGrabCheck) [list source [file join $dir dateentry.itk]] -set auto_index(::iwidgets::Dateentry::_releaseGrab) [list source [file join $dir dateentry.itk]] -set auto_index(::iwidgets::Extfileselectiondialog) [list source [file join $dir extfileselectiondialog.itk]] -set auto_index(::iwidgets::extfileselectiondialog) [list source [file join $dir extfileselectiondialog.itk]] -set auto_index(::iwidgets::Extfileselectiondialog::constructor) [list source [file join $dir extfileselectiondialog.itk]] -set auto_index(::iwidgets::Extfileselectiondialog::childsite) [list source [file join $dir extfileselectiondialog.itk]] -set auto_index(::iwidgets::Extfileselectiondialog::get) [list source [file join $dir extfileselectiondialog.itk]] -set auto_index(::iwidgets::Extfileselectiondialog::filter) [list source [file join $dir extfileselectiondialog.itk]] -set auto_index(::iwidgets::Extfileselectiondialog::_dbldir) [list source [file join $dir extfileselectiondialog.itk]] -set auto_index(::iwidgets::Timeentry) [list source [file join $dir timeentry.itk]] -set auto_index(::iwidgets::timeentry) [list source [file join $dir timeentry.itk]] -set auto_index(::iwidgets::Timeentry::constructor) [list source [file join $dir timeentry.itk]] -set auto_index(::iwidgets::Timeentry::icon) [list source [file join $dir timeentry.itk]] -set auto_index(::iwidgets::Timeentry::grab) [list source [file join $dir timeentry.itk]] -set auto_index(::iwidgets::Timeentry::state) [list source [file join $dir timeentry.itk]] -set auto_index(::iwidgets::Timeentry::_getDefaultIcon) [list source [file join $dir timeentry.itk]] -set auto_index(::iwidgets::Timeentry::_popup) [list source [file join $dir timeentry.itk]] -set auto_index(::iwidgets::Timeentry::_getPopupTime) [list source [file join $dir timeentry.itk]] -set auto_index(::iwidgets::Timeentry::_releaseGrab) [list source [file join $dir timeentry.itk]] -set auto_index(::iwidgets::Regexpfield) [list source [file join $dir regexpfield.itk]] -set auto_index(::iwidgets::regexpfield) [list source [file join $dir regexpfield.itk]] -set auto_index(::iwidgets::Regexpfield::constructor) [list source [file join $dir regexpfield.itk]] -set auto_index(::iwidgets::Regexpfield::command) [list source [file join $dir regexpfield.itk]] -set auto_index(::iwidgets::Regexpfield::focuscommand) [list source [file join $dir regexpfield.itk]] -set auto_index(::iwidgets::Regexpfield::regexp) [list source [file join $dir regexpfield.itk]] -set auto_index(::iwidgets::Regexpfield::invalid) [list source [file join $dir regexpfield.itk]] -set auto_index(::iwidgets::Regexpfield::fixed) [list source [file join $dir regexpfield.itk]] -set auto_index(::iwidgets::Regexpfield::childsitepos) [list source [file join $dir regexpfield.itk]] -set auto_index(::iwidgets::Regexpfield::nocase) [list source [file join $dir regexpfield.itk]] -set auto_index(::iwidgets::Regexpfield::childsite) [list source [file join $dir regexpfield.itk]] -set auto_index(::iwidgets::Regexpfield::get) [list source [file join $dir regexpfield.itk]] -set auto_index(::iwidgets::Regexpfield::delete) [list source [file join $dir regexpfield.itk]] -set auto_index(::iwidgets::Regexpfield::icursor) [list source [file join $dir regexpfield.itk]] -set auto_index(::iwidgets::Regexpfield::index) [list source [file join $dir regexpfield.itk]] -set auto_index(::iwidgets::Regexpfield::insert) [list source [file join $dir regexpfield.itk]] -set auto_index(::iwidgets::Regexpfield::scan) [list source [file join $dir regexpfield.itk]] -set auto_index(::iwidgets::Regexpfield::selection) [list source [file join $dir regexpfield.itk]] -set auto_index(::iwidgets::Regexpfield::xview) [list source [file join $dir regexpfield.itk]] -set auto_index(::iwidgets::Regexpfield::clear) [list source [file join $dir regexpfield.itk]] -set auto_index(::iwidgets::Regexpfield::_peek) [list source [file join $dir regexpfield.itk]] -set auto_index(::iwidgets::Regexpfield::_focusCommand) [list source [file join $dir regexpfield.itk]] -set auto_index(::iwidgets::Regexpfield::_keyPress) [list source [file join $dir regexpfield.itk]] -set auto_index(::iwidgets::Scopedobject) [list source [file join $dir scopedobject.itcl]] -set auto_index(::iwidgets::scopedobject) [list source [file join $dir scopedobject.itcl]] -set auto_index(::iwidgets::Scopedobject::constructor) [list source [file join $dir scopedobject.itcl]] -set auto_index(::iwidgets::Scopedobject::destructor) [list source [file join $dir scopedobject.itcl]] -set auto_index(::iwidgets::Scopedobject::_traceCommand) [list source [file join $dir scopedobject.itcl]] -set auto_index(::iwidgets::Scopedobject::enterscopecommand) [list source [file join $dir scopedobject.itcl]] -set auto_index(::iwidgets::Scopedobject::exitscopecommand) [list source [file join $dir scopedobject.itcl]] -set auto_index(::iwidgets::colors::rgbToNumeric) [list source [file join $dir colors.itcl]] -set auto_index(::iwidgets::colors::rgbToHsb) [list source [file join $dir colors.itcl]] -set auto_index(::iwidgets::colors::hsbToRgb) [list source [file join $dir colors.itcl]] -set auto_index(::iwidgets::colors::topShadow) [list source [file join $dir colors.itcl]] -set auto_index(::iwidgets::colors::bottomShadow) [list source [file join $dir colors.itcl]] diff --git a/itcl/iwidgets3.0.0/generic/timeentry.itk b/itcl/iwidgets3.0.0/generic/timeentry.itk deleted file mode 100644 index 8366e524f7e..00000000000 --- a/itcl/iwidgets3.0.0/generic/timeentry.itk +++ /dev/null @@ -1,398 +0,0 @@ -# -# Timeentry -# ---------------------------------------------------------------------- -# Implements a quicken style time entry field with a popup clock -# by combining the timefield and watch widgets together. This -# allows a user to enter the time via the keyboard or by using the -# mouse by selecting the watch icon which brings up a popup clock. -# ---------------------------------------------------------------------- -# AUTHOR: Mark L. Ulferts E-mail: mulferts@austin.dsccc.com -# -# @(#) $Id$ -# ---------------------------------------------------------------------- -# Copyright (c) 1997 DSC Technologies Corporation -# ====================================================================== -# Permission to use, copy, modify, distribute and license this software -# and its documentation for any purpose, and without fee or written -# agreement with DSC, is hereby granted, provided that the above copyright -# notice appears in all copies and that both the copyright notice and -# warranty disclaimer below appear in supporting documentation, and that -# the names of DSC Technologies Corporation or DSC Communications -# Corporation not be used in advertising or publicity pertaining to the -# software without specific, written prior permission. -# -# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING -# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- -# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE -# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, -# SUPPORT, UPTIMES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL -# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR -# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, -# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, -# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS -# SOFTWARE. -# ====================================================================== - -# -# Usual options. -# -itk::usual Timeentry { - keep -background -borderwidth -cursor -foreground -highlightcolor \ - -highlightthickness -labelfont -textbackground -textfont -} - -# ------------------------------------------------------------------ -# TIMEENTRY -# ------------------------------------------------------------------ -class iwidgets::Timeentry { - inherit iwidgets::Timefield - - constructor {args} {} - - itk_option define -grab grab Grab "global" - itk_option define -icon icon Icon {} - itk_option define -state state State normal - itk_option define -closetext closeText Text Close - - # - # The watch widget isn't created until needed, yet we need - # its options to be available upon creation of a timeentry widget. - # So, we'll define them in these class now so they can just be - # propagated onto the watch later. - # - itk_option define -hourradius hourRadius Radius .50 - itk_option define -hourcolor hourColor Color red - - itk_option define -minuteradius minuteRadius Radius .80 - itk_option define -minutecolor minuteColor Color yellow - - itk_option define -pivotradius pivotRadius Radius .10 - itk_option define -pivotcolor pivotColor Color white - - itk_option define -secondradius secondRadius Radius .90 - itk_option define -secondcolor secondColor Color black - - itk_option define -clockcolor clockColor Color white - itk_option define -clockstipple clockStipple ClockStipple {} - - itk_option define -tickcolor tickColor Color black - - itk_option define -watchheight watchHeight Height 175 - itk_option define -watchwidth watchWidth Width 155 - - protected { - method _getPopupTime {} - method _releaseGrab {} - method _popup {} - method _getDefaultIcon {} - - common _defaultIcon "" - } -} - -# -# Provide a lowercased access method for the timeentry class. -# -proc ::iwidgets::timeentry {pathName args} { - uplevel ::iwidgets::Timeentry $pathName $args -} - -# -# Use option database to override default resources of base classes. -# -option add *Timeentry.watchWidth 155 widgetDefault -option add *Timeentry.watchHeight 175 widgetDefault - -# ------------------------------------------------------------------ -# CONSTRUCTOR -# ------------------------------------------------------------------ -body iwidgets::Timeentry::constructor {args} { - # - # Create an icon label to act as a button to bring up the - # watch popup. - # - itk_component add iconbutton { - label $itk_interior.iconbutton -relief raised - } { - keep -borderwidth -cursor -foreground - } - grid $itk_component(iconbutton) -row 0 -column 0 -sticky ns - - # - # Initialize the widget based on the command line options. - # - eval itk_initialize $args -} - -# ------------------------------------------------------------------ -# OPTIONS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# OPTION: -icon -# -# Specifies the clock icon image to be used in the time entry. -# Should one not be provided, then a default pixmap will be used -# if possible, bitmap otherwise. -# ------------------------------------------------------------------ -configbody iwidgets::Timeentry::icon { - if {$itk_option(-icon) == {}} { - $itk_component(iconbutton) configure -image [_getDefaultIcon] - } else { - if {[lsearch [image names] $itk_option(-icon)] == -1} { - error "bad icon option \"$itk_option(-icon)\":\ - should be an existing image" - } else { - $itk_component(iconbutton) configure -image $itk_option(-icon) - } - } -} - -# ------------------------------------------------------------------ -# OPTION: -grab -# -# Specifies the grab level, local or global, to be obtained when -# bringing up the popup watch. The default is global. -# ------------------------------------------------------------------ -configbody iwidgets::Timeentry::grab { - switch -- $itk_option(-grab) { - "local" - "global" {} - default { - error "bad grab option \"$itk_option(-grab)\":\ - should be local or global" - } - } -} - -# ------------------------------------------------------------------ -# OPTION: -state -# -# Specifies the state of the widget which may be disabled or -# normal. A disabled state prevents selection of the time field -# or time icon button. -# ------------------------------------------------------------------ -configbody iwidgets::Timeentry::state { - switch -- $itk_option(-state) { - normal { - bind $itk_component(iconbutton) <Button-1> [code $this _popup] - } - disabled { - bind $itk_component(iconbutton) <Button-1> {} - } - } -} - -# ------------------------------------------------------------------ -# METHODS -# ------------------------------------------------------------------ -# ------------------------------------------------------------------ -# PROTECTED METHOD: _getDefaultIcon -# -# This method is invoked uto retrieve the name of the default icon -# image displayed in the icon button. -# ------------------------------------------------------------------ -body iwidgets::Timeentry::_getDefaultIcon {} { - - if {[lsearch [image types] pixmap] != -1} { - set _defaultIcon [image create pixmap -data { - /* XPM */ - static char *watch1a[] = { - /* width height num_colors chars_per_pixel */ - " 20 20 8 1", - /* colors */ - ". c #000000", - "# c #000099", - "a c #009999", - "b c #999999", - "c c #cccccc", - "d c #ffff00", - "e c #d9d9d9", - "f c #ffffff", - /* pixels */ - "eeeeebbbcccccbbbeeee", - "eeeee...#####..beeee", - "eeeee#aacccccaabeeee", - "eeee#accccccccc##eee", - "eee#ccc#cc#ccdcff#ee", - "ee#accccccccccfcca#e", - "eeaccccccc.cccfcccae", - "eeac#cccfc.cccc##cae", - "e#cccccffc.cccccccc#", - "e#ccccfffc.cccccccc#", - "e#cc#ffcc......c#cc#", - "e#ccfffccc.cccccccc#", - "e#cffccfcc.cccccccc#", - "eeafdccfcccccccd#cae", - "eeafcffcccccccccccae", - "eee#fcc#cccccdccc#ee", - "eee#fcc#cc#cc#ccc#ee", - "eeee#accccccccc##eee", - "eeeee#aacccccaabeeee", - "eeeee...#####..beeee" - }; - }] - } else { - set _defaultIcon [image create bitmap -data { - #define watch1a_width 20 - #define watch1a_height 20 - static char watch1a_bits[] = { - 0x40,0x40,0xf0,0xe0,0x7f,0xf0,0xe0,0xe0,0xf0,0x30, - 0x80,0xf1,0x88,0x04,0xf2,0x0c,0x00,0xf6,0x04,0x04, - 0xf4,0x94,0x84,0xf5,0x02,0x06,0xf8,0x02,0x0c,0xf8, - 0x12,0x7e,0xf9,0x02,0x04,0xf8,0x02,0x24,0xf8,0x04, - 0x00,0xf5,0x04,0x00,0xf4,0x88,0x02,0xf2,0x88,0x64, - 0xf2,0x30,0x80,0xf1,0xe0,0x60,0xf0,0xe0,0xff,0xf0}; - }] - } - - # - # Since this image will only need to be created once, we redefine - # this method to just return the image name for subsequent calls. - # - body ::iwidgets::Timeentry::_getDefaultIcon {} { - return $_defaultIcon - } - - return $_defaultIcon -} - - -# ------------------------------------------------------------------ -# PROTECTED METHOD: _popup -# -# This method is invoked upon selection of the icon button. It -# creates a watch widget within a toplevel popup, calculates -# the position at which to display the watch, performs a grab -# and displays the watch. -# ------------------------------------------------------------------ -body iwidgets::Timeentry::_popup {} { - # - # First, let's nullify the icon binding so that any another - # selections are ignored until were done with this one. Next, - # change the relief of the icon. - # - bind $itk_component(iconbutton) <Button-1> {} - $itk_component(iconbutton) configure -relief sunken - - # - # Create a withdrawn toplevel widget and remove the window - # decoration via override redirect. - # - itk_component add -private popup { - toplevel $itk_interior.popup - } - $itk_component(popup) configure -borderwidth 2 -background black - wm withdraw $itk_component(popup) - wm overrideredirect $itk_component(popup) 1 - - # - # Add a binding to for Escape to always release the grab. - # - bind $itk_component(popup) <KeyPress-Escape> [code $this _releaseGrab] - - # - # Create the watch widget. - # - itk_component add watch { - iwidgets::Watch $itk_component(popup).watch - } { - usual - - rename -width -watchwidth watchWidth Width - rename -height -watchheight watchHeight Height - - keep -hourradius -minuteradius -minutecolor -pivotradius -pivotcolor \ - -secondradius -secondcolor -clockcolor -clockstipple -tickcolor - } - grid $itk_component(watch) -row 0 -column 0 - $itk_component(watch) configure -cursor top_left_arrow - - # - # Create a button widget so the user can say they are done. - # - itk_component add close { - button $itk_component(popup).close -command [code $this _getPopupTime] - } { - usual - rename -text -closetext closeText Text - } - grid $itk_component(close) -row 1 -column 0 -sticky ew - $itk_component(close) configure -cursor top_left_arrow - - # - # The icon button will be used as the basis for the position of the - # popup on the screen. We'll always attempt to locate the popup - # off the lower right corner of the button. If that would put - # the popup off the screen, then we'll put above the upper left. - # - set rootx [winfo rootx $itk_component(iconbutton)] - set rooty [winfo rooty $itk_component(iconbutton)] - set popupwidth [cget -watchwidth] - set popupheight [expr [cget -watchheight] + \ - [winfo reqheight $itk_component(close)]] - - set popupx [expr $rootx + 3 + \ - [winfo width $itk_component(iconbutton)]] - set popupy [expr $rooty + 3 + \ - [winfo height $itk_component(iconbutton)]] - - if {([expr $popupx + $popupwidth] > [winfo screenwidth .]) || \ - ([expr $popupy + $popupheight] > [winfo screenheight .])} { - set popupx [expr $rootx - 3 - $popupwidth] - set popupy [expr $rooty - 3 - $popupheight] - } - - # - # Get the current time from the timefield widget and both - # show and select it on the watch. - # - $itk_component(watch) show [get] - - # - # Display the popup at the calculated position. - # - wm geometry $itk_component(popup) +$popupx+$popupy - wm deiconify $itk_component(popup) - tkwait visibility $itk_component(popup) - - # - # Perform either a local or global grab based on the -grab option. - # - if {$itk_option(-grab) == "local"} { - grab $itk_component(popup) - } else { - grab -global $itk_component(popup) - } - - # - # Make sure the widget is above all others and give it focus. - # - raise $itk_component(popup) - focus $itk_component(watch) -} - -# ------------------------------------------------------------------ -# PROTECTED METHOD: _popupGetTime -# -# This method is the callback for selection of a time on the -# watch. It releases the grab and sets the time in the -# timefield widget. -# ------------------------------------------------------------------ -body iwidgets::Timeentry::_getPopupTime {} { - show [$itk_component(watch) get -clicks] - _releaseGrab -} - -# ------------------------------------------------------------------ -# PROTECTED METHOD: _releaseGrab -# -# This method releases the grab, destroys the popup, changes the -# relief of the button back to raised and reapplies the binding -# to the icon button that engages the popup action. -# ------------------------------------------------------------------ -body iwidgets::Timeentry::_releaseGrab {} { - grab release $itk_component(popup) - $itk_component(iconbutton) configure -relief raised - destroy $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 deleted file mode 100644 index c9b8c54c437..00000000000 --- a/itcl/iwidgets3.0.0/generic/timefield.itk +++ /dev/null @@ -1,1018 +0,0 @@ -# -# Timefield -# ---------------------------------------------------------------------- -# Implements a time entry field with adjustable built-in intelligence -# levels. -# ---------------------------------------------------------------------- -# AUTHOR: John A. Tucker E-mail: jatucker@austin.dsccc.com -# -# @(#) $Id$ -# ---------------------------------------------------------------------- -# Copyright (c) 1997 DSC Technologies Corporation -# ====================================================================== -# Permission to use, copy, modify, distribute and license this software -# and its documentation for any purpose, and without fee or written -# agreement with DSC, is hereby granted, provided that the above copyright -# notice appears in all copies and that both the copyright notice and -# warranty disclaimer below appear in supporting documentation, and that -# the names of DSC Technologies Corporation or DSC Communications -# Corporation not be used in advertising or publicity pertaining to the -# software without specific, written prior permission. -# -# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING -# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- -# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE -# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, -# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL -# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR -# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, -# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, -# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS -# SOFTWARE. -# ====================================================================== - -# -# Use option database to override default resources of base classes. -# -option add *Timefield.justify center widgetDefault - - -# -# Usual options. -# -itk::usual Timefield { - keep -background -borderwidth -cursor -foreground -highlightcolor \ - -highlightthickness -labelfont -textbackground -textfont -} - -# ------------------------------------------------------------------ -# TIMEFIELD -# ------------------------------------------------------------------ -class iwidgets::Timefield { - - inherit iwidgets::Labeledwidget - - constructor {args} {} - - itk_option define -childsitepos childSitePos Position e - itk_option define -command command Command {} - 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"}} - method isvalid {} - method show {{time "now"}} - } - - protected { - method _backwardCivilian {} - method _backwardMilitary {} - method _focusIn {} - method _forwardCivilian {} - method _forwardMilitary {} - method _keyPress {char sym state} - method _moveField {direction} - method _setField {field} - method _whichField {} - method _toggleAmPm {} - - variable _cfield hour - variable _formatString "%r" - variable _fields {} - variable _numFields 4 - variable _forward {} - variable _backward {} - variable _timeVar "" - - common _militaryFields {hour minute second} - common _civilianFields {hour minute second ampm} - } -} - -# -# Provide a lowercased access method for the timefield class. -# -proc iwidgets::timefield {pathName args} { - uplevel iwidgets::Timefield $pathName $args -} - -# ------------------------------------------------------------------ -# CONSTRUCTOR -# ------------------------------------------------------------------ -body iwidgets::Timefield::constructor {args} { - component hull configure -borderwidth 0 - - # - # Create an entry field for entering the time. - # - itk_component add time { - entry $itk_interior.time - } { - keep -borderwidth -cursor -exportselection \ - -foreground -highlightcolor -highlightthickness \ - -insertbackground -justify -relief -textvariable - - rename -font -textfont textFont Font - rename -highlightbackground -background background Background - rename -background -textbackground textBackground Background - } - - # - # Create the child site widget. - # - itk_component add -protected dfchildsite { - frame $itk_interior.dfchildsite - } - set itk_interior $itk_component(dfchildsite) - - # - # Add timefield event bindings for focus in and keypress events. - # - 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: - # Button Motion - # Double-Clicks - # Triple-Clicks - # Button2 - # - bind $itk_component(time) <Button1-Motion> break - bind $itk_component(time) <Button2-Motion> break - bind $itk_component(time) <Double-Button> break - bind $itk_component(time) <Triple-Button> break - bind $itk_component(time) <2> break - - # - # Initialize the widget based on the command line options. - # - eval itk_initialize $args - - # - # Initialize the time to the current time. - # - show -} - -# ------------------------------------------------------------------ -# OPTIONS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# OPTION: -childsitepos -# -# Specifies the position of the child site in the widget. Valid -# locations are n, s, e, and w. -# ------------------------------------------------------------------ -configbody iwidgets::Timefield::childsitepos { - set parent [winfo parent $itk_component(time)] - - switch $itk_option(-childsitepos) { - n { - grid $itk_component(dfchildsite) -row 0 -column 0 -sticky ew - grid $itk_component(time) -row 1 -column 0 -sticky nsew - - grid rowconfigure $parent 0 -weight 0 - grid rowconfigure $parent 1 -weight 1 - grid columnconfigure $parent 0 -weight 1 - grid columnconfigure $parent 1 -weight 0 - } - - e { - grid $itk_component(dfchildsite) -row 0 -column 1 -sticky ns - grid $itk_component(time) -row 0 -column 0 -sticky nsew - - grid rowconfigure $parent 0 -weight 1 - grid rowconfigure $parent 1 -weight 0 - grid columnconfigure $parent 0 -weight 1 - grid columnconfigure $parent 1 -weight 0 - } - - s { - grid $itk_component(dfchildsite) -row 1 -column 0 -sticky ew - grid $itk_component(time) -row 0 -column 0 -sticky nsew - - grid rowconfigure $parent 0 -weight 1 - grid rowconfigure $parent 1 -weight 0 - grid columnconfigure $parent 0 -weight 1 - grid columnconfigure $parent 1 -weight 0 - } - - w { - grid $itk_component(dfchildsite) -row 0 -column 0 -sticky ns - grid $itk_component(time) -row 0 -column 1 -sticky nsew - - grid rowconfigure $parent 0 -weight 1 - grid rowconfigure $parent 1 -weight 0 - grid columnconfigure $parent 0 -weight 0 - grid columnconfigure $parent 1 -weight 1 - } - - default { - error "bad childsite option\ - \"$itk_option(-childsitepos)\":\ - should be n, e, s, or w" - } - } -} - -# ------------------------------------------------------------------ -# OPTION: -command -# -# Command invoked upon detection of return key press event. -# ------------------------------------------------------------------ -configbody iwidgets::Timefield::command {} - -# ------------------------------------------------------------------ -# OPTION: -iq -# -# Specifies the level of intelligence to be shown in the actions -# taken by the time field during the processing of keypress events. -# Valid settings include high or low. With a high iq, -# the time prevents the user from typing in an invalid time. For -# example, if the current time is 05/31/1997 and the user changes -# the hour to 04, then the minute will be instantly modified for them -# to be 30. In addition, leap seconds are fully taken into account. -# A setting of low iq instructs the widget to do no validity checking -# at all during time entry. With a low iq level, it is assumed that -# the validity will be determined at a later time using the time's -# isvalid command. -# ------------------------------------------------------------------ -configbody iwidgets::Timefield::iq { - - switch $itk_option(-iq) { - high - low { - - } - default { - error "bad iq option \"$itk_option(-iq)\": should be high or low" - } - } -} - -# ------------------------------------------------------------------ -# OPTION: -format -# -# Specifies the time format displayed in the entry widget. -# ------------------------------------------------------------------ -configbody iwidgets::Timefield::format { - - switch $itk_option(-format) { - civilian { - set _backward _backwardCivilian - set _forward _forwardCivilian - set _fields $_civilianFields - set _numFields 4 - set _formatString "%r" - $itk_component(time) config -width 11 - } - military { - set _backward _backwardMilitary - set _forward _forwardMilitary - set _fields $_militaryFields - set _numFields 3 - set _formatString "%T" - $itk_component(time) config -width 8 - } - default { - error "bad iq option \"$itk_option(-iq)\":\ - should be civilian or military" - } - } - - # - # Update the current contents of the entry field to reflect - # the configured format. - # - 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 -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# PUBLIC METHOD: get ?format? -# -# Return the current contents of the timefield in one of two formats -# string or as an integer clock value using the -string and -clicks -# options respectively. The default is by string. Reference the -# clock command for more information on obtaining times and their -# formats. -# ------------------------------------------------------------------ -body iwidgets::Timefield::get {{format "-string"}} { - set _timeVar [$itk_component(time) get] - - switch -- $format { - "-string" { - return $_timeVar - } - "-clicks" { - return [::clock scan $_timeVar -gmt $itk_option(-gmt)] - } - default { - error "bad format option \"$format\":\ - should be -string or -clicks" - } - } -} - -# ------------------------------------------------------------------ -# PUBLIC METHOD: show time -# -# Changes the currently displayed time to be that of the time -# argument. The time may be specified either as a string or an -# integer clock value. Reference the clock command for more -# 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" - } - - switch -regexp -- $time { - - {^now$} { - set seconds [::clock seconds] - } - - {^[0-9]+$} { - 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" - } - set seconds $time - } - - default { - 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 [::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 -} - -# ------------------------------------------------------------------ -# PUBLIC METHOD: isvalid -# -# Returns a boolean indication of the validity of the currently -# displayed time value. For example, 09:59::59 is valid whereas -# 26:59:59 is invalid. -# ------------------------------------------------------------------ -body iwidgets::Timefield::isvalid {} { - set _timeVar [$itk_component(time) get] - return [expr ([catch {::clock scan $_timeVar -gmt $itk_option(-gmt)}] == 0)] -} - -# ------------------------------------------------------------------ -# PROTECTED METHOD: _focusIn -# -# This method is bound to the <FocusIn> event. It resets the -# insert cursor and field settings to be back to their last known -# positions. -# ------------------------------------------------------------------ -body iwidgets::Timefield::_focusIn {} { - _setField $_cfield -} - -# ------------------------------------------------------------------ -# PROTECTED METHOD: _keyPress -# -# This method is the workhorse of the class. It is bound to the -# <KeyPress> event and controls the processing of all key strokes. -# ------------------------------------------------------------------ -body iwidgets::Timefield::_keyPress {char sym state} { - - # - # Determine which field we are in currently. This is needed - # since the user may have moved to this position via a mouse - # selection and so it would not be in the position we last - # knew it to be. - # - set _cfield [_whichField ] - - # - # Set up a few basic variables we'll be needing throughout the - # rest of the method such as the position of the insert cursor - # and the currently displayed minute, hour, and second. - # - set inValid 0 - set icursor [$itk_component(time) index insert] - set lastField [lindex $_fields end] - - set prevtime $_timeVar - regexp {^([0-9])([0-9]):([0-9])([0-9]):([0-9])([0-9]).*$} \ - $_timeVar dummy \ - hour1 hour2 minute1 minute2 second1 second2 - set hour "$hour1$hour2" - set minute "$minute1$minute2" - set second "$second1$second2" - - # - # Process numeric keystrokes. This involes a fair amount of - # processing with step one being to check and make sure we - # aren't attempting to insert more that 6 characters. If - # so ring the bell and break. - # - if {![catch {expr int($char)}]} { - - # If we are currently in the hour field then we process the - # number entered based on the cursor position. If we are at - # at the first position and our iq is low, then accept any - # input. - # - # if the current format is military, then - # validate the hour field which can be [00 - 23] - # - switch $_cfield { - hour { - if {$itk_option(-iq) == "low"} { - $itk_component(time) delete $icursor - $itk_component(time) insert $icursor $char - - } elseif {$itk_option(-format) == "military"} { - if {$icursor == 0} { - # - # if the digit is less than 2, then - # the second hour digit is valid for 0-9 - # - if {$char < 2} { - $itk_component(time) delete 0 1 - $itk_component(time) insert 0 $char - - # - # if the digit is equal to 2, then - # the second hour digit is valid for 0-3 - # - } elseif {$char == 2} { - $itk_component(time) delete 0 1 - $itk_component(time) insert 0 $char - - if {$hour2 > 3} { - $itk_component(time) delete 1 2 - $itk_component(time) insert 1 "0" - $itk_component(time) icursor 1 - } - - # - # if the digit is greater than 2, then - # set the first hour digit to 0 and the - # second hour digit to the value. - # - } elseif {$char > 2} { - $itk_component(time) delete 0 2 - $itk_component(time) insert 0 "0$char" - set icursor 1 - } else { - set inValid 1 - } - - # - # if the insertion cursor is for the second hour digit, then - # format is military, then it can only be valid if the first - # hour digit is less than 2 or the new digit is less than 4 - # - } else { - if {$hour1 < 2 || $char < 4} { - $itk_component(time) delete 1 2 - $itk_component(time) insert 1 $char - } else { - set inValid 1 - } - } - - # - # The format is civilian, so we need to - # validate the hour field which can be [01 - 12] - # - } else { - if {$icursor == 0} { - # - # if the digit is 0, then - # the second hour digit is valid for 1-9 - # so just insert it. - # - if {$char == 0 && $hour2 != 0} { - $itk_component(time) delete 0 1 - $itk_component(time) insert 0 $char - - # - # if the digit is equal to 1, then - # the second hour digit is valid for 0-2 - # - } elseif {$char == 1} { - $itk_component(time) delete 0 1 - $itk_component(time) insert 0 $char - - if {$hour2 > 2} { - $itk_component(time) delete 1 2 - $itk_component(time) insert 1 0 - set icursor 1 - } - - # - # if the digit is greater than 1, then - # set the first hour digit to 0 and the - # second hour digit to the value. - # - } elseif {$char > 1} { - $itk_component(time) delete 0 2 - $itk_component(time) insert 0 "0$char" - set icursor 1 - - } else { - set inValid 1 - } - - # - # The insertion cursor is at the second hour digit, so - # it can only be valid if the firs thour digit is 0 - # or the new digit is less than or equal to 2 - # - } else { - if {$hour1 == 0 || $char <= 2} { - $itk_component(time) delete 1 2 - $itk_component(time) insert 1 $char - } else { - set inValid 1 - } - } - } - - if {$inValid} { - bell - } elseif {$icursor == 1} { - _setField minute - } - } - - minute { - if {$itk_option(-iq) == "low" || $char < 6 || $icursor == 4} { - $itk_component(time) delete $icursor - $itk_component(time) insert $icursor $char - } elseif {$itk_option(-iq) == "high"} { - if {$char > 5} { - $itk_component(time) delete 3 5 - $itk_component(time) insert 3 "0$char" - set icursor 4 - } - } - - if {$icursor == 4} { - _setField second - } - } - - second { - if {$itk_option(-iq) == "low" || $char < 6 || $icursor == 7} { - $itk_component(time) delete $icursor - $itk_component(time) insert $icursor $char - - } elseif {$itk_option(-iq) == "high"} { - if {$char > 5} { - $itk_component(time) delete 6 8 - $itk_component(time) insert 6 "0$char" - set icursor 7 - } - } - - if {$icursor == 7} { - _moveField forward - } - } - } - - set _timeVar [$itk_component(time) get] - return -code break - } - - # - # Process the plus and the up arrow keys. They both yield the same - # effect, they increment the minute by one. - # - switch $sym { - p - P { - if {$itk_option(-format) == "civilian"} { - $itk_component(time) delete 9 10 - $itk_component(time) insert 9 P - _setField hour - } - } - - a - A { - if {$itk_option(-format) == "civilian"} { - $itk_component(time) delete 9 10 - $itk_component(time) insert 9 A - _setField hour - } - } - - plus - Up { - if {$_cfield == "ampm"} { - _toggleAmPm - } else { - set newclicks [::clock scan "$prevtime 1 $_cfield"] - show [::clock format $newclicks -format $_formatString] - } - } - - minus - Down { - # - # Process the minus and the down arrow keys which decrement the value - # of the field in which the cursor is currently positioned. - # - if {$_cfield == "ampm"} { - _toggleAmPm - } else { - set newclicks [::clock scan "$prevtime 1 $_cfield ago"] - show [::clock format $newclicks -format $_formatString] - } - } - - Tab { - # - # A tab key moves the "hour:minute:second" field forward by one unless - # the current field is the second. In that case we'll let tab - # do what is supposed to and pass the focus onto the next widget. - # - if {$state == 0} { - - if {($itk_option(-format) == "civilian" && $_cfield == $lastField)} { - _setField hour - return -code continue - } - _moveField forward - - # - # A ctrl-tab key moves the hour:minute:second field backwards by one - # unless the current field is the hour. In that case we'll let - # tab take the focus to a previous widget. - # - } elseif {$state == 4} { - if {$_cfield == "hour"} { - _setField hour - return -code continue - } - _moveField backward - } - } - - Right { - # - # A right arrow key moves the insert cursor to the right one. - # - $_forward - } - - Left - BackSpace - Delete { - # - # A left arrow, backspace, or delete key moves the insert cursor - # to the left one. This is what you expect for the left arrow - # and since the whole widget always operates in overstrike mode, - # it makes the most sense for backspace and delete to do the same. - # - $_backward - } - - Return { - # - # A Return key invokes the optionally specified command option. - # - uplevel #0 $itk_option(-command) - } - - default { - - } - } - - return -code break -} - -# ------------------------------------------------------------------ -# PROTECTED METHOD: _toggleAmPm -# -# Internal method which toggles the displayed time -# between "AM" and "PM" when format is "civilian". -# ------------------------------------------------------------------ -body iwidgets::Timefield::_toggleAmPm {} { - 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] -} - -# ------------------------------------------------------------------ -# PROTECTED METHOD: _setField field -# -# Adjusts the current field to be that of the argument, setting the -# insert cursor appropriately. -# ------------------------------------------------------------------ -body iwidgets::Timefield::_setField {field} { - - # Move the position of the cursor to the first character of the - # field given by the argument: - # - # Field First Character Index - # ----- --------------------- - # hour 0 - # minute 3 - # second 6 - # ampm 9 - # - switch $field { - hour { - $itk_component(time) icursor 0 - } - minute { - $itk_component(time) icursor 3 - } - second { - $itk_component(time) icursor 6 - } - ampm { - if {$itk_option(-format) == "military"} { - error "bad field: \"$field\", must be hour, minute or second" - } - $itk_component(time) icursor 9 - } - default { - if {$itk_option(-format) == "military"} { - error "bad field: \"$field\", must be hour, minute or second" - } else { - error "bad field: \"$field\", must be hour, minute, second or ampm" - } - } - } - - set _cfield $field - - return $_cfield -} - -# ------------------------------------------------------------------ -# PROTECTED METHOD: _moveField -# -# Moves the cursor one field forward or backward. -# ------------------------------------------------------------------ -body iwidgets::Timefield::_moveField {direction} { - - # Since the value "_fields" list variable is always either value: - # military => {hour minute second} - # civilian => {hour minute second ampm} - # - # the index of the previous or next field index can be determined - # by subtracting or adding 1 to current the index, respectively. - # - set index [lsearch $_fields $_cfield] - expr {($direction == "forward") ? [incr index] : [incr index -1]} - - if {$index == $_numFields} { - set index 0 - } elseif {$index < 0} { - set index [expr $_numFields-1] - } - - _setField [lindex $_fields $index] -} - -# ------------------------------------------------------------------ -# PROTECTED METHOD: _whichField -# -# Returns the current field that the cursor is positioned within. -# ------------------------------------------------------------------ -body iwidgets::Timefield::_whichField {} { - - # Return the current field based on the position of the cursor. - # - # Field Index - # ----- ----- - # hour 0,1 - # minute 3,4 - # second 6,7 - # ampm 9,10 - # - set icursor [$itk_component(time) index insert] - switch $icursor { - 0 - 1 { - set _cfield hour - } - 3 - 4 { - set _cfield minute - } - 6 - 7 { - set _cfield second - } - 9 - 10 { - set _cfield ampm - } - } - - return $_cfield -} - -# ------------------------------------------------------------------ -# PROTECTED METHOD: _forwardCivilian -# -# Internal method which moves the cursor forward by one character -# jumping over the slashes and wrapping. -# ------------------------------------------------------------------ -body iwidgets::Timefield::_forwardCivilian {} { - - # - # If the insertion cursor is at the second digit - # of either the hour, minute or second field, then - # move the cursor to the first digit of the right-most field. - # - # else move the insertion cursor right one character - # - set icursor [$itk_component(time) index insert] - switch $icursor { - 1 { - _setField minute - } - 4 { - _setField second - } - 7 { - _setField ampm - } - 9 - 10 { - _setField hour - } - default { - $itk_component(time) icursor [expr $icursor+1] - } - } -} - -# ------------------------------------------------------------------ -# PROTECTED METHOD: _forwardMilitary -# -# Internal method which moves the cursor forward by one character -# jumping over the slashes and wrapping. -# ------------------------------------------------------------------ -body iwidgets::Timefield::_forwardMilitary {} { - - # - # If the insertion cursor is at the second digit of either - # the hour, minute or second field, then move the cursor to - # the first digit of the right-most field. - # - # else move the insertion cursor right one character - # - set icursor [$itk_component(time) index insert] - switch $icursor { - 1 { - _setField minute - } - 4 { - _setField second - } - 7 { - _setField hour - } - default { - $itk_component(time) icursor [expr $icursor+1] - } - } -} - -# ------------------------------------------------------------------ -# PROTECTED METHOD: _backwardCivilian -# -# Internal method which moves the cursor backward by one character -# jumping over the ":" and wrapping. -# ------------------------------------------------------------------ -body iwidgets::Timefield::_backwardCivilian {} { - - # - # If the insertion cursor is at the first character - # of either the minute or second field or at the ampm - # field, then move the cursor to the second character - # of the left-most field. - # - # else if the insertion cursor is at the first digit of the - # hour field, then move the cursor to the first character - # of the ampm field. - # - # else move the insertion cursor left one character - # - set icursor [$itk_component(time) index insert] - switch $icursor { - 9 { - _setField second - $itk_component(time) icursor 7 - } - 6 { - _setField minute - $itk_component(time) icursor 4 - } - 3 { - _setField hour - $itk_component(time) icursor 1 - } - 0 { - _setField ampm - $itk_component(time) icursor 9 - } - default { - $itk_component(time) icursor [expr $icursor-1] - } - } -} - -# ------------------------------------------------------------------ -# PROTECTED METHOD: _backwardMilitary -# -# Internal method which moves the cursor backward by one character -# jumping over the slashes and wrapping. -# ------------------------------------------------------------------ -body iwidgets::Timefield::_backwardMilitary {} { - - # - # If the insertion cursor is at the first digit of either - # the minute or second field, then move the cursor to the - # second character of the left-most field. - # - # else if the insertion cursor is at the first digit of the - # hour field, then move the cursor to the second digit - # of the second field. - # - # else move the insertion cursor left one character - # - set icursor [$itk_component(time) index insert] - switch $icursor { - 6 { - _setField minute - $itk_component(time) icursor 4 - } - 3 { - _setField hour - $itk_component(time) icursor 1 - } - 0 { - _setField second - $itk_component(time) icursor 7 - } - default { - $itk_component(time) icursor [expr $icursor-1] - } - } -} diff --git a/itcl/iwidgets3.0.0/generic/toolbar.itk b/itcl/iwidgets3.0.0/generic/toolbar.itk deleted file mode 100644 index c9e2be2d463..00000000000 --- a/itcl/iwidgets3.0.0/generic/toolbar.itk +++ /dev/null @@ -1,983 +0,0 @@ -# -# Toolbar -# ---------------------------------------------------------------------- -# -# The Toolbar command creates a new window (given by the pathName -# argument) and makes it into a Tool Bar widget. Additional options, -# described above may be specified on the command line or in the -# option database to configure aspects of the Toolbar such as its -# colors, font, and orientation. The Toolbar command returns its -# pathName argument. At the time this command is invoked, there -# must not exist a window named pathName, but pathName's parent -# must exist. -# -# A Toolbar is a widget that displays a collection of widgets arranged -# either in a row or a column (depending on the value of the -orient -# option). This collection of widgets is usually for user convenience -# to give access to a set of commands or settings. Any widget may be -# placed on a Toolbar. However, command or value-oriented widgets (such -# as button, radiobutton, etc.) are usually the most useful kind of -# widgets to appear on a Toolbar. -# -# WISH LIST: -# This section lists possible future enhancements. -# -# Toggle between text and image/bitmap so that the toolbar could -# display either all text or all image/bitmaps. -# Implementation of the -toolbarfile option that allows toolbar -# add commands to be read in from a file. -# ---------------------------------------------------------------------- -# AUTHOR: Bill W. Scott EMAIL: bscott@spd.dsccc.com -# -# @(#) $Id$ -# ---------------------------------------------------------------------- -# Copyright (c) 1995 DSC Technologies Corporation -# ====================================================================== -# Permission to use, copy, modify, distribute and license this software -# and its documentation for any purpose, and without fee or written -# agreement with DSC, is hereby granted, provided that the above copyright -# notice appears in all copies and that both the copyright notice and -# warranty disclaimer below appear in supporting documentation, and that -# the names of DSC Technologies Corporation or DSC Communications -# Corporation not be used in advertising or publicity pertaining to the -# software without specific, written prior permission. -# -# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING -# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- -# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE -# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, -# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL -# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR -# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, -# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, -# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS -# SOFTWARE. -# ====================================================================== - -# -# Default resources. -# -option add *Toolbar*padX 5 widgetDefault -option add *Toolbar*padY 5 widgetDefault -option add *Toolbar*orient horizontal widgetDefault -option add *Toolbar*highlightThickness 0 widgetDefault -option add *Toolbar*indicatorOn false widgetDefault -option add *Toolbar*selectColor [. cget -bg] widgetDefault - -# -# Usual options. -# -itk::usual Toolbar { - keep -activebackground -activeforeground -background -balloonbackground \ - -balloondelay1 -balloondelay2 -balloonfont -balloonforeground \ - -borderwidth -cursor -disabledforeground -font -foreground \ - -highlightbackground -highlightcolor -highlightthickness \ - -insertbackground -insertforeground -selectbackground \ - -selectborderwidth -selectcolor -selectforeground -troughcolor -} - -# ------------------------------------------------------------------ -# TOOLBAR -# ------------------------------------------------------------------ -class iwidgets::Toolbar { - inherit itk::Widget - - constructor {args} {} - destructor {} - - itk_option define -balloonbackground \ - balloonBackground BalloonBackground yellow - itk_option define -balloonforeground \ - balloonForeground BalloonForeground black - itk_option define -balloonfont balloonFont BalloonFont 6x10 - itk_option define -balloondelay1 \ - balloonDelay1 BalloonDelay1 1000 - itk_option define -balloondelay2 \ - balloonDelay2 BalloonDelay2 200 - itk_option define -helpvariable helpVariable HelpVariable {} - itk_option define -orient orient Orient "horizontal" - - # - # The following options implement propogated configurations to - # any widget that might be added to us. The problem is this is - # not deterministic as someone might add a new kind of widget with - # and option like -armbackground, so we would not be aware of - # this kind of option. Anyway we support as many of the obvious - # ones that we can. They can always configure them with itemconfigures. - # - itk_option define -activebackground activeBackground Foreground #c3c3c3 - itk_option define -activeforeground activeForeground Background Black - itk_option define -background background Background #d9d9d9 - itk_option define -borderwidth borderWidth BorderWidth 2 - itk_option define -cursor cursor Cursor {} - itk_option define -disabledforeground \ - disabledForeground DisabledForeground #a3a3a3 - itk_option define -font \ - font Font "-Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*" - itk_option define -foreground foreground Foreground #000000000000 - itk_option define -highlightbackground \ - highlightBackground HighlightBackground #d9d9d9 - itk_option define -highlightcolor highlightColor HighlightColor Black - itk_option define -highlightthickness \ - highlightThickness HighlightThickness 0 - itk_option define -insertforeground insertForeground Background #c3c3c3 - itk_option define -insertbackground insertBackground Foreground Black - itk_option define -selectbackground selectBackground Foreground #c3c3c3 - itk_option define -selectborderwidth selectBorderWidth BorderWidth {} - itk_option define -selectcolor selectColor Background #b03060 - itk_option define -selectforeground selectForeground Background Black - itk_option define -state state State normal - itk_option define -troughcolor troughColor Background #c3c3c3 - - public method add {widgetCommand name args} - public method delete {args} - public method index {index} - public method insert {beforeIndex widgetCommand name args} - public method itemcget {index args} - public method itemconfigure {index args} - - public method _resetBalloonTimer {} - public method _startBalloonDelay {window} - public method _stopBalloonDelay {window balloonClick} - - private method _deleteWidgets {index1 index2} - private method _addWidget {widgetCommand name args} - private method _index {toolList index} - private method _getAttachedOption {optionListName widget args retValue} - private method _setAttachedOption {optionListName widget option args} - private method _packToolbar {} - - public method hideHelp {} - public method showHelp {window} - public method showBalloon {window} - public method hideBalloon {} - - private variable _balloonTimer 0 - private variable _balloonAfterID 0 - private variable _balloonClick false - - private variable _interior {} - private variable _initialMapping 1 ;# Is this the first mapping? - private variable _toolList {} ;# List of all widgets on toolbar - private variable _opts ;# New options for child widgets - private variable _currHelpWidget {} ;# Widget currently displaying help for - private variable _hintWindow {} ;# Balloon help bubble. - - # list of options we want to propogate to widgets added to toolbar. - private common _optionList { - -activebackground \ - -activeforeground \ - -background \ - -borderwidth \ - -cursor \ - -disabledforeground \ - -font \ - -foreground \ - -highlightbackground \ - -highlightcolor \ - -highlightthickness \ - -insertbackground \ - -insertforeground \ - -selectbackground \ - -selectborderwidth \ - -selectcolor \ - -selectforeground \ - -state \ - -troughcolor \ - } -} - -# ------------------------------------------------------------------ -# CONSTRUCTOR -# ------------------------------------------------------------------ -body iwidgets::Toolbar::constructor {args} { - component hull configure -borderwidth 0 - set _interior $itk_interior - - # - # Handle configs - # - eval itk_initialize $args - - # build balloon help window - set _hintWindow [toplevel $itk_component(hull).balloonHintWindow] - wm withdraw $_hintWindow - label $_hintWindow.label \ - -foreground $itk_option(-balloonforeground) \ - -background $itk_option(-balloonbackground) \ - -font $itk_option(-balloonfont) \ - -relief raised \ - -borderwidth 1 - pack $_hintWindow.label - - # ... Attach help handler to this widget - bind toolbar-help-$itk_component(hull) \ - <Enter> "+[code $this showHelp %W]" - bind toolbar-help-$itk_component(hull) \ - <Leave> "+[code $this hideHelp]" - - # ... Set up Microsoft style balloon help display. - set _balloonTimer $itk_option(-balloondelay1) - bind $_interior \ - <Leave> "+[code $this _resetBalloonTimer]" - bind toolbar-balloon-$itk_component(hull) \ - <Enter> "+[code $this _startBalloonDelay %W]" - bind toolbar-balloon-$itk_component(hull) \ - <Leave> "+[code $this _stopBalloonDelay %W false]" - bind toolbar-balloon-$itk_component(hull) \ - <Button-1> "+[code $this _stopBalloonDelay %W true]" -} - -# -# Provide a lowercase access method for the Toolbar class -# -proc ::iwidgets::toolbar {pathName args} { - uplevel ::iwidgets::Toolbar $pathName $args -} - -# ------------------------------------------------------------------ -# DESTURCTOR -# ------------------------------------------------------------------ -body iwidgets::Toolbar::destructor {} { - if {$_balloonAfterID != 0} {after cancel $_balloonAfterID} -} - -# ------------------------------------------------------------------ -# OPTIONS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------------ -# OPTION -balloonbackground -# ------------------------------------------------------------------ -configbody iwidgets::Toolbar::balloonbackground { - if { $_hintWindow != {} } { - if { $itk_option(-balloonbackground) != {} } { - $_hintWindow.label configure \ - -background $itk_option(-balloonbackground) - } - } -} - -# ------------------------------------------------------------------ -# OPTION -balloonforeground -# ------------------------------------------------------------------ -configbody iwidgets::Toolbar::balloonforeground { - if { $_hintWindow != {} } { - if { $itk_option(-balloonforeground) != {} } { - $_hintWindow.label configure \ - -foreground $itk_option(-balloonforeground) - } - } -} - -# ------------------------------------------------------------------ -# OPTION -balloonfont -# ------------------------------------------------------------------ -configbody iwidgets::Toolbar::balloonfont { - if { $_hintWindow != {} } { - if { $itk_option(-balloonfont) != {} } { - $_hintWindow.label configure \ - -font $itk_option(-balloonfont) - } - } -} - -# ------------------------------------------------------------------ -# OPTION: -orient -# -# Position buttons either horizontally or vertically. -# ------------------------------------------------------------------ -configbody iwidgets::Toolbar::orient { - switch $itk_option(-orient) { - "horizontal" - "vertical" { - _packToolbar - } - default {error "Invalid orientation. Must be either \ - horizontal or vertical" - } - } -} - -# ------------------------------------------------------------------ -# METHODS -# ------------------------------------------------------------------ - -# ------------------------------------------------------------- -# METHOD: add widgetCommand name ?option value? -# -# Adds a widget with the command widgetCommand whose name is -# name to the Toolbar. If widgetCommand is radiobutton -# or checkbutton, its packing is slightly padded to match the -# geometry of button widgets. -# ------------------------------------------------------------- -body iwidgets::Toolbar::add { widgetCommand name args } { - - eval "_addWidget $widgetCommand $name $args" - - lappend _toolList $itk_component($name) - - if { $widgetCommand == "radiobutton" || \ - $widgetCommand == "checkbutton" } { - set iPad 1 - } else { - set iPad 0 - } - - # repack the tool bar - _packToolbar - - return $itk_component($name) - -} - -# ------------------------------------------------------------- -# -# METHOD: delete index ?index2? -# -# This command deletes all components between index and -# index2 inclusive. If index2 is omitted then it defaults -# to index. Returns an empty string -# -# ------------------------------------------------------------- -body iwidgets::Toolbar::delete { args } { - # empty toolbar - if { $_toolList == {} } { - error "can't delete widget, no widgets in the Toolbar \ - \"$itk_component(hull)\"" - } - - set len [llength $args] - switch -- $len { - 1 { - set fromWidget [_index $_toolList [lindex $args 0]] - - if { $fromWidget < 0 || $fromWidget >= [llength $_toolList] } { - error "bad Toolbar widget index in delete method: \ - should be between 0 and [expr [llength $_toolList] - 1]" - } - - set toWidget $fromWidget - _deleteWidgets $fromWidget $toWidget - } - - 2 { - set fromWidget [_index $_toolList [lindex $args 0]] - - if { $fromWidget < 0 || $fromWidget >= [llength $_toolList] } { - error "bad Toolbar widget index1 in delete method: \ - should be between 0 and [expr [llength $_toolList] - 1]" - } - - set toWidget [_index $_toolList [lindex $args 1]] - - if { $toWidget < 0 || $toWidget >= [llength $_toolList] } { - error "bad Toolbar widget index2 in delete method: \ - should be between 0 and [expr [llength $_toolList] - 1]" - } - - if { $fromWidget > $toWidget } { - error "bad Toolbar widget index1 in delete method: \ - index1 is greater than index2" - } - - _deleteWidgets $fromWidget $toWidget - } - - default { - # ... too few/many parameters passed - error "wrong # args: should be \ - \"$itk_component(hull) delete index1 ?index2?\"" - } - } - - return {} -} - - -# ------------------------------------------------------------- -# -# METHOD: index index -# -# Returns the widget's numerical index for the entry corresponding -# to index. If index is not found, -1 is returned -# -# ------------------------------------------------------------- -body iwidgets::Toolbar::index { index } { - - return [_index $_toolList $index] - -} - -# ------------------------------------------------------------- -# -# METHOD: insert beforeIndex widgetCommand name ?option value? -# -# Insert a new component named name with the command -# widgetCommand before the com ponent specified by beforeIndex. -# If widgetCommand is radiobutton or checkbutton, its packing -# is slightly padded to match the geometry of button widgets. -# -# ------------------------------------------------------------- -body iwidgets::Toolbar::insert { beforeIndex widgetCommand name args } { - - set beforeIndex [_index $_toolList $beforeIndex] - - if {$beforeIndex < 0 || $beforeIndex > [llength $_toolList] } { - error "bad toolbar entry index $beforeIndex" - } - - eval "_addWidget $widgetCommand $name $args" - - # linsert into list - set _toolList [linsert $_toolList $beforeIndex $itk_component($name)] - - # repack the tool bar - _packToolbar - - return $itk_component($name) - -} - -# ---------------------------------------------------------------------- -# METHOD: itemcget index ?option? -# -# Returns the value for the option setting of the widget at index $index. -# index can be numeric or widget name -# -# ---------------------------------------------------------------------- -body iwidgets::Toolbar::itemcget { index args} { - - return [lindex [eval itemconfigure $index $args] 4] -} - -# ------------------------------------------------------------- -# -# METHOD: itemconfigure index ?option? ?value? ?option value...? -# -# Query or modify the configuration options of the widget of -# the Toolbar specified by index. If no option is specified, -# returns a list describing all of the available options for -# index (see Tk_ConfigureInfo for information on the format -# of this list). If option is specified with no value, then -# the command returns a list describing the one named option -# (this list will be identical to the corresponding sublist -# of the value returned if no option is specified). If one -# or more option-value pairs are specified, then the command -# modifies the given widget option(s) to have the given -# value(s); in this case the command returns an empty string. -# The component type of index determines the valid available options. -# -# ------------------------------------------------------------- -body iwidgets::Toolbar::itemconfigure { index args } { - - # Get a numeric index. - set index [_index $_toolList $index] - - # Get the tool path - set toolPath [lindex $_toolList $index] - - set len [llength $args] - - switch $len { - 0 { - # show all options - # '''''''''''''''' - - # support display of -helpstr and -balloonstr configs - set optList [$toolPath configure] - - ## @@@ might want to use _getAttachedOption instead... - if { [info exists _opts($toolPath,-helpstr)] } { - set value $_opts($toolPath,-helpstr) - } else { - set value {} - } - lappend optList [list -helpstr helpStr HelpStr {} $value] - if { [info exists _opts($toolPath,-balloonstr)] } { - set value $_opts($toolPath,-balloonstr) - } else { - set value {} - } - lappend optList [list -balloonstr balloonStr BalloonStr {} $value] - return $optList - } - 1 { - # show only option specified - # '''''''''''''''''''''''''' - # did we satisfy the option get request? - - if { [regexp -- {-helpstr} $args] } { - if { [info exists _opts($toolPath,-helpstr)] } { - set value $_opts($toolPath,-helpstr) - } else { - set value {} - } - return [list -helpstr helpStr HelpStr {} $value] - } elseif { [regexp -- {-balloonstr} $args] } { - if { [info exists _opts($toolPath,-balloonstr)] } { - set value $_opts($toolPath,-balloonstr) - } else { - set value {} - } - return [list -balloonstr balloonStr BalloonStr {} $value] - } else { - return [eval $toolPath configure $args] - } - - } - default { - # ... do a normal configure - - # first screen for all our child options we are adding - _setAttachedOption \ - _opts \ - $toolPath \ - "-helpstr" \ - $args - - _setAttachedOption \ - _opts \ - $toolPath \ - "-balloonstr" \ - $args - - # with a clean args list do a configure - - # if the stripping process brought us down to no options - # to set, then forget the configure of widget. - if { [llength $args] != 0 } { - return [eval $toolPath configure $args] - } else { - return "" - } - } - } - -} - -# ------------------------------------------------------------- -# -# METHOD: _resetBalloonDelay1 -# -# Sets the delay that will occur before a balloon could be popped -# up to balloonDelay1 -# -# ------------------------------------------------------------- -body iwidgets::Toolbar::_resetBalloonTimer {} { - set _balloonTimer $itk_option(-balloondelay1) - - # reset the <1> longer delay - set _balloonClick false -} - -# ------------------------------------------------------------- -# -# METHOD: _startBalloonDelay -# -# Starts waiting to pop up a balloon id -# -# ------------------------------------------------------------- -body iwidgets::Toolbar::_startBalloonDelay {window} { - if {$_balloonAfterID != 0} { - after cancel $_balloonAfterID - } - set _balloonAfterID [after $_balloonTimer [code $this showBalloon $window]] -} - -# ------------------------------------------------------------- -# -# METHOD: _stopBalloonDelay -# -# This method will stop the timer for a balloon popup if one is -# in progress. If however there is already a balloon window up -# it will hide the balloon window and set timing to delay 2 stage. -# -# ------------------------------------------------------------- -body iwidgets::Toolbar::_stopBalloonDelay { window balloonClick } { - - # If <1> then got a click cancel - if { $balloonClick } { - set _balloonClick true - } - if { $_balloonAfterID != 0 } { - after cancel $_balloonAfterID - set _balloonAfterID 0 - } else { - hideBalloon - - # If this was cancelled with a <1> use longer delay. - if { $_balloonClick } { - set _balloonTimer $itk_option(-balloondelay1) - } else { - set _balloonTimer $itk_option(-balloondelay2) - } - } -} - -# ------------------------------------------------------------- -# PRIVATE METHOD: _addWidget -# -# widgetCommand : command to invoke to create the added widget -# name : name of the new widget to add -# args : options for the widget create command -# -# Looks for -helpstr, -balloonstr and grabs them, strips from -# args list. Then tries to add a component and keeps based -# on known type. If it fails, it tries to clean up. Then it -# binds handlers for helpstatus and balloon help. -# -# Returns the path of the widget added. -# -# ------------------------------------------------------------- -body iwidgets::Toolbar::_addWidget { widgetCommand name args } { - - # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, - # Add the widget to the tool bar - # ''''''''''''''''''''''''''''''''''''''''''''''''''''' - - # ... Strip out and save the -helpstr, -balloonstr options from args - # and save it in _opts - _setAttachedOption \ - _opts \ - $_interior.$name \ - -helpstr \ - $args - - _setAttachedOption \ - _opts \ - $_interior.$name \ - -balloonstr \ - $args - - - # ... Add the new widget as a component (catch an error if occurs) - set createFailed [catch { - itk_component add $name { - eval $widgetCommand $_interior.$name $args - } { - } - } errMsg] - - # ... Clean up if the create failed, and exit. - # The _opts list if it has -helpstr, -balloonstr just entered for - # this, it must be cleaned up. - if { $createFailed } { - # clean up - if {![catch {set _opts($_interior.$name,-helpstr)}]} { - set lastIndex [\ - expr [llength \ - $_opts($_interior.$name,-helpstr) ]-1] - lreplace $_opts($_interior.$name,-helpstr) \ - $lastIndex $lastIndex "" - } - if {![catch {set _opts($_interior.$name,-balloonstr)}]} { - set lastIndex [\ - expr [llength \ - $_opts($_interior.$name,-balloonstr) ]-1] - lreplace $_opts($_interior.$name,-balloonstr) \ - $lastIndex $lastIndex "" - } - error $errMsg - } - - # ... Add in dynamic options that apply from the _optionList - foreach optionSet [$itk_component($name) configure] { - set option [lindex $optionSet 0] - if { [lsearch $_optionList $option] != -1 } { - itk_option add $name.$option - } - } - - bindtags $itk_component($name) \ - [linsert [bindtags $itk_component($name)] end \ - toolbar-help-$itk_component(hull)] - bindtags $itk_component($name) \ - [linsert [bindtags $itk_component($name)] end \ - toolbar-balloon-$itk_component(hull)] - - return $itk_component($name) -} - -# ------------------------------------------------------------- -# -# PRIVATE METHOD: _deleteWidgets -# -# deletes widget range by numerical index numbers. -# -# ------------------------------------------------------------- -body iwidgets::Toolbar::_deleteWidgets { index1 index2 } { - - for { set index $index1 } { $index <= $index2 } { incr index } { - - # kill the widget - set component [lindex $_toolList $index] - destroy $component - - } - - # physically remove the page - set _toolList [lreplace $_toolList $index1 $index2] - -} - -# ------------------------------------------------------------- -# PRIVATE METHOD: _index -# -# toolList : list of widget names to search thru if index -# is non-numeric -# index : either number, 'end', 'last', or pattern -# -# _index takes takes the value $index converts it to -# a numeric identifier. If the value is not already -# an integer it looks it up in the $toolList array. -# If it fails it returns -1 -# -# ------------------------------------------------------------- -body iwidgets::Toolbar::_index { toolList index } { - - switch -- $index { - end - last { - set number [expr [llength $toolList] -1] - } - default { - # is it a number already? Then just use the number - if { [regexp {^[0-9]+$} $index] } { - set number $index - # check bounds - if { $number < 0 || $number >= [llength $toolList] } { - set number -1 - } - # otherwise it is a widget name - } else { - if { [catch { set itk_component($index) } ] } { - set number -1 - } else { - set number [lsearch -exact $toolList \ - $itk_component($index)] - } - } - } - } - - return $number -} - -# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -# STATUS HELP for linking to helpVariable -# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -# ------------------------------------------------------------- -# -# PUBLIC METHOD: hideHelp -# -# Bound to the <Leave> event on a toolbar widget. This clears the -# status widget help area and resets the help entry. -# -# ------------------------------------------------------------- -body iwidgets::Toolbar::hideHelp {} { - if { $itk_option(-helpvariable) != {} } { - upvar #0 $itk_option(-helpvariable) helpvar - set helpvar {} - } - set _currHelpWidget {} -} - -# ------------------------------------------------------------- -# -# PUBLIC METHOD: showHelp -# -# Bound to the <Motion> event on a tool bar widget. This puts the -# help string associated with the tool bar widget into the -# status widget help area. If no help exists for the current -# entry, the status widget is cleared. -# -# ------------------------------------------------------------- -body iwidgets::Toolbar::showHelp { window } { - - set widgetPath $window - # already on this item? - if { $window == $_currHelpWidget } { - return - } - - set _currHelpWidget $window - - # Do we have a helpvariable set on the toolbar? - if { $itk_option(-helpvariable) != {} } { - upvar #0 $itk_option(-helpvariable) helpvar - - # is the -helpstr set for this widget? - set args "-helpstr" - if {[_getAttachedOption _opts \ - $window args value]} { - set helpvar $value. - } else { - set helpvar {} - } - } -} - -# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -# BALLOON HELP for show/hide of hint window -# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -# ------------------------------------------------------------- -# -# PUBLIC METHOD: showBalloon -# -# ------------------------------------------------------------- -body iwidgets::Toolbar::showBalloon {window} { - set _balloonClick false - set _balloonAfterID 0 - # Are we still inside the window? - set mouseWindow \ - [winfo containing [winfo pointerx .] [winfo pointery .]] - - if { [string match $window* $mouseWindow] } { - # set up the balloonString - set args "-balloonstr" - if {[_getAttachedOption _opts \ - $window args hintStr]} { - # configure the balloon help - $_hintWindow.label configure -text $hintStr - - # Coordinates of the balloon - set balloonLeft \ - [expr [winfo rootx $window] + round(([winfo width $window]/2.0))] - set balloonTop \ - [expr [winfo rooty $window] + [winfo height $window]] - - # put up balloon window - wm overrideredirect $_hintWindow 0 - wm geometry $_hintWindow "+$balloonLeft+$balloonTop" - wm overrideredirect $_hintWindow 1 - wm deiconify $_hintWindow - raise $_hintWindow - } else { - #NO BALLOON HELP AVAILABLE - } - } else { - #NOT IN BUTTON - } - -} - -# ------------------------------------------------------------- -# -# PUBLIC METHOD: hideBalloon -# -# ------------------------------------------------------------- -body iwidgets::Toolbar::hideBalloon {} { - wm withdraw $_hintWindow -} - -# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -# OPTION MANAGEMENT for -helpstr, -balloonstr -# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -# ------------------------------------------------------------- -# PRIVATE METHOD: _getAttachedOption -# -# optionListName : the name of the array that holds all attached -# options. It is indexed via widget,option to get -# the value. -# widget : the widget that the option is associated with -# option : the option whose value we are looking for on -# this widget. -# -# expects to be called only if the $option is length 1 -# ------------------------------------------------------------- -body iwidgets::Toolbar::_getAttachedOption { optionListName widget args retValue} { - - # get a reference to the option, so we can change it. - upvar $args argsRef - upvar $retValue retValueRef - - set success false - - if { ![catch { set retValueRef \ - [eval set [subst [set optionListName]]($widget,$argsRef)]}]} { - - # remove the option argument - set success true - set argsRef "" - } - - return $success -} - -# ------------------------------------------------------------- -# PRIVATE METHOD: _setAttachedOption -# -# This method allows us to attach new options to a widget. It -# catches the 'option' to be attached, strips it out of 'args' -# attaches it to the 'widget' by stuffing the value into -# 'optionList(widget,option)' -# -# optionListName: where to store the option and widget association -# widget: is the widget we want to associate the attached option -# option: is the attached option (unknown to this widget) -# args: the arg list to search and remove the option from (if found) -# -# Modifies the args parameter. -# Returns boolean indicating the success of the method -# -# ------------------------------------------------------------- -body iwidgets::Toolbar::_setAttachedOption {optionListName widget option args} { - - upvar args argsRef - - set success false - - # check for 'option' in the 'args' list for the 'widget' - set optPos [eval lsearch $args $option] - - # ... found it - if { $optPos != -1 } { - # grab a copy of the option from arg list - set [subst [set optionListName]]($widget,$option) \ - [eval lindex $args [expr $optPos + 1]] - - # remove the option argument and value from the arg list - set argsRef [eval lreplace $args $optPos [expr $optPos + 1]] - set success true - } - # ... if not found, will leave args alone - - return $success -} - -# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -# GEOMETRY MANAGEMENT for tool widgets -# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -# ------------------------------------------------------------- -# -# PRIVATE METHOD: _packToolbar -# -# -# -# ------------------------------------------------------------- -body iwidgets::Toolbar::_packToolbar {} { - - # forget the previous locations - foreach tool $_toolList { - pack forget $tool - } - - # pack in order of _toolList. - foreach tool $_toolList { - # adjust for radios and checks to match buttons - if { [winfo class $tool] == "Radiobutton" || - [winfo class $tool] == "Checkbutton" } { - set iPad 1 - } else { - set iPad 0 - } - - # pack by horizontal or vertical orientation - if {$itk_option(-orient) == "horizontal" } { - pack $tool -side left -fill y \ - -ipadx $iPad -ipady $iPad - } else { - pack $tool -side top -fill x \ - -ipadx $iPad -ipady $iPad - } - } -} diff --git a/itcl/iwidgets3.0.0/generic/unknownimage.gif b/itcl/iwidgets3.0.0/generic/unknownimage.gif Binary files differdeleted file mode 100644 index d000bf70258..00000000000 --- a/itcl/iwidgets3.0.0/generic/unknownimage.gif +++ /dev/null diff --git a/itcl/iwidgets3.0.0/generic/watch.itk b/itcl/iwidgets3.0.0/generic/watch.itk deleted file mode 100755 index bfe662ea2b9..00000000000 --- a/itcl/iwidgets3.0.0/generic/watch.itk +++ /dev/null @@ -1,626 +0,0 @@ -# -# Watch -# ---------------------------------------------------------------------- -# Implements a a clock widget in a canvas. -# -# ---------------------------------------------------------------------- -# AUTHOR: John A. Tucker EMAIL: jatucker@spd.dsccc.com -# -# ====================================================================== -# Copyright (c) 1997 DSC Technologies Corporation -# ====================================================================== -# Permission to use, copy, modify, distribute and license this software -# and its documentation for any purpose, and without fee or written -# agreement with DSC, is hereby granted, provided that the above copyright -# notice appears in all copies and that both the copyright notice and -# warranty disclaimer below appear in supporting documentation, and that -# the names of DSC Technologies Corporation or DSC Communications -# Corporation not be used in advertising or publicity pertaining to the -# software without specific, written prior permission. -# -# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING -# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- -# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE -# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, -# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL -# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR -# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, -# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, -# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS -# SOFTWARE. -# ====================================================================== - -# -# Default resources. -# -option add *Watch.labelFont \ - -*-Courier-Medium-R-Normal--*-120-*-*-*-*-*-* widgetDefault - -# -# Usual options. -# -itk::usual Watch { - keep -background -cursor -labelfont -foreground -} - -class iwidgets::Watch { - - inherit itk::Widget - - itk_option define -hourradius hourRadius Radius .50 - itk_option define -hourcolor hourColor Color red - - itk_option define -minuteradius minuteRadius Radius .80 - itk_option define -minutecolor minuteColor Color yellow - - itk_option define -pivotradius pivotRadius Radius .10 - itk_option define -pivotcolor pivotColor Color white - - itk_option define -secondradius secondRadius Radius .90 - itk_option define -secondcolor secondColor Color black - - itk_option define -clockcolor clockColor Color white - itk_option define -clockstipple clockStipple ClockStipple {} - - itk_option define -state state State normal - itk_option define -showampm showAmPm ShowAmPm true - - itk_option define -tickcolor tickColor Color black - - constructor {args} {} - destructor {} - - # - # Public methods - # - public { - method get {{format "-string"}} - method show {{time "now"}} - method watch {args} - } - - # - # Private methods - # - private { - method _handMotionCB {tag x y} - method _drawHand {tag} - method _handReleaseCB {tag x y} - method _displayClock {{when "later"}} - - variable _interior - variable _radius - variable _theta - variable _extent - variable _reposition "" ;# non-null => _displayClock pending - variable _timeVar - variable _x0 1 - variable _y0 1 - - common _ampmVar - common PI [expr 2*asin(1.0)] - } -} - -# -# Provide a lowercased access method for the Watch class. -# -proc ::iwidgets::watch {pathName args} { - uplevel ::iwidgets::Watch $pathName $args -} - -# -# Use option database to override default resources of base classes. -# -option add *Watch.width 155 widgetDefault -option add *Watch.height 175 widgetDefault - -# ----------------------------------------------------------------------------- -# CONSTRUCTOR -# ----------------------------------------------------------------------------- -body iwidgets::Watch::constructor { args } { - # - # Add back to the hull width and height options and make the - # borderwidth zero since we don't need it. - # - set _interior $itk_interior - - itk_option add hull.width hull.height - component hull configure -borderwidth 0 - grid propagate $itk_component(hull) no - - set _ampmVar($this) "AM" - set _radius(outer) 1 - - set _radius(hour) 1 - set _radius(minute) 1 - set _radius(second) 1 - - set _theta(hour) 30 - set _theta(minute) 6 - set _theta(second) 6 - - set _extent(hour) 14 - set _extent(minute) 14 - set _extent(second) 2 - - set _timeVar(hour) 12 - set _timeVar(minute) 0 - set _timeVar(second) 0 - - # - # Create the frame in which the "AM" and "PM" radiobuttons will be drawn - # - itk_component add frame { - frame $itk_interior.frame - } - - # - # Create the canvas in which the clock will be drawn - # - itk_component add canvas { - canvas $itk_interior.canvas - } - bind $itk_component(canvas) <Map> +[code $this _displayClock] - bind $itk_component(canvas) <Configure> +[code $this _displayClock] - - # - # Create the "AM" and "PM" radiobuttons to be drawn in the canvas - # - itk_component add am { - radiobutton $itk_component(frame).am \ - -text "AM" \ - -value "AM" \ - -variable [scope _ampmVar($this)] - } { - usual - rename -font -labelfont labelFont Font - } - - itk_component add pm { - radiobutton $itk_component(frame).pm \ - -text "PM" \ - -value "PM" \ - -variable [scope _ampmVar($this)] - } { - usual - rename -font -labelfont labelFont Font - } - - # - # Create the canvas item for displaying the main oval which encapsulates - # the entire clock. - # - watch create oval 0 0 2 2 -width 5 -tags clock - - # - # Create the canvas items for displaying the 60 ticks marks around the - # inner perimeter of the watch. - # - set extent 3 - for {set i 0} {$i < 60} {incr i} { - set start [expr $i*6-1] - set tag [expr {[expr $i%5] == 0 ? "big" : "little"}] - watch create arc 0 0 0 0 \ - -style arc \ - -extent $extent \ - -start $start \ - -tags "tick$i tick $tag" - } - - # - # Create the canvas items for displaying the hour, minute, and second hands - # of the watch. Add bindings to allow the mouse to move and set the - # clock hands. - # - watch create arc 1 1 1 1 -extent 30 -tags minute - watch create arc 1 1 1 1 -extent 30 -tags hour - watch create arc 1 1 1 1 -tags second - - # - # Create the canvas item for displaying the center of the watch in which - # the hour, minute, and second hands will pivot. - # - watch create oval 0 0 1 1 -width 5 -fill black -tags pivot - - # - # Position the "AM/PM" button frame and watch canvas. - # - grid $itk_component(frame) -row 0 -column 0 -sticky new - grid $itk_component(canvas) -row 1 -column 0 -sticky nsew - - grid rowconfigure $itk_interior 0 -weight 0 - grid rowconfigure $itk_interior 1 -weight 1 - grid columnconfigure $itk_interior 0 -weight 1 - - eval itk_initialize $args -} - -# ----------------------------------------------------------------------------- -# DESTURCTOR -# ----------------------------------------------------------------------------- -body iwidgets::Watch::destructor {} { - if {$_reposition != ""} { - after cancel $_reposition - } -} - -# ----------------------------------------------------------------------------- -# METHODS -# ----------------------------------------------------------------------------- - -# ----------------------------------------------------------------------------- -# METHOD: _handReleaseCB tag x y -# -# ----------------------------------------------------------------------------- -body iwidgets::Watch::_handReleaseCB {tag x y} { - - set atanab [expr atan2(double($y-$_y0),double($x-$_x0))*(180/$PI)] - set degrees [expr {$atanab > 0 ? [expr 360-$atanab] : abs($atanab)}] - set ticks [expr round($degrees/$_theta($tag))] - set _timeVar($tag) [expr ((450-$ticks*$_theta($tag))%360)/$_theta($tag)] - - if {$tag == "hour" && $_timeVar(hour) == 0} { - set _timeVar($tag) 12 - } - - _drawHand $tag -} - -# ----------------------------------------------------------------------------- -# PROTECTED METHOD: _handMotionCB tag x y -# -# ----------------------------------------------------------------------------- -body iwidgets::Watch::_handMotionCB {tag x y} { - if {$x == $_x0 || $y == $_y0} { - return - } - - set a [expr $y-$_y0] - set b [expr $x-$_x0] - set c [expr hypot($a,$b)] - - set atanab [expr atan2(double($a),double($b))*(180/$PI)] - set degrees [expr {$atanab > 0 ? [expr 360-$atanab] : abs($atanab)}] - - set x2 [expr $_x0+$_radius($tag)*($b/double($c))] - set y2 [expr $_y0+$_radius($tag)*($a/double($c))] - watch coords $tag \ - [expr $x2-$_radius($tag)] \ - [expr $y2-$_radius($tag)] \ - [expr $x2+$_radius($tag)] \ - [expr $y2+$_radius($tag)] - set start [expr $degrees-180-($_extent($tag)/2)] - watch itemconfigure $tag -start $start -extent $_extent($tag) -} - -# ----------------------------------------------------------------------------- -# PROTECTED METHOD: get ?format? -# -# ----------------------------------------------------------------------------- -body iwidgets::Watch::get {{format "-string"}} { - set timestr [format "%02d:%02d:%02d %s" \ - $_timeVar(hour) $_timeVar(minute) \ - $_timeVar(second) $_ampmVar($this)] - - switch -- $format { - "-string" { - return $timestr - } - "-clicks" { - return [clock scan $timestr] - } - default { - error "bad format option \"$format\":\ - should be -string or -clicks" - } - } -} - -# ----------------------------------------------------------------------------- -# METHOD: watch ?args? -# -# Evaluates the specified args against the canvas component. -# ----------------------------------------------------------------------------- -body iwidgets::Watch::watch {args} { - return [eval $itk_component(canvas) $args] -} - -# ----------------------------------------------------------------------------- -# METHOD: _drawHand tag -# -# ----------------------------------------------------------------------------- -body iwidgets::Watch::_drawHand {tag} { - - set degrees [expr abs(450-($_timeVar($tag)*$_theta($tag)))%360] - set radians [expr $degrees*($PI/180)] - set x [expr $_x0+$_radius($tag)*cos($radians)] - set y [expr $_y0+$_radius($tag)*sin($radians)*(-1)] - watch coords $tag \ - [expr $x-$_radius($tag)] \ - [expr $y-$_radius($tag)] \ - [expr $x+$_radius($tag)] \ - [expr $y+$_radius($tag)] - set start [expr $degrees-180-($_extent($tag)/2)] - watch itemconfigure $tag -start $start -} - -# ------------------------------------------------------------------ -# PUBLIC METHOD: show time -# -# Changes the currently displayed time to be that of the time -# argument. The time may be specified either as a string or an -# integer clock value. Reference the clock command for more -# information on obtaining times and their formats. -# ------------------------------------------------------------------ -body iwidgets::Watch::show {{time "now"}} { - if {$time == "now"} { - set seconds [clock seconds] - } elseif {![catch {clock format $time}]} { - set seconds $time - } elseif {[catch {set seconds [clock scan $time]}]} { - error "bad time: \"$time\", must be a valid time\ - string, clock clicks value or the keyword now" - } - - set timestring [clock format $seconds -format "%I %M %S %p"] - set _timeVar(hour) [expr int(1[lindex $timestring 0] - 100)] - set _timeVar(minute) [expr int(1[lindex $timestring 1] - 100)] - set _timeVar(second) [expr int(1[lindex $timestring 2] - 100)] - set _ampmVar($this) [lindex $timestring 3] - - _drawHand hour - _drawHand minute - _drawHand second -} - -# ----------------------------------------------------------------------------- -# PROTECTED METHOD: _displayClock ?when? -# -# Places the hour, minute, and second dials in the canvas. If "when" is "now", -# the change is applied immediately. If it is "later" or it is not specified, -# then the change is applied later, when the application is idle. -# ----------------------------------------------------------------------------- -body iwidgets::Watch::_displayClock {{when "later"}} { - - if {$when == "later"} { - if {$_reposition == ""} { - set _reposition [after idle [code $this _displayClock now]] - } - return - } - - # - # Compute the center coordinates for the clock based on the - # with and height of the canvas. - # - set width [winfo width $itk_component(canvas)] - set height [winfo height $itk_component(canvas)] - set _x0 [expr $width/2] - set _y0 [expr $height/2] - - # - # Set the radius of the watch, pivot, hour, minute and second items. - # - set _radius(outer) [expr {$_x0 < $_y0 ? $_x0 : $_y0}] - set _radius(pivot) [expr $itk_option(-pivotradius)*$_radius(outer)] - set _radius(hour) [expr $itk_option(-hourradius)*$_radius(outer)] - set _radius(minute) [expr $itk_option(-minuteradius)*$_radius(outer)] - set _radius(second) [expr $itk_option(-secondradius)*$_radius(outer)] - set outerWidth [watch itemcget clock -width] - - # - # Set the coordinates of the clock item - # - set x1Outer $outerWidth - set y1Outer $outerWidth - set x2Outer [expr $width-$outerWidth] - set y2Outer [expr $height-$outerWidth] - watch coords clock $x1Outer $y1Outer $x2Outer $y2Outer - - # - # Set the coordinates of the tick items - # - set offset [expr $outerWidth*2] - set x1Tick [expr $x1Outer+$offset] - set y1Tick [expr $y1Outer+$offset] - set x2Tick [expr $x2Outer-$offset] - set y2Tick [expr $y2Outer-$offset] - for {set i 0} {$i < 60} {incr i} { - watch coords tick$i $x1Tick $y1Tick $x2Tick $y2Tick - } - set maxTickWidth [expr $_radius(outer)-$_radius(second)+1] - set minTickWidth [expr round($maxTickWidth/2)] - watch itemconfigure big -width $maxTickWidth - watch itemconfigure little -width [expr round($maxTickWidth/2)] - - # - # Set the coordinates of the pivot item - # - set x1Center [expr $_x0-$_radius(pivot)] - set y1Center [expr $_y0-$_radius(pivot)] - set x2Center [expr $_x0+$_radius(pivot)] - set y2Center [expr $_y0+$_radius(pivot)] - watch coords pivot $x1Center $y1Center $x2Center $y2Center - - # - # Set the coordinates of the hour, minute, and second dial items - # - watch itemconfigure hour -extent $_extent(hour) - _drawHand hour - - watch itemconfigure minute -extent $_extent(minute) - _drawHand minute - - watch itemconfigure second -extent $_extent(second) - _drawHand second - - set _reposition "" -} - -# ----------------------------------------------------------------------------- -# OPTIONS -# ----------------------------------------------------------------------------- - -# ------------------------------------------------------------------ -# OPTION: state -# -# Configure the editable state of the widget. Valid values are -# normal and disabled. In a disabled state, the hands of the -# watch are not selectabled. -# ------------------------------------------------------------------ -configbody ::iwidgets::Watch::state { - if {$itk_option(-state) == "normal"} { - watch bind minute <B1-Motion> \ - [code $this _handMotionCB minute %x %y] - watch bind minute <ButtonRelease-1> \ - [code $this _handReleaseCB minute %x %y] - - watch bind hour <B1-Motion> \ - [code $this _handMotionCB hour %x %y] - watch bind hour <ButtonRelease-1> \ - [code $this _handReleaseCB hour %x %y] - - watch bind second <B1-Motion> \ - [code $this _handMotionCB second %x %y] - watch bind second <ButtonRelease-1> \ - [code $this _handReleaseCB second %x %y] - - $itk_component(am) configure -state normal - $itk_component(pm) configure -state normal - - } elseif {$itk_option(-state) == "disabled"} { - watch bind minute <B1-Motion> {} - watch bind minute <ButtonRelease-1> {} - - watch bind hour <B1-Motion> {} - watch bind hour <ButtonRelease-1> {} - - watch bind second <B1-Motion> {} - watch bind second <ButtonRelease-1> {} - - $itk_component(am) configure -state disabled \ - -disabledforeground [$itk_component(am) cget -background] - $itk_component(pm) configure -state normal \ - -disabledforeground [$itk_component(am) cget -background] - - } else { - error "bad state option \"$itk_option(-state)\":\ - should be normal or disabled" - } -} - -# ------------------------------------------------------------------ -# OPTION: showampm -# -# Configure the display of the AM/PM radio buttons. -# ------------------------------------------------------------------ -configbody ::iwidgets::Watch::showampm { - switch -- $itk_option(-showampm) { - 0 - no - false - off { - pack forget $itk_component(am) - pack forget $itk_component(pm) - } - - 1 - yes - true - on { - pack $itk_component(am) -side left -fill both -expand 1 - pack $itk_component(pm) -side right -fill both -expand 1 - } - - default { - error "bad showampm option \"$itk_option(-showampm)\":\ - should be boolean" - } - } -} - -# ------------------------------------------------------------------ -# OPTION: pivotcolor -# -# Configure the color of the clock pivot. -# -configbody ::iwidgets::Watch::pivotcolor { - watch itemconfigure pivot -fill $itk_option(-pivotcolor) -} - -# ------------------------------------------------------------------ -# OPTION: clockstipple -# -# Configure the stipple pattern for the clock fill color. -# -configbody ::iwidgets::Watch::clockstipple { - watch itemconfigure clock -stipple $itk_option(-clockstipple) -} - -# ------------------------------------------------------------------ -# OPTION: clockcolor -# -# Configure the color of the clock. -# -configbody ::iwidgets::Watch::clockcolor { - watch itemconfigure clock -fill $itk_option(-clockcolor) -} - -# ------------------------------------------------------------------ -# OPTION: hourcolor -# -# Configure the color of the hour hand. -# -configbody ::iwidgets::Watch::hourcolor { - watch itemconfigure hour -fill $itk_option(-hourcolor) -} - -# ------------------------------------------------------------------ -# OPTION: minutecolor -# -# Configure the color of the minute hand. -# -configbody ::iwidgets::Watch::minutecolor { - watch itemconfigure minute -fill $itk_option(-minutecolor) -} - -# ------------------------------------------------------------------ -# OPTION: secondcolor -# -# Configure the color of the second hand. -# -configbody ::iwidgets::Watch::secondcolor { - watch itemconfigure second -fill $itk_option(-secondcolor) -} - -# ------------------------------------------------------------------ -# OPTION: tickcolor -# -# Configure the color of the ticks. -# -configbody ::iwidgets::Watch::tickcolor { - watch itemconfigure tick -outline $itk_option(-tickcolor) -} - -# ------------------------------------------------------------------ -# OPTION: hourradius -# -# Configure the radius of the hour hand. -# -configbody ::iwidgets::Watch::hourradius { - _displayClock -} - -# ------------------------------------------------------------------ -# OPTION: minuteradius -# -# Configure the radius of the minute hand. -# -configbody ::iwidgets::Watch::minuteradius { - _displayClock -} - -# ------------------------------------------------------------------ -# OPTION: secondradius -# -# Configure the radius of the second hand. -# -configbody ::iwidgets::Watch::secondradius { - _displayClock -} - |
