figenc

[RADIOACTIVE] rsa and symmetric key encryption scripts and executables
git clone git://git.figbert.com/figenc.git
Log | Files | Refs | README

combobox.tcl (12423B)


      1 #
      2 # Combobox bindings.
      3 #
      4 # <<NOTE-WM-TRANSIENT>>:
      5 #
      6 #	Need to set [wm transient] just before mapping the popdown
      7 #	instead of when it's created, in case a containing frame
      8 #	has been reparented [#1818441].
      9 #
     10 #	On Windows: setting [wm transient] prevents the parent
     11 #	toplevel from becoming inactive when the popdown is posted
     12 #	(Tk 8.4.8+)
     13 #
     14 #	On X11: WM_TRANSIENT_FOR on override-redirect windows
     15 #	may be used by compositing managers and by EWMH-aware
     16 #	window managers (even though the older ICCCM spec says
     17 #	it's meaningless).
     18 #
     19 #	On OSX: [wm transient] does utterly the wrong thing.
     20 #	Instead, we use [MacWindowStyle "help" "noActivates hideOnSuspend"].
     21 #	The "noActivates" attribute prevents the parent toplevel
     22 #	from deactivating when the popdown is posted, and is also
     23 #	necessary for "help" windows to receive mouse events.
     24 #	"hideOnSuspend" makes the popdown disappear (resp. reappear)
     25 #	when the parent toplevel is deactivated (resp. reactivated).
     26 #	(see [#1814778]).  Also set [wm resizable 0 0], to prevent
     27 #	TkAqua from shrinking the scrollbar to make room for a grow box
     28 #	that isn't there.
     29 #
     30 #	In order to work around other platform quirks in TkAqua,
     31 #	[grab] and [focus] are set in <Map> bindings instead of
     32 #	immediately after deiconifying the window.
     33 #
     34 
     35 namespace eval ttk::combobox {
     36     variable Values	;# Values($cb) is -listvariable of listbox widget
     37     variable State
     38     set State(entryPress) 0
     39 }
     40 
     41 ### Combobox bindings.
     42 #
     43 # Duplicate the Entry bindings, override if needed:
     44 #
     45 
     46 ttk::copyBindings TEntry TCombobox
     47 
     48 bind TCombobox <KeyPress-Down> 		{ ttk::combobox::Post %W }
     49 bind TCombobox <KeyPress-Escape> 	{ ttk::combobox::Unpost %W }
     50 
     51 bind TCombobox <ButtonPress-1> 		{ ttk::combobox::Press "" %W %x %y }
     52 bind TCombobox <Shift-ButtonPress-1>	{ ttk::combobox::Press "s" %W %x %y }
     53 bind TCombobox <Double-ButtonPress-1> 	{ ttk::combobox::Press "2" %W %x %y }
     54 bind TCombobox <Triple-ButtonPress-1> 	{ ttk::combobox::Press "3" %W %x %y }
     55 bind TCombobox <B1-Motion>		{ ttk::combobox::Drag %W %x }
     56 bind TCombobox <Motion>			{ ttk::combobox::Motion %W %x %y }
     57 
     58 ttk::bindMouseWheel TCombobox [list ttk::combobox::Scroll %W]
     59 
     60 bind TCombobox <<TraverseIn>> 		{ ttk::combobox::TraverseIn %W }
     61 
     62 ### Combobox listbox bindings.
     63 #
     64 bind ComboboxListbox <ButtonRelease-1>	{ ttk::combobox::LBSelected %W }
     65 bind ComboboxListbox <KeyPress-Return>	{ ttk::combobox::LBSelected %W }
     66 bind ComboboxListbox <KeyPress-Escape>  { ttk::combobox::LBCancel %W }
     67 bind ComboboxListbox <KeyPress-Tab>	{ ttk::combobox::LBTab %W next }
     68 bind ComboboxListbox <<PrevWindow>>	{ ttk::combobox::LBTab %W prev }
     69 bind ComboboxListbox <Destroy>		{ ttk::combobox::LBCleanup %W }
     70 bind ComboboxListbox <Motion>		{ ttk::combobox::LBHover %W %x %y }
     71 bind ComboboxListbox <Map>		{ focus -force %W }
     72 
     73 switch -- [tk windowingsystem] {
     74     win32 {
     75 	# Dismiss listbox when user switches to a different application.
     76 	# NB: *only* do this on Windows (see #1814778)
     77 	bind ComboboxListbox <FocusOut>		{ ttk::combobox::LBCancel %W }
     78     }
     79 }
     80 
     81 ### Combobox popdown window bindings.
     82 #
     83 bind ComboboxPopdown	<Map>		{ ttk::combobox::MapPopdown %W }
     84 bind ComboboxPopdown	<Unmap>		{ ttk::combobox::UnmapPopdown %W }
     85 bind ComboboxPopdown	<ButtonPress> \
     86 			{ ttk::combobox::Unpost [winfo parent %W] }
     87 
     88 ### Option database settings.
     89 #
     90 
     91 option add *TCombobox*Listbox.font TkTextFont
     92 option add *TCombobox*Listbox.relief flat
     93 option add *TCombobox*Listbox.highlightThickness 0
     94 
     95 ## Platform-specific settings.
     96 #
     97 switch -- [tk windowingsystem] {
     98     x11 {
     99 	option add *TCombobox*Listbox.background white
    100     }
    101     aqua {
    102 	option add *TCombobox*Listbox.borderWidth 0
    103     }
    104 }
    105 
    106 ### Binding procedures.
    107 #
    108 
    109 ## Press $mode $x $y -- ButtonPress binding for comboboxes.
    110 #	Either post/unpost the listbox, or perform Entry widget binding,
    111 #	depending on widget state and location of button press.
    112 #
    113 proc ttk::combobox::Press {mode w x y} {
    114     variable State
    115 
    116     $w instate disabled { return }
    117 
    118     set State(entryPress) [expr {
    119 	   [$w instate !readonly]
    120 	&& [string match *textarea [$w identify element $x $y]]
    121     }]
    122 
    123     focus $w
    124     if {$State(entryPress)} {
    125 	switch -- $mode {
    126 	    s 	{ ttk::entry::Shift-Press $w $x 	; # Shift }
    127 	    2	{ ttk::entry::Select $w $x word 	; # Double click}
    128 	    3	{ ttk::entry::Select $w $x line 	; # Triple click }
    129 	    ""	-
    130 	    default { ttk::entry::Press $w $x }
    131 	}
    132     } else {
    133 	Post $w
    134     }
    135 }
    136 
    137 ## Drag -- B1-Motion binding for comboboxes.
    138 #	If the initial ButtonPress event was handled by Entry binding,
    139 #	perform Entry widget drag binding; otherwise nothing.
    140 #
    141 proc ttk::combobox::Drag {w x}  {
    142     variable State
    143     if {$State(entryPress)} {
    144 	ttk::entry::Drag $w $x
    145     }
    146 }
    147 
    148 ## Motion --
    149 #	Set cursor.
    150 #
    151 proc ttk::combobox::Motion {w x y} {
    152     if {   [$w identify $x $y] eq "textarea"
    153         && [$w instate {!readonly !disabled}]
    154     } {
    155 	ttk::setCursor $w text
    156     } else {
    157 	ttk::setCursor $w ""
    158     }
    159 }
    160 
    161 ## TraverseIn -- receive focus due to keyboard navigation
    162 #	For editable comboboxes, set the selection and insert cursor.
    163 #
    164 proc ttk::combobox::TraverseIn {w} {
    165     $w instate {!readonly !disabled} {
    166 	$w selection range 0 end
    167 	$w icursor end
    168     }
    169 }
    170 
    171 ## SelectEntry $cb $index --
    172 #	Set the combobox selection in response to a user action.
    173 #
    174 proc ttk::combobox::SelectEntry {cb index} {
    175     $cb current $index
    176     $cb selection range 0 end
    177     $cb icursor end
    178     event generate $cb <<ComboboxSelected>> -when mark
    179 }
    180 
    181 ## Scroll -- Mousewheel binding
    182 #
    183 proc ttk::combobox::Scroll {cb dir} {
    184     $cb instate disabled { return }
    185     set max [llength [$cb cget -values]]
    186     set current [$cb current]
    187     incr current $dir
    188     if {$max != 0 && $current == $current % $max} {
    189 	SelectEntry $cb $current
    190     }
    191 }
    192 
    193 ## LBSelected $lb -- Activation binding for listbox
    194 #	Set the combobox value to the currently-selected listbox value
    195 #	and unpost the listbox.
    196 #
    197 proc ttk::combobox::LBSelected {lb} {
    198     set cb [LBMaster $lb]
    199     LBSelect $lb
    200     Unpost $cb
    201     focus $cb
    202 }
    203 
    204 ## LBCancel --
    205 #	Unpost the listbox.
    206 #
    207 proc ttk::combobox::LBCancel {lb} {
    208     Unpost [LBMaster $lb]
    209 }
    210 
    211 ## LBTab -- Tab key binding for combobox listbox.
    212 #	Set the selection, and navigate to next/prev widget.
    213 #
    214 proc ttk::combobox::LBTab {lb dir} {
    215     set cb [LBMaster $lb]
    216     switch -- $dir {
    217 	next	{ set newFocus [tk_focusNext $cb] }
    218 	prev	{ set newFocus [tk_focusPrev $cb] }
    219     }
    220 
    221     if {$newFocus ne ""} {
    222 	LBSelect $lb
    223 	Unpost $cb
    224 	# The [grab release] call in [Unpost] queues events that later
    225 	# re-set the focus (@@@ NOTE: this might not be true anymore).
    226 	# Set new focus later:
    227 	after 0 [list ttk::traverseTo $newFocus]
    228     }
    229 }
    230 
    231 ## LBHover -- <Motion> binding for combobox listbox.
    232 #	Follow selection on mouseover.
    233 #
    234 proc ttk::combobox::LBHover {w x y} {
    235     $w selection clear 0 end
    236     $w activate @$x,$y
    237     $w selection set @$x,$y
    238 }
    239 
    240 ## MapPopdown -- <Map> binding for ComboboxPopdown
    241 #
    242 proc ttk::combobox::MapPopdown {w} {
    243     [winfo parent $w] state pressed
    244     ttk::globalGrab $w
    245 }
    246 
    247 ## UnmapPopdown -- <Unmap> binding for ComboboxPopdown
    248 #
    249 proc ttk::combobox::UnmapPopdown {w} {
    250     [winfo parent $w] state !pressed
    251     ttk::releaseGrab $w
    252 }
    253 
    254 ###
    255 #
    256 
    257 namespace eval ::ttk::combobox {
    258     # @@@ Until we have a proper native scrollbar on Aqua, use
    259     # @@@ the regular Tk one.  Use ttk::scrollbar on other platforms.
    260     variable scrollbar ttk::scrollbar
    261     if {[tk windowingsystem] eq "aqua"} {
    262 	set scrollbar ::scrollbar
    263     }
    264 }
    265 
    266 ## PopdownWindow --
    267 #	Returns the popdown widget associated with a combobox,
    268 #	creating it if necessary.
    269 #
    270 proc ttk::combobox::PopdownWindow {cb} {
    271     variable scrollbar
    272 
    273     if {![winfo exists $cb.popdown]} {
    274 	set poplevel [PopdownToplevel $cb.popdown]
    275 	set popdown [ttk::frame $poplevel.f -style ComboboxPopdownFrame]
    276 
    277 	$scrollbar $popdown.sb \
    278 	    -orient vertical -command [list $popdown.l yview]
    279 	listbox $popdown.l \
    280 	    -listvariable ttk::combobox::Values($cb) \
    281 	    -yscrollcommand [list $popdown.sb set] \
    282 	    -exportselection false \
    283 	    -selectmode browse \
    284 	    -activestyle none \
    285 	    ;
    286 
    287 	bindtags $popdown.l \
    288 	    [list $popdown.l ComboboxListbox Listbox $popdown all]
    289 
    290 	grid $popdown.l -row 0 -column 0 -padx {1 0} -pady 1 -sticky nsew
    291         grid $popdown.sb -row 0 -column 1 -padx {0 1} -pady 1 -sticky ns
    292 	grid columnconfigure $popdown 0 -weight 1
    293 	grid rowconfigure $popdown 0 -weight 1
    294 
    295         grid $popdown -sticky news -padx 0 -pady 0
    296         grid rowconfigure $poplevel 0 -weight 1
    297         grid columnconfigure $poplevel 0 -weight 1
    298     }
    299     return $cb.popdown
    300 }
    301 
    302 ## PopdownToplevel -- Create toplevel window for the combobox popdown
    303 #
    304 #	See also <<NOTE-WM-TRANSIENT>>
    305 #
    306 proc ttk::combobox::PopdownToplevel {w} {
    307     toplevel $w -class ComboboxPopdown
    308     wm withdraw $w
    309     switch -- [tk windowingsystem] {
    310 	default -
    311 	x11 {
    312 	    $w configure -relief flat -borderwidth 0
    313 	    wm attributes $w -type combo
    314 	    wm overrideredirect $w true
    315 	}
    316 	win32 {
    317 	    $w configure -relief flat -borderwidth 0
    318 	    wm overrideredirect $w true
    319 	    wm attributes $w -topmost 1
    320 	}
    321 	aqua {
    322 	    $w configure -relief solid -borderwidth 0
    323 	    tk::unsupported::MacWindowStyle style $w \
    324 	    	help {noActivates hideOnSuspend}
    325 	    wm resizable $w 0 0
    326 	}
    327     }
    328     return $w
    329 }
    330 
    331 ## ConfigureListbox --
    332 #	Set listbox values, selection, height, and scrollbar visibility
    333 #	from current combobox values.
    334 #
    335 proc ttk::combobox::ConfigureListbox {cb} {
    336     variable Values
    337 
    338     set popdown [PopdownWindow $cb].f
    339     set values [$cb cget -values]
    340     set current [$cb current]
    341     if {$current < 0} {
    342 	set current 0 		;# no current entry, highlight first one
    343     }
    344     set Values($cb) $values
    345     $popdown.l selection clear 0 end
    346     $popdown.l selection set $current
    347     $popdown.l activate $current
    348     $popdown.l see $current
    349     set height [llength $values]
    350     if {$height > [$cb cget -height]} {
    351 	set height [$cb cget -height]
    352     	grid $popdown.sb
    353         grid configure $popdown.l -padx {1 0}
    354     } else {
    355 	grid remove $popdown.sb
    356         grid configure $popdown.l -padx 1
    357     }
    358     $popdown.l configure -height $height
    359 }
    360 
    361 ## PlacePopdown --
    362 #	Set popdown window geometry.
    363 #
    364 # @@@TODO: factor with menubutton::PostPosition
    365 #
    366 proc ttk::combobox::PlacePopdown {cb popdown} {
    367     set x [winfo rootx $cb]
    368     set y [winfo rooty $cb]
    369     set w [winfo width $cb]
    370     set h [winfo height $cb]
    371     set style [$cb cget -style]
    372     set postoffset [ttk::style lookup $style -postoffset {} {0 0 0 0}]
    373     foreach var {x y w h} delta $postoffset {
    374     	incr $var $delta
    375     }
    376 
    377     set H [winfo reqheight $popdown]
    378     if {$y + $h + $H > [winfo screenheight $popdown]} {
    379 	set Y [expr {$y - $H}]
    380     } else {
    381 	set Y [expr {$y + $h}]
    382     }
    383     wm geometry $popdown ${w}x${H}+${x}+${Y}
    384 }
    385 
    386 ## Post $cb --
    387 #	Pop down the associated listbox.
    388 #
    389 proc ttk::combobox::Post {cb} {
    390     # Don't do anything if disabled:
    391     #
    392     $cb instate disabled { return }
    393 
    394     # ASSERT: ![$cb instate pressed]
    395 
    396     # Run -postcommand callback:
    397     #
    398     uplevel #0 [$cb cget -postcommand]
    399 
    400     set popdown [PopdownWindow $cb]
    401     ConfigureListbox $cb
    402     update idletasks	;# needed for geometry propagation.
    403     PlacePopdown $cb $popdown
    404     # See <<NOTE-WM-TRANSIENT>>
    405     switch -- [tk windowingsystem] {
    406 	x11 - win32 { wm transient $popdown [winfo toplevel $cb] }
    407     }
    408 
    409     # Post the listbox:
    410     #
    411     wm attribute $popdown -topmost 1
    412     wm deiconify $popdown
    413     raise $popdown
    414 }
    415 
    416 ## Unpost $cb --
    417 #	Unpost the listbox.
    418 #
    419 proc ttk::combobox::Unpost {cb} {
    420     if {[winfo exists $cb.popdown]} {
    421 	wm withdraw $cb.popdown
    422     }
    423     grab release $cb.popdown ;# in case of stuck or unexpected grab [#1239190]
    424 }
    425 
    426 ## LBMaster $lb --
    427 #	Return the combobox main widget that owns the listbox.
    428 #
    429 proc ttk::combobox::LBMaster {lb} {
    430     winfo parent [winfo parent [winfo parent $lb]]
    431 }
    432 
    433 ## LBSelect $lb --
    434 #	Transfer listbox selection to combobox value.
    435 #
    436 proc ttk::combobox::LBSelect {lb} {
    437     set cb [LBMaster $lb]
    438     set selection [$lb curselection]
    439     if {[llength $selection] == 1} {
    440 	SelectEntry $cb [lindex $selection 0]
    441     }
    442 }
    443 
    444 ## LBCleanup $lb --
    445 #	<Destroy> binding for combobox listboxes.
    446 #	Cleans up by unsetting the linked textvariable.
    447 #
    448 #	Note: we can't just use { unset [%W cget -listvariable] }
    449 #	because the widget command is already gone when this binding fires).
    450 #	[winfo parent] still works, fortunately.
    451 #
    452 proc ttk::combobox::LBCleanup {lb} {
    453     variable Values
    454     unset Values([LBMaster $lb])
    455 }
    456 
    457 #*EOF*