home *** CD-ROM | disk | FTP | other *** search
/ Freelog Special Freeware 31 / FreelogHS31.iso / Texte / scribus / scribus-1.3.3.9-win32-install.exe / tcl / tix8.1 / Select.tcl < prev    next >
Text File  |  2001-11-03  |  8KB  |  301 lines
  1. # -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
  2. #
  3. #    $Id: Select.tcl,v 1.2.2.1 2001/11/03 07:23:17 idiscovery Exp $
  4. #
  5. # Select.tcl --
  6. #
  7. #    Implement the tixSelect widget.
  8. #
  9. # Copyright (c) 1993-1999 Ioi Kim Lam.
  10. # Copyright (c) 2000-2001 Tix Project Group.
  11. #
  12. # See the file "license.terms" for information on usage and redistribution
  13. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  14. #
  15.  
  16. tixWidgetClass tixSelect {
  17.     -superclass tixLabelWidget
  18.     -classname  TixSelect
  19.     -method {
  20.     add button invoke
  21.     }
  22.     -flag {
  23.     -allowzero -buttontype -command -disablecallback -orientation
  24.     -orient -padx -pady -radio -selectedbg -state -validatecmd
  25.     -value -variable
  26.     }
  27.     -forcecall {
  28.     -variable -state
  29.     }
  30.     -static {
  31.     -allowzero -orientation -padx -pady -radio
  32.     }
  33.     -configspec {
  34.     {-allowzero allowZero AllowZero 0 tixVerifyBoolean}
  35.     {-buttontype buttonType ButtonType button}
  36.     {-command command Command ""}
  37.     {-disablecallback disableCallback DisableCallback 0 tixVerifyBoolean}
  38.     {-orientation orientation Orientation horizontal}
  39.     {-padx padx Pad 0}
  40.     {-pady pady Pad 0}
  41.     {-radio radio Radio 0 tixVerifyBoolean}
  42.     {-selectedbg selectedBg SelectedBg gray}
  43.     {-state state State normal}
  44.     {-validatecmd validateCmd ValidateCmd ""}
  45.     {-value value Value ""}
  46.     {-variable variable Variable ""}
  47.     }
  48.     -alias {
  49.     {-orient -orientation}
  50.     }
  51.     -default {
  52.     {*frame.borderWidth            1}
  53.     {*frame.relief                sunken}
  54.     {*Button.borderWidth            2}
  55.     {*Button.highlightThickness        0}
  56.     }
  57. }
  58.  
  59. proc tixSelect:InitWidgetRec {w} {
  60.     upvar #0 $w data
  61.  
  62.     tixChainMethod $w InitWidgetRec
  63.     set data(items)    ""
  64.     set data(buttonbg) ""
  65.     set data(varInited)      0
  66. }
  67.  
  68. #----------------------------------------------------------------------
  69. #                           CONFIG OPTIONS
  70. #----------------------------------------------------------------------
  71. proc tixSelect:config-state {w arg} {
  72.     upvar #0 $w data
  73.  
  74.     if {$arg == "disabled"} {
  75.     foreach item $data(items) {
  76.         $data(w:$item) config -state disabled -relief raised \
  77.         -bg $data(buttonbg)
  78.     }
  79.     if {![info exists data(labelFg)]} {
  80.         set data(labelFg) [$data(w:label) cget -foreground]
  81.         catch {
  82.         $data(w:label) config -fg [tix option get disabled_fg]
  83.         }
  84.     }
  85.     } else {
  86.     foreach item $data(items) {
  87.         if {[lsearch $data(-value) $item] != -1} {
  88.         # This button is selected
  89.         #
  90.         $data(w:$item) config -relief sunken -bg $data(-selectedbg) \
  91.             -state normal
  92.         } else {
  93.         $data(w:$item) config -relief raised -bg $data(buttonbg) \
  94.             -command "$w invoke $item" -state normal
  95.         }
  96.     }
  97.     if {[info exists data(labelFg)]} {
  98.         catch {
  99.         $data(w:label) config -fg $data(labelFg)
  100.         }
  101.         unset data(labelFg)
  102.     }
  103.     }
  104.  
  105.     return ""
  106. }
  107.  
  108. proc tixSelect:config-variable {w arg} {
  109.     upvar #0 $w data
  110.  
  111.     set oldValue $data(-value)
  112.  
  113.     if {[tixVariable:ConfigVariable $w $arg]} {
  114.     # The value of data(-value) is changed if tixVariable:ConfigVariable 
  115.     # returns true
  116.     set newValue $data(-value)
  117.     set data(-value) $oldValue
  118.     tixSelect:config-value $w $newValue
  119.     }
  120.     catch {
  121.     unset data(varInited)
  122.     }
  123.     set data(-variable) $arg
  124. }
  125.  
  126. proc tixSelect:config-value {w value} {
  127.     upvar #0 $w data
  128.  
  129.     # sanity checking
  130.     #
  131.     foreach item $value {
  132.     if {[lsearch $data(items) $item] == "-1"} {
  133.         error "subwidget \"$item\" does not exist"
  134.     }
  135.     }
  136.  
  137.     tixSelect:SetValue $w $value
  138. }
  139.  
  140. #----------------------------------------------------------------------
  141. #                     WIDGET COMMANDS
  142. #----------------------------------------------------------------------
  143. proc tixSelect:add {w name args} {
  144.     upvar #0 $w data
  145.  
  146.     set data(w:$name) [eval $data(-buttontype) $data(w:frame).$name -command \
  147.      [list "$w invoke $name"] -takefocus 0 $args]
  148.  
  149.     if {$data(-orientation) == "horizontal"} {
  150.     pack $data(w:$name) -side left -expand yes -fill y\
  151.         -padx $data(-padx) -pady $data(-pady)
  152.     } else {
  153.     pack $data(w:$name) -side top -expand yes  -fill x\
  154.         -padx $data(-padx) -pady $data(-pady)
  155.     }
  156.  
  157.     if {$data(-state) == "disabled"} {
  158.     $data(w:$name) config -relief raised -state disabled
  159.     }
  160.  
  161.     # find out the background of the buttons
  162.     #
  163.     if {$data(buttonbg) == ""} {
  164.     set data(buttonbg) [lindex [$data(w:$name) config -background] 4]
  165.     
  166.     }
  167.  
  168.     lappend data(items) $name
  169. }
  170.  
  171. # Obsolete command
  172. #
  173. proc tixSelect:button {w name args} {
  174.     upvar #0 $w data
  175.  
  176.     if {$args != ""} {
  177.     return [eval $data(w:$name) $args]
  178.     } else {
  179.     return $w.$name
  180.     }
  181. }
  182.  
  183. # This is called when a button is invoked
  184. #
  185. proc tixSelect:invoke {w button} {
  186.     upvar #0 $w data
  187.  
  188.     if {$data(-state) != "normal"} {
  189.     return
  190.     }
  191.  
  192.     set newValue $data(-value)
  193.  
  194.     if {[lsearch $data(-value) $button] != -1} {
  195.     # This button was selected
  196.     #
  197.         if {[llength $data(-value)] > 1 || [tixGetBoolean $data(-allowzero)]} {
  198.  
  199.         # Take the button from the selected list
  200.         #
  201.         set newValue ""
  202.         foreach item $data(-value) {
  203.         if {$item != $button} {
  204.             lappend newValue $item
  205.         }
  206.         }
  207.     }
  208.     } else {
  209.     # This button was not selected
  210.     #
  211.     if {[tixGetBoolean $data(-radio)]} {
  212.         # The button become the sole item in the list
  213.         #
  214.         set newValue [list $button]
  215.     } else {
  216.         # Add this button into the list
  217.         #
  218.         lappend newValue $button
  219.     }
  220.     }
  221.  
  222.     if {$newValue != $data(-value)} {
  223.     tixSelect:SetValue $w $newValue
  224.     }
  225. }
  226.  
  227. #----------------------------------------------------------------------
  228. #                Private functions
  229. #----------------------------------------------------------------------
  230. proc tixSelect:SetValue {w newValue {noUpdate 0}} {
  231.     upvar #0 $w data
  232.  
  233.     set oldValue $data(-value)
  234.  
  235.     if {$data(-validatecmd) != ""} {
  236.        set data(-value) [tixEvalCmdBinding $w $data(-validatecmd) "" $newValue]
  237.     } else {
  238.     if {[tixGetBoolean $data(-radio)] && [llength $newValue] > 1} {
  239.         error "cannot choose more than one items in a radio box"
  240.     }
  241.  
  242.     if {![tixGetBoolean $data(-allowzero)] && [llength $newValue] == 0} {
  243.         error "empty selection not allowed"
  244.     }
  245.  
  246.     set data(-value) $newValue
  247.     }
  248.  
  249.     if {! $noUpdate} {
  250.     tixVariable:UpdateVariable $w
  251.     }
  252.  
  253.     # Reset all to be unselected
  254.     #
  255.     foreach item $data(items) {
  256.     if {[lsearch $data(-value) $item] == -1} {
  257.         # Is unselected
  258.         #
  259.         if {[lsearch $oldValue $item] != -1} {
  260.         # was selected
  261.         # -> popup the button, call command
  262.         #
  263.         $data(w:$item) config -relief raised -bg $data(buttonbg)
  264.         tixSelect:CallCommand $w $item 0
  265.         }
  266.     } else {
  267.         # Is selected
  268.         #
  269.         if {[lsearch $oldValue $item] == -1} {
  270.         # was unselected
  271.         # -> push down the button, call command
  272.         #
  273.         $data(w:$item) config -relief sunken -bg $data(-selectedbg)
  274.         tixSelect:CallCommand $w  $item 1
  275.         }
  276.     }
  277.     }
  278. }
  279.  
  280. proc tixSelect:CallCommand {w name value} {
  281.     upvar #0 $w data
  282.  
  283.     if {!$data(-disablecallback) && $data(-command) != ""} {
  284.     if {![info exists data(varInited)]} {
  285.         set bind(specs) "name value"
  286.         set bind(name)  $name
  287.         set bind(value) $value
  288.         tixEvalCmdBinding $w $data(-command) bind $name $value
  289.     }
  290.     }
  291. }
  292.  
  293. proc tixSelect:Destructor {w} {
  294.  
  295.     tixVariable:DeleteVariable $w
  296.  
  297.     # Chain this to the superclass
  298.     #
  299.     tixChainMethod $w Destructor
  300. }
  301.