EcchiShell v1.0

usr

lib64

tcl8.5

$s" set data(state) $s } proc tixComboBox:StateError {w} { upvar #0 $w data # error "wrong state $data(state)" } #---------------------------------------------------------------------- # Listbox handling #---------------------------------------------------------------------- # Set a selection if there isn't one. Returns true if there was already # a good selection inside the listbox # proc tixComboBox:CheckListboxSelection {w} { upvar #0 $w data if {![winfo exists $data(w:listbox)]} { tixDebug "tixComboBox:CheckListboxSelection error non-existent $data(w:listbox)" return 0 } if {[$data(w:listbox) curselection] == ""} { if {$data(curIndex) == ""} { set data(curIndex) 0 } $data(w:listbox) activate $data(curIndex) $data(w:listbox) selection clear 0 end $data(w:listbox) selection set $data(curIndex) $data(w:listbox) see $data(curIndex) return 0 } else { return 1 } } proc tixComboBox:SetSelectionFromListbox {w} { upvar #0 $w data set string [$data(w:listbox) get $data(curIndex)] tixComboBox:SetSelection $w $string tixComboBox:UpdateListboxSelection $w $data(curIndex) } proc tixComboBox:LbGetSelection {w} { upvar #0 $w data set index [tixComboBox:LbIndex $w emptyOK] if {$index >=0} { return [$data(w:listbox) get $index] } else { return "" } } proc tixComboBox:LbSelect {w x y X Y} { upvar #0 $w data set index [tixComboBox:LbIndex $w emptyOK] if {$index == ""} { set index [$data(w:listbox) nearest $y] } if {$index >= 0} { if {[focus -lastfor $data(w:entry)] ne $data(w:entry) && [focus -lastfor $data(w:entry)] ne $data(w:listbox)} { focus $data(w:entry) } set string [$data(w:listbox) get $index] tixComboBox:SetSelection $w $string tixComboBox:UpdateListboxSelection $w $index } } #---------------------------------------------------------------------- # Internal commands #---------------------------------------------------------------------- proc tixComboBox:CrossBtn {w} { upvar #0 $w data $data(w:entry) delete 0 end tixComboBox:ClearListboxSelection $w tixComboBox:SetSelection $w "" } #-------------------------------------------------- # Popping up list shell #-------------------------------------------------- # Popup the listbox and grab # # proc tixComboBox:Popup {w} { global tcl_platform upvar #0 $w data if {![winfo ismapped $data(w:root)]} { return } #--------------------------------------------------------------------- # Pop up # if {$data(-listcmd) != ""} { # This option allows the user to fill in the listbox on demand # tixEvalCmdBinding $w $data(-listcmd) } # calculate the size set y [winfo rooty $data(w:entry)] incr y [winfo height $data(w:entry)] incr y 3 set bd [$data(w:shell) cget -bd] # incr bd [$data(w:shell) cget -highlightthickness] set height [expr {[winfo reqheight $data(w:slistbox)] + 2*$bd}] set x1 [winfo rootx $data(w:entry)] if {$data(-listwidth) == ""} { if {[winfo ismapped $data(w:arrow)]} { set x2 [winfo rootx $data(w:arrow)] if {$x2 >= $x1} { incr x2 [winfo width $data(w:arrow)] set width [expr {$x2 - $x1}] } else { set width [winfo width $data(w:entry)] set x2 [expr {$x1 + $width}] } } else { set width [winfo width $data(w:entry)] set x2 [expr {$x1 + $width}] } } else { set width $data(-listwidth) set x2 [expr {$x1 + $width}] } set reqwidth [winfo reqwidth $data(w:shell)] if {$reqwidth < $width} { set reqwidth $width } else { if {$reqwidth > [expr {$width *3}]} { set reqwidth [expr {$width *3}] } if {$reqwidth > [winfo vrootwidth .]} { set reqwidth [winfo vrootwidth .] } } set width $reqwidth # If the listbox is too far right, pull it back to the left # set scrwidth [winfo vrootwidth .] if {$x2 > $scrwidth} { set x1 [expr {$scrwidth - $width}] } # If the listbox is too far left, pull it back to the right # if {$x1 < 0} { set x1 0 } # If the listbox is below bottom of screen, put it upwards # set scrheight [winfo vrootheight .] set bottom [expr {$y+$height}] if {$bottom > $scrheight} { set y [expr {$y-$height-[winfo height $data(w:entry)]-5}] } # OK , popup the shell # global tcl_platform wm geometry $data(w:shell) $reqwidth\x$height+$x1+$y if {$tcl_platform(platform) eq "windows"} { update } wm deiconify $data(w:shell) if {$tcl_platform(platform) eq "windows"} { update } raise $data(w:shell) focus $data(w:entry) set data(popped) 1 # add for safety update tixComboBox:Grab $w } proc tixComboBox:SetCursor {w cursor} { upvar #0 $w data $w config -cursor $cursor } proc tixComboBox:Popdown {w} { upvar #0 $w data wm withdraw $data(w:shell) tixComboBox:SetCursor $w "" } # Grab the server so that user cannot move the windows around proc tixComboBox:Grab {w} { upvar #0 $w data tixComboBox:SetCursor $w arrow if {[catch { # We catch here because grab may fail under a lot of circumstances # Just don't want to break the code ... switch -exact -- $data(-grab) { global { tixPushGrab -global $data(w:root) } local { tixPushGrab $data(w:root) } } } err]} { tixDebug "tixComboBox:Grab+: Error grabbing $data(w:root)\n$err" } } proc tixComboBox:Ungrab {w} { upvar #0 $w data if {[catch { catch { switch -exact -- $data(-grab) { global { tixPopGrab } local { tixPopGrab } } } } err]} { tixDebug "tixComboBox:Grab+: Error grabbing $data(w:root)\n$err" } } #---------------------------------------------------------------------- # Alignment #---------------------------------------------------------------------- # The following two routines can emulate a "right align mode" for the # entry in the combo box. proc tixComboBox:EntryAlignEnd {w} { upvar #0 $w data $data(w:entry) xview end } proc tixComboBox:Destructor {w} { upvar #0 $w data tixUnsetMegaWidget $data(w:entry) tixVariable:DeleteVariable $w # Chain this to the superclass # tixChainMethod $w Destructor } #---------------------------------------------------------------------- # CONFIG OPTIONS #---------------------------------------------------------------------- proc tixComboBox:config-state {w value} { upvar #0 $w data catch {if {[$data(w:arrow) cget -state] eq $value} {set a 1}} if {[info exists a]} { return } catch {$data(w:arrow) config -state $value} catch {$data(w:tick) config -state $value} catch {$data(w:cross) config -state $value} catch {$data(w:slistbox) config -state $value} if {[string equal $value normal]} { set fg [$data(w:arrow) cget -fg] set entryFg $data(entryfg) set lbSelFg [lindex [$data(w:listbox) config -selectforeground] 3] set lbSelBg [lindex [$data(w:listbox) config -selectbackground] 3] set entrySelFg [lindex [$data(w:entry) config -selectforeground] 3] set entrySelBg [lindex [$data(w:entry) config -selectbackground] 3] } else { set fg [$data(w:arrow) cget -disabledforeground] set entryFg $data(-disabledforeground) set lbSelFg $entryFg set lbSelBg [$data(w:listbox) cget -bg] set entrySelFg $entryFg set entrySelBg [$data(w:entry) cget -bg] } if {$fg ne ""} { $data(w:label) config -fg $fg $data(w:listbox) config -fg $fg -selectforeground $lbSelFg \ -selectbackground $lbSelBg } $data(w:entry) config -fg $entryFg -selectforeground $entrySelFg \ -selectbackground $entrySelBg if {$value eq "normal"} { if {$data(-editable)} { $data(w:entry) config -state normal } $data(w:entry) config -takefocus 1 } else { if {$data(-editable)} { $data(w:entry) config -state disabled } $data(w:entry) config -takefocus 0 } } proc tixComboBox:config-value {w value} { upvar #0 $w data tixComboBox:SetValue $w $value set data(-selection) $value if {[tixComboBox:LbGetSelection $w] ne $value} { tixComboBox:ClearListboxSelection $w } } proc tixComboBox:config-selection {w value} { upvar #0 $w data tixComboBox:SetSelection $w $value if {[tixComboBox:LbGetSelection $w] ne $value} { tixComboBox:ClearListboxSelection $w } } proc tixComboBox: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 set data(-selection) $data(-value) tixComboBox:SetValue $w $data(-value) 1 } catch { unset data(varInited) } set data(-variable) $arg } #---------------------------------------------------------------------- # WIDGET COMMANDS #---------------------------------------------------------------------- proc tixComboBox:align {w args} { upvar #0 $w data if {$data(-anchor) eq "e"} { tixComboBox:EntryAlignEnd $w } } proc tixComboBox:addhistory {w value} { upvar #0 $w data tixComboBox:insert $w 0 $value $data(w:listbox) selection clear 0 end if {$data(-prunehistory)} { # Prune from the end # set max [$data(w:listbox) size] if {$max <= 1} { return } for {set i [expr {$max -1}]} {$i >= 1} {incr i -1} { if {[$data(w:listbox) get $i] eq $value} { $data(w:listbox) delete $i break } } } } proc tixComboBox:appendhistory {w value} { upvar #0 $w data tixComboBox:insert $w end $value $data(w:listbox) selection clear 0 end if {$data(-prunehistory)} { # Prune from the end # set max [$data(w:listbox) size] if {$max <= 1} { return } for {set i [expr {$max -2}]} {$i >= 0} {incr i -1} { if {[$data(w:listbox) get $i] eq $value} { $data(w:listbox) delete $i break } } } } proc tixComboBox:insert {w index newitem} { upvar #0 $w data $data(w:listbox) insert $index $newitem if {$data(-history) && $data(-historylimit) != "" && [$data(w:listbox) size] eq $data(-historylimit)} { $data(w:listbox) delete 0 } } proc tixComboBox:pick {w index} { upvar #0 $w data $data(w:listbox) activate $index $data(w:listbox) selection clear 0 end $data(w:listbox) selection set active $data(w:listbox) see active set text [$data(w:listbox) get $index] tixComboBox:SetValue $w $text set data(curIndex) $index } proc tixComboBox:invoke {w} { tixComboBox:Invoke $w } proc tixComboBox:popdown {w} { upvar #0 $w data if {$data(-dropdown)} { tixComboBox:Popdown $w } }