neingeist/arduinisten
Archived
1
0
Fork 0
Code Releases Activity

arduino-0018-windows

Browse source
This commit is contained in:
orange 2010-03-30 21:53:44 +02:00
parent 157fd6f1a1
commit f39fc49523
5182 changed files with 950586 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

571
arduino-0018-windows/hardware/tools/avr/share/iwidgets4.0.1/scripts/buttonbox.itk Normal file
View file

@ -0,0 +1,571 @@
#
# 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: buttonbox.itk,v 1.3 2001/08/15 18:30:53 smithc Exp $
# ----------------------------------------------------------------------
# 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
# ------------------------------------------------------------------
itcl::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> [itcl::code %W _setBoxSize]
bind bbox-config <Configure> [itcl::code %W _positionButtons]
}
#
# Provide a lowercased access method for the Buttonbox class.
#
proc ::iwidgets::buttonbox {pathName args} {
uplevel ::iwidgets::Buttonbox $pathName $args
}
# ------------------------------------------------------------------
# CONSTRUCTOR
# ------------------------------------------------------------------
itcl::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
# ------------------------------------------------------------------
itcl::body iwidgets::Buttonbox::destructor {} {
if {$_resizeFlag != ""} {after cancel $_resizeFlag}
}
# ------------------------------------------------------------------
# OPTIONS
# ------------------------------------------------------------------
# ------------------------------------------------------------------
# OPTION: -pady
#
# Pad the y space between the button box frame and the hull.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Buttonbox::pady {
_setBoxSize
}
# ------------------------------------------------------------------
# OPTION: -padx
#
# Pad the x space between the button box frame and the hull.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Buttonbox::padx {
_setBoxSize
}
# ------------------------------------------------------------------
# OPTION: -orient
#
# Position buttons either horizontally or vertically.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# -----------------------------------------------------------------
itcl::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.
# -----------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::body iwidgets::Buttonbox::_setBoxSize {{when later}} {
if {[winfo ismapped $itk_component(hull)]} {
if {$when == "later"} {
if {$_resizeFlag == ""} {
set _resizeFlag [after idle [itcl::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.
# ------------------------------------------------------------------
itcl::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}]
}
}
}
}

983
arduino-0018-windows/hardware/tools/avr/share/iwidgets4.0.1/scripts/calendar.itk Normal file
View file

@ -0,0 +1,983 @@
#
# 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: calendar.itk,v 1.7 2002/09/05 19:33:06 smithc Exp $
# ----------------------------------------------------------------------
# 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
# ------------------------------------------------------------------
itcl::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
itk_option define -int int DateFormat no
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
private variable _format {}
}
#
# 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
# ------------------------------------------------------------------
itcl::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 [itcl::code $this _change -1]
} {
keep -background -cursor
}
itk_component add forward {
button $itk_component(page).forward \
-command [itcl::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> [itcl::code $this _configureHandler]
#
# Evaluate the option arguments.
#
eval itk_initialize $args
}
# ------------------------------------------------------------------
# OPTIONS
# ------------------------------------------------------------------
# ------------------------------------------------------------------
# OPTION: -int
#
# Added by Mark Alston 2001/10/21
#
# Allows for the use of dates in "international" format: YYYY-MM-DD.
# It must be a boolean value.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Calendar::int {
switch $itk_option(-int) {
1 - yes - true - on {
set itk_option(-int) yes
}
0 - no - false - off {
set itk_option(-int) no
}
default {
error "bad int option \"$itk_option(-int)\": should be boolean"
}
}
}
# ------------------------------------------------------------------
# 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.
# ------------------------------------------------------------------
itcl::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}.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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"
}
}
switch $itk_option(-int) {
yes { set _format "%Y-%m-%d" }
no { set _format "%m/%d/%Y" }
}
_select [clock format $time -format "$_format"]
}
# ------------------------------------------------------------------
# PUBLIC METHOD: show date_
#
# Changes the currently display month to be that of the specified
# date.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::body iwidgets::Calendar::_redraw {} {
#
# Set the format based on the option -int
#
switch $itk_option(-int) {
yes { set _format "%Y-%m-%d" }
no { set _format "%m/%d/%Y" }
}
#
# 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 "$_format"]
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> \
[itcl::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 "$_format"]
_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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::body iwidgets::Calendar::_layout {time_} {
switch $itk_option(-int) {
yes { set _format "%Y-%m-%d" }
no { set _format "%m/%d/%Y" }
}
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 "$_format"]
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.
# ------------------------------------------------------------------
itcl::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".
# ------------------------------------------------------------------
itcl::body iwidgets::Calendar::_select {date_} {
switch $itk_option(-int) {
yes { set _format "%Y-%m-%d" }
no { set _format "%m/%d/%Y" }
}
set time [clock scan $date_]
set date [clock format $time -format "$_format"]
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".
# ------------------------------------------------------------------
itcl::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_>.
# ------------------------------------------------------------------
itcl::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"
}

1111
arduino-0018-windows/hardware/tools/avr/share/iwidgets4.0.1/scripts/canvasprintbox.itk Normal file
View file

File diff suppressed because it is too large Load diff

155
arduino-0018-windows/hardware/tools/avr/share/iwidgets4.0.1/scripts/canvasprintdialog.itk Normal file
View file

