arcadia 0.1.1 → 0.1.2

data/tcl/BWidget-1.8.0/LICENSE.txt

@@ -0,0 +1,41 @@
+BWidget ToolKit
+Copyright (c) 1998-1999 UNIFIX. 
+Copyright (c) 2001-2002 ActiveState Corp. 
+
+The following terms apply to all files associated with the software
+unless explicitly disclaimed in individual files.
+
+The authors hereby grant permission to use, copy, modify, distribute,
+and license this software and its documentation for any purpose, provided
+that existing copyright notices are retained in all copies and that this
+notice is included verbatim in any distributions. No written agreement,
+license, or royalty fee is required for any of the authorized uses.
+Modifications to this software may be copyrighted by their authors
+and need not follow the licensing terms described here, provided that
+the new terms are clearly indicated on the first page of each file where
+they apply.
+
+IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
+FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
+ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
+DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.
+
+THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE, 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.
+
+GOVERNMENT USE: If you are acquiring this software on behalf of the
+U.S. government, the Government shall have only "Restricted Rights"
+in the software and related documentation as defined in the Federal 
+Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2).  If you
+are acquiring the software on behalf of the Department of Defense, the
+software shall be classified as "Commercial Computer Software" and the
+Government shall have only "Restricted Rights" as defined in Clause
+252.227-7013 (c) (1) of DFARs.  Notwithstanding the foregoing, the
+authors grant the U.S. Government and others acting in its behalf
+permission to use and distribute the software in accordance with the
+terms specified in this license. 

data/tcl/BWidget-1.8.0/README.txt

