Файловый менеджер

Файловый менеджер - Редактировать - /usr/lib64/tcl8.6/Tix8.4.3/OptMenu.tcl

Назад
# -- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -- # # $Id: OptMenu.tcl,v 1.3 2001/12/09 05:04:02 idiscovery Exp $ # # OptMenu.tcl -- # # This file implements the TixOptionMenu widget. # # Copyright (c) 1993-1999 Ioi Kim Lam. # Copyright (c) 2000-2001 Tix Project Group. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # tixWidgetClass tixOptionMenu { -classname TixOptionMenu -superclass tixLabelWidget -method { add delete disable enable entrycget entryconfigure entries } -flag { -command -disablecallback -dynamicgeometry -value -variable -validatecmd -state } -forcecall { -variable -state } -configspec { {-command command Command ""} {-disablecallback disableCallback DisableCallback 0 tixVerifyBoolean} {-dynamicgeometry dynamicGeometry DynamicGeometry 0 tixVerifyBoolean} {-state state State normal} {-value value Value ""} {-validatecmd validateCmd ValidateCmd ""} {-variable variable Variable ""} } -default { {.highlightThickness 0} {.takeFocus 0} {.frame.menubutton.relief raised} {.frame.menubutton.borderWidth 2} {.frame.menubutton.anchor w} {.frame.menubutton.highlightThickness 2} {.frame.menubutton.takeFocus 1} } } proc tixOptionMenu:InitWidgetRec {w} { upvar #0 $w data tixChainMethod $w InitWidgetRec set data(nItems) 0 set data(items) "" set data(posted) 0 set data(varInited) 0 set data(maxWidth) 0 } proc tixOptionMenu:ConstructFramedWidget {w frame} { upvar #0 $w data tixChainMethod $w ConstructFramedWidget $frame set data(w:menubutton) [menubutton $frame.menubutton -indicatoron 1] set data(w:menu) [menu $frame.menubutton.menu -tearoff 0] pack $data(w:menubutton) -side left -expand yes -fill both $data(w:menubutton) config -menu $data(w:menu) bind $data(w:menubutton) <Up> [bind Menubutton <space>] bind $data(w:menubutton) <Down> [bind Menubutton <space>] tixSetMegaWidget $data(w:menubutton) $w } proc tixOptionMenu:SetBindings {w} { upvar #0 $w data tixChainMethod $w SetBindings } #---------------------------------------------------------------------- # Private methods #---------------------------------------------------------------------- proc tixOptionMenu:Invoke {w name} { upvar #0 $w data if {"$data(-state)" == "normal"} { tixOptionMenu:SetValue $w $name } } proc tixOptionMenu:SetValue {w value {noUpdate 0}} { upvar #0 $w data if {$data(-validatecmd) != ""} { set value [tixEvalCmdBinding $w $data(-validatecmd) "" $value] } set name $value if {$name == "" \|\| [info exists data(varInited)]} { # variable may contain a bogus value if {![info exists data($name,index)]} { set data(-value) "" tixVariable:UpdateVariable $w $data(w:menubutton) config -text "" return } } if {[info exists data($name,index)]} { $data(w:menubutton) config -text $data($name,label) set data(-value) $value if {! $noUpdate} { tixVariable:UpdateVariable $w } if {$data(-command) != "" && !$data(-disablecallback)} { if {![info exists data(varInited)]} { set bind(specs) "" tixEvalCmdBinding $w $data(-command) bind $value } } } else { error "item \"$value\" does not exist" } } proc tixOptionMenu:SetMaxWidth {w} { upvar #0 $w data foreach name $data(items) { set len [string length $data($name,label)] if {$data(maxWidth) < $len} { set data(maxWidth) $len } } if {$data(maxWidth) > 0} { $data(w:menubutton) config -width $data(maxWidth) } } #---------------------------------------------------------------------- # Configuration #---------------------------------------------------------------------- proc tixOptionMenu:config-state {w value} { upvar #0 $w data if {![info exists data(w:label)]} { return } if {$value == "normal"} { catch { $data(w:label) config -fg \ [$data(w:menubutton) cget -foreground] } $data(w:menubutton) config -state $value } else { catch { $data(w:label) config -fg \ [$data(w:menubutton) cget -disabledforeground] } $data(w:menubutton) config -state $value } } proc tixOptionMenu:config-value {w value} { upvar #0 $w data tixOptionMenu:SetValue $w $value # This will tell the Intrinsics: "Please use this value" # because "value" might be altered by SetValues # return $data(-value) } proc tixOptionMenu:config-variable {w arg} { upvar #0 $w data if {[tixVariable:ConfigVariable $w $arg]} { # The value of data(-value) is changed if tixVariable:ConfigVariable # returns true tixOptionMenu:SetValue $w $data(-value) 1 } catch { unset data(varInited) } set data(-variable) $arg } #---------------------------------------------------------------------- # Public Methdos #---------------------------------------------------------------------- proc tixOptionMenu:add {w type name args} { upvar #0 $w data if {[info exists data($name,index)]} { error "item $name already exists in the option menu $w" } case $type { "command" { set validOptions { -command -label } set opt(-command) "" set opt(-label) $name tixHandleOptions -nounknown opt $validOptions $args if {$opt(-command) != ""} { error "option -command cannot be specified" } # Create a new item inside the menu # eval $data(w:menu) add command $args \ [list -label $opt(-label) \ -command "tixOptionMenu:Invoke $w \{$name\}"] set index $data(nItems) # Store info about this item # set data($index,name) $name set data($name,type) cmd set data($name,label) $opt(-label) set data($name,index) $index if {$index == 0} { $data(w:menubutton) config -text $data($name,label) tixOptionMenu:SetValue $w $name } incr data(nItems) lappend data(items) $name if $data(-dynamicgeometry) { tixOptionMenu:SetMaxWidth $w } } "separator" { $data(w:menu) add separator set index $data(nItems) # Store info about this item # set data($index,name) $name set data($name,type) sep set data($name,label) "" set data($name,index) $index incr data(nItems) lappend data(items) $name } default { error "only types \"separator\" and \"command\" are allowed" } } return "" } proc tixOptionMenu:delete {w item} { upvar #0 $w data if {![info exists data($item,index)]} { error "item $item does not exist in $w" } # Rehash the item list set newItems "" set oldIndex 0 set newIndex 0 foreach name $data(items) { if {$item == $name} { unset data($name,label) unset data($name,index) unset data($name,type) $data(w:menu) delete $oldIndex } else { set data($name,index) $newIndex set data($newIndex,name) $name incr newIndex lappend newItems $name } incr oldIndex } incr oldIndex -1; unset data($oldIndex,name) set data(nItems) $newIndex set data(items) $newItems if {$data(-value) == $item} { set newVal "" foreach item $data(items) { if {$data($item,type) == "cmd"} { set newVal $item } } tixOptionMenu:SetValue $w $newVal } return "" } proc tixOptionMenu:disable {w item} { upvar #0 $w data if {![info exists data($item,index)]} { error "item $item does not exist in $w" } else { catch {$data(w:menu) entryconfig $data($item,index) -state disabled} } } proc tixOptionMenu:enable {w item} { upvar #0 $w data if {![info exists data($item,index)]} { error "item $item does not exist in $w" } else { catch {$data(w:menu) entryconfig $data($item,index) -state normal} } } proc tixOptionMenu:entryconfigure {w item args} { upvar #0 $w data if {![info exists data($item,index)]} { error "item $item does not exist in $w" } else { return [eval $data(w:menu) entryconfig $data($item,index) $args] } } proc tixOptionMenu:entrycget {w item arg} { upvar #0 $w data if {![info exists data($item,index)]} { error "item $item does not exist in $w" } else { return [$data(w:menu) entrycget $data($item,index) $arg] } } proc tixOptionMenu:entries {w} { upvar #0 $w data return $data(items) } proc tixOptionMenu:Destructor {w} { tixVariable:DeleteVariable $w # Chain this to the superclass # tixChainMethod $w Destructor } #---------------------------------------------------------------------- # Obsolete # These have been replaced by new commands in Tk 4.0 # proc tixOptionMenu:Post {w} { upvar #0 $w data set rootx [winfo rootx $data(w:frame)] set rooty [winfo rooty $data(w:frame)] # adjust for the border of the menu and frame # incr rootx [lindex [$data(w:menu) config -border] 4] incr rooty [lindex [$data(w:frame) config -border] 4] incr rooty [lindex [$data(w:menu) config -border] 4] set value $data(-value) set y [$data(w:menu) yposition $data($value,index)] $data(w:menu) post $rootx [expr $rooty - $y] $data(w:menu) activate $data($value,index) grab -global $data(w:menubutton) set data(posted) 1 }

| ver. 1.4 | Github | . | PHP 8.1.32 | Генерация страницы: 0.01 | proxy | phpinfo | Настройка