@ -0,0 +1,155 @@
#
# 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
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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 [itcl::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.
# ------------------------------------------------------------------
itcl::body iwidgets::Canvasprintdialog::deactivate {args} {
$itk_component(cpb) stop
return [eval Shell::deactivate $args]
}
# ------------------------------------------------------------------
# METHOD: getoutput
#
# Thinwrapped method of canvas print box class.
# ------------------------------------------------------------------
itcl::body iwidgets::Canvasprintdialog::getoutput {} {
return [$itk_component(cpb) getoutput]
}
# ------------------------------------------------------------------
# METHOD: setcanvas
#
# Thinwrapped method of canvas print box class.
# ------------------------------------------------------------------
itcl::body iwidgets::Canvasprintdialog::setcanvas {canv} {
return [$itk_component(cpb) setcanvas $canv]
}
# ------------------------------------------------------------------
# METHOD: refresh
#
# Thinwrapped method of canvas print box class.
# ------------------------------------------------------------------
itcl::body iwidgets::Canvasprintdialog::refresh {} {
return [$itk_component(cpb) refresh]
}
# ------------------------------------------------------------------
# METHOD: print
#
# Thinwrapped method of canvas print box class.
# ------------------------------------------------------------------
itcl::body iwidgets::Canvasprintdialog::print {} {
return [$itk_component(cpb) print]
}

341
arduino-0018-windows/hardware/tools/avr/share/iwidgets4.0.1/scripts/checkbox.itk Normal file
View file

@ -0,0 +1,341 @@
#
# 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
# ------------------------------------------------------------------
itcl::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
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::body iwidgets::Checkbox::add {tag args} {
itk_component add $tag {
eval checkbutton $itk_component(childsite).cb[incr _unique] \
-variable [list [itcl::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.
# ------------------------------------------------------------------
itcl::body iwidgets::Checkbox::insert {index tag args} {
itk_component add $tag {
eval checkbutton $itk_component(childsite).cb[incr _unique] \
-variable [list [itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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 [itcl::scope buttonVar($this,$tag)]] ==
[[component $tag] cget -onvalue]} {
return
}
$itk_component($tag) invoke
}
# ------------------------------------------------------------------
# METHOD: toggle index
#
# Toggle a specified checkbutton between selected and unselected
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::body iwidgets::Checkbox::deselect {index} {
set tag [gettag $index]
$itk_component($tag) deselect
}
# ------------------------------------------------------------------
# METHOD: flash index
#
# Flash the specified checkbutton.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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
# ------------------------------------------------------------------
itcl::body iwidgets::Checkbox::gettag {index} {
return [lindex $_buttons [index $index]]
}

209
arduino-0018-windows/hardware/tools/avr/share/iwidgets4.0.1/scripts/colors.itcl Normal file
View file

@ -0,0 +1,209 @@
#
# 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: colors.itcl,v 1.2 2001/08/15 18:33:55 smithc Exp $
# ----------------------------------------------------------------------
# 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
}
}

1443
arduino-0018-windows/hardware/tools/avr/share/iwidgets4.0.1/scripts/combobox.itk Normal file
View file

File diff suppressed because it is too large Load diff

424
arduino-0018-windows/hardware/tools/avr/share/iwidgets4.0.1/scripts/dateentry.itk Normal file
View file

@ -0,0 +1,424 @@
#
# 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: dateentry.itk,v 1.6 2002/09/05 19:33:58 smithc Exp $
# ----------------------------------------------------------------------
# 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.
# ======================================================================
#
# ----------------------------------------------------------------------
#
# Modified 2001-10-23 by Mark Alston to pass options to the datefield
# constructor. Needed to allow use of new option -int which lets the
# user use dates in YYYY-MM-DD format as well as MM/DD/YYYY format.
#
# option -int yes sets dates to YYYY-MM-DD format
# -int no sets dates to MM/DD/YYYY format.
#
# ----------------------------------------------------------------------
#
# Usual options.
#
itk::usual Dateentry {
keep -background -borderwidth -currentdatefont -cursor \
-datefont -dayfont -foreground -highlightcolor \
-highlightthickness -labelfont -textbackground -textfont \
-titlefont -int
}
# ------------------------------------------------------------------
# DATEENTRY
# ------------------------------------------------------------------
itcl::class iwidgets::Dateentry {
inherit iwidgets::Datefield
constructor {args} {
eval 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
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Dateentry::state {
switch -- $itk_option(-state) {
normal {
bind $itk_component(iconbutton) <Button-1> [itcl::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.
# ------------------------------------------------------------------
itcl::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.
#
itcl::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.
# ------------------------------------------------------------------
itcl::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> [itcl::code $this _releaseGrabCheck %X %Y]
bind $itk_component(popup) <KeyPress-Escape> [itcl::code $this _releaseGrab]
#
# Create the calendar widget and set its cursor properly.
#
itk_component add calendar {
iwidgets::Calendar $itk_component(popup).calendar \
-command [itcl::code $this _getPopupDate %d] \
-int $itk_option(-int)
} {
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 {(($popupx + $popupwidth) > [winfo screenwidth .]) || \
(($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.
#
# Added catch for bad dates. Calendar then shows current date.
if [catch "$itk_component(calendar) show [get]" err] {
$itk_component(calendar) show now
$itk_component(calendar) select now
} else {
$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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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 > ($calx + $calwidth)) || \
($rooty < $caly) || ($rooty > ($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.
# ------------------------------------------------------------------
itcl::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> [itcl::code $this _popup]
}

1021
arduino-0018-windows/hardware/tools/avr/share/iwidgets4.0.1/scripts/datefield.itk Normal file
View file

File diff suppressed because it is too large Load diff

92
arduino-0018-windows/hardware/tools/avr/share/iwidgets4.0.1/scripts/dialog.itk Normal file
View file

@ -0,0 +1,92 @@
#
# 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: dialog.itk,v 1.2 2001/08/07 19:56:47 smithc Exp $
# ----------------------------------------------------------------------
# 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
# ------------------------------------------------------------------
itcl::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
# ------------------------------------------------------------------
itcl::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 [itcl::code $this deactivate 1]
add Apply -text Apply
add Cancel -text Cancel -command [itcl::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 \
[itcl::code $this invoke Cancel]
#
# Initialize the widget based on the command line options.
#
eval itk_initialize $args
}

350
arduino-0018-windows/hardware/tools/avr/share/iwidgets4.0.1/scripts/dialogshell.itk Normal file
View file

@ -0,0 +1,350 @@
# 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: dialogshell.itk,v 1.3 2001/08/15 18:32:02 smithc Exp $
# ----------------------------------------------------------------------
# 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
# ------------------------------------------------------------------
itcl::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
# ------------------------------------------------------------------
itcl::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> [itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Dialogshell::pady {
grid configure $itk_component(dschildsite) -pady $itk_option(-pady)
}
# ------------------------------------------------------------------
# METHODS
# ------------------------------------------------------------------
# ------------------------------------------------------------------
# METHOD: childsite
#
# Return the pathname of the user accessible area.
# ------------------------------------------------------------------
itcl::body iwidgets::Dialogshell::childsite {} {
return $itk_component(dschildsite)
}
# ------------------------------------------------------------------
# METHOD: index index
#
# Thin wrapper of Buttonbox's index method.
# ------------------------------------------------------------------
itcl::body iwidgets::Dialogshell::index {args} {
uplevel $itk_component(bbox) index $args
}
# ------------------------------------------------------------------
# METHOD: add tag ?option value ...?
#
# Thin wrapper of Buttonbox's add method.
# ------------------------------------------------------------------
itcl::body iwidgets::Dialogshell::add {args} {
uplevel $itk_component(bbox) add $args
}
# ------------------------------------------------------------------
# METHOD: insert index tag ?option value ...?
#
# Thin wrapper of Buttonbox's insert method.
# ------------------------------------------------------------------
itcl::body iwidgets::Dialogshell::insert {args} {
uplevel $itk_component(bbox) insert $args
}
# ------------------------------------------------------------------
# METHOD: delete tag
#
# Thin wrapper of Buttonbox's delete method.
# ------------------------------------------------------------------
itcl::body iwidgets::Dialogshell::delete {args} {
uplevel $itk_component(bbox) delete $args
}
# ------------------------------------------------------------------
# METHOD: hide index
#
# Thin wrapper of Buttonbox's hide method.
# ------------------------------------------------------------------
itcl::body iwidgets::Dialogshell::hide {args} {
uplevel $itk_component(bbox) hide $args
}
# ------------------------------------------------------------------
# METHOD: show index
#
# Thin wrapper of Buttonbox's show method.
# ------------------------------------------------------------------
itcl::body iwidgets::Dialogshell::show {args} {
uplevel $itk_component(bbox) show $args
}
# ------------------------------------------------------------------
# METHOD: default index
#
# Thin wrapper of Buttonbox's default method.
# ------------------------------------------------------------------
itcl::body iwidgets::Dialogshell::default {args} {
uplevel $itk_component(bbox) default $args
}
# ------------------------------------------------------------------
# METHOD: invoke ?index?
#
# Thin wrapper of Buttonbox's invoke method.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::body iwidgets::Dialogshell::buttonconfigure {args} {
uplevel $itk_component(bbox) buttonconfigure $args
}
# ------------------------------------------------------------------
# METHOD: buttoncget index option
#
# Thin wrapper of Buttonbox's buttoncget method.
# ------------------------------------------------------------------
itcl::body iwidgets::Dialogshell::buttoncget {index option} {
uplevel $itk_component(bbox) buttoncget [list $index] \
[list $option]
}

529
arduino-0018-windows/hardware/tools/avr/share/iwidgets4.0.1/scripts/disjointlistbox.itk Normal file
View file

@ -0,0 +1,529 @@
#
# ::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
option add *Disjointlistbox.lhsSortOption increasing widgetDefault
option add *Disjointlistbox.rhsSortOption increasing widgetDefault
#
# Usual options.
#
itk::usual Disjointlistbox {
keep -background -textbackground -cursor \
-foreground -textfont -labelfont
}
# ----------------------------------------------------------------------
# ::iwidgets::Disjointlistbox
# ----------------------------------------------------------------------
itcl::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}
itk_option define -lhssortoption lhsSortOption LhsSortOption increasing
itk_option define -rhssortoption rhsSortOption RhsSortOption increasing
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:
#
itcl::body ::iwidgets::Disjointlistbox::constructor {args} {
#
# Create the left-most Listbox
#
itk_component add lhs {
iwidgets::Scrolledlistbox $itk_interior.lhs \
-selectioncommand [itcl::code $this listboxClick lhs rhs] \
-dblclickcommand [itcl::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 [itcl::code $this listboxClick rhs lhs] \
-dblclickcommand [itcl::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> [itcl::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.
#
itcl::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 $clickSide
set destinationListbox $otherSide
}
# ------------------------------------------------------------------
# Method: listboxDblClick
#
# Purpose: Evaluate a double click in the specified Listbox.
#
itcl::body ::iwidgets::Disjointlistbox::listboxDblClick {clickSide otherSide} {
listboxClick $clickSide $otherSide
transfer
}
# ------------------------------------------------------------------
# Method: transfer
#
# Purpose: Transfer source Listbox items to destination Listbox
#
itcl::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
}
if {![string equal $itk_option(-${destinationListbox}sortoption) "none"]} {
$destinationListbox sort $itk_option(-${destinationListbox}sortoption)
}
showCount
}
# ------------------------------------------------------------------
# Method: getlhs
#
# Purpose: Retrieve the items of the left Listbox widget
#
itcl::body ::iwidgets::Disjointlistbox::getlhs {{first 0} {last end}} {
return [lhs get $first $last]
}
# ------------------------------------------------------------------
# Method: getrhs
#
# Purpose: Retrieve the items of the right Listbox widget
#
itcl::body ::iwidgets::Disjointlistbox::getrhs {{first 0} {last end}} {
return [rhs get $first $last]
}
# ------------------------------------------------------------------
# Method: insertrhs
#
# Purpose: Insert items into the right Listbox widget
#
itcl::body ::iwidgets::Disjointlistbox::insertrhs {items} {
remove $itk_component(lhs) $items
insert rhs $items
}
# ------------------------------------------------------------------
# Method: insertlhs
#
# Purpose: Insert items into the left Listbox widget
#
itcl::body ::iwidgets::Disjointlistbox::insertlhs {items} {
remove $itk_component(rhs) $items
insert lhs $items
}
# ------------------------------------------------------------------
# Method: clear
#
# Purpose: Remove the items from the Listbox widgets and set the item count
# Labels text to 0
#
itcl::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.
#
itcl::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
}
}
if {![string equal $itk_option(-${theListbox}sortoption) "none"]} {
$theListbox sort $itk_option(-${theListbox}sortoption)
}
showCount
}
# ------------------------------------------------------------------
# Method: remove
#
# Purpose: Remove the input items from the input Listbox widget while
# maintaining the disjoint property between them.
#
itcl::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.
#
itcl::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
#
itcl::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
#
itcl::body ::iwidgets::Disjointlistbox::setrhs {items} {
rhs clear
insertrhs $items
}
# ------------------------------------------------------------------
# Method: lhs
#
# Purpose: Evaluates the specified arguments against the lhs Listbox
#
itcl::body ::iwidgets::Disjointlistbox::lhs {args} {
return [eval $itk_component(lhs) $args]
}
# ------------------------------------------------------------------
# Method: rhs
#
# Purpose: Evaluates the specified arguments against the rhs Listbox
#
itcl::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.
#
itcl::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 [itcl::code \
$this transfer]
} {
usual
rename -text -lhsbuttonlabel lhsButtonLabel LabelText
rename -font -labelfont labelFont Font
}
itk_component add rhsbutton {
button $itk_component(bbox).rhsbutton -command [itcl::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 [itcl::code $this \
transfer]
} {
usual
rename -text -lhsbuttonlabel lhsButtonLabel LabelText
rename -font -labelfont labelFont Font
}
itk_component add rhsbutton {
button $itk_interior.rhsbutton -command [itcl::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"
}
}
}
}
# ------------------------------------------------------------------
# OPTION: lhssortoption
#
# Configure the sort option to use for the left side
#
itcl::configbody ::iwidgets::Disjointlistbox::lhssortoption {
if {![string equal $itk_option(-lhssortoption) "none"]} {
$itk_component(lhs) sort $itk_option(-lhssortoption)
}
}
# ------------------------------------------------------------------
# OPTION: rhssortoption
#
# Configure the sort option to use for the right side
#
itcl::configbody ::iwidgets::Disjointlistbox::rhssortoption {
if {![string equal $itk_option(-rhssortoption) "none"]} {
$itk_component(rhs) sort $itk_option(-rhssortoption)
}
}

603
arduino-0018-windows/hardware/tools/avr/share/iwidgets4.0.1/scripts/entryfield.itk Normal file
View file

@ -0,0 +1,603 @@
#
# 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: entryfield.itk,v 1.6 2001/09/17 19:24:46 smithc Exp $
# ----------------------------------------------------------------------
# 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
# ------------------------------------------------------------------
itcl::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}
private method _checkLength {}
}
#
# Provide a lowercased access method for the Entryfield class.
#
proc ::iwidgets::entryfield {pathName args} {
uplevel ::iwidgets::Entryfield $pathName $args
}
# ------------------------------------------------------------------
# CONSTRUCTOR
# ------------------------------------------------------------------
itcl::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> [itcl::code $this _keyPress %A %K %s]
bind $itk_component(entry) <FocusIn> [itcl::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
# ------------------------------------------------------------------
itcl::configbody iwidgets::Entryfield::command {}
# ------------------------------------------------------------------
# OPTION: -focuscommand
#
# Command associated upon detection of focus.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Entryfield::focuscommand {}
# ------------------------------------------------------------------
# OPTION: -validate
#
# Specify a command to executed for the validation of Entryfields.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Entryfield::pasting {
set oldtags [bindtags $itk_component(entry)]
if {[lindex $oldtags 0] != "pastetag"} {
bindtags $itk_component(entry) [linsert $oldtags 0 pastetag]
}
if ($itk_option(-pasting)) {
bind pastetag <ButtonRelease-2> [itcl::code $this _checkLength]
bind pastetag <Control-v> [itcl::code $this _checkLength]
bind pastetag <Insert> [itcl::code $this _checkLength]
bind pastetag <KeyPress> {}
} else {
bind pastetag <ButtonRelease-2> {break}
bind pastetag <Control-v> {break}
bind pastetag <Insert> {break}
bind pastetag <KeyPress> {
# Disable function keys > F9.
if {[regexp {^F[1,2][0-9]+$} "%K"]} {
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).
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::body iwidgets::Entryfield::childsite {} {
return $itk_component(efchildsite)
}
# ------------------------------------------------------------------
# METHOD: get
#
# Thin wrap of the standard entry widget get method.
# ------------------------------------------------------------------
itcl::body iwidgets::Entryfield::get {} {
return [$itk_component(entry) get]
}
# ------------------------------------------------------------------
# METHOD: delete
#
# Thin wrap of the standard entry widget delete method.
# ------------------------------------------------------------------
itcl::body iwidgets::Entryfield::delete {args} {
return [eval $itk_component(entry) delete $args]
}
# ------------------------------------------------------------------
# METHOD: icursor
#
# Thin wrap of the standard entry widget icursor method.
# ------------------------------------------------------------------
itcl::body iwidgets::Entryfield::icursor {args} {
return [eval $itk_component(entry) icursor $args]
}
# ------------------------------------------------------------------
# METHOD: index
#
# Thin wrap of the standard entry widget index method.
# ------------------------------------------------------------------
itcl::body iwidgets::Entryfield::index {args} {
return [eval $itk_component(entry) index $args]
}
# ------------------------------------------------------------------
# METHOD: insert
#
# Thin wrap of the standard entry widget index method.
# ------------------------------------------------------------------
itcl::body iwidgets::Entryfield::insert {args} {
return [eval $itk_component(entry) insert $args]
}
# ------------------------------------------------------------------
# METHOD: scan
#
# Thin wrap of the standard entry widget scan method.
# ------------------------------------------------------------------
itcl::body iwidgets::Entryfield::scan {args} {
return [eval $itk_component(entry) scan $args]
}
# ------------------------------------------------------------------
# METHOD: selection
#
# Thin wrap of the standard entry widget selection method.
# ------------------------------------------------------------------
itcl::body iwidgets::Entryfield::selection {args} {
return [eval $itk_component(entry) selection $args]
}
# ------------------------------------------------------------------
# METHOD: xview
#
# Thin wrap of the standard entry widget xview method.
# ------------------------------------------------------------------
itcl::body iwidgets::Entryfield::xview {args} {
return [eval $itk_component(entry) xview $args]
}
# ------------------------------------------------------------------
# METHOD: clear
#
# Delete the current entry contents.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _checkLength
#
# This method was added by csmith for SF ticket 227912. We need to
# to check the clipboard content before allowing any pasting into
# the entryfield to disallow text that is longer than the value
# specified by the -fixed option.
# ------------------------------------------------------------------
itcl::body iwidgets::Entryfield::_checkLength {} {
if {$itk_option(-fixed) != 0} {
if [catch {::selection get -selection CLIPBOARD} pending] {
# Nothing in the clipboard. Check the primary selection.
if [catch {::selection get -selection PRIMARY} pending] {
# Nothing here either. Goodbye.
return
}
}
set len [expr {[string length $pending] + [string length [get]]}]
if {$len > $itk_option(-fixed)} {
uplevel #0 $itk_option(-invalid)
return -code break 0
}
}
}

439
arduino-0018-windows/hardware/tools/avr/share/iwidgets4.0.1/scripts/extbutton.itk Normal file
View file

@ -0,0 +1,439 @@
#-------------------------------------------------------------------------------
# Extbutton
#-------------------------------------------------------------------------------
# This [incr Widget] is pretty simple - it just extends the behavior of
# the Tk button by allowing the user to add a bitmap or an image, which
# can be placed at various locations relative to the text via the -imagepos
# configuration option.
#
#-------------------------------------------------------------------------------
# IMPORTANT NOTE: This [incr Widget] will only work with Tk 8.4 or later.
#
#-------------------------------------------------------------------------------
# AUTHOR: Chad Smith E-mail: csmith@adc.com, itclguy@yahoo.com
#-------------------------------------------------------------------------------
# Permission to use, copy, modify, distribute, and license this software
# and its documentation for any purpose is hereby granted as long as this
# comment block remains intact.
#-------------------------------------------------------------------------------
#
# Default resources
#
option add *Extbutton.borderwidth 2 widgetDefault
option add *Extbutton.relief raised widgetDefault
#
# Usual options
#
itk::usual Extbutton {
keep -cursor -font
}
itcl::class iwidgets::Extbutton {
inherit itk::Widget
constructor {args} {}
itk_option define -activebackground activeBackground Foreground #ececec
itk_option define -bd borderwidth BorderWidth 2
itk_option define -bitmap bitmap Bitmap {}
itk_option define -command command Command {}
itk_option define -defaultring defaultring DefaultRing 0
itk_option define -defaultringpad defaultringpad Pad 4
itk_option define -image image Image {}
itk_option define -imagepos imagePos Position w
itk_option define -relief relief Relief raised
itk_option define -state state State normal
itk_option define -text text Text {}
public method invoke {} {eval $itk_option(-command)}
public method flash {}
private method changeColor {event_}
private method sink {}
private method raise {} {configure -relief $_oldValues(-relief)}
private variable _oldValues
}
#
# Provide the usual lowercase access command.
#
proc iwidgets::extbutton {path_ args} {
uplevel iwidgets::Extbutton $path_ $args
}
#-------------------------------------------------------------------------------
# OPTION: -bd
#
# DESCRIPTION: This isn't a new option. Similar to -image, we just need to
# repack the frame when the borderwidth changes. This option is kept by
# the private reliefframe component.
#-------------------------------------------------------------------------------
itcl::configbody iwidgets::Extbutton::bd {
pack $itk_component(frame) -padx 4 -pady 4
}
#-------------------------------------------------------------------------------
# OPTION: -bitmap
#
# DESCRIPTION: This isn't a new option - we just need to reset the -image option
# so that the user can toggle back and forth between images and bitmaps.
# Otherwise, the image will take precedence and the user will be unable to
# change to a bitmap without manually setting the label component's -image to
# an empty string. This option is kept by the image component.
#-------------------------------------------------------------------------------
itcl::configbody iwidgets::Extbutton::bitmap {
if {$itk_option(-bitmap) == ""} {
return
}
if {$itk_option(-image) != ""} {
configure -image {}
}
pack $itk_component(frame) -padx 4 -pady 4
}
#-------------------------------------------------------------------------------
# OPTION: -command
#
# DESCRIPTION: Invoke the given command to simulate the Tk button's -command
# option. The command is invoked on <ButtonRelease-1> events only or by
# direct calls to the public invoke() method.
#-------------------------------------------------------------------------------
itcl::configbody iwidgets::Extbutton::command {
if {$itk_option(-command) == ""} {
return
}
# Only create the tag binding if the button is operable.
if {$itk_option(-state) == "normal"} {
bind $this-commandtag <ButtonRelease-1> [itcl::code $this invoke]
}
# Associate the tag with each component if it's not already done.
if {[lsearch [bindtags $itk_interior] $this-commandtag] == -1} {
foreach component [component] {
bindtags [component $component] \
[linsert [bindtags [component $component]] end $this-commandtag]
}
}
}
#-------------------------------------------------------------------------------
# OPTION: -defaultring
#
# DESCRIPTION: Controls display of the sunken frame surrounding the button.
# This option simulates the pushbutton iwidget -defaultring option.
#-------------------------------------------------------------------------------
itcl::configbody iwidgets::Extbutton::defaultring {
switch -- $itk_option(-defaultring) {
1 {set ring 1}
0 {set ring 0}
default {
error "Invalid option for -defaultring: \"$itk_option(-defaultring)\". \
Should be 1 or 0."
}
}
if ($ring) {
$itk_component(ring) configure -borderwidth 2
pack $itk_component(reliefframe) -padx $itk_option(-defaultringpad) \
-pady $itk_option(-defaultringpad)
} else {
$itk_component(ring) configure -borderwidth 0
pack $itk_component(reliefframe) -padx 0 -pady 0
}
}
#-------------------------------------------------------------------------------
# OPTION: -defaultringpad
#
# DESCRIPTION: The pad distance between the ring and the button.
#-------------------------------------------------------------------------------
itcl::configbody iwidgets::Extbutton::defaultringpad {
# Must be an integer.
if ![string is integer $itk_option(-defaultringpad)] {
error "Invalid value specified for -defaultringpad:\
\"$itk_option(-defaultringpad)\". Must be an integer."
}
# Let's go ahead and make the maximum padding 20 pixels. Surely no one
# will want more than that.
if {$itk_option(-defaultringpad) < 0 || $itk_option(-defaultringpad) > 20} {
error "Value for -defaultringpad must be between 0 and 20."
}
# If the ring is displayed, repack it according to the new padding amount.
if {$itk_option(-defaultring)} {
pack $itk_component(reliefframe) -padx $itk_option(-defaultringpad) \
-pady $itk_option(-defaultringpad)
}
}
#-------------------------------------------------------------------------------
# OPTION: -image
#
# DESCRIPTION: This isn't a new option - we just need to repack the frame after
# the image is changed in case the size is different than the previous one.
# This option is kept by the image component.
#-------------------------------------------------------------------------------
itcl::configbody iwidgets::Extbutton::image {
pack $itk_component(frame) -padx 4 -pady 4
}
#-------------------------------------------------------------------------------
# OPTION: -imagepos
#
# DESCRIPTION: Allows the user to move the image to different locations areound
# the text. Valid options are n, nw, ne, s, sw, se e, en, es, w, wn or ws.
#-------------------------------------------------------------------------------
itcl::configbody iwidgets::Extbutton::imagepos {
switch -- $itk_option(-imagepos) {
n {set side top; set anchor center}
ne {set side top; set anchor e}
nw {set side top; set anchor w}
s {set side bottom; set anchor center}
se {set side bottom; set anchor e}
sw {set side bottom; set anchor w}
w {set side left; set anchor center}
wn {set side left; set anchor n}
ws {set side left; set anchor s}
e {set side right; set anchor center}
en {set side right; set anchor n}
es {set side right; set anchor s}
default {
error "Invalid option: \"$itk_option(-imagepos)\". \
Must be n, nw, ne, s, sw, se e, en, es, w, wn or ws."
}
}
pack $itk_component(image) -side $side -anchor $anchor
pack $itk_component(frame) -padx 4 -pady 4
}
#-------------------------------------------------------------------------------
# OPTION: -relief
#
# DESCRIPTION: Move the frame component according to the relief to simulate
# the text in a Tk button when its relief is changed.
#-------------------------------------------------------------------------------
itcl::configbody iwidgets::Extbutton::relief {
update idletasks
switch -- $itk_option(-relief) {
flat - ridge - groove {
place $itk_component(frame) -x 5 -y 5
}
raised {
place $itk_component(frame) -x 4 -y 4
}
sunken {
place $itk_component(frame) -x 6 -y 6
}
default {
error "Invalid option: \"$itk_option(-relief)\". \
Must be flat, ridge, groove, raised, or sunken."
}
}
}
#-------------------------------------------------------------------------------
# OPTION: -state
#
# DESCRIPTION: Simulate the button's -state option.
#-------------------------------------------------------------------------------
itcl::configbody iwidgets::Extbutton::state {
switch -- $itk_option(-state) {
disabled {
bind $itk_interior <Enter> { }
bind $itk_interior <Leave> { }
bind $this-sunkentag <1> { }
bind $this-raisedtag <ButtonRelease-1> { }
bind $this-commandtag <ButtonRelease-1> { }
set _oldValues(-fg) [cget -foreground]
set _oldValues(-cursor) [cget -cursor]
configure -foreground $itk_option(-disabledforeground)
configure -cursor "X_cursor red black"
}
normal {
bind $itk_interior <Enter> [itcl::code $this changeColor enter]
bind $itk_interior <Leave> [itcl::code $this changeColor leave]
bind $this-sunkentag <1> [itcl::code $this sink]
bind $this-raisedtag <ButtonRelease-1> [itcl::code $this raise]
bind $this-commandtag <ButtonRelease-1> [itcl::code $this invoke]
configure -foreground $_oldValues(-fg)
configure -cursor $_oldValues(-cursor)
}
default {
error "Bad option for -state: \"$itk_option(-state)\". Should be\
normal or disabled."
}
}
}
#-------------------------------------------------------------------------------
# OPTION: -text
#
# DESCRIPTION: This isn't a new option. Similar to -image, we just need to
# repack the frame when the text changes.
#-------------------------------------------------------------------------------
itcl::configbody iwidgets::Extbutton::text {
pack $itk_component(frame) -padx 4 -pady 4
}
#-------------------------------------------------------------------------------
# CONSTRUCTOR
#-------------------------------------------------------------------------------
itcl::body iwidgets::Extbutton::constructor {args} {
# Extbutton will not work with versions of Tk less than 8.4 (the
# -activeforeground option was added to the Tk label widget in 8.4, for
# example). So disallow its use unless the right wish is being used.
if {$::tk_version < 8.4} {
error "The extbutton \[incr Widget\] can only be used with versions of\
Tk greater than 8.3.\nYou're currently using version $::tk_version."
}
# This frame is optionally displayed as a "default ring" around the button.
itk_component add ring {
frame $itk_interior.ring -relief sunken
} {
rename -background -ringbackground ringBackground Background
}
# Add an outer frame for the widget's relief. Ideally we could just keep
# the hull's -relief, but it's too tricky to handle relief changes.
itk_component add -private reliefframe {
frame $itk_component(ring).f
} {
rename -borderwidth -bd borderwidth BorderWidth
keep -relief
usual
}
# This frame contains the image and text. It will be moved slightly to
# simulate the text in a Tk button when the button is depressed/raised.
itk_component add frame {
frame $itk_component(reliefframe).f -borderwidth 0
}
itk_component add image {
label $itk_component(frame).img -borderwidth 0
} {
keep -bitmap -background -image
rename -foreground -bitmapforeground foreground Foreground
}
itk_component add label {
label $itk_component(frame).txt -borderwidth 0
} {
keep -activeforeground -background -disabledforeground
keep -font -foreground -justify -text
}
pack $itk_component(image) $itk_component(label) -side left -padx 6 -pady 4
pack $itk_component(frame) -padx 4 -pady 4
pack $itk_component(reliefframe) -fill both
pack $itk_component(ring) -fill both
# Create a couple of binding tags for handling relief changes. Then
# add these tags to each component.
foreach component [component] {
bindtags [component $component] \
[linsert [bindtags [component $component]] end $this-sunkentag]
bindtags [component $component] \
[linsert [bindtags [component $component]] end $this-raisedtag]
}
set _oldValues(-fg) [cget -foreground]
set _oldValues(-cursor) [cget -cursor]
eval itk_initialize $args
}
#-------------------------------------------------------------------------------
# METHOD: flash
#
# ACCESS: public
#
# DESCRIPTION: Simulate the Tk button flash command.
#
# ARGUMENTS: none
#-------------------------------------------------------------------------------
itcl::body iwidgets::Extbutton::flash {} {
set oldbg [cget -background]
config -background $itk_option(-activebackground)
update idletasks
after 50; config -background $oldbg; update idletasks
after 50; config -background $itk_option(-activebackground); update idletasks
after 50; config -background $oldbg
}
#-------------------------------------------------------------------------------
# METHOD: changeColor
#
# ACCESS: private
#
# DESCRIPTION: This method is invoked by <Enter> and <Leave> events to change
# the background and foreground colors of the widget.
#
# ARGUMENTS: event_ --> either "enter" or "leave"
#-------------------------------------------------------------------------------
itcl::body iwidgets::Extbutton::changeColor {event_} {
switch -- $event_ {
enter {
set _oldValues(-bg) [cget -background]
set _oldValues(-fg) [cget -foreground]
configure -background $itk_option(-activebackground)
configure -foreground $itk_option(-activeforeground)
}
leave {
configure -background $_oldValues(-bg)
configure -foreground $_oldValues(-fg)
}
}
}
#-------------------------------------------------------------------------------
# METHOD: sink
#
# ACCESS: private
#
# DESCRIPTION: This method is invoked on <1> mouse events. It saves the
# current relief for later restoral and configures the relief to sunken if
# it isn't already sunken.
#
# ARGUMENTS: none
#-------------------------------------------------------------------------------
itcl::body iwidgets::Extbutton::sink {} {
set _oldValues(-relief) [cget -relief]
if {$_oldValues(-relief) == "sunken"} {
return
}
configure -relief sunken
}

1187
arduino-0018-windows/hardware/tools/avr/share/iwidgets4.0.1/scripts/extfileselectionbox.itk Normal file
View file

File diff suppressed because it is too large Load diff

182
arduino-0018-windows/hardware/tools/avr/share/iwidgets4.0.1/scripts/extfileselectiondialog.itk Normal file
View file

@ -0,0 +1,182 @@
#
# 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: extfileselectiondialog.itk,v 1.3 2002/02/27 06:45:10 mgbacke Exp $
# ----------------------------------------------------------------------
# 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
# ------------------------------------------------------------------
itcl::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
# ------------------------------------------------------------------
itcl::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 [itcl::code $this invoke] \
-selectdircommand [itcl::code $this default Apply] \
-selectfilecommand [itcl::code $this default OK]
} {
usual
keep -labelfont -childsitepos -directory -dirslabel \
-dirsearchcommand -dirson -fileslabel -fileson \
-filesearchcommand -filterlabel -filteron \
-filetype -invalid -mask -nomatchstring \
-selectionlabel -selectionon -sashcursor
}
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 [itcl::code $this default Apply]
$itk_component(fsb) component selection configure \
-focuscommand [itcl::code $this default OK]
$itk_component(fsb) component dirs configure \
-dblclickcommand [itcl::code $this _dbldir]
$itk_component(fsb) component files configure \
-dblclickcommand [itcl::code $this invoke]
buttonconfigure Apply -text "Filter" \
-command [itcl::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.
# ------------------------------------------------------------------
itcl::body iwidgets::Extfileselectiondialog::childsite {} {
return [$itk_component(fsb) childsite]
}
# ------------------------------------------------------------------
# METHOD: get
#
# Thinwrapped method of file selection box class.
# ------------------------------------------------------------------
itcl::body iwidgets::Extfileselectiondialog::get {} {
return [$itk_component(fsb) get]
}
# ------------------------------------------------------------------
# METHOD: filter
#
# Thinwrapped method of file selection box class.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::body iwidgets::Extfileselectiondialog::_dbldir {} {
if {$itk_option(-fileson)} {
default Apply
}
invoke
}

212
arduino-0018-windows/hardware/tools/avr/share/iwidgets4.0.1/scripts/feedback.itk Normal file
View file

@ -0,0 +1,212 @@
#
# 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: feedback.itk,v 1.5 2001/08/15 18:32:18 smithc Exp $
# ----------------------------------------------------------------------
# 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
# ------------------------------------------------------------------
itcl::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
}

1296
arduino-0018-windows/hardware/tools/avr/share/iwidgets4.0.1/scripts/fileselectionbox.itk Normal file
View file

File diff suppressed because it is too large Load diff

181
arduino-0018-windows/hardware/tools/avr/share/iwidgets4.0.1/scripts/fileselectiondialog.itk Normal file
View file

@ -0,0 +1,181 @@
#
# 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: fileselectiondialog.itk,v 1.2 2001/08/07 19:56:48 smithc Exp $
# ----------------------------------------------------------------------
# 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
# ------------------------------------------------------------------
itcl::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
# ------------------------------------------------------------------
itcl::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 [itcl::code $this invoke] \
-selectdircommand [itcl::code $this default Apply] \
-selectfilecommand [itcl::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 [itcl::code $this default Apply]
$itk_component(fsb) component selection configure \
-focuscommand [itcl::code $this default OK]
$itk_component(fsb) component dirs configure \
-dblclickcommand [itcl::code $this _dbldir]
$itk_component(fsb) component files configure \
-dblclickcommand [itcl::code $this invoke]
buttonconfigure Apply -text "Filter" \
-command [itcl::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.
# ------------------------------------------------------------------
itcl::body iwidgets::Fileselectiondialog::childsite {} {
return [$itk_component(fsb) childsite]
}
# ------------------------------------------------------------------
# METHOD: get
#
# Thinwrapped method of file selection box class.
# ------------------------------------------------------------------
itcl::body iwidgets::Fileselectiondialog::get {} {
return [$itk_component(fsb) get]
}
# ------------------------------------------------------------------
# METHOD: filter
#
# Thinwrapped method of file selection box class.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::body iwidgets::Fileselectiondialog::_dbldir {} {
if {$itk_option(-fileson)} {
default Apply
}
invoke
}

488
arduino-0018-windows/hardware/tools/avr/share/iwidgets4.0.1/scripts/finddialog.itk Normal file
View file

@ -0,0 +1,488 @@
#
# 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: finddialog.itk,v 1.3 2001/08/07 19:56:48 smithc Exp $
# ----------------------------------------------------------------------
# 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
# ------------------------------------------------------------------
itcl::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
# ------------------------------------------------------------------
itcl::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> "[itcl::code $this invoke]; break"
#
# Add the find all checkbutton.
#
itk_component add all {
checkbutton $itk_interior.all \
-variable [itcl::scope _optionValues($this-all)] \
-text "All"
}
#
# Add the case consideration checkbutton.
#
itk_component add case {
checkbutton $itk_interior.case \
-variable [itcl::scope _optionValues($this-case)] \
-text "Consider Case"
}
#
# Add the regular expression checkbutton.
#
itk_component add regexp {
checkbutton $itk_interior.regexp \
-variable [itcl::scope _optionValues($this-regexp)] \
-text "Use Regular Expression"
}
#
# Add the find backwards checkbutton.
#
itk_component add backwards {
checkbutton $itk_interior.backwards \
-variable [itcl::scope _optionValues($this-backwards)] \
-text "Find Backwards"
}
#
# Add the find, clear, and close buttons, making find be the default.
#
add Find -text Find -command [itcl::code $this find]
add Clear -text Clear -command [itcl::code $this clear]
add Close -text Close -command [itcl::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.
# ------------------------------------------------------------------
itcl::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 {}.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Finddialog::searchbackground {}
# ------------------------------------------------------------------
# OPTION: -textwidget
#
# Specifies the scrolledtext or text widget to be searched.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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 [itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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
}

1983
arduino-0018-windows/hardware/tools/avr/share/iwidgets4.0.1/scripts/hierarchy.itk Normal file
View file

File diff suppressed because it is too large Load diff

508
arduino-0018-windows/hardware/tools/avr/share/iwidgets4.0.1/scripts/hyperhelp.itk Normal file
View file

@ -0,0 +1,508 @@
#
# Hyperhelp
# ----------------------------------------------------------------------
# Implements a help facility using html formatted hypertext files.
#
# ----------------------------------------------------------------------
# AUTHOR: Kris Raney EMAIL: kraney@spd.dsccc.com
#
# @(#) $Id: hyperhelp.itk,v 1.5 2002/03/16 05:26:19 mgbacke Exp $
# ----------------------------------------------------------------------
# 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
# ------------------------------------------------------------------
itcl::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
# ------------------------------------------------------------------
itcl::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 [itcl::code $this forward] -accelerator f
$m add command -label "Back" -underline 0 -state disabled \
-command [itcl::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 [itcl::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> [itcl::code $this forward]
bind $itk_component(hull) <Key-b> [itcl::code $this back]
bind $itk_component(hull) <Alt-Right> [itcl::code $this forward]
bind $itk_component(hull) <Alt-Left> [itcl::code $this back]
bind $itk_component(hull) <Key-space> [itcl::code $this _pageforward]
bind $itk_component(hull) <Key-Next> [itcl::code $this _pageforward]
bind $itk_component(hull) <Key-BackSpace> [itcl::code $this _pageback]
bind $itk_component(hull) <Key-Prior> [itcl::code $this _pageback]
bind $itk_component(hull) <Key-Delete> [itcl::code $this _pageback]
bind $itk_component(hull) <Key-Down> [itcl::code $this _lineforward]
bind $itk_component(hull) <Key-Up> [itcl::code $this _lineback]
wm title $itk_component(hull) "Help"
eval itk_initialize $args
if {[lsearch -exact $args -closecmd] == -1} {
configure -closecmd [itcl::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
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Hyperhelp::title {
wm title $itk_component(hull) $itk_option(-title)
}
# ------------------------------------------------------------------
# OPTION: -helpdir
#
# Set location of help files
# ------------------------------------------------------------------
itcl::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
# ------------------------------------------------------------------
itcl::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
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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
# ------------------------------------------------------------------
itcl::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
# ------------------------------------------------------------------
itcl::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
# ------------------------------------------------------------------
itcl::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
# ------------------------------------------------------------------
itcl::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
}
return
}
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"
itcl::delete object [$itk_interior.feedbackshell \
childsite].helpfeedback
itcl::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
# ------------------------------------------------------------------
itcl::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
# ------------------------------------------------------------------
itcl::body iwidgets::Hyperhelp::_pageforward {} {
$itk_component(scrtxt) yview scroll 1 pages
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _pageback
#
# Callback for page back shortcut key
# ------------------------------------------------------------------
itcl::body iwidgets::Hyperhelp::_pageback {} {
$itk_component(scrtxt) yview scroll -1 pages
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _lineforward
#
# Callback for line forward shortcut key
# ------------------------------------------------------------------
itcl::body iwidgets::Hyperhelp::_lineforward {} {
$itk_component(scrtxt) yview scroll 1 units
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _lineback
#
# Callback for line back shortcut key
# ------------------------------------------------------------------
itcl::body iwidgets::Hyperhelp::_lineback {} {
$itk_component(scrtxt) yview scroll -1 units
}

496
arduino-0018-windows/hardware/tools/avr/share/iwidgets4.0.1/scripts/labeledframe.itk Normal file
View file

@ -0,0 +1,496 @@
#
# 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.borderWidth 2 widgetDefault
option add *Labeledframe.relief groove widgetDefault
#
# Usual options.
#
itk::usual Labeledframe {
keep -background -cursor -labelfont -foreground
}
itcl::class iwidgets::Labeledframe {
inherit itk::Archetype
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
constructor {args} {}
destructor {}
#
# Public methods
#
public method childsite {}
#
# 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 itk_hull ""
common _LAYOUT_TABLE
}
}
#
# Provide a lowercased access method for the Labeledframe class.
#
proc ::iwidgets::labeledframe {pathName args} {
uplevel ::iwidgets::Labeledframe $pathName $args
}
# -----------------------------------------------------------------------------
# CONSTRUCTOR
# -----------------------------------------------------------------------------
itcl::body iwidgets::Labeledframe::constructor { args } {
#
# Create a window with the same name as this object
#
set itk_hull [namespace tail $this]
set itk_interior $itk_hull
itk_component add hull {
frame $itk_hull \
-relief groove \
-class [namespace tail [info class]]
} {
keep -background -cursor -relief -borderwidth
rename -highlightbackground -background background Background
rename -highlightcolor -background background Background
}
bind itk-delete-$itk_hull <Destroy> "itcl::delete object $this"
set tags [bindtags $itk_hull]
bindtags $itk_hull [linsert $tags 0 itk-delete-$itk_hull]
#
# Create the childsite frame window
# _______
# |_____|
# |_|X|_|
# |_____|
#
itk_component add childsite {
frame $itk_interior.childsite -highlightthickness 0 -bd 0
}
#
# Create the label to be positioned within the grooved relief
# of the hull frame.
#
itk_component add label {
label $itk_interior.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
}
grid $itk_component(childsite) -row 1 -column 1 -sticky nsew
grid columnconfigure $itk_interior 1 -weight 1
grid rowconfigure $itk_interior 1 -weight 1
bind $itk_component(label) <Configure> +[itcl::code $this _positionLabel]
#
# 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
# -----------------------------------------------------------------------------
itcl::body iwidgets::Labeledframe::destructor {} {
if {$_reposition != ""} {
after cancel $_reposition
}
if {[winfo exists $itk_hull]} {
set tags [bindtags $itk_hull]
set i [lsearch $tags itk-delete-$itk_hull]
if {$i >= 0} {
bindtags $itk_hull [lreplace $tags $i $i]
}
destroy $itk_hull
}
}
# -----------------------------------------------------------------------------
# OPTIONS
# -----------------------------------------------------------------------------
# ------------------------------------------------------------------
# OPTION: -ipadx
#
# Specifies the width of the horizontal gap from the border to the
# the child site.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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 hull
# relief.
# ----------------------------------------------------------------------------
itcl::configbody iwidgets::Labeledframe::labelmargin {
_positionLabel
}
# -----------------------------------------------------------------------------
# OPTION: -labelpos
#
# Set the position of the label within the relief of the hull frame
# widget.
# ----------------------------------------------------------------------------
itcl::configbody iwidgets::Labeledframe::labelpos {
_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 hull
# 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>}
# -----------------------------------------------------------------------------
itcl::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
#
# -----------------------------------------------------------------------------
itcl::body iwidgets::Labeledframe::childsite {} {
return $itk_component(childsite)
}
# -----------------------------------------------------------------------------
# PROTECTED METHOD: _positionLabel ?when?
#
# Places the label in the relief of the hull. 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.
# -----------------------------------------------------------------------------
itcl::body iwidgets::Labeledframe::_positionLabel {{when later}} {
if {$when == "later"} {
if {$_reposition == ""} {
set _reposition [after idle [itcl::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"
}
update idletasks
$itk_component(label) configure -wraplength $_LAYOUT_TABLE($pos-wrap)
set labelWidth [winfo reqwidth $itk_component(label)]
set labelHeight [winfo reqheight $itk_component(label)]
set borderwidth $itk_option(-borderwidth)
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_interior $number -minsize $minsize
set _reposition ""
}
# -----------------------------------------------------------------------------
# PROTECTED METHOD: _collapseMargin
#
# Resets the "-minsize" of all rows and columns of the hull's grid
# used to set the label margin to 0
# -----------------------------------------------------------------------------
itcl::body iwidgets::Labeledframe::_collapseMargin {} {
grid columnconfigure $itk_interior 0 -minsize 0
grid columnconfigure $itk_interior 2 -minsize 0
grid rowconfigure $itk_interior 0 -minsize 0
grid rowconfigure $itk_interior 2 -minsize 0
}
# -----------------------------------------------------------------------------
# PROTECTED METHOD: _setMarginThickness
#
# Set the margin thickness ( i.e. the hidden "-highlightthickness"
# of the hull ) to the input value.
#
# The "-highlightthickness" option of the hull frame is not intended to be
# configured by users of this class, but does need to be configured to properly
# place the label whenever the label is configured.
#
# Therefore, since I can't find a better way at this time, I achieve this
# configuration by: adding the "-highlightthickness" option back into
# the hull frame; configuring the "-highlightthickness" option to properly
# place the label; and then remove the "-highlightthickness" option from the
# hull.
#
# This way the option is not visible or configurable without some hacking.
#
# -----------------------------------------------------------------------------
itcl::body iwidgets::Labeledframe::_setMarginThickness {value} {
itk_option add hull.highlightthickness
$itk_component(hull) configure -highlightthickness $value
itk_option remove hull.highlightthickness
}

445
arduino-0018-windows/hardware/tools/avr/share/iwidgets4.0.1/scripts/labeledwidget.itk Normal file
View file

@ -0,0 +1,445 @@
#
# 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: labeledwidget.itk,v 1.4 2001/08/20 20:02:53 smithc Exp $
# ----------------------------------------------------------------------
# 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
# ------------------------------------------------------------------
itcl::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
itk_option define -sticky sticky Sticky nsew
public method childsite
private 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
# ------------------------------------------------------------------
itcl::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
}
# ------------------------------------------------------------------
# DESTRUCTOR
# ------------------------------------------------------------------
itcl::body iwidgets::Labeledwidget::destructor {} {
if {$_reposition != ""} {after cancel $_reposition}
}
# ------------------------------------------------------------------
# OPTIONS
# ------------------------------------------------------------------
# ------------------------------------------------------------------
# OPTION: -disabledforeground
#
# Specified the foreground to be used on the label when disabled.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Labeledwidget::labelpos {
_positionLabel
}
# ------------------------------------------------------------------
# OPTION: -labelmargin
#
# Specifies the distance between the widget and label.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Labeledwidget::labelmargin {
_positionLabel
}
# ------------------------------------------------------------------
# OPTION: -labeltext
#
# Specifies the label text.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Labeledwidget::labeltext {
$itk_component(label) configure -text $itk_option(-labeltext)
_positionLabel
}
# ------------------------------------------------------------------
# OPTION: -labelvariable
#
# Specifies the label text variable.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Labeledwidget::labelvariable {
$itk_component(label) configure -textvariable $itk_option(-labelvariable)
_positionLabel
}
# ------------------------------------------------------------------
# OPTION: -labelbitmap
#
# Specifies the label bitmap.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Labeledwidget::labelbitmap {
$itk_component(label) configure -bitmap $itk_option(-labelbitmap)
_positionLabel
}
# ------------------------------------------------------------------
# OPTION: -labelimage
#
# Specifies the label image.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Labeledwidget::labelimage {
$itk_component(label) configure -image $itk_option(-labelimage)
_positionLabel
}
# ------------------------------------------------------------------
# OPTION: -sticky
#
# Specifies the stickyness of the child site. This option was added
# by James Bonfield (committed by Chad Smith 8/20/01).
# ------------------------------------------------------------------
itcl::configbody iwidgets::Labeledwidget::sticky {
grid $itk_component(lwchildsite) -sticky $itk_option(-sticky)
}
# ------------------------------------------------------------------
# OPTION: -state
#
# Specifies the state of the label.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Labeledwidget::state {
_positionLabel
}
# ------------------------------------------------------------------
# METHODS
# ------------------------------------------------------------------
# ------------------------------------------------------------------
# METHOD: childsite
#
# Returns the path name of the child site widget.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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 {($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.
# ------------------------------------------------------------------
itcl::body iwidgets::Labeledwidget::_positionLabel {{when later}} {
if {$when == "later"} {
if {$_reposition == ""} {
set _reposition [after idle [itcl::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 $itk_option(-sticky)
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 $itk_option(-sticky)
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 $itk_option(-sticky)
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 $itk_option(-sticky)
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 $itk_option(-sticky)
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 ""
}

313
arduino-0018-windows/hardware/tools/avr/share/iwidgets4.0.1/scripts/mainwindow.itk Normal file
View file

@ -0,0 +1,313 @@
#
# 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: mainwindow.itk,v 1.2 2001/08/07 19:56:48 smithc Exp $
# ----------------------------------------------------------------------
# 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
# ------------------------------------------------------------------
itcl::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
# ------------------------------------------------------------------
itcl::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 [itcl::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 [itcl::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 [itcl::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 [itcl::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 [itcl::scope _helpVar($this)] \
-relief sunken -borderwidth 2 -width 10
}
itk_component add status {
label $itk_component(lineframe).status \
-textvariable [itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::body iwidgets::Mainwindow::childsite {} {
return $itk_component(mwchildsite)
}
# ------------------------------------------------------------------
# METHOD: menubar ?args?
#
# Evaluate the args against the Menubar component.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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
}
}

2267
arduino-0018-windows/hardware/tools/avr/share/iwidgets4.0.1/scripts/menubar.itk Normal file
View file

File diff suppressed because it is too large Load diff

399
arduino-0018-windows/hardware/tools/avr/share/iwidgets4.0.1/scripts/messagebox.itk Normal file
View file

@ -0,0 +1,399 @@
#
# 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: messagebox.itk,v 1.6 2002/03/19 19:48:57 mgbacke Exp $
# ----------------------------------------------------------------------
# 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
# ------------------------------------------------------------------
itcl::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
# ------------------------------------------------------------------
itcl::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
# ------------------------------------------------------------------
itcl::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> [itcl::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 "Find" \
-command [itcl::code $this find]
$itk_component(itemMenu) add command -label "Save" \
-command [itcl::code $this save]
$itk_component(itemMenu) add command -label "Clear" \
-command [itcl::code $this clear]
#
# Create a standard type to be used if no others are specified.
#
type add DEFAULT
eval itk_initialize $args
}
# ------------------------------------------------------------------
# DESTURCTOR
# ------------------------------------------------------------------
itcl::body iwidgets::Messagebox::destructor {} {
foreach type $_types {
type remove $type
}
}
# ------------------------------------------------------------------
# METHODS
# ------------------------------------------------------------------
# ------------------------------------------------------------------
# METHOD clear
#
# Clear the text area.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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} {
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::body iwidgets::Messagebox::save {} {
set saveFile ""
set filter ""
set saveFile [tk_getSaveFile -title "Save Messages" \
-initialdir $itk_option(-savedir) \
-parent $itk_interior \
-initialfile $itk_option(-filename)]
if { $saveFile != "" } {
$itk_component(text) export $saveFile
}
}
# ------------------------------------------------------------------
# PUBLIC METHOD: find
#
# Search the contents of messages area for a specific string.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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)
# ------------------------------------------------------------------
itcl::body iwidgets::Messagebox::export {filename} {
$itk_component(text) export $filename
}

144
arduino-0018-windows/hardware/tools/avr/share/iwidgets4.0.1/scripts/messagedialog.itk Normal file
View file

@ -0,0 +1,144 @@
#
# 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: messagedialog.itk,v 1.3 2001/08/07 19:56:48 smithc Exp $
# ----------------------------------------------------------------------
# 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
# ------------------------------------------------------------------
itcl::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
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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"
}
}
}

946
arduino-0018-windows/hardware/tools/avr/share/iwidgets4.0.1/scripts/notebook.itk Normal file
View file

@ -0,0 +1,946 @@
#
# 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: notebook.itk,v 1.4 2001/08/15 18:33:31 smithc Exp $
# ----------------------------------------------------------------------
# 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
# ------------------------------------------------------------------
itcl::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
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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 {$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
# ------------------------------------------------------------------
itcl::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
# ------------------------------------------------------------------
itcl::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
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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 { $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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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
# ------------------------------------------------------------------
itcl::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?
# ------------------------------------------------------------------
itcl::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
itcl::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
# ------------------------------------------------------------------
itcl::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
# ------------------------------------------------------------------
itcl::configbody iwidgets::Page::disabledforeground {
}
# ------------------------------------------------------------------
# OPTION -label
#
# Sets the label of this page. The label is a string identifier
# for this page.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Page::label {
}
# ------------------------------------------------------------------
# OPTION -command
#
# The Tcl Command to associate with this page.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Page::command {
}
# ------------------------------------------------------------------
# METHODS
# ------------------------------------------------------------------
# ------------------------------------------------------------------
# METHOD: childsite
#
# Returns the child site widget of this page
# ------------------------------------------------------------------
itcl::body iwidgets::Page::childsite { } {
return $itk_component(cs)
}

664
arduino-0018-windows/hardware/tools/avr/share/iwidgets4.0.1/scripts/optionmenu.itk Normal file
View file

@ -0,0 +1,664 @@
#
# 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: optionmenu.itk,v 1.9 2001/10/26 15:28:22 smithc Exp $
# ----------------------------------------------------------------------
# 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
# ------------------------------------------------------------------
itcl::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
# ------------------------------------------------------------------
itcl::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 [itcl::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> \
"[itcl::code $this _postMenu %t]; break"
bind $itk_component(menuBtn) <KeyPress-space> \
"[itcl::code $this _postMenu %t]; break"
bind $itk_component(popupMenu) <ButtonRelease-1> \
[itcl::code $this _buttonRelease %t]
#
# Initialize the widget based on the command line options.
#
eval itk_initialize $args
}
# ------------------------------------------------------------------
# DESTRUCTOR
# ------------------------------------------------------------------
itcl::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!
# ------------------------------------------------------------------
itcl::configbody iwidgets::Optionmenu::clicktime {}
# ------------------------------------------------------------------
# OPTION -command
#
# Specifies a command to be evaluated upon change in option menu.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Optionmenu::cyclicon {
if {$itk_option(-cyclicon)} {
bind $itk_component(menuBtn) <3> [itcl::code $this _next]
bind $itk_component(menuBtn) <Shift-3> [itcl::code $this _previous]
bind $itk_component(menuBtn) <KeyPress-Down> [itcl::code $this _next]
bind $itk_component(menuBtn) <KeyPress-Up> [itcl::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
# ------------------------------------------------------------------
itcl::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).
# ------------------------------------------------------------------
itcl::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).
# ------------------------------------------------------------------
itcl::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).
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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 [expr {$_numitems - 1}]
} 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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::body iwidgets::Optionmenu::enable {index} {
set index [index $index]
$itk_component(popupMenu) entryconfigure $index -state normal
}
# ------------------------------------------------------------------
# METHOD: get
#
# Returns the current menu item.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::body iwidgets::Optionmenu::insert {index string args} {
if {$index == "end"} {
set index $_numitems
} else {
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.
# ------------------------------------------------------------------
itcl::body iwidgets::Optionmenu::select {index} {
set index [index $index]
if {$index > ($_numitems - 1)} {
incr index -1
}
_setItem [lindex $_items $index]
}
# ------------------------------------------------------------------
# METHOD: popupMenu
#
# Evaluates the specified args against the popup menu component
# and returns the result.
# ------------------------------------------------------------------
itcl::body iwidgets::Optionmenu::popupMenu {args} {
return [eval $itk_component(popupMenu) $args]
}
# ------------------------------------------------------------------
# METHOD: sort mode
#
# Sort the current menu in either "ascending" or "descending" order.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::body iwidgets::Optionmenu::_buttonRelease {time} {
if {(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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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 [itcl::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.
# ------------------------------------------------------------------
itcl::body iwidgets::Optionmenu::_setSize {{when later}} {
if {$when == "later"} {
if {$_calcSize == ""} {
set _calcSize [after idle [itcl::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 ""
}

128
arduino-0018-windows/hardware/tools/avr/share/iwidgets4.0.1/scripts/pane.itk Normal file
View file

@ -0,0 +1,128 @@
#
# 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: pane.itk,v 1.3 2001/08/07 19:56:48 smithc Exp $
# ----------------------------------------------------------------------
# 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
# ------------------------------------------------------------------
itcl::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
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::body iwidgets::Pane::childSite {} {
return $itk_component(childsite)
}

942
arduino-0018-windows/hardware/tools/avr/share/iwidgets4.0.1/scripts/panedwindow.itk Normal file
View file

@ -0,0 +1,942 @@
#
# 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: panedwindow.itk,v 1.7 2001/09/06 15:12:46 smithc Exp $
# ----------------------------------------------------------------------
# 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
# ------------------------------------------------------------------
itcl::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
itk_option define -showhandle showHandle ShowHandle 1
public method index {index}
public method childsite {args}
public method fraction {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.
private variable _relief ;# relief for -showhandle
}
#
# 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
# ------------------------------------------------------------------
itcl::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> [itcl::code $this _pwConfigureEventHandler %w %h]
bindtags $itk_component(hull) \
[linsert [bindtags $itk_component(hull)] 0 pw-config-$this]
array set _relief {0 sunken 1 raised}
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.
# ------------------------------------------------------------------
itcl::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> \
[itcl::code $this _startGrip %x $i]
bind $itk_component(sash$i) <B1-Motion> \
[itcl::code $this _handleGrip %x $i]
bind $itk_component(sash$i) <B1-ButtonRelease-1> \
[itcl::code $this _endGrip %x $i]
bind $itk_component(sash$i) <Configure> \
[itcl::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> \
[itcl::code $this _startGrip %y $i]
bind $itk_component(sash$i) <B1-Motion> \
[itcl::code $this _handleGrip %y $i]
bind $itk_component(sash$i) <B1-ButtonRelease-1> \
[itcl::code $this _endGrip %y $i]
bind $itk_component(sash$i) <Configure> \
[itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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,
# ------------------------------------------------------------------
itcl::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: -showhandle
#
# Specifies whether or not to show the sash handle. If not, then the
# whole separator becomes the handle. Valid values are 0 or 1.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Panedwindow::showhandle {
switch $itk_option(-showhandle) {
0 - 1 {
# Update the sashes.
_makeSashes
_placePanes
}
default {
error "Invalid option for -showhandle: $itk_option(-showhandle).\
Must be 1 or 0."
}
}
}
# ------------------------------------------------------------------
# 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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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).
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::body iwidgets::Panedwindow::fraction {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"
}
} elseif {[llength $args] == 0} {
for {set i 0; set j 1} {$j < [llength $_activePanes]} {incr i; incr j} {
lappend _ret [expr {round(($_frac($j) - $_frac($i))*100)}]
}
lappend _ret [eval expr {100 - ([join $_ret +])}]
return $_ret
} else {
error "wrong # args: should be \"$itk_component(hull)\
fraction percentage percentage ?percentage ...?\",\
where the number of percentages is\
[llength $_activePanes] and equal 100
or \"$itk_component(hull) fraction\"
which will return a list of the current percentages"
}
}
# ------------------------------------------------------------------
# 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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::body iwidgets::Panedwindow::_endGrip {where num} {
$itk_component(sash$num) configure -relief $_relief($itk_option(-showhandle))
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.
# ------------------------------------------------------------------
itcl::body iwidgets::Panedwindow::_configGrip {where num} {
set _sashloc($num) $where
}
# ------------------------------------------------------------------
# PROTECTED METHOD: _handleGrip where num
#
# Motion action for sash.
# ------------------------------------------------------------------
itcl::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
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::body iwidgets::Panedwindow::_calcFraction {where num} {
set numi [expr {$num + 1}]
set numd [expr {$num - 1}]
set _lowerlimit [expr {$_pixels($numd) + $_minheight($numd)}]
set _upperlimit [expr {$_pixels($numi) - $_minheight($num)}]
set dir [expr {$where - $_pixels($num)}]
if {$where < $_lowerlimit && $dir <= 0} {
if {$num == 1} {
set _pixels($num) $_lowerlimit
} {
_moveSash [expr {$where - $_minheight($numd)}] $numd
set _pixels($num) [expr {$_pixels($numd) + $_minheight($numd)}]
}
} elseif {$where > $_upperlimit && $dir >= 0} {
if {$numi == [llength $_activePanes]} {
set _pixels($num) $_upperlimit
} {
_moveSash [expr {$where + $_minheight($num)}] $numi
set _pixels($num) \
[expr {$_pixels($numi) - $_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.
# ------------------------------------------------------------------
itcl::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 $_relief($itk_option(-showhandle)) \
-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> \
[itcl::code $this _startGrip %x $id]
bind $itk_component(sash$id) <B1-Motion> \
[itcl::code $this _handleGrip %x $id]
bind $itk_component(sash$id) <B1-ButtonRelease-1> \
[itcl::code $this _endGrip %x $id]
bind $itk_component(sash$id) <Configure> \
[itcl::code $this _configGrip %x $id]
}
horizontal {
bind $itk_component(sash$id) <Button-1> \
[itcl::code $this _startGrip %y $id]
bind $itk_component(sash$id) <B1-Motion> \
[itcl::code $this _handleGrip %y $id]
bind $itk_component(sash$id) <B1-ButtonRelease-1> \
[itcl::code $this _endGrip %y $id]
bind $itk_component(sash$id) <Configure> \
[itcl::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.
# ------------------------------------------------------------------
itcl::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
}
if {$itk_option(-showhandle)} {
place $itk_component(sash$i) -in $itk_component(hull) \
-x $sashPos -rely $_frac($i) -anchor $sashAnchor
} else {
place $itk_component(sash$i) -in $itk_component(hull) \
-x 0 -relwidth 1 -rely $_frac($i) -anchor w \
-height $itk_option(-thickness)
}
} 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
}
if {$itk_option(-showhandle)} {
place $itk_component(sash$i) -in $itk_component(hull) \
-y $sashPos -relx $_frac($i) -anchor $sashAnchor
} else {
place $itk_component(sash$i) -in $itk_component(hull) \
-y 0 -relheight 1 -relx $_frac($i) -anchor n \
-width $itk_option(-thickness)
}
}
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _placePanes
#
# Resets the panes of the window following movement of the sash.
# ------------------------------------------------------------------
itcl::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)
}
}
}

199
arduino-0018-windows/hardware/tools/avr/share/iwidgets4.0.1/scripts/promptdialog.itk Normal file
View file

@ -0,0 +1,199 @@
#
# 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: promptdialog.itk,v 1.2 2001/08/07 19:56:48 smithc Exp $
# ----------------------------------------------------------------------
# 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
# ------------------------------------------------------------------
itcl::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
# ------------------------------------------------------------------
itcl::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 [itcl::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.
# ------------------------------------------------------------------
itcl::body iwidgets::Promptdialog::get {} {
return [$itk_component(prompt) get]
}
# ------------------------------------------------------------------
# METHOD: clear
#
# Thinwrapped method of entry field class.
# ------------------------------------------------------------------
itcl::body iwidgets::Promptdialog::clear {} {
eval $itk_component(prompt) clear
}
# ------------------------------------------------------------------
# METHOD: insert args
#
# Thinwrapped method of entry field class.
# ------------------------------------------------------------------
itcl::body iwidgets::Promptdialog::insert {args} {
eval $itk_component(prompt) insert $args
}
# ------------------------------------------------------------------
# METHOD: delete first ?last?
#
# Thinwrapped method of entry field class.
# ------------------------------------------------------------------
itcl::body iwidgets::Promptdialog::delete {args} {
eval $itk_component(prompt) delete $args
}
# ------------------------------------------------------------------
# METHOD: icursor
#
# Thinwrapped method of entry field class.
# ------------------------------------------------------------------
itcl::body iwidgets::Promptdialog::icursor {args} {
eval $itk_component(prompt) icursor $args
}
# ------------------------------------------------------------------
# METHOD: index
#
# Thinwrapped method of entry field class.
# ------------------------------------------------------------------
itcl::body iwidgets::Promptdialog::index {args} {
return [eval $itk_component(prompt) index $args]
}
# ------------------------------------------------------------------
# METHOD: scan option args
#
# Thinwrapped method of entry field class.
# ------------------------------------------------------------------
itcl::body iwidgets::Promptdialog::scan {args} {
eval $itk_component(prompt) scan $args
}
# ------------------------------------------------------------------
# METHOD: selection args
#
# Thinwrapped method of entry field class.
# ------------------------------------------------------------------
itcl::body iwidgets::Promptdialog::selection {args} {
eval $itk_component(prompt) selection $args
}
# ------------------------------------------------------------------
# METHOD: xview args
#
# Thinwrapped method of entry field class.
# ------------------------------------------------------------------
itcl::body iwidgets::Promptdialog::xview {args} {
eval $itk_component(prompt) xview $args
}

356
arduino-0018-windows/hardware/tools/avr/share/iwidgets4.0.1/scripts/pushbutton.itk Normal file
View file

@ -0,0 +1,356 @@
#
# 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: pushbutton.itk,v 1.3 2001/08/17 19:03:44 smithc Exp $
# ----------------------------------------------------------------------
# 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
# ------------------------------------------------------------------
itcl::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
# ------------------------------------------------------------------
itcl::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
# ------------------------------------------------------------------
itcl::body iwidgets::Pushbutton::destructor {} {
if {$_reposition != ""} {after cancel $_reposition}
}
# ------------------------------------------------------------------
# OPTIONS
# ------------------------------------------------------------------
# ------------------------------------------------------------------
# OPTION: -padx
#
# Specifies the extra space surrounding the label in the x direction.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Pushbutton::pady {
$itk_component(pushbutton) configure -pady $itk_option(-pady)
_relayout
}
# ------------------------------------------------------------------
# OPTION: -font
#
# Specifies the label font.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Pushbutton::font {
$itk_component(pushbutton) configure -font $itk_option(-font)
_relayout
}
# ------------------------------------------------------------------
# OPTION: -text
#
# Specifies the label text.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Pushbutton::text {
$itk_component(pushbutton) configure -text $itk_option(-text)
_relayout
}
# ------------------------------------------------------------------
# OPTION: -bitmap
#
# Specifies the label bitmap.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Pushbutton::bitmap {
$itk_component(pushbutton) configure -bitmap $itk_option(-bitmap)
_relayout
}
# ------------------------------------------------------------------
# OPTION: -image
#
# Specifies the label image.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Pushbutton::image {
$itk_component(pushbutton) configure -image $itk_option(-image)
_relayout
}
# ------------------------------------------------------------------
# OPTION: -highlightthickness
#
# Specifies the thickness of the highlight ring.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Pushbutton::highlightthickness {
$itk_component(pushbutton) configure \
-highlightthickness $itk_option(-highlightthickness)
_relayout
}
# ------------------------------------------------------------------
# OPTION: -borderwidth
#
# Specifies the width of the relief border.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Pushbutton::borderwidth {
$itk_component(pushbutton) configure -borderwidth $itk_option(-borderwidth)
_relayout
}
# ------------------------------------------------------------------
# OPTION: -defaultring
#
# Boolean describing whether the button displays its default ring.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Pushbutton::defaultring {
_relayout
}
# ------------------------------------------------------------------
# OPTION: -defaultringpad
#
# The size of the padded default ring around the button.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Pushbutton::width {
_relayout
}
# ------------------------------------------------------------------
# METHODS
# ------------------------------------------------------------------
# ------------------------------------------------------------------
# METHOD: flash
#
# Thin wrap of standard button widget flash method.
# ------------------------------------------------------------------
itcl::body iwidgets::Pushbutton::flash {} {
$itk_component(pushbutton) flash
}
# ------------------------------------------------------------------
# METHOD: invoke
#
# Thin wrap of standard button widget invoke method.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::body iwidgets::Pushbutton::_relayout {{when later}} {
if {$when == "later"} {
if {$_reposition == ""} {
set _reposition [after idle [itcl::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
}
}

427
arduino-0018-windows/hardware/tools/avr/share/iwidgets4.0.1/scripts/radiobox.itk Normal file
View file

@ -0,0 +1,427 @@
#
# 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: radiobox.itk,v 1.8 2002/02/27 05:59:07 mgbacke Exp $
# ----------------------------------------------------------------------
# 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
# ------------------------------------------------------------------
itcl::class iwidgets::Radiobox {
inherit iwidgets::Labeledframe
constructor {args} {}
destructor {}
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 component {{name ""} 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
# ------------------------------------------------------------------
itcl::body iwidgets::Radiobox::constructor {args} {
#
# Initialize the _modes array element prior to setting the trace. This
# prevents the -command command (if defined) from being triggered when
# the first radiobutton is added via the add method.
#
set _modes($this) {}
trace variable [itcl::scope _modes($this)] w [itcl::code $this _command]
grid columnconfigure $itk_component(childsite) 0 -weight 1
eval itk_initialize $args
}
# ------------------------------------------------------------------
# DESTRUCTOR
# ------------------------------------------------------------------
itcl::body iwidgets::Radiobox::destructor { } {
trace vdelete [itcl::scope _modes($this)] w [itcl::code $this _command]
catch {unset _modes($this)}
}
# ------------------------------------------------------------------
# OPTIONS
# ------------------------------------------------------------------
# ------------------------------------------------------------------
# OPTION: -command
#
# Specifies a command to be evaluated upon change in the radiobox
# ------------------------------------------------------------------
itcl::configbody iwidgets::Radiobox::command {}
# ------------------------------------------------------------------
# OPTION: -orient
#
# Allows the user to orient the radiobuttons either horizontally
# or vertically.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::body iwidgets::Radiobox::add {tag args} {
set options {-value -variable}
foreach option $options {
if {[lsearch $args $option] != -1} {
error "Error: specifying values for radiobutton component options\
\"-value\" and\n \"-variable\" is disallowed. The Radiobox must\
use these options when\n adding radiobuttons."
}
}
itk_component add $tag {
eval radiobutton $itk_component(childsite).rb[incr _unique] \
-variable [list [itcl::scope _modes($this)]] \
-anchor w \
-justify left \
-highlightthickness 0 \
-value $tag $args
} {
usual
keep -state
ignore -highlightthickness -highlightcolor
rename -font -labelfont labelFont Font
}
lappend _buttons $tag
grid $itk_component($tag)
after idle [itcl::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.
# ------------------------------------------------------------------
itcl::body iwidgets::Radiobox::insert {index tag args} {
set options {-value -variable}
foreach option $options {
if {[lsearch $args $option] != -1} {
error "Error: specifying values for radiobutton component options\
\"-value\" and\n \"-variable\" is disallowed. The Radiobox must\
use these options when\n adding radiobuttons."
}
}
itk_component add $tag {
eval radiobutton $itk_component(childsite).rb[incr _unique] \
-variable [list [itcl::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 [itcl::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.
# ------------------------------------------------------------------
itcl::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) -column 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) -column $col -row 0 -sticky nw
grid columnconfigure $itk_component(childsite) $col -weight 1
incr col
}
}
}
}
# ------------------------------------------------------------------
# METHOD: component ?name? ?arg arg arg...?
#
# This method overrides the base class definition to provide some
# error checking. The user is disallowed from modifying the values
# of the -value and -variable options for individual radiobuttons.
# Addition of this method prompted by SF ticket 227923.
# ------------------------------------------------------------------
itcl::body iwidgets::Radiobox::component {{name ""} args} {
if {[lsearch $_buttons $name] != -1} {
# See if the user's trying to use the configure method. Note that
# because of globbing, as few characters as "co" are expanded to
# "config". Similarly, "configu" will expand to "configure".
if [regexp {^co+} [lindex $args 0]] {
# The user's trying to modify a radiobutton. This is all fine and
# dandy unless -value or -variable is being modified.
set options {-value -variable}
foreach option $options {
set index [lsearch $args $option]
if {$index != -1} {
# If a value is actually specified, throw an error.
if {[lindex $args [expr {$index + 1}]] != ""} {
error "Error: specifying values for radiobutton component options\
\"-value\" and\n \"-variable\" is disallowed. The Radiobox\
uses these options internally."
}
}
}
}
}
eval chain $name $args
}
# ------------------------------------------------------------------
# METHOD: delete index
#
# Delete the specified radiobutton.
# ------------------------------------------------------------------
itcl::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 [itcl::code $this _rearrange]
return
}
# ------------------------------------------------------------------
# METHOD: select index
#
# Select the specified radiobutton.
# ------------------------------------------------------------------
itcl::body iwidgets::Radiobox::select {index} {
set tag [gettag $index]
$itk_component($tag) invoke
}
# ------------------------------------------------------------------
# METHOD: get
#
# Return the tag of the currently selected radiobutton.
# ------------------------------------------------------------------
itcl::body iwidgets::Radiobox::get {} {
return $_modes($this)
}
# ------------------------------------------------------------------
# METHOD: deselect index
#
# Deselect the specified radiobutton.
# ------------------------------------------------------------------
itcl::body iwidgets::Radiobox::deselect {index} {
set tag [gettag $index]
$itk_component($tag) deselect
}
# ------------------------------------------------------------------
# METHOD: flash index
#
# Flash the specified radiobutton.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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
# ------------------------------------------------------------------
itcl::body iwidgets::Radiobox::gettag {index} {
return [lindex $_buttons [index $index]]
}

455
arduino-0018-windows/hardware/tools/avr/share/iwidgets4.0.1/scripts/regexpfield.itk Normal file
View file

@ -0,0 +1,455 @@
#
# 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
# ------------------------------------------------------------------
itcl::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
# ------------------------------------------------------------------
itcl::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> [itcl::code $this _keyPress %A %K %s]
bind $itk_component(entry) <FocusIn> [itcl::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
# ------------------------------------------------------------------
itcl::configbody iwidgets::Regexpfield::command {}
# ------------------------------------------------------------------
# OPTION: -focuscommand
#
# Command associated upon detection of focus.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Regexpfield::focuscommand {}
# ------------------------------------------------------------------
# OPTION: -regexp
#
# Specify a regular expression to use in performing validation
# of the content of the entry widget.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Regexpfield::regexp {
}
# ------------------------------------------------------------------
# OPTION: -invalid
#
# Specify a command to executed should the current Regexpfield contents
# be proven invalid.
# ------------------------------------------------------------------
itcl::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).
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::body iwidgets::Regexpfield::childsite {} {
return $itk_component(efchildsite)
}
# ------------------------------------------------------------------
# METHOD: get
#
# Thin wrap of the standard entry widget get method.
# ------------------------------------------------------------------
itcl::body iwidgets::Regexpfield::get {} {
return [$itk_component(entry) get]
}
# ------------------------------------------------------------------
# METHOD: delete
#
# Thin wrap of the standard entry widget delete method.
# ------------------------------------------------------------------
itcl::body iwidgets::Regexpfield::delete {args} {
return [eval $itk_component(entry) delete $args]
}
# ------------------------------------------------------------------
# METHOD: icursor
#
# Thin wrap of the standard entry widget icursor method.
# ------------------------------------------------------------------
itcl::body iwidgets::Regexpfield::icursor {args} {
return [eval $itk_component(entry) icursor $args]
}
# ------------------------------------------------------------------
# METHOD: index
#
# Thin wrap of the standard entry widget index method.
# ------------------------------------------------------------------
itcl::body iwidgets::Regexpfield::index {args} {
return [eval $itk_component(entry) index $args]
}
# ------------------------------------------------------------------
# METHOD: insert
#
# Thin wrap of the standard entry widget index method.
# ------------------------------------------------------------------
itcl::body iwidgets::Regexpfield::insert {args} {
return [eval $itk_component(entry) insert $args]
}
# ------------------------------------------------------------------
# METHOD: scan
#
# Thin wrap of the standard entry widget scan method.
# ------------------------------------------------------------------
itcl::body iwidgets::Regexpfield::scan {args} {
return [eval $itk_component(entry) scan $args]
}
# ------------------------------------------------------------------
# METHOD: selection
#
# Thin wrap of the standard entry widget selection method.
# ------------------------------------------------------------------
itcl::body iwidgets::Regexpfield::selection {args} {
return [eval $itk_component(entry) selection $args]
}
# ------------------------------------------------------------------
# METHOD: xview
#
# Thin wrap of the standard entry widget xview method.
# ------------------------------------------------------------------
itcl::body iwidgets::Regexpfield::xview {args} {
return [eval $itk_component(entry) xview $args]
}
# ------------------------------------------------------------------
# METHOD: clear
#
# Delete the current entry contents.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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
}

29
arduino-0018-windows/hardware/tools/avr/share/iwidgets4.0.1/scripts/roman.itcl Normal file
View file

@ -0,0 +1,29 @@
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
}
}

181
arduino-0018-windows/hardware/tools/avr/share/iwidgets4.0.1/scripts/scopedobject.itcl Normal file
View file

@ -0,0 +1,181 @@
#
# 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
# -----------------------------------------------------------------------------
itcl::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
#--------------------------------------------------------------------------------
itcl::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 \"[itcl::code $this _traceCommand]\"
eval configure $args
if {$enterscopecommand != {}} {
eval $enterscopecommand
}
}
#--------------------------------------------------------------------------------
# DESTRUCTOR
#--------------------------------------------------------------------------------
itcl::body iwidgets::Scopedobject::destructor {} {
uplevel $_level trace vdelete _localVar($this) u \"[itcl::code $this _traceCommand]\"
if {$exitscopecommand != {}} {
eval $exitscopecommand
}
}
#--------------------------------------------------------------------------------#
#
# METHOD: _traceCommand
#
# PURPOSE:
# Callback used to destroy instances when their locally created variable
# goes out of scope.
#
itcl::body iwidgets::Scopedobject::_traceCommand {varName varValue op} {
delete object $this
}
#------------------------------------------------------------------------------
#
# OPTION: -enterscopecommand
#
# PURPOSE:
# Specifies a Tcl command to invoke when a object enters scope.
#
itcl::configbody iwidgets::Scopedobject::enterscopecommand {
}
#------------------------------------------------------------------------------
#
# OPTION: -exitscopecommand
#
# PURPOSE:
# Specifies a Tcl command to invoke when an object exits scope.
#
itcl::configbody iwidgets::Scopedobject::exitscopecommand {
}

477
arduino-0018-windows/hardware/tools/avr/share/iwidgets4.0.1/scripts/scrolledcanvas.itk Normal file
View file

@ -0,0 +1,477 @@
#
# 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: scrolledcanvas.itk,v 1.3 2001/08/17 19:04:06 smithc Exp $
# ----------------------------------------------------------------------
# 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
# ------------------------------------------------------------------
itcl::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
# ------------------------------------------------------------------
itcl::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 0 -column 0 -sticky nsew
grid rowconfigure $_interior 0 -weight 1
grid columnconfigure $_interior 0 -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 \
[itcl::code $this _scrollWidget $itk_interior.horizsb] \
-yscrollcommand \
[itcl::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 [itcl::code $itk_component(canvas) yview]
#
# Configure the command on the horizontal scroll bar in the base class.
#
$itk_component(horizsb) configure \
-command [itcl::code $itk_component(canvas) xview]
#
# Initialize the widget based on the command line options.
#
eval itk_initialize $args
}
# ------------------------------------------------------------------
# DESTURCTOR
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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 ...?
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledcanvas::addtag {args} {
return [eval $itk_component(canvas) addtag $args]
}
# ------------------------------------------------------------------
# METHOD: bbox tagOrId ?tagOrId tagOrId ...?
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledcanvas::bbox {args} {
return [eval $itk_component(canvas) bbox $args]
}
# ------------------------------------------------------------------
# METHOD: bind tagOrId ?sequence? ?command?
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledcanvas::bind {args} {
return [eval $itk_component(canvas) bind $args]
}
# ------------------------------------------------------------------
# METHOD: canvasx screenx ?gridspacing?
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledcanvas::canvasx {args} {
return [eval $itk_component(canvas) canvasx $args]
}
# ------------------------------------------------------------------
# METHOD: canvasy screeny ?gridspacing?
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledcanvas::canvasy {args} {
return [eval $itk_component(canvas) canvasy $args]
}
# ------------------------------------------------------------------
# METHOD: coords tagOrId ?x0 y0 ...?
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledcanvas::coords {args} {
return [eval $itk_component(canvas) coords $args]
}
# ------------------------------------------------------------------
# METHOD: create type x y ?x y ...? ?option value ...?
# ------------------------------------------------------------------
itcl::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?
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledcanvas::dchars {args} {
return [eval $itk_component(canvas) dchars $args]
}
# ------------------------------------------------------------------
# METHOD: delete tagOrId ?tagOrId tagOrId ...?
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledcanvas::delete {args} {
set retval [eval $itk_component(canvas) delete $args]
configure -autoresize $itk_option(-autoresize)
return $retval
}
# ------------------------------------------------------------------
# METHOD: dtag tagOrId ?tagToDelete?
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledcanvas::dtag {args} {
eval $itk_component(canvas) dtag $args
configure -autoresize $itk_option(-autoresize)
}
# ------------------------------------------------------------------
# METHOD: find searchCommand ?arg arg ...?
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledcanvas::find {args} {
return [eval $itk_component(canvas) find $args]
}
# ------------------------------------------------------------------
# METHOD: focus ?tagOrId?
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledcanvas::focus {args} {
return [eval $itk_component(canvas) focus $args]
}
# ------------------------------------------------------------------
# METHOD: gettags tagOrId
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledcanvas::gettags {args} {
return [eval $itk_component(canvas) gettags $args]
}
# ------------------------------------------------------------------
# METHOD: icursor tagOrId index
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledcanvas::icursor {args} {
eval $itk_component(canvas) icursor $args
}
# ------------------------------------------------------------------
# METHOD: index tagOrId index
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledcanvas::index {args} {
return [eval $itk_component(canvas) index $args]
}
# ------------------------------------------------------------------
# METHOD: insert tagOrId beforeThis string
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledcanvas::insert {args} {
eval $itk_component(canvas) insert $args
}
# ------------------------------------------------------------------
# METHOD: itemconfigure tagOrId ?option? ?value? ?option value ...?
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledcanvas::itemconfigure {args} {
set retval [eval $itk_component(canvas) itemconfigure $args]
configure -autoresize $itk_option(-autoresize)
return $retval
}
# ------------------------------------------------------------------
# METHOD: itemcget tagOrId ?option?
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledcanvas::itemcget {args} {
set retval [eval $itk_component(canvas) itemcget $args]
return $retval
}
# ------------------------------------------------------------------
# METHOD: lower tagOrId ?belowThis?
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledcanvas::lower {args} {
eval $itk_component(canvas) lower $args
}
# ------------------------------------------------------------------
# METHOD: move tagOrId xAmount yAmount
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledcanvas::move {args} {
eval $itk_component(canvas) move $args
configure -autoresize $itk_option(-autoresize)
}
# ------------------------------------------------------------------
# METHOD: postscript ?option value ...?
# ------------------------------------------------------------------
itcl::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?
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledcanvas::raise {args} {
eval $itk_component(canvas) raise $args
}
# ------------------------------------------------------------------
# METHOD: scale tagOrId xOrigin yOrigin xScale yScale
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledcanvas::scale {args} {
eval $itk_component(canvas) scale $args
}
# ------------------------------------------------------------------
# METHOD: scan option args
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledcanvas::scan {args} {
eval $itk_component(canvas) scan $args
}
# ------------------------------------------------------------------
# METHOD: select option ?tagOrId arg?
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledcanvas::select {args} {
eval $itk_component(canvas) select $args
}
# ------------------------------------------------------------------
# METHOD: type tagOrId
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledcanvas::type {args} {
return [eval $itk_component(canvas) type $args]
}
# ------------------------------------------------------------------
# METHOD: xview index
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledcanvas::xview {args} {
eval $itk_component(canvas) xview $args
}
# ------------------------------------------------------------------
# METHOD: yview index
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledcanvas::yview {args} {
eval $itk_component(canvas) yview $args
}

250
arduino-0018-windows/hardware/tools/avr/share/iwidgets4.0.1/scripts/scrolledframe.itk Normal file
View file

@ -0,0 +1,250 @@
#
# 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: scrolledframe.itk,v 1.3 2001/08/07 19:56:48 smithc Exp $
# ----------------------------------------------------------------------
# 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
# ------------------------------------------------------------------
itcl::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
# ------------------------------------------------------------------
itcl::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 0 -column 0 -sticky nsew
grid rowconfigure $_interior 0 -weight 1
grid columnconfigure $_interior 0 -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 \
[itcl::code $this _scrollWidget $itk_interior.horizsb] \
-yscrollcommand \
[itcl::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 [itcl::code $itk_component(canvas) yview]
#
# Configure the command on the horizontal scroll bar in the base class.
#
$itk_component(horizsb) configure \
-command [itcl::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> [itcl::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> [itcl::code $this _configureFrame]
#
# Initialize the widget based on the command line options.
#
eval itk_initialize $args
}
# ------------------------------------------------------------------
# DESTURCTOR
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledframe::destructor {} {
}
# ------------------------------------------------------------------
# METHODS
# ------------------------------------------------------------------
# ------------------------------------------------------------------
# METHOD: childsite
#
# Returns the path name of the child site widget.
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledframe::childsite {} {
return $itk_component(sfchildsite)
}
# ------------------------------------------------------------------
# METHOD: justify
#
# Justifies the scrolled region in one of four directions: top,
# bottom, left, or right.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledframe::_configureFrame {} {
$itk_component(canvas) configure \
-scrollregion [$itk_component(canvas) bbox frameTag]
}

2521
arduino-0018-windows/hardware/tools/avr/share/iwidgets4.0.1/scripts/scrolledhtml.itk Normal file
View file

File diff suppressed because it is too large Load diff

732
arduino-0018-windows/hardware/tools/avr/share/iwidgets4.0.1/scripts/scrolledlistbox.itk Normal file
View file

@ -0,0 +1,732 @@
#
# 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: scrolledlistbox.itk,v 1.9 2002/03/16 16:25:44 mgbacke Exp $
# ----------------------------------------------------------------------
# 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
# ------------------------------------------------------------------
itcl::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 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> \
}
}
#
# 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
# ------------------------------------------------------------------
itcl::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 \
[itcl::code $this _scrollWidget $itk_interior.horizsb] \
-yscrollcommand \
[itcl::code $this _scrollWidget $itk_interior.vertsb]
} {
usual
keep -borderwidth -exportselection -relief -selectmode
keep -listvariable
rename -font -textfont textFont Font
rename -background -textbackground textBackground Background
rename -highlightbackground -background background Background
}
grid $itk_component(listbox) -row 0 -column 0 -sticky nsew
grid rowconfigure $_interior 0 -weight 1
grid columnconfigure $_interior 0 -weight 1
#
# Configure the command on the vertical scroll bar in the base class.
#
$itk_component(vertsb) configure \
-command [itcl::code $itk_component(listbox) yview]
#
# Configure the command on the horizontal scroll bar in the base class.
#
$itk_component(horizsb) configure \
-command [itcl::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 [itcl::code $this _makeSelection]
}
foreach seq $doubleSelectSeq {
bind SLBSelect$this $seq [itcl::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
# ------------------------------------------------------------------
itcl::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
# ------------------------------------------------------------------
itcl::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..
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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 {
$itk_component(listbox) configure \
-foreground $itk_option(-foreground)
$itk_component(listbox) configure \
-selectforeground $itk_option(-selectforeground)
if {[set index [lsearch $tags SLBDisabled]] != -1} {
bindtags $itk_component(listbox) \
[lreplace $tags $index $index]
}
}
disabled {
$itk_component(listbox) configure \
-foreground $itk_option(-disabledforeground)
$itk_component(listbox) configure \
-selectforeground $itk_option(-disabledforeground)
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.
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledlistbox::curselection {} {
return [$itk_component(listbox) curselection]
}
# ------------------------------------------------------------------
# METHOD: activate index
#
# Sets the active element to the one indicated by index.
# ------------------------------------------------------------------
itcl::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
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledlistbox::bbox {index} {
return [$itk_component(listbox) bbox [_fixIndex $index]]
}
# ------------------------------------------------------------------
# METHOD clear
#
# Clear the listbox area of all items.
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledlistbox::clear {} {
delete 0 end
}
# ------------------------------------------------------------------
# METHOD: see index
#
# Adjusts the view such that the element given by index is visible.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledlistbox::insert {index args} {
set index [_fixIndex $index]
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.
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledlistbox::nearest {y} {
$itk_component(listbox) nearest $y
}
# ------------------------------------------------------------------
# METHOD: scan option args
#
# Implements scanning on listboxes.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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. This can take any sort switch from
# the lsort command: ascii, integer, real, command,
# increasing/ascending, decreasing/descending, etc.
#
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledlistbox::sort {{mode ascending}} {
set vals [$itk_component(listbox) get 0 end]
if {[llength $vals] == 0} {return}
switch $mode {
ascending {set mode increasing}
descending {set mode decreasing}
}
$itk_component(listbox) delete 0 end
if {[catch {eval $itk_component(listbox) insert end \
[lsort -${mode} $vals]} errorstring]} {
error "bad sort argument \"$mode\": must be a valid argument to the\
Tcl lsort command"
}
return
}
# ------------------------------------------------------------------
# METHOD: xview args
#
# Change or query the vertical position of the text in the list box.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledlistbox::itemconfigure {args} {
return [eval $itk_component(listbox) itemconfigure $args]
}
# ------------------------------------------------------------------
# PROTECTED METHOD: _makeSelection
#
# Evaluate the selection command.
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledlistbox::_makeSelection {} {
uplevel #0 $itk_option(-selectioncommand)
}
# ------------------------------------------------------------------
# PROTECTED METHOD: _dblclick
#
# Evaluate the double click command option if not empty.
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledlistbox::_dblclick {} {
uplevel #0 $itk_option(-dblclickcommand)
}

501
arduino-0018-windows/hardware/tools/avr/share/iwidgets4.0.1/scripts/scrolledtext.itk Normal file
View file

@ -0,0 +1,501 @@
#
# 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: scrolledtext.itk,v 1.5 2002/09/10 03:05:25 smithc Exp $
# ----------------------------------------------------------------------
# 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
}
# ------------------------------------------------------------------
# SCROLLEDTEXT
# ------------------------------------------------------------------
itcl::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 childsite {}
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
# ------------------------------------------------------------------
itcl::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 0 -column 0 -sticky nsew
grid rowconfigure $_interior 0 -weight 1
grid columnconfigure $_interior 0 -weight 1
#
# Create the text area.
#
itk_component add text {
text $itk_component(clipper).text \
-width 1 -height 1 \
-xscrollcommand \
[itcl::code $this _scrollWidget $itk_interior.horizsb] \
-yscrollcommand \
[itcl::code $this _scrollWidget $itk_interior.vertsb] \
-borderwidth 0 -highlightthickness 0
} {
usual
ignore -highlightthickness -highlightcolor -borderwidth
keep -exportselection -padx -pady -setgrid \
-spacing1 -spacing2 -spacing3 -state -tabs -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 [itcl::code $itk_component(text) yview]
#
# Configure the command on the horizontal scroll bar in the base class.
#
$itk_component(horizsb) configure \
-command [itcl::code $itk_component(text) xview]
#
# Initialize the widget based on the command line options.
#
eval itk_initialize $args
}
# ------------------------------------------------------------------
# DESTURCTOR
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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: childsite
#
# Returns the path name of the child site widget.
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledtext::childsite {} {
return $itk_component(text)
}
# ------------------------------------------------------------------
# METHOD: bbox index
#
# Returns four element list describing the bounding box for the list
# item at index
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledtext::bbox {index} {
return [$itk_component(text) bbox $index]
}
# ------------------------------------------------------------------
# METHOD clear
#
# Clear the text area.
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledtext::clear {} {
$itk_component(text) delete 1.0 end
}
# ------------------------------------------------------------------
# METHOD import filename
#
# Load text from an existing file (import filename)
# ------------------------------------------------------------------
itcl::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)
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledtext::debug {args} {
eval $itk_component(text) debug $args
}
# ------------------------------------------------------------------
# METHOD delete first ?last?
#
# Delete a range of characters from the text.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledtext::dlineinfo {index} {
return [$itk_component(text) dlineinfo $index]
}
# ------------------------------------------------------------------
# METHOD get index1 ?index2?
#
# Return text from start index to end index.
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledtext::get {index1 {index2 {}}} {
return [$itk_component(text) get $index1 $index2]
}
# ------------------------------------------------------------------
# METHOD image option ?arg arg ...?
#
# Manipulate images dependent on options.
#
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledtext::image {option args} {
return [eval $itk_component(text) image $option $args]
}
# ------------------------------------------------------------------
# METHOD index index
#
# Return position corresponding to index.
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledtext::index {index} {
return [$itk_component(text) index $index]
}
# ------------------------------------------------------------------
# METHOD insert index chars ?tagList?
#
# Insert text at index.
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledtext::insert {args} {
eval $itk_component(text) insert $args
}
# ------------------------------------------------------------------
# METHOD mark option ?arg arg ...?
#
# Manipulate marks dependent on options.
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledtext::mark {option args} {
return [eval $itk_component(text) mark $option $args]
}
# ------------------------------------------------------------------
# METHOD scan option args
#
# Implements scanning on texts.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledtext::see {index} {
$itk_component(text) see $index
}
# ------------------------------------------------------------------
# METHOD tag option ?arg arg ...?
#
# Manipulate tags dependent on options.
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledtext::tag {option args} {
return [eval $itk_component(text) tag $option $args]
}
# ------------------------------------------------------------------
# METHOD window option ?arg arg ...?
#
# Manipulate embedded windows.
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledtext::window {option args} {
return [eval $itk_component(text) window $option $args]
}
# ------------------------------------------------------------------
# METHOD xview
#
# Changes x view in widget's window.
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledtext::xview {args} {
return [eval $itk_component(text) xview $args]
}
# ------------------------------------------------------------------
# METHOD yview
#
# Changes y view in widget's window.
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledtext::yview {args} {
return [eval $itk_component(text) yview $args]
}

376
arduino-0018-windows/hardware/tools/avr/share/iwidgets4.0.1/scripts/scrolledwidget.itk Normal file
View file

@ -0,0 +1,376 @@
#
# 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: scrolledwidget.itk,v 1.2 2001/08/07 19:56:48 smithc Exp $
# ----------------------------------------------------------------------
# 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
# ------------------------------------------------------------------
itcl::class iwidgets::Scrolledwidget {
inherit iwidgets::Labeledwidget
constructor {args} {}
destructor {}
itk_option define -sbwidth sbWidth Width 15
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}
protected method _vertScrollbarDisplay {mode}
protected method _horizScrollbarDisplay {mode}
protected method _configureEvent {}
protected variable _vmode off ;# Vertical scroll mode
protected variable _hmode off ;# Vertical scroll mode
protected variable _recheckHoriz 1 ;# Flag to check need for
;# horizontal scrollbar
protected variable _recheckVert 1 ;# Flag to check need for
;# vertical scrollbar
protected 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
# ------------------------------------------------------------------
itcl::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 $itk_interior
#
# Check if the scrollbars need mapping upon a configure event.
#
bind $_interior <Configure> [itcl::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 $itk_interior.vertsb -orient vertical
} {
usual
keep -borderwidth -elementborderwidth -jump -relief
rename -highlightbackground -background background Background
}
#
# Create the horizontal scrollbar
#
itk_component add horizsb {
scrollbar $itk_interior.horizsb -orient horizontal
} {
usual
keep -borderwidth -elementborderwidth -jump -relief
rename -highlightbackground -background background Background
}
#
# Initialize the widget based on the command line options.
#
eval itk_initialize $args
}
# ------------------------------------------------------------------
# DESTURCTOR
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledwidget::destructor {} {
}
# ------------------------------------------------------------------
# OPTIONS
# ------------------------------------------------------------------
# ------------------------------------------------------------------
# OPTION: -sbwidth
#
# Set the width of the scrollbars.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Scrolledwidget::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.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Scrolledwidget::scrollmargin {
set pixels [winfo pixels $_interior $itk_option(-scrollmargin)]
if {$_hmode == "on"} {
grid rowconfigure $_interior 1 -minsize $pixels
}
if {$_vmode == "on"} {
grid columnconfigure $_interior 1 -minsize $pixels
}
}
# ------------------------------------------------------------------
# OPTION: -vscrollmode
#
# Enable/disable display and mode of veritcal scrollbars.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Scrolledwidget::height {
$_interior configure -height \
[winfo pixels $_interior $itk_option(-height)]
}
# ------------------------------------------------------------------
# METHODS
# ------------------------------------------------------------------
# ------------------------------------------------------------------
# PROTECTED METHOD: _vertScrollbarDisplay mode
#
# Displays the vertical scrollbar based on the input mode.
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledwidget::_vertScrollbarDisplay {mode} {
switch $mode {
on {
set _vmode on
grid columnconfigure $_interior 1 -minsize \
[winfo pixels $_interior $itk_option(-scrollmargin)]
grid $itk_component(vertsb) -row 0 -column 2 -sticky ns
}
off {
set _vmode off
grid columnconfigure $_interior 1 -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.
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledwidget::_horizScrollbarDisplay {mode} {
switch $mode {
on {
set _hmode on
grid rowconfigure $_interior 1 -minsize \
[winfo pixels $_interior $itk_option(-scrollmargin)]
grid $itk_component(horizsb) -row 2 -column 0 -sticky ew
}
off {
set _hmode off
grid rowconfigure $_interior 1 -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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::body iwidgets::Scrolledwidget::_configureEvent {} {
update idletasks
set _recheckVert 1
set _recheckHoriz 1
}

560
arduino-0018-windows/hardware/tools/avr/share/iwidgets4.0.1/scripts/selectionbox.itk Normal file
View file

@ -0,0 +1,560 @@
#
# 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: selectionbox.itk,v 1.2 2001/08/07 19:56:48 smithc Exp $
# ----------------------------------------------------------------------
# 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
# ------------------------------------------------------------------
itcl::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
# ------------------------------------------------------------------
itcl::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 [itcl::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
# ------------------------------------------------------------------
itcl::body iwidgets::Selectionbox::destructor {} {
if {$_repacking != ""} {after cancel $_repacking}
}
# ------------------------------------------------------------------
# OPTIONS
# ------------------------------------------------------------------
# ------------------------------------------------------------------
# OPTION: -childsitepos
#
# Specifies the position of the child site in the selection box.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Selectionbox::childsitepos {
_packComponents
}
# ------------------------------------------------------------------
# OPTION: -margin
#
# Specifies distance between the items list and selection entry.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Selectionbox::margin {
_packComponents
}
# ------------------------------------------------------------------
# OPTION: -itemson
#
# Specifies whether or not to display the items list.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Selectionbox::itemson {
_packComponents
}
# ------------------------------------------------------------------
# OPTION: -selectionon
#
# Specifies whether or not to display the selection entry widget.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::body iwidgets::Selectionbox::childsite {} {
return $itk_component(sbchildsite)
}
# ------------------------------------------------------------------
# METHOD: get
#
# Returns the current selection.
# ------------------------------------------------------------------
itcl::body iwidgets::Selectionbox::get {} {
return [$itk_component(selection) get]
}
# ------------------------------------------------------------------
# METHOD: curselection
#
# Returns the current selection index.
# ------------------------------------------------------------------
itcl::body iwidgets::Selectionbox::curselection {} {
return [$itk_component(items) curselection]
}
# ------------------------------------------------------------------
# METHOD: clear component
#
# Delete the contents of either the selection entry widget or items
# list.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::body iwidgets::Selectionbox::size {} {
return [$itk_component(items) size]
}
# ------------------------------------------------------------------
# METHOD: scan option args
#
# Implements scanning on items list.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::body iwidgets::Selectionbox::index {index} {
return [$itk_component(items) index $index]
}
# ------------------------------------------------------------------
# METHOD: selection option args
#
# Adjusts the selection within the items list.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::body iwidgets::Selectionbox::_packComponents {{when later}} {
if {$when == "later"} {
if {$_repacking == ""} {
set _repacking [after idle [itcl::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)
}

233
arduino-0018-windows/hardware/tools/avr/share/iwidgets4.0.1/scripts/selectiondialog.itk Normal file
View file

@ -0,0 +1,233 @@
#
# 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: selectiondialog.itk,v 1.2 2001/08/07 19:56:48 smithc Exp $
# ----------------------------------------------------------------------
# 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
# ------------------------------------------------------------------
itcl::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
# ------------------------------------------------------------------
itcl::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 [itcl::code $this invoke]
} {
usual
keep -childsitepos -exportselection -itemscommand -itemslabel \
-itemson -selectionlabel -selectionon -selectioncommand
}
configure -itemscommand [itcl::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.
# ------------------------------------------------------------------
itcl::body iwidgets::Selectiondialog::childsite {} {
return [$itk_component(selectionbox) childsite]
}
# ------------------------------------------------------------------
# METHOD: get
#
# Thinwrapped method of selection box class.
# ------------------------------------------------------------------
itcl::body iwidgets::Selectiondialog::get {} {
return [$itk_component(selectionbox) get]
}
# ------------------------------------------------------------------
# METHOD: curselection
#
# Thinwrapped method of selection box class.
# ------------------------------------------------------------------
itcl::body iwidgets::Selectiondialog::curselection {} {
return [$itk_component(selectionbox) curselection]
}
# ------------------------------------------------------------------
# METHOD: clear component
#
# Thinwrapped method of selection box class.
# ------------------------------------------------------------------
itcl::body iwidgets::Selectiondialog::clear {component} {
$itk_component(selectionbox) clear $component
return
}
# ------------------------------------------------------------------
# METHOD: insert component index args
#
# Thinwrapped method of selection box class.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::body iwidgets::Selectiondialog::delete {first {last {}}} {
$itk_component(selectionbox) delete $first $last
return
}
# ------------------------------------------------------------------
# METHOD: size
#
# Thinwrapped method of selection box class.
# ------------------------------------------------------------------
itcl::body iwidgets::Selectiondialog::size {} {
return [$itk_component(selectionbox) size]
}
# ------------------------------------------------------------------
# METHOD: scan option args
#
# Thinwrapped method of selection box class.
# ------------------------------------------------------------------
itcl::body iwidgets::Selectiondialog::scan {option args} {
return [eval $itk_component(selectionbox) scan $option $args]
}
# ------------------------------------------------------------------
# METHOD: nearest y
#
# Thinwrapped method of selection box class.
# ------------------------------------------------------------------
itcl::body iwidgets::Selectiondialog::nearest {y} {
return [$itk_component(selectionbox) nearest $y]
}
# ------------------------------------------------------------------
# METHOD: index index
#
# Thinwrapped method of selection box class.
# ------------------------------------------------------------------
itcl::body iwidgets::Selectiondialog::index {index} {
return [$itk_component(selectionbox) index $index]
}
# ------------------------------------------------------------------
# METHOD: selection option args
#
# Thinwrapped method of selection box class.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::body iwidgets::Selectiondialog::selectitem {} {
default OK
$itk_component(selectionbox) selectitem
}

375
arduino-0018-windows/hardware/tools/avr/share/iwidgets4.0.1/scripts/shell.itk Normal file
View file

@ -0,0 +1,375 @@
# 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: shell.itk,v 1.7 2002/02/25 06:43:26 mgbacke Exp $
# ----------------------------------------------------------------------
# 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
# ------------------------------------------------------------------
itcl::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
# ------------------------------------------------------------------
itcl::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 [itcl::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.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Shell::master {}
# ------------------------------------------------------------------
# OPTION: -modality
#
# Specify the modality of the dialog.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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)
# Need to flush the event loop. This line added as a result of
# SF ticket #227885.
update idletasks
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 [itcl::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 [itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::body iwidgets::Shell::center {{widget {}}} {
update idletasks
set hull $itk_component(hull)
set w [winfo width $hull]
set h [winfo height $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 { ($reqX+$w+$wfudge) > $sw } { set reqX [expr {$sw-$w-$wfudge}] }
if { $reqX < $wfudge } { set reqX $wfudge }
if { ($reqY+$h+$hfudge) > $sh } { set reqY [expr {$sh-$h-$hfudge}] }
if { $reqY < $hfudge } { set reqY $hfudge }
}
wm geometry $hull +$reqX+$reqY
}

693
arduino-0018-windows/hardware/tools/avr/share/iwidgets4.0.1/scripts/spindate.itk Normal file
View file

@ -0,0 +1,693 @@
# 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: spindate.itk,v 1.5 2001/08/22 15:51:13 smithc Exp $
# ----------------------------------------------------------------------
# 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
# ------------------------------------------------------------------
itcl::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
# ------------------------------------------------------------------
itcl::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 [itcl::code $this _spinMonth -1] \
-increment [itcl::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 [itcl::code $this _spinDay -1] \
-increment [itcl::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
# ------------------------------------------------------------------
itcl::body iwidgets::Spindate::destructor {} {
if {$_repack != ""} {after cancel $_repack}
}
# ------------------------------------------------------------------
# OPTIONS
# ------------------------------------------------------------------
# ------------------------------------------------------------------
# OPTION: -labelpos
#
# Specifies the location of all 3 spinners' labels.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Spindate::orient {
_packDate
}
# ------------------------------------------------------------------
# OPTION: -monthon
#
# Specifies whether or not to display the month spinner.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Spindate::monthon {
_packDate
}
# ------------------------------------------------------------------
# OPTION: -dayon
#
# Specifies whether or not to display the day spinner.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Spindate::dayon {
_packDate
}
# ------------------------------------------------------------------
# OPTION: -yearon
#
# Specifies whether or not to display the year spinner.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Spindate::yearon {
_packDate
}
# ------------------------------------------------------------------
# OPTION: -datemargin
#
# Specifies the margin space between the month and day spinners
# and the day and year spinners.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Spindate::datemargin {
_packDate
}
# ------------------------------------------------------------------
# OPTION: -yeardigits
#
# Number of digits for year display, 2 or 4
# ------------------------------------------------------------------
itcl::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).
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ----------------------------------------------------------------
itcl::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 currday [$itk_component(day) get]
set lastday [_lastDay [$itk_component(month) get] $year]
if {$currday > $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.
# ----------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::body iwidgets::Spindate::_packDate {{when later}} {
if {$when == "later"} {
if {$_repack == ""} {
set _repack [after idle [itcl::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.
# ------------------------------------------------------------------
itcl::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
}
}
}
}

237
arduino-0018-windows/hardware/tools/avr/share/iwidgets4.0.1/scripts/spinint.itk Normal file
View file

@ -0,0 +1,237 @@
# 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: spinint.itk,v 1.3 2001/08/07 19:56:48 smithc Exp $
# ----------------------------------------------------------------------
# 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
# ------------------------------------------------------------------
itcl::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
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Spinint::step {
}
# ------------------------------------------------------------------
# OPTION: -wrap
#
# Specify whether spinner should wrap value if at min or max.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Spinint::wrap {
}
# ------------------------------------------------------------------
# METHODS
# ------------------------------------------------------------------
# ------------------------------------------------------------------
# METHOD: up
#
# Up arrow button press event. Increment value in entry.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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
}
}

