diff options
author | jan.nijtmans <nijtmans@users.sourceforge.net> | 2020-09-15 13:15:14 (GMT) |
---|---|---|
committer | jan.nijtmans <nijtmans@users.sourceforge.net> | 2020-09-15 13:15:14 (GMT) |
commit | 418fba3d3d0db14e0f74b19da9c077903f7dbdcd (patch) | |
tree | 9228e48dd6be2573326e1506c130a0932a45ac66 /library/ttk | |
parent | 405efb77f1e112a07406b05b1dfca6b8622cc9c9 (diff) | |
parent | 51da8fabbfe52df8ccaa273c48fcf127f35f79fd (diff) | |
download | tk-418fba3d3d0db14e0f74b19da9c077903f7dbdcd.zip tk-418fba3d3d0db14e0f74b19da9c077903f7dbdcd.tar.gz tk-418fba3d3d0db14e0f74b19da9c077903f7dbdcd.tar.bz2 |
Merge 8.7. Make test-cases on MacOS and X11 pass (win32 not tested yet)
Diffstat (limited to 'library/ttk')
-rw-r--r-- | library/ttk/aquaTheme.tcl | 27 | ||||
-rw-r--r-- | library/ttk/button.tcl | 14 | ||||
-rw-r--r-- | library/ttk/combobox.tcl | 45 | ||||
-rw-r--r-- | library/ttk/cursors.tcl | 28 | ||||
-rw-r--r-- | library/ttk/entry.tcl | 111 | ||||
-rw-r--r-- | library/ttk/fonts.tcl | 14 | ||||
-rw-r--r-- | library/ttk/menubutton.tcl | 14 | ||||
-rw-r--r-- | library/ttk/notebook.tcl | 28 | ||||
-rw-r--r-- | library/ttk/panedwindow.tcl | 15 | ||||
-rw-r--r-- | library/ttk/scale.tcl | 8 | ||||
-rw-r--r-- | library/ttk/scrollbar.tcl | 28 | ||||
-rw-r--r-- | library/ttk/sizegrip.tcl | 2 | ||||
-rw-r--r-- | library/ttk/spinbox.tcl | 38 | ||||
-rw-r--r-- | library/ttk/treeview.tcl | 52 | ||||
-rw-r--r-- | library/ttk/utils.tcl | 2 | ||||
-rw-r--r-- | library/ttk/vistaTheme.tcl | 14 | ||||
-rw-r--r-- | library/ttk/xpTheme.tcl | 7 |
17 files changed, 275 insertions, 172 deletions
diff --git a/library/ttk/aquaTheme.tcl b/library/ttk/aquaTheme.tcl index 15e13ce..8bba226 100644 --- a/library/ttk/aquaTheme.tcl +++ b/library/ttk/aquaTheme.tcl @@ -9,8 +9,8 @@ namespace eval ttk::theme::aqua { -font TkDefaultFont \ -background systemWindowBackgroundColor \ -foreground systemLabelColor \ - -selectbackground systemHighlight \ - -selectforeground systemLabelColor \ + -selectbackground systemSelectedTextBackgroundColor \ + -selectforeground systemSelectedTextColor \ -selectborderwidth 0 \ -insertwidth 1 @@ -38,7 +38,18 @@ namespace eval ttk::theme::aqua { # Entry ttk::style configure TEntry \ -foreground systemTextColor \ - -background systemTextBackgroundColor \ + -background systemTextBackgroundColor + ttk::style map TEntry \ + -foreground { + disabled systemDisabledControlTextColor + } \ + -selectforeground { + background systemTextColor + } \ + -selectbackground { + background systemTextBackgroundColor + } + # Workaround for #1100117: # Actually, on Aqua we probably shouldn't stipple images in @@ -59,20 +70,16 @@ namespace eval ttk::theme::aqua { # Combobox: ttk::style configure TCombobox \ -foreground systemTextColor \ - -background systemTransparent \ - -selectforeground systemSelectedTextColor \ - -selectbackground systemSelectedTextBackgroundColor + -background systemTransparent ttk::style map TCombobox \ -foreground { disabled systemDisabledControlTextColor } \ -selectforeground { - !active systemTextColor + background systemTextColor } \ -selectbackground { - !active systemTextBackgroundColor - !focus systemTextBackgroundColor - focus systemSelectedTextBackgroundColor + background systemTransparent } # Spinbox diff --git a/library/ttk/button.tcl b/library/ttk/button.tcl index 24065c2..e8c24a1 100644 --- a/library/ttk/button.tcl +++ b/library/ttk/button.tcl @@ -9,7 +9,7 @@ # we get a <Leave> event then, which turns off the "active" state) # # Normally, <ButtonRelease> and <ButtonN-Enter/Leave> events are -# delivered to the widget which received the initial <ButtonPress> +# delivered to the widget which received the initial <Button> # event. However, Tk [grab]s (#1223103) and menu interactions # (#1222605) can interfere with this. To guard against spurious # <Button1-Enter> events, the <Button1-Enter> binding only sets @@ -20,10 +20,10 @@ namespace eval ttk::button {} bind TButton <Enter> { %W instate !disabled {%W state active} } bind TButton <Leave> { %W state !active } -bind TButton <Key-space> { ttk::button::activate %W } +bind TButton <space> { ttk::button::activate %W } bind TButton <<Invoke>> { ttk::button::activate %W } -bind TButton <ButtonPress-1> \ +bind TButton <Button-1> \ { %W instate !disabled { ttk::clickToFocus %W; %W state pressed } } bind TButton <ButtonRelease-1> \ { %W instate pressed { %W state !pressed; %W instate !disabled { %W invoke } } } @@ -39,11 +39,11 @@ ttk::copyBindings TButton TRadiobutton # ...plus a few more: -bind TRadiobutton <KeyPress-Up> { ttk::button::RadioTraverse %W -1 } -bind TRadiobutton <KeyPress-Down> { ttk::button::RadioTraverse %W +1 } +bind TRadiobutton <Up> { ttk::button::RadioTraverse %W -1 } +bind TRadiobutton <Down> { ttk::button::RadioTraverse %W +1 } -# bind TCheckbutton <KeyPress-plus> { %W select } -# bind TCheckbutton <KeyPress-minus> { %W deselect } +# bind TCheckbutton <plus> { %W select } +# bind TCheckbutton <minus> { %W deselect } # activate -- # Simulate a button press: temporarily set the state to 'pressed', diff --git a/library/ttk/combobox.tcl b/library/ttk/combobox.tcl index 1355a04..0a7e519 100644 --- a/library/ttk/combobox.tcl +++ b/library/ttk/combobox.tcl @@ -45,13 +45,13 @@ namespace eval ttk::combobox { ttk::copyBindings TEntry TCombobox -bind TCombobox <KeyPress-Down> { ttk::combobox::Post %W } -bind TCombobox <KeyPress-Escape> { ttk::combobox::Unpost %W } +bind TCombobox <Down> { ttk::combobox::Post %W } +bind TCombobox <Escape> { ttk::combobox::Unpost %W } -bind TCombobox <ButtonPress-1> { ttk::combobox::Press "" %W %x %y } -bind TCombobox <Shift-ButtonPress-1> { ttk::combobox::Press "s" %W %x %y } -bind TCombobox <Double-ButtonPress-1> { ttk::combobox::Press "2" %W %x %y } -bind TCombobox <Triple-ButtonPress-1> { ttk::combobox::Press "3" %W %x %y } +bind TCombobox <Button-1> { ttk::combobox::Press "" %W %x %y } +bind TCombobox <Shift-Button-1> { ttk::combobox::Press "s" %W %x %y } +bind TCombobox <Double-Button-1> { ttk::combobox::Press "2" %W %x %y } +bind TCombobox <Triple-Button-1> { ttk::combobox::Press "3" %W %x %y } bind TCombobox <B1-Motion> { ttk::combobox::Drag %W %x } bind TCombobox <Motion> { ttk::combobox::Motion %W %x %y } @@ -62,9 +62,9 @@ bind TCombobox <<TraverseIn>> { ttk::combobox::TraverseIn %W } ### Combobox listbox bindings. # bind ComboboxListbox <ButtonRelease-1> { ttk::combobox::LBSelected %W } -bind ComboboxListbox <KeyPress-Return> { ttk::combobox::LBSelected %W } -bind ComboboxListbox <KeyPress-Escape> { ttk::combobox::LBCancel %W } -bind ComboboxListbox <KeyPress-Tab> { ttk::combobox::LBTab %W next } +bind ComboboxListbox <Return> { ttk::combobox::LBSelected %W } +bind ComboboxListbox <Escape> { ttk::combobox::LBCancel %W } +bind ComboboxListbox <Tab> { ttk::combobox::LBTab %W next } bind ComboboxListbox <<PrevWindow>> { ttk::combobox::LBTab %W prev } bind ComboboxListbox <Destroy> { ttk::combobox::LBCleanup %W } bind ComboboxListbox <Motion> { ttk::combobox::LBHover %W %x %y } @@ -82,7 +82,7 @@ switch -- [tk windowingsystem] { # bind ComboboxPopdown <Map> { ttk::combobox::MapPopdown %W } bind ComboboxPopdown <Unmap> { ttk::combobox::UnmapPopdown %W } -bind ComboboxPopdown <ButtonPress> \ +bind ComboboxPopdown <Button> \ { ttk::combobox::Unpost [winfo parent %W] } ### Option database settings. @@ -106,7 +106,7 @@ switch -- [tk windowingsystem] { ### Binding procedures. # -## Press $mode $x $y -- ButtonPress binding for comboboxes. +## Press $mode $x $y -- Button binding for comboboxes. # Either post/unpost the listbox, or perform Entry widget binding, # depending on widget state and location of button press. # @@ -135,7 +135,7 @@ proc ttk::combobox::Press {mode w x y} { } ## Drag -- B1-Motion binding for comboboxes. -# If the initial ButtonPress event was handled by Entry binding, +# If the initial Button event was handled by Entry binding, # perform Entry widget drag binding; otherwise nothing. # proc ttk::combobox::Drag {w x} { @@ -149,12 +149,14 @@ proc ttk::combobox::Drag {w x} { # Set cursor. # proc ttk::combobox::Motion {w x y} { + variable State + ttk::saveCursor $w State(userConfCursor) [ttk::cursor text] if { [$w identify $x $y] eq "textarea" && [$w instate {!readonly !disabled}] } { ttk::setCursor $w text } else { - ttk::setCursor $w "" + ttk::setCursor $w $State(userConfCursor) } } @@ -195,7 +197,7 @@ proc ttk::combobox::Scroll {cb dir} { # and unpost the listbox. # proc ttk::combobox::LBSelected {lb} { - set cb [LBMaster $lb] + set cb [LBMain $lb] LBSelect $lb Unpost $cb focus $cb @@ -205,14 +207,14 @@ proc ttk::combobox::LBSelected {lb} { # Unpost the listbox. # proc ttk::combobox::LBCancel {lb} { - Unpost [LBMaster $lb] + Unpost [LBMain $lb] } ## LBTab -- Tab key binding for combobox listbox. # Set the selection, and navigate to next/prev widget. # proc ttk::combobox::LBTab {lb dir} { - set cb [LBMaster $lb] + set cb [LBMain $lb] switch -- $dir { next { set newFocus [tk_focusNext $cb] } prev { set newFocus [tk_focusPrev $cb] } @@ -355,6 +357,9 @@ proc ttk::combobox::PlacePopdown {cb popdown} { set w [winfo width $cb] set h [winfo height $cb] set style [$cb cget -style] + if { $style eq {} } { + set style TCombobox + } set postoffset [ttk::style lookup $style -postoffset {} {0 0 0 0}] foreach var {x y w h} delta $postoffset { incr $var $delta @@ -409,10 +414,10 @@ proc ttk::combobox::Unpost {cb} { grab release $cb.popdown ;# in case of stuck or unexpected grab [#1239190] } -## LBMaster $lb -- +## LBMain $lb -- # Return the combobox main widget that owns the listbox. # -proc ttk::combobox::LBMaster {lb} { +proc ttk::combobox::LBMain {lb} { winfo parent [winfo parent [winfo parent $lb]] } @@ -420,7 +425,7 @@ proc ttk::combobox::LBMaster {lb} { # Transfer listbox selection to combobox value. # proc ttk::combobox::LBSelect {lb} { - set cb [LBMaster $lb] + set cb [LBMain $lb] set selection [$lb curselection] if {[llength $selection] == 1} { SelectEntry $cb [lindex $selection 0] @@ -437,7 +442,7 @@ proc ttk::combobox::LBSelect {lb} { # proc ttk::combobox::LBCleanup {lb} { variable Values - unset Values([LBMaster $lb]) + unset Values([LBMain $lb]) } #*EOF* diff --git a/library/ttk/cursors.tcl b/library/ttk/cursors.tcl index 852f01c..9d1e1ae 100644 --- a/library/ttk/cursors.tcl +++ b/library/ttk/cursors.tcl @@ -137,8 +137,30 @@ proc ttk::cursor {name} { proc ttk::setCursor {w name} { variable Cursors - if {[$w cget -cursor] ne $Cursors($name)} { - $w configure -cursor $Cursors($name) + if {[info exists Cursors($name)]} { + set cursorname $Cursors($name) + } else { + set cursorname $name + } + if {[$w cget -cursor] ne $cursorname} { + $w configure -cursor $cursorname + } +} + +## ttk::saveCursor $w $saveVar $excludeList -- +# Set variable $saveVar to the -cursor value from widget $w, +# if either: +# a. $saveVar does not yet exist +# b. the currently user-specified cursor for $w is not in +# $excludeList + +proc ttk::saveCursor {w saveVar excludeList} { + upvar $saveVar sv + if {![info exists sv]} { + set sv [$w cget -cursor] + } + if {[$w cget -cursor] ni $excludeList} { + set sv [$w cget -cursor] } } @@ -176,7 +198,7 @@ proc ttk::CursorSampler {f} { if {[info exists argv0] && $argv0 eq [info script]} { wm title . "[array size ::ttk::Cursors] cursors" pack [ttk::CursorSampler .f] -expand true -fill both - bind . <KeyPress-Escape> [list destroy .] + bind . <Escape> [list destroy .] focus .f } diff --git a/library/ttk/entry.tcl b/library/ttk/entry.tcl index 383eebd..2f3c1a6 100644 --- a/library/ttk/entry.tcl +++ b/library/ttk/entry.tcl @@ -40,31 +40,24 @@ option add *TEntry.cursor [ttk::cursor text] widgetDefault # # Removed the following standard Tk bindings: # -# <Control-Key-space>, <Control-Shift-Key-space>, -# <Key-Select>, <Shift-Key-Select>: +# <Control-space>, <Control-Shift-space>, +# <Select>, <Shift-Select>: # Ttk entry widget doesn't use selection anchor. -# <Key-Insert>: +# <Insert>: # Inserts PRIMARY selection (on non-Windows platforms). # This is inconsistent with typical platform bindings. -# <Double-Shift-ButtonPress-1>, <Triple-Shift-ButtonPress-1>: +# <Double-Shift-Button-1>, <Triple-Shift-Button-1>: # These don't do the right thing to start with. -# <Meta-Key-b>, <Meta-Key-d>, <Meta-Key-f>, -# <Meta-Key-BackSpace>, <Meta-Key-Delete>: +# <Meta-b>, <Meta-d>, <Meta-f>, +# <Meta-BackSpace>, <Meta-Delete>: # Judgment call. If <Meta> happens to be assigned to the Alt key, # these could conflict with application accelerators. # (Plus, who has a Meta key these days?) -# <Control-Key-t>: +# <Control-t>: # Another judgment call. If anyone misses this, let me know # and I'll put it back. # -##Bindings to register with macOS Services API. -bind T.Entry <Map> { - if {[tk windowingsystem] eq "aqua"} { - ::tk::RegisterServiceWidget %W - } -} - ## Clipboard events: # bind TEntry <<Cut>> { ttk::entry::Cut %W } @@ -75,27 +68,34 @@ bind TEntry <<Clear>> { ttk::entry::Clear %W } ## Button1 bindings: # Used for selection and navigation. # -bind TEntry <ButtonPress-1> { ttk::entry::Press %W %x } -bind TEntry <Shift-ButtonPress-1> { ttk::entry::Shift-Press %W %x } -bind TEntry <Double-ButtonPress-1> { ttk::entry::Select %W %x word } -bind TEntry <Triple-ButtonPress-1> { ttk::entry::Select %W %x line } +bind TEntry <Button-1> { ttk::entry::Press %W %x } +bind TEntry <Shift-Button-1> { ttk::entry::Shift-Press %W %x } +bind TEntry <Double-Button-1> { ttk::entry::Select %W %x word } +bind TEntry <Triple-Button-1> { ttk::entry::Select %W %x line } bind TEntry <B1-Motion> { ttk::entry::Drag %W %x } -bind TEntry <B1-Leave> { ttk::entry::DragOut %W %m } -bind TEntry <B1-Enter> { ttk::entry::DragIn %W } -bind TEntry <ButtonRelease-1> { ttk::entry::Release %W } +bind TEntry <B1-Leave> { ttk::entry::DragOut %W %m } +bind TEntry <B1-Enter> { ttk::entry::DragIn %W } +bind TEntry <ButtonRelease-1> { ttk::entry::Release %W } bind TEntry <<ToggleSelection>> { %W instate {!readonly !disabled} { %W icursor @%x ; focus %W } } -## Button2 bindings: +## Button2 (Button3 on Aqua) bindings: # Used for scanning and primary transfer. -# Note: ButtonRelease-2 is mapped to <<PasteSelection>> in tk.tcl. -# -bind TEntry <ButtonPress-2> { ttk::entry::ScanMark %W %x } -bind TEntry <B2-Motion> { ttk::entry::ScanDrag %W %x } -bind TEntry <ButtonRelease-2> { ttk::entry::ScanRelease %W %x } +# Note: ButtonRelease-2 (ButtonRelease-3 on Aqua) +# is mapped to <<PasteSelection>> in tk.tcl. +# +if {[tk windowingsystem] ne "aqua"} { + bind TEntry <Button-2> { ttk::entry::ScanMark %W %x } + bind TEntry <B2-Motion> { ttk::entry::ScanDrag %W %x } + bind TEntry <ButtonRelease-2> { ttk::entry::ScanRelease %W %x } +} else { + bind TEntry <Button-3> { ttk::entry::ScanMark %W %x } + bind TEntry <B3-Motion> { ttk::entry::ScanDrag %W %x } + bind TEntry <ButtonRelease-3> { ttk::entry::ScanRelease %W %x } +} bind TEntry <<PasteSelection>> { ttk::entry::ScanRelease %W %x } ## Keyboard navigation bindings: @@ -121,26 +121,26 @@ bind TEntry <<TraverseIn>> { %W selection range 0 end; %W icursor end } ## Edit bindings: # -bind TEntry <KeyPress> { ttk::entry::Insert %W %A } -bind TEntry <Key-Delete> { ttk::entry::Delete %W } -bind TEntry <Key-BackSpace> { ttk::entry::Backspace %W } +bind TEntry <Key> { ttk::entry::Insert %W %A } +bind TEntry <Delete> { ttk::entry::Delete %W } +bind TEntry <BackSpace> { ttk::entry::Backspace %W } # Ignore all Alt, Meta, and Control keypresses unless explicitly bound. -# Otherwise, the <KeyPress> class binding will fire and insert the character. +# Otherwise, the <Key> class binding will fire and insert the character. # Ditto for Escape, Return, and Tab. # -bind TEntry <Alt-KeyPress> {# nothing} -bind TEntry <Meta-KeyPress> {# nothing} -bind TEntry <Control-KeyPress> {# nothing} -bind TEntry <Key-Escape> {# nothing} -bind TEntry <Key-Return> {# nothing} -bind TEntry <Key-KP_Enter> {# nothing} -bind TEntry <Key-Tab> {# nothing} +bind TEntry <Alt-Key> {# nothing} +bind TEntry <Meta-Key> {# nothing} +bind TEntry <Control-Key> {# nothing} +bind TEntry <Escape> {# nothing} +bind TEntry <Return> {# nothing} +bind TEntry <KP_Enter> {# nothing} +bind TEntry <Tab> {# nothing} # Argh. Apparently on Windows, the NumLock modifier is interpreted # as a Command modifier. if {[tk windowingsystem] eq "aqua"} { - bind TEntry <Command-KeyPress> {# nothing} + bind TEntry <Command-Key> {# nothing} } # Tk-on-Cocoa generates characters for these two keys. [Bug 2971663] bind TEntry <<PrevLine>> {# nothing} @@ -148,9 +148,28 @@ bind TEntry <<NextLine>> {# nothing} ## Additional emacs-like bindings: # -bind TEntry <Control-Key-d> { ttk::entry::Delete %W } -bind TEntry <Control-Key-h> { ttk::entry::Backspace %W } -bind TEntry <Control-Key-k> { %W delete insert end } +bind TEntry <Control-d> { ttk::entry::Delete %W } +bind TEntry <Control-h> { ttk::entry::Backspace %W } +bind TEntry <Control-k> { %W delete insert end } + +# Bindings for IME text input. + +bind TEntry <<TkStartIMEMarkedText>> { + dict set ::tk::Priv(IMETextMark) "%W" [%W index insert] +} +bind TEntry <<TkEndIMEMarkedText>> { + if { [catch {dict get $::tk::Priv(IMETextMark) "%W"} mark] } { + bell + } else { + %W selection range $mark insert + } +} +bind TEntry <<TkClearIMEMarkedText>> { + %W delete [dict get $::tk::Priv(IMETextMark) "%W"] [%W index insert] +} +bind TEntry <<TkAccentBackspace>> { + ttk::entry::Backspace %W +} ### Clipboard procedures. # @@ -160,7 +179,7 @@ bind TEntry <Control-Key-k> { %W delete insert end } # proc ttk::entry::EntrySelection {w} { set entryString [string range [$w get] [$w index sel.first] \ - [expr {[$w index sel.last] - 1}]] + [$w index sel.last]-1] if {[$w cget -show] ne ""} { return [string repeat [string index [$w cget -show] 0] \ [string length $entryString]] @@ -339,7 +358,7 @@ proc ttk::entry::Extend {w where} { # Triple-clicking enters "line-select" mode. # -## Press -- ButtonPress-1 binding. +## Press -- Button-1 binding. # Set the insertion cursor, claim the input focus, set up for # future drag operations. # @@ -356,7 +375,7 @@ proc ttk::entry::Press {w x} { set State(anchor) [$w index insert] } -## Shift-Press -- Shift-ButtonPress-1 binding. +## Shift-Press -- Shift-Button-1 binding. # Extends the selection, sets anchor for future drag operations. # proc ttk::entry::Shift-Press {w x} { @@ -505,7 +524,7 @@ proc ttk::entry::LineSelect {w _ _} { ### Button 2 binding procedures. # -## ScanMark -- ButtonPress-2 binding. +## ScanMark -- Button-2 binding. # Marks the start of a scan or primary transfer operation. # proc ttk::entry::ScanMark {w x} { diff --git a/library/ttk/fonts.tcl b/library/ttk/fonts.tcl index a2781c6..65f2c5e 100644 --- a/library/ttk/fonts.tcl +++ b/library/ttk/fonts.tcl @@ -53,10 +53,6 @@ # Most other toolkits use medium weight for all UI elements, # which is what we do now. # -# Font size specified in pixels on X11, not points. -# This is Theoretically Wrong, but in practice works better; using -# points leads to huge inconsistencies across different servers. -# namespace eval ttk { @@ -82,7 +78,7 @@ switch -- [tk windowingsystem] { set F(family) "MS Sans Serif" } } else { - if {[lsearch -exact [font families] Tahoma] != -1} { + if {[lsearch -exact [font families] Tahoma] >= 0} { set F(family) "Tahoma" } else { set F(family) "MS Sans Serif" @@ -131,10 +127,10 @@ switch -- [tk windowingsystem] { set F(family) "Helvetica" set F(fixed) "courier" } - set F(size) -12 - set F(ttsize) -10 - set F(capsize) -14 - set F(fixedsize) -12 + set F(size) 10 + set F(ttsize) 9 + set F(capsize) 12 + set F(fixedsize) 10 font configure TkDefaultFont -family $F(family) -size $F(size) font configure TkTextFont -family $F(family) -size $F(size) diff --git a/library/ttk/menubutton.tcl b/library/ttk/menubutton.tcl index bb947c2..a245df8 100644 --- a/library/ttk/menubutton.tcl +++ b/library/ttk/menubutton.tcl @@ -5,7 +5,7 @@ # # Pulldown: Press menubutton, drag over menu, release to activate menu entry # Popdown: Click menubutton to post menu -# Keyboard: <Key-space> or accelerator key to post menu +# Keyboard: <space> or accelerator key to post menu # # (In addition, when menu system is active, "dropdown" -- menu posts # on mouse-over. Ttk menubuttons don't implement this). @@ -19,7 +19,7 @@ # This won't work for Ttk menubuttons in pulldown mode, # since we need to process the final <ButtonRelease> event, # and this might be delivered to the menu. So instead we -# rely on the passive grab that occurs on <ButtonPress> events, +# rely on the passive grab that occurs on <Button> events, # and transition to popdown mode when the mouse is released # or dragged outside the menubutton. # @@ -46,15 +46,15 @@ namespace eval ttk { bind TMenubutton <Enter> { %W instate !disabled {%W state active } } bind TMenubutton <Leave> { %W state !active } -bind TMenubutton <Key-space> { ttk::menubutton::Popdown %W } +bind TMenubutton <space> { ttk::menubutton::Popdown %W } bind TMenubutton <<Invoke>> { ttk::menubutton::Popdown %W } if {[tk windowingsystem] eq "x11"} { - bind TMenubutton <ButtonPress-1> { ttk::menubutton::Pulldown %W } + bind TMenubutton <Button-1> { ttk::menubutton::Pulldown %W } bind TMenubutton <ButtonRelease-1> { ttk::menubutton::TransferGrab %W } bind TMenubutton <B1-Leave> { ttk::menubutton::TransferGrab %W } } else { - bind TMenubutton <ButtonPress-1> \ + bind TMenubutton <Button-1> \ { %W state pressed ; ttk::menubutton::Popdown %W } bind TMenubutton <ButtonRelease-1> \ { if {[winfo exists %W]} { %W state !pressed } } @@ -224,11 +224,11 @@ proc ttk::menubutton::TransferGrab {mb} { # FindMenuEntry -- # Hack to support tk_optionMenus. # Returns the index of the menu entry with a matching -label, -# -1 if not found. +# "" if not found. # proc ttk::menubutton::FindMenuEntry {menu s} { set last [$menu index last] - if {$last eq "none"} { + if {$last eq "none" || $last eq ""} { return "" } for {set i 0} {$i <= $last} {incr i} { diff --git a/library/ttk/notebook.tcl b/library/ttk/notebook.tcl index 92efe40..c5340a5 100644 --- a/library/ttk/notebook.tcl +++ b/library/ttk/notebook.tcl @@ -6,11 +6,11 @@ namespace eval ttk::notebook { variable TLNotebooks ;# See enableTraversal } -bind TNotebook <ButtonPress-1> { ttk::notebook::Press %W %x %y } -bind TNotebook <Key-Right> { ttk::notebook::CycleTab %W 1; break } -bind TNotebook <Key-Left> { ttk::notebook::CycleTab %W -1; break } -bind TNotebook <Control-Key-Tab> { ttk::notebook::CycleTab %W 1; break } -bind TNotebook <Control-Shift-Key-Tab> { ttk::notebook::CycleTab %W -1; break } +bind TNotebook <Button-1> { ttk::notebook::Press %W %x %y } +bind TNotebook <Right> { ttk::notebook::CycleTab %W 1; break } +bind TNotebook <Left> { ttk::notebook::CycleTab %W -1; break } +bind TNotebook <Control-Tab> { ttk::notebook::CycleTab %W 1; break } +bind TNotebook <Control-Shift-Tab> { ttk::notebook::CycleTab %W -1; break } catch { bind TNotebook <Control-ISO_Left_Tab> { ttk::notebook::CycleTab %W -1; break } } @@ -43,7 +43,7 @@ proc ttk::notebook::ActivateTab {w tab} { } # Press $nb $x $y -- -# ButtonPress-1 binding for notebook widgets. +# Button-1 binding for notebook widgets. # Activate the tab under the mouse cursor, if any. # proc ttk::notebook::Press {w x y} { @@ -105,18 +105,18 @@ proc ttk::notebook::enableTraversal {nb} { if {![info exists TLNotebooks($top)]} { # Augment $top bindings: # - bind $top <Control-Key-Next> {+ttk::notebook::TLCycleTab %W 1} - bind $top <Control-Key-Prior> {+ttk::notebook::TLCycleTab %W -1} - bind $top <Control-Key-Tab> {+ttk::notebook::TLCycleTab %W 1} - bind $top <Control-Shift-Key-Tab> {+ttk::notebook::TLCycleTab %W -1} + bind $top <Control-Next> {+ttk::notebook::TLCycleTab %W 1} + bind $top <Control-Prior> {+ttk::notebook::TLCycleTab %W -1} + bind $top <Control-Tab> {+ttk::notebook::TLCycleTab %W 1} + bind $top <Control-Shift-Tab> {+ttk::notebook::TLCycleTab %W -1} catch { - bind $top <Control-Key-ISO_Left_Tab> {+ttk::notebook::TLCycleTab %W -1} + bind $top <Control-ISO_Left_Tab> {+ttk::notebook::TLCycleTab %W -1} } if {[tk windowingsystem] eq "aqua"} { - bind $top <Option-KeyPress> \ + bind $top <Option-Key> \ +[list ttk::notebook::MnemonicActivation $top %K] } else { - bind $top <Alt-KeyPress> \ + bind $top <Alt-Key> \ +[list ttk::notebook::MnemonicActivation $top %K] } bind $top <Destroy> {+ttk::notebook::TLCleanup %W} @@ -182,7 +182,7 @@ proc ttk::notebook::TLCycleTab {w dir} { } # MnemonicActivation $nb $key -- -# Alt-KeyPress binding procedure for mnemonic activation. +# Alt-Key binding procedure for mnemonic activation. # Scan all notebooks in specified toplevel for a tab with the # the specified mnemonic. If found, activate it and return TCL_BREAK. # diff --git a/library/ttk/panedwindow.tcl b/library/ttk/panedwindow.tcl index a2e073b..0fd9bd7 100644 --- a/library/ttk/panedwindow.tcl +++ b/library/ttk/panedwindow.tcl @@ -15,7 +15,7 @@ namespace eval ttk::panedwindow { ## Bindings: # -bind TPanedwindow <ButtonPress-1> { ttk::panedwindow::Press %W %x %y } +bind TPanedwindow <Button-1> { ttk::panedwindow::Press %W %x %y } bind TPanedwindow <B1-Motion> { ttk::panedwindow::Drag %W %x %y } bind TPanedwindow <ButtonRelease-1> { ttk::panedwindow::Release %W %x %y } @@ -62,13 +62,22 @@ proc ttk::panedwindow::Release {w x y} { # proc ttk::panedwindow::ResetCursor {w} { variable State + + ttk::saveCursor $w State(userConfCursor) \ + [list [ttk::cursor hresize] [ttk::cursor vresize]] + if {!$State(pressed)} { - ttk::setCursor $w {} + ttk::setCursor $w $State(userConfCursor) } } proc ttk::panedwindow::SetCursor {w x y} { - set cursor "" + variable State + + ttk::saveCursor $w State(userConfCursor) \ + [list [ttk::cursor hresize] [ttk::cursor vresize]] + + set cursor $State(userConfCursor) if {[llength [$w identify $x $y]]} { # Assume we're over a sash. switch -- [$w cget -orient] { diff --git a/library/ttk/scale.tcl b/library/ttk/scale.tcl index 62c85bf..61c4136 100644 --- a/library/ttk/scale.tcl +++ b/library/ttk/scale.tcl @@ -9,15 +9,15 @@ namespace eval ttk::scale { } } -bind TScale <ButtonPress-1> { ttk::scale::Press %W %x %y } +bind TScale <Button-1> { ttk::scale::Press %W %x %y } bind TScale <B1-Motion> { ttk::scale::Drag %W %x %y } bind TScale <ButtonRelease-1> { ttk::scale::Release %W %x %y } -bind TScale <ButtonPress-2> { ttk::scale::Jump %W %x %y } +bind TScale <Button-2> { ttk::scale::Jump %W %x %y } bind TScale <B2-Motion> { ttk::scale::Drag %W %x %y } bind TScale <ButtonRelease-2> { ttk::scale::Release %W %x %y } -bind TScale <ButtonPress-3> { ttk::scale::Jump %W %x %y } +bind TScale <Button-3> { ttk::scale::Jump %W %x %y } bind TScale <B3-Motion> { ttk::scale::Drag %W %x %y } bind TScale <ButtonRelease-3> { ttk::scale::Release %W %x %y } @@ -52,7 +52,7 @@ proc ttk::scale::Press {w x y} { } } -# scale::Jump -- ButtonPress-2/3 binding for scale acts like +# scale::Jump -- Button-2/3 binding for scale acts like # Press except that clicking in the trough jumps to the # clicked position. proc ttk::scale::Jump {w x y} { diff --git a/library/ttk/scrollbar.tcl b/library/ttk/scrollbar.tcl index e1e16e0..fdba265 100644 --- a/library/ttk/scrollbar.tcl +++ b/library/ttk/scrollbar.tcl @@ -9,14 +9,32 @@ namespace eval ttk::scrollbar { # State(first) -- value of -first at start of drag. } -bind TScrollbar <ButtonPress-1> { ttk::scrollbar::Press %W %x %y } +bind TScrollbar <Button-1> { ttk::scrollbar::Press %W %x %y } bind TScrollbar <B1-Motion> { ttk::scrollbar::Drag %W %x %y } bind TScrollbar <ButtonRelease-1> { ttk::scrollbar::Release %W %x %y } -bind TScrollbar <ButtonPress-2> { ttk::scrollbar::Jump %W %x %y } +bind TScrollbar <Button-2> { ttk::scrollbar::Jump %W %x %y } bind TScrollbar <B2-Motion> { ttk::scrollbar::Drag %W %x %y } bind TScrollbar <ButtonRelease-2> { ttk::scrollbar::Release %W %x %y } +# Redirect scrollwheel bindings to the scrollbar widget +# +# The shift-bindings scroll left/right (not up/down) +# if a widget has both possibilities +set eventList [list <MouseWheel>] +switch [tk windowingsystem] { + aqua { + lappend eventList <Option-MouseWheel> + } + x11 { + lappend eventList <Button-4> <Button-5> <Button-6> <Button-7> + } +} +foreach event $eventList { + bind TScrollbar $event [bind Scrollbar $event] +} +unset eventList event + proc ttk::scrollbar::Scroll {w n units} { set cmd [$w cget -command] if {$cmd ne ""} { @@ -38,7 +56,7 @@ proc ttk::scrollbar::Press {w x y} { set State(yPress) $y switch -glob -- [$w identify $x $y] { - *uparrow - + *uparrow - *leftarrow { ttk::Repeatedly Scroll $w -1 units } @@ -46,6 +64,7 @@ proc ttk::scrollbar::Press {w x y} { *rightarrow { ttk::Repeatedly Scroll $w 1 units } + *grip - *thumb { set State(first) [lindex [$w get] 0] } @@ -83,7 +102,7 @@ proc ttk::scrollbar::Release {w x y} { ttk::CancelRepeat } -# scrollbar::Jump -- ButtonPress-2 binding for scrollbars. +# scrollbar::Jump -- Button-2 binding for scrollbars. # Behaves exactly like scrollbar::Press, except that # clicking in the trough jumps to the the selected position. # @@ -91,6 +110,7 @@ proc ttk::scrollbar::Jump {w x y} { variable State switch -glob -- [$w identify $x $y] { + *grip - *thumb - *trough { set State(first) [$w fraction $x $y] diff --git a/library/ttk/sizegrip.tcl b/library/ttk/sizegrip.tcl index 24a67c6..080ab2d 100644 --- a/library/ttk/sizegrip.tcl +++ b/library/ttk/sizegrip.tcl @@ -32,7 +32,7 @@ namespace eval ttk::sizegrip { } } -bind TSizegrip <ButtonPress-1> { ttk::sizegrip::Press %W %X %Y } +bind TSizegrip <Button-1> { ttk::sizegrip::Press %W %X %Y } bind TSizegrip <B1-Motion> { ttk::sizegrip::Drag %W %X %Y } bind TSizegrip <ButtonRelease-1> { ttk::sizegrip::Release %W %X %Y } diff --git a/library/ttk/spinbox.tcl b/library/ttk/spinbox.tcl index 1aa0ccb..33936d9 100644 --- a/library/ttk/spinbox.tcl +++ b/library/ttk/spinbox.tcl @@ -12,13 +12,13 @@ namespace eval ttk::spinbox { } ttk::copyBindings TEntry TSpinbox bind TSpinbox <Motion> { ttk::spinbox::Motion %W %x %y } -bind TSpinbox <ButtonPress-1> { ttk::spinbox::Press %W %x %y } +bind TSpinbox <Button-1> { ttk::spinbox::Press %W %x %y } bind TSpinbox <ButtonRelease-1> { ttk::spinbox::Release %W } bind TSpinbox <Double-Button-1> { ttk::spinbox::DoubleClick %W %x %y } bind TSpinbox <Triple-Button-1> {} ;# disable TEntry triple-click -bind TSpinbox <KeyPress-Up> { event generate %W <<Increment>> } -bind TSpinbox <KeyPress-Down> { event generate %W <<Decrement>> } +bind TSpinbox <Up> { event generate %W <<Increment>> } +bind TSpinbox <Down> { event generate %W <<Decrement>> } bind TSpinbox <<Increment>> { ttk::spinbox::Spin %W +1 } bind TSpinbox <<Decrement>> { ttk::spinbox::Spin %W -1 } @@ -29,12 +29,14 @@ ttk::bindMouseWheel TSpinbox [list ttk::spinbox::MouseWheel %W] # Sets cursor. # proc ttk::spinbox::Motion {w x y} { + variable State + ttk::saveCursor $w State(userConfCursor) [ttk::cursor text] if { [$w identify $x $y] eq "textarea" && [$w instate {!readonly !disabled}] } { ttk::setCursor $w text } else { - ttk::setCursor $w "" + ttk::setCursor $w $State(userConfCursor) } } @@ -81,6 +83,7 @@ proc ttk::spinbox::Release {w} { # or <<Decrement> (+1, down) events. # proc ttk::spinbox::MouseWheel {w dir} { + if {[$w instate disabled]} { return } if {$dir < 0} { event generate $w <<Increment>> } else { @@ -132,12 +135,27 @@ proc ttk::spinbox::Adjust {w v min max} { # -from, -to, and -increment. # proc ttk::spinbox::Spin {w dir} { - set nvalues [llength [set values [$w cget -values]]] - set value [$w get] - if {$nvalues} { - set current [lsearch -exact $values $value] - set index [Adjust $w [expr {$current + $dir}] 0 [expr {$nvalues - 1}]] - $w set [lindex $values $index] + variable State + + if {[$w instate disabled]} { return } + + if {![info exists State($w,values.length)]} { + set State($w,values.index) -1 + set State($w,values.last) {} + } + set State($w,values) [$w cget -values] + set State($w,values.length) [llength $State($w,values)] + + if {$State($w,values.length) > 0} { + set value [$w get] + set current $State($w,values.index) + if {$value ne $State($w,values.last)} { + set current [lsearch -exact $State($w,values) $value] + } + set State($w,values.index) [Adjust $w [expr {$current + $dir}] 0 \ + [expr {$State($w,values.length) - 1}]] + set State($w,values.last) [lindex $State($w,values) $State($w,values.index)] + $w set $State($w,values.last) } else { if {[catch { set v [expr {[scan [$w get] %f] + $dir * [$w cget -increment]}] diff --git a/library/ttk/treeview.tcl b/library/ttk/treeview.tcl index 39273ed..62fc630 100644 --- a/library/ttk/treeview.tcl +++ b/library/ttk/treeview.tcl @@ -28,20 +28,20 @@ namespace eval ttk::treeview { bind Treeview <Motion> { ttk::treeview::Motion %W %x %y } bind Treeview <B1-Leave> { #nothing } bind Treeview <Leave> { ttk::treeview::ActivateHeading {} {}} -bind Treeview <ButtonPress-1> { ttk::treeview::Press %W %x %y } -bind Treeview <Double-ButtonPress-1> { ttk::treeview::DoubleClick %W %x %y } +bind Treeview <Button-1> { ttk::treeview::Press %W %x %y } +bind Treeview <Double-Button-1> { ttk::treeview::DoubleClick %W %x %y } bind Treeview <ButtonRelease-1> { ttk::treeview::Release %W %x %y } bind Treeview <B1-Motion> { ttk::treeview::Drag %W %x %y } -bind Treeview <KeyPress-Up> { ttk::treeview::Keynav %W up } -bind Treeview <KeyPress-Down> { ttk::treeview::Keynav %W down } -bind Treeview <KeyPress-Right> { ttk::treeview::Keynav %W right } -bind Treeview <KeyPress-Left> { ttk::treeview::Keynav %W left } -bind Treeview <KeyPress-Prior> { %W yview scroll -1 pages } -bind Treeview <KeyPress-Next> { %W yview scroll 1 pages } -bind Treeview <KeyPress-Return> { ttk::treeview::ToggleFocus %W } -bind Treeview <KeyPress-space> { ttk::treeview::ToggleFocus %W } - -bind Treeview <Shift-ButtonPress-1> \ +bind Treeview <Up> { ttk::treeview::Keynav %W up } +bind Treeview <Down> { ttk::treeview::Keynav %W down } +bind Treeview <Right> { ttk::treeview::Keynav %W right } +bind Treeview <Left> { ttk::treeview::Keynav %W left } +bind Treeview <Prior> { %W yview scroll -1 pages } +bind Treeview <Next> { %W yview scroll 1 pages } +bind Treeview <Return> { ttk::treeview::ToggleFocus %W } +bind Treeview <space> { ttk::treeview::ToggleFocus %W } + +bind Treeview <Shift-Button-1> \ { ttk::treeview::Select %W %x %y extend } bind Treeview <<ToggleSelection>> \ { ttk::treeview::Select %W %x %y toggle } @@ -102,7 +102,11 @@ proc ttk::treeview::Keynav {w dir} { # Sets cursor, active element ... # proc ttk::treeview::Motion {w x y} { - set cursor {} + variable State + + ttk::saveCursor $w State(userConfCursor) [ttk::cursor hresize] + + set cursor $State(userConfCursor) set activeHeading {} switch -- [$w identify region $x $y] { @@ -121,7 +125,17 @@ proc ttk::treeview::ActivateHeading {w heading} { if {$w != $State(activeWidget) || $heading != $State(activeHeading)} { if {[winfo exists $State(activeWidget)] && $State(activeHeading) != {}} { - $State(activeWidget) heading $State(activeHeading) state !active + # It may happen that $State(activeHeading) no longer corresponds + # to an existing display column. This happens for instance when + # changing -displaycolumns in a bound script when this change + # triggers a <Leave> event. A proc checking if the display column + # $State(activeHeading) is really still present or not could be + # written but it would need to check several special cases: + # a. -displaycolumns "#all" or being an explicit columns list + # b. column #0 display is not governed by the -displaycolumn + # list but by the value of the -show option + # --> Let's rather catch the following line. + catch {$State(activeWidget) heading $State(activeHeading) state !active} } if {$heading != {}} { $w heading $heading state active @@ -141,7 +155,7 @@ proc ttk::treeview::Select {w x y op} { } } -## DoubleClick -- Double-ButtonPress-1 binding. +## DoubleClick -- Double-Button-1 binding. # proc ttk::treeview::DoubleClick {w x y} { if {[set row [$w identify row $x $y]] ne ""} { @@ -151,7 +165,7 @@ proc ttk::treeview::DoubleClick {w x y} { } } -## Press -- ButtonPress binding. +## Press -- Button binding. # proc ttk::treeview::Press {w x y} { focus $w @@ -251,9 +265,9 @@ proc ttk::treeview::SelectOp {w item op} { ## -selectmode none: # -proc ttk::treeview::select.choose.none {w item} { $w focus $item } -proc ttk::treeview::select.toggle.none {w item} { $w focus $item } -proc ttk::treeview::select.extend.none {w item} { $w focus $item } +proc ttk::treeview::select.choose.none {w item} { $w focus $item; $w see $item } +proc ttk::treeview::select.toggle.none {w item} { $w focus $item; $w see $item } +proc ttk::treeview::select.extend.none {w item} { $w focus $item; $w see $item } ## -selectmode browse: # diff --git a/library/ttk/utils.tcl b/library/ttk/utils.tcl index 3729254..c58d39e 100644 --- a/library/ttk/utils.tcl +++ b/library/ttk/utils.tcl @@ -58,7 +58,7 @@ proc ttk::traverseTo {w} { } ## ttk::clickToFocus $w -- -# Utility routine, used in <ButtonPress-1> bindings -- +# Utility routine, used in <Button-1> bindings -- # Assign keyboard focus to the specified widget if -takefocus is enabled. # proc ttk::clickToFocus {w} { diff --git a/library/ttk/vistaTheme.tcl b/library/ttk/vistaTheme.tcl index 165b496..d841962 100644 --- a/library/ttk/vistaTheme.tcl +++ b/library/ttk/vistaTheme.tcl @@ -69,9 +69,9 @@ namespace eval ttk::theme::vista { ttk::style layout TCombobox { Combobox.border -sticky nswe -border 0 -children { Combobox.rightdownarrow -side right -sticky ns - Combobox.padding -expand 1 -sticky nswe -children { + Combobox.padding -sticky nswe -children { Combobox.background -sticky nswe -children { - Combobox.focus -expand 1 -sticky nswe -children { + Combobox.focus -sticky nswe -children { Combobox.textarea -sticky nswe } } @@ -138,7 +138,7 @@ namespace eval ttk::theme::vista { Spinbox.background -sticky news -children { Spinbox.padding -sticky news -children { Spinbox.innerbg -sticky news -children { - Spinbox.textarea -expand 1 + Spinbox.textarea } } Spinbox.uparrow -side top -sticky ens @@ -203,8 +203,8 @@ namespace eval ttk::theme::vista { TRACKBAR 3 {disabled 5 focus 4 pressed 3 active 2 {} 1} \ -width 6 -height 12 ttk::style layout Horizontal.TScale { - Scale.focus -expand 1 -sticky nswe -children { - Horizontal.Scale.trough -expand 1 -sticky nswe -children { + Scale.focus -sticky nswe -children { + Horizontal.Scale.trough -sticky nswe -children { Horizontal.Scale.track -sticky we Horizontal.Scale.slider -side left -sticky {} } @@ -214,8 +214,8 @@ namespace eval ttk::theme::vista { TRACKBAR 6 {disabled 5 focus 4 pressed 3 active 2 {} 1} \ -width 12 -height 6 ttk::style layout Vertical.TScale { - Scale.focus -expand 1 -sticky nswe -children { - Vertical.Scale.trough -expand 1 -sticky nswe -children { + Scale.focus -sticky nswe -children { + Vertical.Scale.trough -sticky nswe -children { Vertical.Scale.track -sticky ns Vertical.Scale.slider -side top -sticky {} } diff --git a/library/ttk/xpTheme.tcl b/library/ttk/xpTheme.tcl index 4c4f680..da7b422 100644 --- a/library/ttk/xpTheme.tcl +++ b/library/ttk/xpTheme.tcl @@ -28,13 +28,6 @@ namespace eval ttk::theme::xpnative { ttk::style map TNotebook.Tab \ -expand [list selected {2 2 2 2}] - # Treeview: - ttk::style configure Heading -font TkHeadingFont - ttk::style configure Treeview -background SystemWindow - ttk::style map Treeview \ - -background [list selected SystemHighlight] \ - -foreground [list selected SystemHighlightText] ; - ttk::style configure TLabelframe.Label -foreground "#0046d5" # OR: -padding {3 3 3 6}, which some apps seem to use. |