@@ -0,0 +1,127 @@
+BWidget ToolKit 1.8.0				October 2006
+Copyright (c) 1998-1999 UNIFIX.
+Copyright (c) 2001-2002 ActiveState Corp. 
+
+See the file LICENSE.txt for license info (uses Tcl's BSD-style license).
+
+--------------------------------------------------------------------------
+
+WHAT IS BWIDGET ?
+
+The BWidget Toolkit is a high-level Widget Set for Tcl/Tk built using
+native Tcl/Tk 8.x namespaces.
+
+The BWidgets have a professional look&feel as in other well known
+Toolkits (Tix or Incr Widgets), but the concept is radically different
+because everything is pure Tcl/Tk.  No platform dependencies, and no
+compiling required.  The code is 100% Pure Tcl/Tk.
+
+The BWidget library was originally developed by UNIFIX Online, and
+released under both the GNU Public License and the Tcl license.
+BWidget is now maintained as a community project, hosted by
+Sourceforge.  Scores of fixes and enhancements have been added by
+community developers.  See the ChangeLog file for details.
+
+--------------------------------------------------------------------------
+
+WIDGET LIST (1.8)
+
+Simple Widgets 
+      Label           Extended Label widget
+      Entry           Extended Entry widget
+      Button          Extended Button widget
+      ArrowButton     Button widget with an arrow shape.
+      ProgressBar     Progress indicator widget
+      ScrollView      Display the visible area of a scrolled window
+      Separator       3D separator widget
+
+Manager Widgets 
+      MainFrame       Manage toplevel with menu, toolbar and statusbar 
+      LabelFrame      Frame with a Label
+      TitleFrame      Frame with a title
+      ScrolledWindow  Generic scrolled widget
+      ScrollableFrame Scrollable frame containing widget
+      PanedWindow     Tiled layout manager widget
+      ButtonBox       Set of buttons with horizontal or vertical layout
+      PagesManager    Pages manager widget
+      NoteBook        Notebook manager widget
+      Dialog          Dialog abstraction with custom buttons
+
+Composite Widgets 
+      LabelEntry      LabelFrame containing an Entry widget. 
+      ComboBox        ComboBox widget
+      SpinBox         SpinBox widget
+      Tree            Tree widget
+      ListBox         ListBox widget
+      MessageDlg      Message dialog box
+      ProgressDlg     Progress indicator dialog box
+      PasswdDlg       Login/Password dialog box (contributed by Stephane Lavirotte)
+      SelectFont      Font selection widget
+      SelectColor     Color selection widget
+
+Commands Classes 
+      Widget          The Widget base class
+      DynamicHelp     Provide help to Tk widget or BWidget
+      DragSite        Commands set for Drag facilities
+      DropSite        Commands set for Drop facilities
+      BWidget         Utilities
+
+--------------------------------------------------------------------------
+INSTALLATION AND USE
+
+- On Unix Platform:
+  Uncompress the file BWidget-<version>.tar.Z|gz
+
+  To use the BWidget:
+  - If you have uncompressed the archive file under the Tcl Library Path
+    directory, you only need to do:
+      % package require BWidget
+  - If not, you have to specify the BWidget installation path in auto_path
+    global variable:
+      % lappend auto_path <install_path>
+      % package require BWidget
+
+  To launch the demo, you need to cd into the demo subdirectory:
+      $ cd <install_path>/demo
+      $ wish demo.tcl
+
+- On Windows and others Platforms:
+  Uncompress the file BWidget-<version>.zip
+
+  To use the BWidget:
+  - If you uncompressed the archive file under the Tcl Library Path
+    directory, you only need to do:
+      % package require BWidget
+  - If not, you have to specify the BWidget installation path in auto_path
+    global variable:
+      % lappend auto_path your_path
+      % package require BWidget
+
+  To launch the demo :
+      Double click on demo.tcl in the demo subdirectory
+
+
+Distribution contains these directories:
+
+BWidget-<version>   Root directory and BWidget Tcl sources
+   BWman        HTML manual pages
+   images       images used by BWidget
+   lang         Resources for language customization
+   demo         Demo sources
+   tests        BWidgets test suite         
+
+
+--------------------------------------------------------------------------
+
+DOCUMENTATION
+
+HTML manual pages are available in the BWman subdirectory.  Point to
+index.html for frame version with tree navigation, or to contents.html
+for no frame version.
+
+--------------------------------------------------------------------------
+
+CONTACTS
+
+The BWidget toolkit is maintained on Sourceforge, at
+http://www.sourceforge.net/projects/tcllib/

data/tcl/BWidget-1.8.0/arrow.tcl

@@ -0,0 +1,551 @@
+# ------------------------------------------------------------------------------
+#  arrow.tcl
+#  This file is part of Unifix BWidget Toolkit
+# ------------------------------------------------------------------------------
+#  Index of commands:
+#   Public commands
+#     - ArrowButton::create
+#     - ArrowButton::configure
+#     - ArrowButton::cget
+#     - ArrowButton::invoke
+#   Private commands (redraw commands)
+#     - ArrowButton::_redraw
+#     - ArrowButton::_redraw_state
+#     - ArrowButton::_redraw_relief
+#     - ArrowButton::_redraw_whole
+#   Private commands (event bindings)
+#     - ArrowButton::_destroy
+#     - ArrowButton::_enter
+#     - ArrowButton::_leave
+#     - ArrowButton::_press
+#     - ArrowButton::_release
+#     - ArrowButton::_repeat
+# ------------------------------------------------------------------------------
+
+namespace eval ArrowButton {
+    Widget::define ArrowButton arrow DynamicHelp
+
+    Widget::tkinclude ArrowButton button .c \
+	    include [list \
+		-borderwidth -bd \
+		-relief -highlightbackground \
+		-highlightcolor -highlightthickness -takefocus]
+
+    Widget::declare ArrowButton [list \
+	    [list -type		Enum button 0 [list arrow button]] \
+	    [list -dir		Enum top    0 [list top bottom left right]] \
+	    [list -width	Int	15	0	"%d >= 0"] \
+	    [list -height	Int	15	0	"%d >= 0"] \
+	    [list -ipadx	Int	0	0	"%d >= 0"] \
+	    [list -ipady	Int	0	0	"%d >= 0"] \
+	    [list -clean	Int	2	0	"%d >= 0 && %d <= 2"] \
+	    [list -activeforeground	TkResource	""	0 button] \
+	    [list -activebackground	TkResource	""	0 button] \
+	    [list -disabledforeground 	TkResource	""	0 button] \
+	    [list -foreground		TkResource	""	0 button] \
+	    [list -background		TkResource	""	0 button] \
+	    [list -state		TkResource	""	0 button] \
+	    [list -troughcolor		TkResource	""	0 scrollbar] \
+	    [list -arrowbd	Int	1	0	"%d >= 0 && %d <= 2"] \
+	    [list -arrowrelief	Enum	raised	0	[list raised sunken]] \
+	    [list -command		String	""	0] \
+	    [list -armcommand		String	""	0] \
+	    [list -disarmcommand	String	""	0] \
+	    [list -repeatdelay		Int	0	0	"%d >= 0"] \
+	    [list -repeatinterval	Int	0	0	"%d >= 0"] \
+	    [list -fg	Synonym	-foreground] \
+	    [list -bg	Synonym	-background] \
+	    ]
+    DynamicHelp::include ArrowButton balloon
+
+    bind BwArrowButtonC <Enter>           {ArrowButton::_enter %W}
+    bind BwArrowButtonC <Leave>           {ArrowButton::_leave %W}
+    bind BwArrowButtonC <ButtonPress-1>   {ArrowButton::_press %W}
+    bind BwArrowButtonC <ButtonRelease-1> {ArrowButton::_release %W}
+    bind BwArrowButtonC <Key-space>       {ArrowButton::invoke %W; break}
+    bind BwArrowButtonC <Return>          {ArrowButton::invoke %W; break}
+    bind BwArrowButton <Configure>       {ArrowButton::_redraw_whole %W %w %h}
+    bind BwArrowButton <Destroy>         {ArrowButton::_destroy %W}
+
+    variable _grab
+    variable _moved
+
+    array set _grab {current "" pressed "" oldstate "" oldrelief ""}
+}
+
+
+# -----------------------------------------------------------------------------
+#  Command ArrowButton::create
+# -----------------------------------------------------------------------------
+proc ArrowButton::create { path args } {
+    # Initialize configuration mappings and parse arguments
+    array set submaps [list ArrowButton [list ] .c [list ]]
+    array set submaps [Widget::parseArgs ArrowButton $args]
+
+    # Create the class frame (so we can do the option db queries)
+    frame $path -class ArrowButton -borderwidth 0 -highlightthickness 0 
+    Widget::initFromODB ArrowButton $path $submaps(ArrowButton)
+
+    # Create the canvas with the initial options
+    eval [list canvas $path.c] $submaps(.c)
+
+    # Compute the width and height of the canvas from the width/height
+    # of the ArrowButton and the borderwidth/hightlightthickness.
+    set w   [Widget::getMegawidgetOption $path -width]
+    set h   [Widget::getMegawidgetOption $path -height]
+    set bd  [Widget::cget $path -borderwidth]
+    set ht  [Widget::cget $path -highlightthickness]
+    set pad [expr {2*($bd+$ht)}]
+
+    $path.c configure -width [expr {$w-$pad}] -height [expr {$h-$pad}]
+    bindtags $path [list $path BwArrowButton [winfo toplevel $path] all]
+    bindtags $path.c [list $path.c BwArrowButtonC [winfo toplevel $path.c] all]
+    pack $path.c -expand yes -fill both
+
+    DynamicHelp::sethelp $path $path.c 1
+
+    set ::ArrowButton::_moved($path) 0
+
+    return [Widget::create ArrowButton $path]
+}
+
+
+# -----------------------------------------------------------------------------
+#  Command ArrowButton::configure
+# -----------------------------------------------------------------------------
+proc ArrowButton::configure { path args } {
+    set res [Widget::configure $path $args]
+
+    set ch1 [expr {[Widget::hasChanged $path -width  w] |
+                   [Widget::hasChanged $path -height h] |
+                   [Widget::hasChanged $path -borderwidth bd] |
+                   [Widget::hasChanged $path -highlightthickness ht]}]
+    set ch2 [expr {[Widget::hasChanged $path -type    val] |
+                   [Widget::hasChanged $path -ipadx   val] |
+                   [Widget::hasChanged $path -ipady   val] |
+                   [Widget::hasChanged $path -arrowbd val] |
+                   [Widget::hasChanged $path -clean   val] |
+                   [Widget::hasChanged $path -dir     val]}]
+
+    if { $ch1 } {
+        set pad [expr {2*($bd+$ht)}]
+        $path.c configure \
+            -width [expr {$w-$pad}] -height [expr {$h-$pad}] \
+            -borderwidth $bd -highlightthickness $ht
+	set ch2 1
+    }
+    if { $ch2 } {
+        _redraw_whole $path [winfo width $path] [winfo height $path]
+    } else {
+        _redraw_relief $path
+        _redraw_state $path
+    }
+    DynamicHelp::sethelp $path $path.c
+
+    return $res
+}
+
+
+# -----------------------------------------------------------------------------
+#  Command ArrowButton::cget
+# -----------------------------------------------------------------------------
+proc ArrowButton::cget { path option } {
+    return [Widget::cget $path $option]
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ArrowButton::invoke
+# ------------------------------------------------------------------------------
+proc ArrowButton::invoke { path } {
+    if { ![string equal [winfo class $path] "ArrowButton"] } {
+	set path [winfo parent $path]
+    }
+    if { ![string equal [Widget::getoption $path -state] "disabled"] } {
+        set oldstate [Widget::getoption $path -state]
+        if { [string equal [Widget::getoption $path -type] "button"] } {
+            set oldrelief [Widget::getoption $path -relief]
+            configure $path -state active -relief sunken
+        } else {
+            set oldrelief [Widget::getoption $path -arrowrelief]
+            configure $path -state active -arrowrelief sunken
+        }
+	update idletasks
+        if {[llength [set cmd [Widget::getoption $path -armcommand]]]} {
+            uplevel \#0 $cmd
+        }
+	after 10
+        if { [string equal [Widget::getoption $path -type] "button"] } {
+            configure $path -state $oldstate -relief $oldrelief
+        } else {
+            configure $path -state $oldstate -arrowrelief $oldrelief
+        }
+        if {[llength [set cmd [Widget::getoption $path -disarmcommand]]]} {
+            uplevel \#0 $cmd
+        }
+        if {[llength [set cmd [Widget::getoption $path -command]]]} {
+            uplevel \#0 $cmd
+        }
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ArrowButton::_redraw
+# ------------------------------------------------------------------------------
+proc ArrowButton::_redraw { path width height } {
+    variable _moved
+
+    set _moved($path) 0
+    set type  [Widget::getoption $path -type]
+    set dir   [Widget::getoption $path -dir]
+    set bd    [expr {[$path.c cget -borderwidth] + [$path.c cget -highlightthickness] + 1}]
+    set clean [Widget::getoption $path -clean]
+    if { [string equal $type "arrow"] } {
+        if { [set id [$path.c find withtag rect]] == "" } {
+            $path.c create rectangle $bd $bd [expr {$width-$bd-1}] [expr {$height-$bd-1}] -tags rect
+        } else {
+            $path.c coords $id $bd $bd [expr {$width-$bd-1}] [expr {$height-$bd-1}]
+        }
+        $path.c lower rect
+        set arrbd [Widget::getoption $path -arrowbd]
+        set bd    [expr {$bd+$arrbd-1}]
+    } else {
+        $path.c delete rect
+    }
+    # w and h are max width and max height of arrow
+    set w [expr {$width  - 2*([Widget::getoption $path -ipadx]+$bd)}]
+    set h [expr {$height - 2*([Widget::getoption $path -ipady]+$bd)}]
+
+    if { $w < 2 } {set w 2}
+    if { $h < 2 } {set h 2}
+
+    if { $clean > 0 } {
+        # arrange for base to be odd
+        if { [string equal $dir "top"] || [string equal $dir "bottom"] } {
+            if { !($w % 2) } {
+                incr w -1
+            }
+            if { $clean == 2 } {
+                # arrange for h = (w+1)/2
+                set h2 [expr {($w+1)/2}]
+                if { $h2 > $h } {
+                    set w [expr {2*$h-1}]
+                } else {
+                    set h $h2
+                }
+            }
+        } else {
+            if { !($h % 2) } {
+                incr h -1
+            }
+            if { $clean == 2 } {
+                # arrange for w = (h+1)/2
+                set w2 [expr {($h+1)/2}]
+                if { $w2 > $w } {
+                    set h [expr {2*$w-1}]
+                } else {
+                    set w $w2
+                }
+            }
+        }
+    }
+
+    set x0 [expr {($width-$w)/2}]
+    set y0 [expr {($height-$h)/2}]
+    set x1 [expr {$x0+$w-1}]
+    set y1 [expr {$y0+$h-1}]
+
+    switch $dir {
+        top {
+            set xd [expr {($x0+$x1)/2}]
+            if { [set id [$path.c find withtag poly]] == "" } {
+                $path.c create polygon $x0 $y1 $x1 $y1 $xd $y0 -tags poly
+            } else {
+                $path.c coords $id $x0 $y1 $x1 $y1 $xd $y0
+            }
+            if { [string equal $type "arrow"] } {
+                if { [set id [$path.c find withtag bot]] == "" } {
+                    $path.c create line $x0 $y1 $x1 $y1 $xd $y0 -tags bot
+                } else {
+                    $path.c coords $id $x0 $y1 $x1 $y1 $xd $y0
+                }
+                if { [set id [$path.c find withtag top]] == "" } {
+                    $path.c create line $x0 $y1 $xd $y0 -tags top
+                } else {
+                    $path.c coords $id $x0 $y1 $xd $y0
+                }
+                $path.c itemconfigure top -width $arrbd
+                $path.c itemconfigure bot -width $arrbd
+            } else {
+                $path.c delete top
+                $path.c delete bot
+            }
+        }
+        bottom {
+            set xd [expr {($x0+$x1)/2}]
+            if { [set id [$path.c find withtag poly]] == "" } {
+                $path.c create polygon $x1 $y0 $x0 $y0 $xd $y1 -tags poly
+            } else {
+                $path.c coords $id $x1 $y0 $x0 $y0 $xd $y1
+            }
+            if { [string equal $type "arrow"] } {
+                if { [set id [$path.c find withtag top]] == "" } {
+                    $path.c create line $x1 $y0 $x0 $y0 $xd $y1 -tags top
+                } else {
+                    $path.c coords $id $x1 $y0 $x0 $y0 $xd $y1
+                }
+                if { [set id [$path.c find withtag bot]] == "" } {
+                    $path.c create line $x1 $y0 $xd $y1 -tags bot
+                } else {
+                    $path.c coords $id $x1 $y0 $xd $y1
+                }
+                $path.c itemconfigure top -width $arrbd
+                $path.c itemconfigure bot -width $arrbd
+            } else {
+                $path.c delete top
+                $path.c delete bot
+            }
+        }
+        left {
+            set yd [expr {($y0+$y1)/2}]
+            if { [set id [$path.c find withtag poly]] == "" } {
+                $path.c create polygon $x1 $y0 $x1 $y1 $x0 $yd -tags poly
+            } else {
+                $path.c coords $id $x1 $y0 $x1 $y1 $x0 $yd
+            }
+            if { [string equal $type "arrow"] } {
+                if { [set id [$path.c find withtag bot]] == "" } {
+                    $path.c create line $x1 $y0 $x1 $y1 $x0 $yd -tags bot
+                } else {
+                    $path.c coords $id $x1 $y0 $x1 $y1 $x0 $yd
+                }
+                if { [set id [$path.c find withtag top]] == "" } {
+                    $path.c create line $x1 $y0 $x0 $yd -tags top
+                } else {
+                    $path.c coords $id $x1 $y0 $x0 $yd
+                }
+                $path.c itemconfigure top -width $arrbd
+                $path.c itemconfigure bot -width $arrbd
+            } else {
+                $path.c delete top
+                $path.c delete bot
+            }
+        }
+        right {
+            set yd [expr {($y0+$y1)/2}]
+            if { [set id [$path.c find withtag poly]] == "" } {
+                $path.c create polygon $x0 $y1 $x0 $y0 $x1 $yd -tags poly
+            } else {
+                $path.c coords $id $x0 $y1 $x0 $y0 $x1 $yd
+            }
+            if { [string equal $type "arrow"] } {
+                if { [set id [$path.c find withtag top]] == "" } {
+                    $path.c create line $x0 $y1 $x0 $y0 $x1 $yd -tags top
+                } else {
+                    $path.c coords $id $x0 $y1 $x0 $y0 $x1 $yd
+                }
+                if { [set id [$path.c find withtag bot]] == "" } {
+                    $path.c create line $x0 $y1 $x1 $yd -tags bot
+                } else {
+                    $path.c coords $id $x0 $y1 $x1 $yd
+                }
+                $path.c itemconfigure top -width $arrbd
+                $path.c itemconfigure bot -width $arrbd
+            } else {
+                $path.c delete top
+                $path.c delete bot
+            }
+        }
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ArrowButton::_redraw_state
+# ------------------------------------------------------------------------------
+proc ArrowButton::_redraw_state { path } {
+    set state [Widget::getoption $path -state]
+    if { [string equal [Widget::getoption $path -type] "button"] } {
+        switch $state {
+            normal   {set bg -background;       set fg -foreground}
+            active   {set bg -activebackground; set fg -activeforeground}
+            disabled {set bg -background;       set fg -disabledforeground}
+        }
+        set fg [Widget::getoption $path $fg]
+        $path.c configure -background [Widget::getoption $path $bg]
+        $path.c itemconfigure poly -fill $fg -outline $fg
+    } else {
+        switch $state {
+            normal   {set stipple "";     set bg [Widget::getoption $path -background] }
+            active   {set stipple "";     set bg [Widget::getoption $path -activebackground] }
+            disabled {set stipple gray50; set bg black }
+        }
+        set thrc [Widget::getoption $path -troughcolor]
+        $path.c configure -background [Widget::getoption $path -background]
+        $path.c itemconfigure rect -fill $thrc -outline $thrc
+        $path.c itemconfigure poly -fill $bg   -outline $bg -stipple $stipple
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ArrowButton::_redraw_relief
+# ------------------------------------------------------------------------------
+proc ArrowButton::_redraw_relief { path } {
+    variable _moved
+
+    if { [string equal [Widget::getoption $path -type] "button"] } {
+        if { [string equal [Widget::getoption $path -relief] "sunken"] } {
+            if { !$_moved($path) } {
+                $path.c move poly 1 1
+                set _moved($path) 1
+            }
+        } else {
+            if { $_moved($path) } {
+                $path.c move poly -1 -1
+                set _moved($path) 0
+            }
+        }
+    } else {
+        set col3d [BWidget::get3dcolor $path [Widget::getoption $path -background]]
+        switch [Widget::getoption $path -arrowrelief] {
+            raised {set top [lindex $col3d 1]; set bot [lindex $col3d 0]}
+            sunken {set top [lindex $col3d 0]; set bot [lindex $col3d 1]}
+        }
+        $path.c itemconfigure top -fill $top
+        $path.c itemconfigure bot -fill $bot
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ArrowButton::_redraw_whole
+# ------------------------------------------------------------------------------
+proc ArrowButton::_redraw_whole { path width height } {
+    _redraw $path $width $height
+    _redraw_relief $path
+    _redraw_state $path
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ArrowButton::_enter
+# ------------------------------------------------------------------------------
+proc ArrowButton::_enter { path } {
+    variable _grab
+    set path [winfo parent $path]
+    set _grab(current) $path
+    if { ![string equal [Widget::getoption $path -state] "disabled"] } {
+        set _grab(oldstate) [Widget::getoption $path -state]
+        configure $path -state active
+        if { $_grab(pressed) == $path } {
+            if { [string equal [Widget::getoption $path -type] "button"] } {
+                set _grab(oldrelief) [Widget::getoption $path -relief]
+                configure $path -relief sunken
+            } else {
+                set _grab(oldrelief) [Widget::getoption $path -arrowrelief]
+                configure $path -arrowrelief sunken
+            }
+        }
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ArrowButton::_leave
+# ------------------------------------------------------------------------------
+proc ArrowButton::_leave { path } {
+    variable _grab
+    set path [winfo parent $path]
+    set _grab(current) ""
+    if { ![string equal [Widget::getoption $path -state] "disabled"] } {
+        configure $path -state $_grab(oldstate)
+        if { $_grab(pressed) == $path } {
+            if { [string equal [Widget::getoption $path -type] "button"] } {
+                configure $path -relief $_grab(oldrelief)
+            } else {
+                configure $path -arrowrelief $_grab(oldrelief)
+            }
+        }
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ArrowButton::_press
+# ------------------------------------------------------------------------------
+proc ArrowButton::_press { path } {
+    variable _grab
+    set path [winfo parent $path]
+    if { ![string equal [Widget::getoption $path -state] "disabled"] } {
+        set _grab(pressed) $path
+            if { [string equal [Widget::getoption $path -type] "button"] } {
+            set _grab(oldrelief) [Widget::getoption $path -relief]
+            configure $path -relief sunken
+        } else {
+            set _grab(oldrelief) [Widget::getoption $path -arrowrelief]
+            configure $path -arrowrelief sunken
+        }
+        if {[llength [set cmd [Widget::getoption $path -armcommand]]]} {
+            uplevel \#0 $cmd
+            if { [set delay [Widget::getoption $path -repeatdelay]]    > 0 ||
+                 [set delay [Widget::getoption $path -repeatinterval]] > 0 } {
+                after $delay [list ArrowButton::_repeat $path]
+            }
+        }
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ArrowButton::_release
+# ------------------------------------------------------------------------------
+proc ArrowButton::_release { path } {
+    variable _grab
+    set path [winfo parent $path]
+    if { $_grab(pressed) == $path } {
+        set _grab(pressed) ""
+            if { [string equal [Widget::getoption $path -type] "button"] } {
+            configure $path -relief $_grab(oldrelief)
+        } else {
+            configure $path -arrowrelief $_grab(oldrelief)
+        }
+        if {[llength [set cmd [Widget::getoption $path -disarmcommand]]]} {
+            uplevel \#0 $cmd
+        }
+        if { $_grab(current) == $path &&
+             ![string equal [Widget::getoption $path -state] "disabled"] &&
+             [llength [set cmd [Widget::getoption $path -command]]]} {
+            uplevel \#0 $cmd
+        }
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ArrowButton::_repeat
+# ------------------------------------------------------------------------------
+proc ArrowButton::_repeat { path } {
+    variable _grab
+    if { $_grab(current) == $path && $_grab(pressed) == $path &&
+         ![string equal [Widget::getoption $path -state] "disabled"] &&
+         [llength [set cmd [Widget::getoption $path -armcommand]]]} {
+        uplevel \#0 $cmd
+    }
+    if { $_grab(pressed) == $path &&
+         ([set delay [Widget::getoption $path -repeatinterval]] > 0 ||
+          [set delay [Widget::getoption $path -repeatdelay]]    > 0) } {
+        after $delay [list ArrowButton::_repeat $path]
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+#  Command ArrowButton::_destroy
+# ------------------------------------------------------------------------------
+proc ArrowButton::_destroy { path } {
+    variable _moved
+    Widget::destroy $path
+    unset _moved($path)
+}