448
arduino-0018-windows/hardware/tools/avr/share/iwidgets4.0.1/scripts/spinner.itk Normal file
View file

@ -0,0 +1,448 @@
# 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: spinner.itk,v 1.3 2001/08/17 19:04:37 smithc Exp $
# ----------------------------------------------------------------------
# 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
# ------------------------------------------------------------------
itcl::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
# ------------------------------------------------------------------
itcl::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> [itcl::code $this _pushup]
bind $itk_component(uparrow) <ButtonRelease-1> [itcl::code $this _relup]
bind $itk_component(downarrow) <ButtonPress-1> [itcl::code $this _pushdown]
bind $itk_component(downarrow) <ButtonRelease-1> [itcl::code $this _reldown]
eval itk_initialize $args
#
# When idle, position the arrows.
#
_positionArrows
}
# ------------------------------------------------------------------
# DESTRUCTOR
# ------------------------------------------------------------------
itcl::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 .
# ------------------------------------------------------------------
itcl::configbody iwidgets::Spinner::arroworient {
_positionArrows
}
# ------------------------------------------------------------------
# OPTION: -textfont
#
# Change font, resize arrow buttons.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Spinner::textfont {
_positionArrows
}
# ------------------------------------------------------------------
# OPTION: -highlightthickness
#
# Change highlightthickness, resize arrow buttons.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Spinner::highlightthickness {
_positionArrows
}
# ------------------------------------------------------------------
# OPTION: -borderwidth
#
# Change borderwidth, resize arrow buttons.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Spinner::borderwidth {
_positionArrows
}
# ------------------------------------------------------------------
# OPTION: -increment
#
# Up arrow callback.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Spinner::increment {
if {$itk_option(-increment) == {}} {
set itk_option(-increment) [itcl::code $this up]
}
}
# ------------------------------------------------------------------
# OPTION: -decrement
#
# Down arrow callback.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Spinner::decrement {
if {$itk_option(-decrement) == {}} {
set itk_option(-decrement) [itcl::code $this down]
}
}
# ------------------------------------------------------------------
# OPTION: -repeatinterval
#
# Arrow repeat rate in milliseconds. A repeatinterval of 0 disables
# button repeat.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Spinner::repeatinterval {
if {$itk_option(-repeatinterval) < 0} {
set itk_option(-repeatinterval) 0
}
}
# ------------------------------------------------------------------
# OPTION: -repeatdelay
#
# Arrow repeat delay in milliseconds.
# ------------------------------------------------------------------
itcl::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...
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::body iwidgets::Spinner::up {} {
}
# ------------------------------------------------------------------
# METHOD: down
#
# Down arrow command. Meant to be overloaded by derived class.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::body iwidgets::Spinner::_positionArrows {{when later}} {
if {$when == "later"} {
if {$_reposition == ""} {
set _reposition [after idle [itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::body iwidgets::Spinner::_doup {rate} {
_up
if {$itk_option(-repeatinterval) > 0} {
set _uptimer [after $rate [itcl::code $this _doup $itk_option(-repeatinterval)]]
}
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _dodown
#
# Call _down and post to do another one after "rate" milliseconds if
# repeatinterval > 0.
# ------------------------------------------------------------------
itcl::body iwidgets::Spinner::_dodown {rate} {
_down
if {$itk_option(-repeatinterval) > 0} {
set _downtimer \
[after $rate [itcl::code $this _dodown $itk_option(-repeatinterval)]]
}
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _relup
#
# Up arrow button release event. Cancel pending up timer.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::body iwidgets::Spinner::_up {} {
uplevel #0 $itk_option(-increment)
}
# ------------------------------------------------------------------
# PRIVATE METHOD: _down
#
# Down arrow button press event. Call defined decrement command.
# ------------------------------------------------------------------
itcl::body iwidgets::Spinner::_down {} {
uplevel #0 $itk_option(-decrement)
}

527
arduino-0018-windows/hardware/tools/avr/share/iwidgets4.0.1/scripts/spintime.itk Normal file
View file

@ -0,0 +1,527 @@
# 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: spintime.itk,v 1.3 2001/08/17 19:04:45 smithc Exp $
# ----------------------------------------------------------------------
# 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
# ------------------------------------------------------------------
itcl::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
# ------------------------------------------------------------------
itcl::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 [itcl::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 [itcl::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
# ------------------------------------------------------------------
itcl::body iwidgets::Spintime::destructor {} {
if {$_repack != ""} {after cancel $_repack}
}
# ------------------------------------------------------------------
# OPTIONS
# ------------------------------------------------------------------
# ------------------------------------------------------------------
# OPTION: -orient
#
# Specifies the orientation of the 3 spinners for Hour, Minute
# and second.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Spintime::orient {
_packTime
}
# ------------------------------------------------------------------
# OPTION: -labelpos
#
# Specifies the location of all 3 spinners' labels.
# Overloaded
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Spintime::houron {
_packTime
}
# ------------------------------------------------------------------
# OPTION: -minuteon
#
# Specifies whether or not to display the minute spinner.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Spintime::minuteon {
_packTime
}
# ------------------------------------------------------------------
# OPTION: -secondon
#
# Specifies whether or not to display the second spinner.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Spintime::secondon {
_packTime
}
# ------------------------------------------------------------------
# OPTION: -timemargin
#
# Specifies the margin space between the hour and minute spinners
# and the minute and second spinners.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Spintime::timemargin {
_packTime
}
# ------------------------------------------------------------------
# OPTION: -militaryon
#
# Specifies 24-hour clock or 12-hour.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::body iwidgets::Spintime::_packTime {{when later}} {
if {$when == "later"} {
if {$_repack == ""} {
set _repack [after idle [itcl::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.
# ------------------------------------------------------------------
itcl::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
}

1105
arduino-0018-windows/hardware/tools/avr/share/iwidgets4.0.1/scripts/tabnotebook.itk Normal file
View file

File diff suppressed because it is too large Load diff

2753
arduino-0018-windows/hardware/tools/avr/share/iwidgets4.0.1/scripts/tabset.itk Normal file
View file

File diff suppressed because it is too large Load diff

1372
arduino-0018-windows/hardware/tools/avr/share/iwidgets4.0.1/scripts/tclIndex Normal file
View file

File diff suppressed because it is too large Load diff

398
arduino-0018-windows/hardware/tools/avr/share/iwidgets4.0.1/scripts/timeentry.itk Normal file
View file

@ -0,0 +1,398 @@
#
# 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: timeentry.itk,v 1.4 2001/08/17 19:05:08 smithc Exp $
# ----------------------------------------------------------------------
# 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
# ------------------------------------------------------------------
itcl::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
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::configbody iwidgets::Timeentry::state {
switch -- $itk_option(-state) {
normal {
bind $itk_component(iconbutton) <Button-1> [itcl::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.
# ------------------------------------------------------------------
itcl::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.
#
itcl::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.
# ------------------------------------------------------------------
itcl::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> [itcl::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 [itcl::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 {(($popupx + $popupwidth) > [winfo screenwidth .]) || \
(($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.
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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> [itcl::code $this _popup]
}

1018
arduino-0018-windows/hardware/tools/avr/share/iwidgets4.0.1/scripts/timefield.itk Normal file
View file

File diff suppressed because it is too large Load diff

983
arduino-0018-windows/hardware/tools/avr/share/iwidgets4.0.1/scripts/toolbar.itk Normal file
View file

@ -0,0 +1,983 @@
#
# 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: toolbar.itk,v 1.5 2001/08/17 19:05:54 smithc Exp $
# ----------------------------------------------------------------------
# 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
# ------------------------------------------------------------------
itcl::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
# ------------------------------------------------------------------
itcl::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> "+[itcl::code $this showHelp %W]"
bind toolbar-help-$itk_component(hull) \
<Leave> "+[itcl::code $this hideHelp]"
# ... Set up Microsoft style balloon help display.
set _balloonTimer $itk_option(-balloondelay1)
bind $_interior \
<Leave> "+[itcl::code $this _resetBalloonTimer]"
bind toolbar-balloon-$itk_component(hull) \
<Enter> "+[itcl::code $this _startBalloonDelay %W]"
bind toolbar-balloon-$itk_component(hull) \
<Leave> "+[itcl::code $this _stopBalloonDelay %W false]"
bind toolbar-balloon-$itk_component(hull) \
<Button-1> "+[itcl::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
# ------------------------------------------------------------------
itcl::body iwidgets::Toolbar::destructor {} {
if {$_balloonAfterID != 0} {after cancel $_balloonAfterID}
}
# ------------------------------------------------------------------
# OPTIONS
# ------------------------------------------------------------------
# ------------------------------------------------------------------
# OPTION -balloonbackground
# ------------------------------------------------------------------
itcl::configbody iwidgets::Toolbar::balloonbackground {
if { $_hintWindow != {} } {
if { $itk_option(-balloonbackground) != {} } {
$_hintWindow.label configure \
-background $itk_option(-balloonbackground)
}
}
}
# ------------------------------------------------------------------
# OPTION -balloonforeground
# ------------------------------------------------------------------
itcl::configbody iwidgets::Toolbar::balloonforeground {
if { $_hintWindow != {} } {
if { $itk_option(-balloonforeground) != {} } {
$_hintWindow.label configure \
-foreground $itk_option(-balloonforeground)
}
}
}
# ------------------------------------------------------------------
# OPTION -balloonfont
# ------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# -------------------------------------------------------------
itcl::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
#
# -------------------------------------------------------------
itcl::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
#
# -------------------------------------------------------------
itcl::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.
#
# -------------------------------------------------------------
itcl::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
#
# ----------------------------------------------------------------------
itcl::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.
#
# -------------------------------------------------------------
itcl::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
#
# -------------------------------------------------------------
itcl::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
#
# -------------------------------------------------------------
itcl::body iwidgets::Toolbar::_startBalloonDelay {window} {
if {$_balloonAfterID != 0} {
after cancel $_balloonAfterID
}
set _balloonAfterID [after $_balloonTimer [itcl::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.
#
# -------------------------------------------------------------
itcl::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.
#
# -------------------------------------------------------------
itcl::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.
#
# -------------------------------------------------------------
itcl::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
#
# -------------------------------------------------------------
itcl::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.
#
# -------------------------------------------------------------
itcl::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.
#
# -------------------------------------------------------------
itcl::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
#
# -------------------------------------------------------------
itcl::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
#
# -------------------------------------------------------------
itcl::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
# -------------------------------------------------------------
itcl::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
#
# -------------------------------------------------------------
itcl::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
#
#
#
# -------------------------------------------------------------
itcl::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
}
}
}

BIN
arduino-0018-windows/hardware/tools/avr/share/iwidgets4.0.1/scripts/unknownimage.gif Normal file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 472 B

626
arduino-0018-windows/hardware/tools/avr/share/iwidgets4.0.1/scripts/watch.itk Normal file
View file

@ -0,0 +1,626 @@
#
# 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
}
itcl::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
# -----------------------------------------------------------------------------
itcl::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> +[itcl::code $this _displayClock]
bind $itk_component(canvas) <Configure> +[itcl::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 [itcl::scope _ampmVar($this)]
} {
usual
rename -font -labelfont labelFont Font
}
itk_component add pm {
radiobutton $itk_component(frame).pm \
-text "PM" \
-value "PM" \
-variable [itcl::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
# -----------------------------------------------------------------------------
itcl::body iwidgets::Watch::destructor {} {
if {$_reposition != ""} {
after cancel $_reposition
}
}
# -----------------------------------------------------------------------------
# METHODS
# -----------------------------------------------------------------------------
# -----------------------------------------------------------------------------
# METHOD: _handReleaseCB tag x y
#
# -----------------------------------------------------------------------------
itcl::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
#
# -----------------------------------------------------------------------------
itcl::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?
#
# -----------------------------------------------------------------------------
itcl::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.
# -----------------------------------------------------------------------------
itcl::body iwidgets::Watch::watch {args} {
return [eval $itk_component(canvas) $args]
}
# -----------------------------------------------------------------------------
# METHOD: _drawHand tag
#
# -----------------------------------------------------------------------------
itcl::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.
# ------------------------------------------------------------------
itcl::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.
# -----------------------------------------------------------------------------
itcl::body iwidgets::Watch::_displayClock {{when "later"}} {
if {$when == "later"} {
if {$_reposition == ""} {
set _reposition [after idle [itcl::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.
# ------------------------------------------------------------------
itcl::configbody ::iwidgets::Watch::state {
if {$itk_option(-state) == "normal"} {
watch bind minute <B1-Motion> \
[itcl::code $this _handMotionCB minute %x %y]
watch bind minute <ButtonRelease-1> \
[itcl::code $this _handReleaseCB minute %x %y]
watch bind hour <B1-Motion> \
[itcl::code $this _handMotionCB hour %x %y]
watch bind hour <ButtonRelease-1> \
[itcl::code $this _handReleaseCB hour %x %y]
watch bind second <B1-Motion> \
[itcl::code $this _handMotionCB second %x %y]
watch bind second <ButtonRelease-1> \
[itcl::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.
# ------------------------------------------------------------------
itcl::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.
#
itcl::configbody ::iwidgets::Watch::pivotcolor {
watch itemconfigure pivot -fill $itk_option(-pivotcolor)
}
# ------------------------------------------------------------------
# OPTION: clockstipple
#
# Configure the stipple pattern for the clock fill color.
#
itcl::configbody ::iwidgets::Watch::clockstipple {
watch itemconfigure clock -stipple $itk_option(-clockstipple)
}
# ------------------------------------------------------------------
# OPTION: clockcolor
#
# Configure the color of the clock.
#
itcl::configbody ::iwidgets::Watch::clockcolor {
watch itemconfigure clock -fill $itk_option(-clockcolor)
}
# ------------------------------------------------------------------
# OPTION: hourcolor
#
# Configure the color of the hour hand.
#
itcl::configbody ::iwidgets::Watch::hourcolor {
watch itemconfigure hour -fill $itk_option(-hourcolor)
}
# ------------------------------------------------------------------
# OPTION: minutecolor
#
# Configure the color of the minute hand.
#
itcl::configbody ::iwidgets::Watch::minutecolor {
watch itemconfigure minute -fill $itk_option(-minutecolor)
}
# ------------------------------------------------------------------
# OPTION: secondcolor
#
# Configure the color of the second hand.
#
itcl::configbody ::iwidgets::Watch::secondcolor {
watch itemconfigure second -fill $itk_option(-secondcolor)
}
# ------------------------------------------------------------------
# OPTION: tickcolor
#
# Configure the color of the ticks.
#
itcl::configbody ::iwidgets::Watch::tickcolor {
watch itemconfigure tick -outline $itk_option(-tickcolor)
}
# ------------------------------------------------------------------
# OPTION: hourradius
#
# Configure the radius of the hour hand.
#
itcl::configbody ::iwidgets::Watch::hourradius {
_displayClock
}
# ------------------------------------------------------------------
# OPTION: minuteradius
#
# Configure the radius of the minute hand.
#
itcl::configbody ::iwidgets::Watch::minuteradius {
_displayClock
}
# ------------------------------------------------------------------
# OPTION: secondradius
#
# Configure the radius of the second hand.
#
itcl::configbody ::iwidgets::Watch::secondradius {
_displayClock
}