diff options
author | Siep Kroonenberg <siepo@cybercomm.nl> | 2020-03-17 20:46:21 +0000 |
---|---|---|
committer | Siep Kroonenberg <siepo@cybercomm.nl> | 2020-03-17 20:46:21 +0000 |
commit | 450bc12eba9ebc61c597b70a633eb1e37ab92180 (patch) | |
tree | 8985a7de63a8ae88e499d497d684da7f00c8c993 /Master/tlpkg/tltcl/lib/tk8.6/ttk | |
parent | 412579d4e7fdcc86bf649615419fb560809bc8f3 (diff) |
New Tcl/Tk for Windows. No longer a single-file kit.
git-svn-id: svn://tug.org/texlive/trunk@54375 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tltcl/lib/tk8.6/ttk')
24 files changed, 4472 insertions, 0 deletions
diff --git a/Master/tlpkg/tltcl/lib/tk8.6/ttk/altTheme.tcl b/Master/tlpkg/tltcl/lib/tk8.6/ttk/altTheme.tcl new file mode 100644 index 00000000000..80ef4153bd3 --- /dev/null +++ b/Master/tlpkg/tltcl/lib/tk8.6/ttk/altTheme.tcl @@ -0,0 +1,109 @@ +# +# Ttk widget set: Alternate theme +# + +namespace eval ttk::theme::alt { + + variable colors + array set colors { + -frame "#d9d9d9" + -window "#ffffff" + -darker "#c3c3c3" + -border "#414141" + -activebg "#ececec" + -disabledfg "#a3a3a3" + -selectbg "#4a6984" + -selectfg "#ffffff" + -altindicator "#aaaaaa" + } + + ttk::style theme settings alt { + + ttk::style configure "." \ + -background $colors(-frame) \ + -foreground black \ + -troughcolor $colors(-darker) \ + -bordercolor $colors(-border) \ + -selectbackground $colors(-selectbg) \ + -selectforeground $colors(-selectfg) \ + -font TkDefaultFont \ + ; + + ttk::style map "." -background \ + [list disabled $colors(-frame) active $colors(-activebg)] ; + ttk::style map "." -foreground [list disabled $colors(-disabledfg)] ; + ttk::style map "." -embossed [list disabled 1] ; + + ttk::style configure TButton \ + -anchor center -width -11 -padding "1 1" \ + -relief raised -shiftrelief 1 \ + -highlightthickness 1 -highlightcolor $colors(-frame) + + ttk::style map TButton -relief { + {pressed !disabled} sunken + {active !disabled} raised + } -highlightcolor {alternate black} + + ttk::style configure TCheckbutton -indicatorcolor "#ffffff" -padding 2 + ttk::style configure TRadiobutton -indicatorcolor "#ffffff" -padding 2 + ttk::style map TCheckbutton -indicatorcolor \ + [list pressed $colors(-frame) \ + alternate $colors(-altindicator) \ + disabled $colors(-frame)] + ttk::style map TRadiobutton -indicatorcolor \ + [list pressed $colors(-frame) \ + alternate $colors(-altindicator) \ + disabled $colors(-frame)] + + ttk::style configure TMenubutton \ + -width -11 -padding "3 3" -relief raised + + ttk::style configure TEntry -padding 1 + ttk::style map TEntry -fieldbackground \ + [list readonly $colors(-frame) disabled $colors(-frame)] + ttk::style configure TCombobox -padding 1 + ttk::style map TCombobox -fieldbackground \ + [list readonly $colors(-frame) disabled $colors(-frame)] \ + -arrowcolor [list disabled $colors(-disabledfg)] + ttk::style configure ComboboxPopdownFrame \ + -relief solid -borderwidth 1 + + ttk::style configure TSpinbox -arrowsize 10 -padding {2 0 10 0} + ttk::style map TSpinbox -fieldbackground \ + [list readonly $colors(-frame) disabled $colors(-frame)] \ + -arrowcolor [list disabled $colors(-disabledfg)] + + ttk::style configure Toolbutton -relief flat -padding 2 + ttk::style map Toolbutton -relief \ + {disabled flat selected sunken pressed sunken active raised} + ttk::style map Toolbutton -background \ + [list pressed $colors(-darker) active $colors(-activebg)] + + ttk::style configure TScrollbar -relief raised + + ttk::style configure TLabelframe -relief groove -borderwidth 2 + + ttk::style configure TNotebook -tabmargins {2 2 1 0} + ttk::style configure TNotebook.Tab \ + -padding {4 2} -background $colors(-darker) + ttk::style map TNotebook.Tab \ + -background [list selected $colors(-frame)] \ + -expand [list selected {2 2 1 0}] \ + ; + + # Treeview: + ttk::style configure Heading -font TkHeadingFont -relief raised + ttk::style configure Treeview -background $colors(-window) + ttk::style map Treeview \ + -background [list disabled $colors(-frame)\ + selected $colors(-selectbg)] \ + -foreground [list disabled $colors(-disabledfg) \ + selected $colors(-selectfg)] + + ttk::style configure TScale \ + -groovewidth 4 -troughrelief sunken \ + -sliderwidth raised -borderwidth 2 + ttk::style configure TProgressbar \ + -background $colors(-selectbg) -borderwidth 0 + } +} diff --git a/Master/tlpkg/tltcl/lib/tk8.6/ttk/aquaTheme.tcl b/Master/tlpkg/tltcl/lib/tk8.6/ttk/aquaTheme.tcl new file mode 100644 index 00000000000..e8009bed348 --- /dev/null +++ b/Master/tlpkg/tltcl/lib/tk8.6/ttk/aquaTheme.tcl @@ -0,0 +1,130 @@ +# +# Aqua theme (OSX native look and feel) +# + +namespace eval ttk::theme::aqua { + ttk::style theme settings aqua { + + ttk::style configure . \ + -font TkDefaultFont \ + -background systemWindowBackgroundColor \ + -foreground systemLabelColor \ + -selectbackground systemSelectedTextBackgroundColor \ + -selectforeground systemSelectedTextColor \ + -selectborderwidth 0 \ + -insertwidth 1 + + ttk::style map . \ + -foreground { + disabled systemDisabledControlTextColor + background systemLabelColor} \ + -selectbackground { + background systemSelectedTextBackgroundColor + !focus systemSelectedTextBackgroundColor} \ + -selectforeground { + background systemSelectedTextColor + !focus systemSelectedTextColor} + + # Button + ttk::style configure TButton -anchor center -width -6 \ + -foreground systemControlTextColor + ttk::style map TButton \ + -foreground { + pressed white + {alternate !pressed !background} white} + ttk::style configure TMenubutton -anchor center -padding {2 0 0 2} + ttk::style configure Toolbutton -anchor center + + # Entry + ttk::style configure TEntry \ + -foreground systemTextColor \ + -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 + # disabled buttons even if it did work... + ttk::style configure . -stipple {} + + # Notebook + ttk::style configure TNotebook -tabmargins {10 0} -tabposition n + ttk::style configure TNotebook -padding {18 8 18 17} + ttk::style configure TNotebook.Tab -padding {12 3 12 2} + ttk::style configure TNotebook.Tab -foreground systemControlTextColor + ttk::style map TNotebook.Tab \ + -foreground { + background systemControlTextColor + disabled systemDisabledControlTextColor + selected systemSelectedTabTextColor} + + # Combobox: + ttk::style configure TCombobox \ + -foreground systemTextColor \ + -background systemTransparent + ttk::style map TCombobox \ + -foreground { + disabled systemDisabledControlTextColor + } \ + -selectforeground { + background systemTextColor + } \ + -selectbackground { + background systemTransparent + } + + # Spinbox + ttk::style configure TSpinbox \ + -foreground systemTextColor \ + -background systemTextBackgroundColor \ + -selectforeground systemSelectedTextColor \ + -selectbackground systemSelectedTextBackgroundColor + ttk::style map TSpinbox \ + -foreground { + disabled systemDisabledControlTextColor + } \ + -selectforeground { + !active systemTextColor + } \ + -selectbackground { + !active systemTextBackgroundColor + !focus systemTextBackgroundColor + focus systemSelectedTextBackgroundColor + } + + # Treeview: + ttk::style configure Heading \ + -font TkHeadingFont \ + -foreground systemTextColor \ + -background systemWindowBackgroundColor + ttk::style configure Treeview -rowheight 18 \ + -background systemTextBackgroundColor \ + -foreground systemTextColor \ + -fieldbackground systemTextBackgroundColor + ttk::style map Treeview \ + -background { + selected systemSelectedTextBackgroundColor + } + + # Enable animation for ttk::progressbar widget: + ttk::style configure TProgressbar -period 100 -maxphase 255 + + # For Aqua, labelframe labels should appear outside the border, + # with a 14 pixel inset and 4 pixels spacing between border and label + # (ref: Apple Human Interface Guidelines / Controls / Grouping Controls) + # + ttk::style configure TLabelframe \ + -labeloutside true -labelmargins {14 0 14 4} + + # TODO: panedwindow sashes should be 9 pixels (HIG:Controls:Split Views) + } +} diff --git a/Master/tlpkg/tltcl/lib/tk8.6/ttk/button.tcl b/Master/tlpkg/tltcl/lib/tk8.6/ttk/button.tcl new file mode 100644 index 00000000000..9f2cec729d8 --- /dev/null +++ b/Master/tlpkg/tltcl/lib/tk8.6/ttk/button.tcl @@ -0,0 +1,83 @@ +# +# Bindings for Buttons, Checkbuttons, and Radiobuttons. +# +# Notes: <Button1-Leave>, <Button1-Enter> only control the "pressed" +# state; widgets remain "active" if the pointer is dragged out. +# This doesn't seem to be conventional, but it's a nice way +# to provide extra feedback while the grab is active. +# (If the button is released off the widget, the grab deactivates and +# 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> +# 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 +# the pressed state if the button is currently active. +# + +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 <<Invoke>> { ttk::button::activate %W } + +bind TButton <ButtonPress-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 } } } +bind TButton <Button1-Leave> \ + { %W state !pressed } +bind TButton <Button1-Enter> \ + { %W instate {active !disabled} { %W state pressed } } + +# Checkbuttons and Radiobuttons have the same bindings as Buttons: +# +ttk::copyBindings TButton TCheckbutton +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 TCheckbutton <KeyPress-plus> { %W select } +# bind TCheckbutton <KeyPress-minus> { %W deselect } + +# activate -- +# Simulate a button press: temporarily set the state to 'pressed', +# then invoke the button. +# +proc ttk::button::activate {w} { + $w instate disabled { return } + set oldState [$w state pressed] + update idletasks; after 100 ;# block event loop to avoid reentrancy + $w state $oldState + $w invoke +} + +# RadioTraverse -- up/down keyboard traversal for radiobutton groups. +# Set focus to previous/next radiobutton in a group. +# A radiobutton group consists of all the radiobuttons with +# the same parent and -variable; this is a pretty good heuristic +# that works most of the time. +# +proc ttk::button::RadioTraverse {w dir} { + set group [list] + foreach sibling [winfo children [winfo parent $w]] { + if { [winfo class $sibling] eq "TRadiobutton" + && [$sibling cget -variable] eq [$w cget -variable] + && ![$sibling instate disabled] + } { + lappend group $sibling + } + } + + if {![llength $group]} { # Shouldn't happen, but can. + return + } + + set pos [expr {([lsearch -exact $group $w] + $dir) % [llength $group]}] + tk::TabToWindow [lindex $group $pos] +} diff --git a/Master/tlpkg/tltcl/lib/tk8.6/ttk/clamTheme.tcl b/Master/tlpkg/tltcl/lib/tk8.6/ttk/clamTheme.tcl new file mode 100644 index 00000000000..6935fc70441 --- /dev/null +++ b/Master/tlpkg/tltcl/lib/tk8.6/ttk/clamTheme.tcl @@ -0,0 +1,147 @@ +# +# "Clam" theme. +# +# Inspired by the XFCE family of Gnome themes. +# + +namespace eval ttk::theme::clam { + variable colors + array set colors { + -disabledfg "#999999" + -frame "#dcdad5" + -window "#ffffff" + -dark "#cfcdc8" + -darker "#bab5ab" + -darkest "#9e9a91" + -lighter "#eeebe7" + -lightest "#ffffff" + -selectbg "#4a6984" + -selectfg "#ffffff" + -altindicator "#5895bc" + -disabledaltindicator "#a0a0a0" + } + + ttk::style theme settings clam { + + ttk::style configure "." \ + -background $colors(-frame) \ + -foreground black \ + -bordercolor $colors(-darkest) \ + -darkcolor $colors(-dark) \ + -lightcolor $colors(-lighter) \ + -troughcolor $colors(-darker) \ + -selectbackground $colors(-selectbg) \ + -selectforeground $colors(-selectfg) \ + -selectborderwidth 0 \ + -font TkDefaultFont \ + ; + + ttk::style map "." \ + -background [list disabled $colors(-frame) \ + active $colors(-lighter)] \ + -foreground [list disabled $colors(-disabledfg)] \ + -selectbackground [list !focus $colors(-darkest)] \ + -selectforeground [list !focus white] \ + ; + # -selectbackground [list !focus "#847d73"] + + ttk::style configure TButton \ + -anchor center -width -11 -padding 5 -relief raised + ttk::style map TButton \ + -background [list \ + disabled $colors(-frame) \ + pressed $colors(-darker) \ + active $colors(-lighter)] \ + -lightcolor [list pressed $colors(-darker)] \ + -darkcolor [list pressed $colors(-darker)] \ + -bordercolor [list alternate "#000000"] \ + ; + + ttk::style configure Toolbutton \ + -anchor center -padding 2 -relief flat + ttk::style map Toolbutton \ + -relief [list \ + disabled flat \ + selected sunken \ + pressed sunken \ + active raised] \ + -background [list \ + disabled $colors(-frame) \ + pressed $colors(-darker) \ + active $colors(-lighter)] \ + -lightcolor [list pressed $colors(-darker)] \ + -darkcolor [list pressed $colors(-darker)] \ + ; + + ttk::style configure TCheckbutton \ + -indicatorbackground "#ffffff" \ + -indicatormargin {1 1 4 1} \ + -padding 2 ; + ttk::style configure TRadiobutton \ + -indicatorbackground "#ffffff" \ + -indicatormargin {1 1 4 1} \ + -padding 2 ; + ttk::style map TCheckbutton -indicatorbackground \ + [list pressed $colors(-frame) \ + {!disabled alternate} $colors(-altindicator) \ + {disabled alternate} $colors(-disabledaltindicator) \ + disabled $colors(-frame)] + ttk::style map TRadiobutton -indicatorbackground \ + [list pressed $colors(-frame) \ + {!disabled alternate} $colors(-altindicator) \ + {disabled alternate} $colors(-disabledaltindicator) \ + disabled $colors(-frame)] + + ttk::style configure TMenubutton \ + -width -11 -padding 5 -relief raised + + ttk::style configure TEntry -padding 1 -insertwidth 1 + ttk::style map TEntry \ + -background [list readonly $colors(-frame)] \ + -bordercolor [list focus $colors(-selectbg)] \ + -lightcolor [list focus "#6f9dc6"] \ + -darkcolor [list focus "#6f9dc6"] \ + ; + + ttk::style configure TCombobox -padding 1 -insertwidth 1 + ttk::style map TCombobox \ + -background [list active $colors(-lighter) \ + pressed $colors(-lighter)] \ + -fieldbackground [list {readonly focus} $colors(-selectbg) \ + readonly $colors(-frame)] \ + -foreground [list {readonly focus} $colors(-selectfg)] \ + -arrowcolor [list disabled $colors(-disabledfg)] + ttk::style configure ComboboxPopdownFrame \ + -relief solid -borderwidth 1 + + ttk::style configure TSpinbox -arrowsize 10 -padding {2 0 10 0} + ttk::style map TSpinbox \ + -background [list readonly $colors(-frame)] \ + -arrowcolor [list disabled $colors(-disabledfg)] + + ttk::style configure TNotebook.Tab -padding {6 2 6 2} + ttk::style map TNotebook.Tab \ + -padding [list selected {6 4 6 2}] \ + -background [list selected $colors(-frame) {} $colors(-darker)] \ + -lightcolor [list selected $colors(-lighter) {} $colors(-dark)] \ + ; + + # Treeview: + ttk::style configure Heading \ + -font TkHeadingFont -relief raised -padding {3} + ttk::style configure Treeview -background $colors(-window) + ttk::style map Treeview \ + -background [list disabled $colors(-frame)\ + selected $colors(-selectbg)] \ + -foreground [list disabled $colors(-disabledfg) \ + selected $colors(-selectfg)] + + ttk::style configure TLabelframe \ + -labeloutside true -labelmargins {0 0 0 4} \ + -borderwidth 2 -relief raised + + ttk::style configure TProgressbar -background $colors(-frame) + + ttk::style configure Sash -sashthickness 6 -gripcount 10 + } +} diff --git a/Master/tlpkg/tltcl/lib/tk8.6/ttk/classicTheme.tcl b/Master/tlpkg/tltcl/lib/tk8.6/ttk/classicTheme.tcl new file mode 100644 index 00000000000..f237fba6850 --- /dev/null +++ b/Master/tlpkg/tltcl/lib/tk8.6/ttk/classicTheme.tcl @@ -0,0 +1,115 @@ +# +# "classic" Tk theme. +# +# Implements Tk's traditional Motif-like look and feel. +# + +namespace eval ttk::theme::classic { + + variable colors; array set colors { + -frame "#d9d9d9" + -window "#ffffff" + -activebg "#ececec" + -troughbg "#c3c3c3" + -selectbg "#c3c3c3" + -selectfg "#000000" + -disabledfg "#a3a3a3" + -indicator "#b03060" + -altindicator "#b05e5e" + } + + ttk::style theme settings classic { + ttk::style configure "." \ + -font TkDefaultFont \ + -background $colors(-frame) \ + -foreground black \ + -selectbackground $colors(-selectbg) \ + -selectforeground $colors(-selectfg) \ + -troughcolor $colors(-troughbg) \ + -indicatorcolor $colors(-frame) \ + -highlightcolor $colors(-frame) \ + -highlightthickness 1 \ + -selectborderwidth 1 \ + -insertwidth 2 \ + ; + + # To match pre-Xft X11 appearance, use: + # ttk::style configure . -font {Helvetica 12 bold} + + ttk::style map "." -background \ + [list disabled $colors(-frame) active $colors(-activebg)] + ttk::style map "." -foreground \ + [list disabled $colors(-disabledfg)] + + ttk::style map "." -highlightcolor [list focus black] + + ttk::style configure TButton \ + -anchor center -padding "3m 1m" -relief raised -shiftrelief 1 + ttk::style map TButton -relief [list {!disabled pressed} sunken] + + ttk::style configure TCheckbutton -indicatorrelief raised + ttk::style map TCheckbutton \ + -indicatorcolor [list \ + pressed $colors(-frame) \ + alternate $colors(-altindicator) \ + selected $colors(-indicator)] \ + -indicatorrelief {alternate raised selected sunken pressed sunken} \ + ; + + ttk::style configure TRadiobutton -indicatorrelief raised + ttk::style map TRadiobutton \ + -indicatorcolor [list \ + pressed $colors(-frame) \ + alternate $colors(-altindicator) \ + selected $colors(-indicator)] \ + -indicatorrelief {alternate raised selected sunken pressed sunken} \ + ; + + ttk::style configure TMenubutton -relief raised -padding "3m 1m" + + ttk::style configure TEntry -relief sunken -padding 1 -font TkTextFont + ttk::style map TEntry -fieldbackground \ + [list readonly $colors(-frame) disabled $colors(-frame)] + ttk::style configure TCombobox -padding 1 + ttk::style map TCombobox -fieldbackground \ + [list readonly $colors(-frame) disabled $colors(-frame)] + ttk::style configure ComboboxPopdownFrame \ + -relief solid -borderwidth 1 + + ttk::style configure TSpinbox -arrowsize 10 -padding {2 0 10 0} + ttk::style map TSpinbox -fieldbackground \ + [list readonly $colors(-frame) disabled $colors(-frame)] + + ttk::style configure TLabelframe -borderwidth 2 -relief groove + + ttk::style configure TScrollbar -relief raised + ttk::style map TScrollbar -relief {{pressed !disabled} sunken} + + ttk::style configure TScale -sliderrelief raised + ttk::style map TScale -sliderrelief {{pressed !disabled} sunken} + + ttk::style configure TProgressbar -background SteelBlue + ttk::style configure TNotebook.Tab \ + -padding {3m 1m} \ + -background $colors(-troughbg) + ttk::style map TNotebook.Tab -background [list selected $colors(-frame)] + + # Treeview: + ttk::style configure Heading -font TkHeadingFont -relief raised + ttk::style configure Treeview -background $colors(-window) + ttk::style map Treeview \ + -background [list disabled $colors(-frame)\ + selected $colors(-selectbg)] \ + -foreground [list disabled $colors(-disabledfg) \ + selected $colors(-selectfg)] + + # + # Toolbar buttons: + # + ttk::style configure Toolbutton -padding 2 -relief flat -shiftrelief 2 + ttk::style map Toolbutton -relief \ + {disabled flat selected sunken pressed sunken active raised} + ttk::style map Toolbutton -background \ + [list pressed $colors(-troughbg) active $colors(-activebg)] + } +} diff --git a/Master/tlpkg/tltcl/lib/tk8.6/ttk/combobox.tcl b/Master/tlpkg/tltcl/lib/tk8.6/ttk/combobox.tcl new file mode 100644 index 00000000000..1355a048500 --- /dev/null +++ b/Master/tlpkg/tltcl/lib/tk8.6/ttk/combobox.tcl @@ -0,0 +1,443 @@ +# +# Combobox bindings. +# +# <<NOTE-WM-TRANSIENT>>: +# +# Need to set [wm transient] just before mapping the popdown +# instead of when it's created, in case a containing frame +# has been reparented [#1818441]. +# +# On Windows: setting [wm transient] prevents the parent +# toplevel from becoming inactive when the popdown is posted +# (Tk 8.4.8+) +# +# On X11: WM_TRANSIENT_FOR on override-redirect windows +# may be used by compositing managers and by EWMH-aware +# window managers (even though the older ICCCM spec says +# it's meaningless). +# +# On OSX: [wm transient] does utterly the wrong thing. +# Instead, we use [MacWindowStyle "help" "noActivates hideOnSuspend"]. +# The "noActivates" attribute prevents the parent toplevel +# from deactivating when the popdown is posted, and is also +# necessary for "help" windows to receive mouse events. +# "hideOnSuspend" makes the popdown disappear (resp. reappear) +# when the parent toplevel is deactivated (resp. reactivated). +# (see [#1814778]). Also set [wm resizable 0 0], to prevent +# TkAqua from shrinking the scrollbar to make room for a grow box +# that isn't there. +# +# In order to work around other platform quirks in TkAqua, +# [grab] and [focus] are set in <Map> bindings instead of +# immediately after deiconifying the window. +# + +namespace eval ttk::combobox { + variable Values ;# Values($cb) is -listvariable of listbox widget + variable State + set State(entryPress) 0 +} + +### Combobox bindings. +# +# Duplicate the Entry bindings, override if needed: +# + +ttk::copyBindings TEntry TCombobox + +bind TCombobox <KeyPress-Down> { ttk::combobox::Post %W } +bind TCombobox <KeyPress-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 <B1-Motion> { ttk::combobox::Drag %W %x } +bind TCombobox <Motion> { ttk::combobox::Motion %W %x %y } + +ttk::bindMouseWheel TCombobox [list ttk::combobox::Scroll %W] + +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 <<PrevWindow>> { ttk::combobox::LBTab %W prev } +bind ComboboxListbox <Destroy> { ttk::combobox::LBCleanup %W } +bind ComboboxListbox <Motion> { ttk::combobox::LBHover %W %x %y } +bind ComboboxListbox <Map> { focus -force %W } + +switch -- [tk windowingsystem] { + win32 { + # Dismiss listbox when user switches to a different application. + # NB: *only* do this on Windows (see #1814778) + bind ComboboxListbox <FocusOut> { ttk::combobox::LBCancel %W } + } +} + +### Combobox popdown window bindings. +# +bind ComboboxPopdown <Map> { ttk::combobox::MapPopdown %W } +bind ComboboxPopdown <Unmap> { ttk::combobox::UnmapPopdown %W } +bind ComboboxPopdown <ButtonPress> \ + { ttk::combobox::Unpost [winfo parent %W] } + +### Option database settings. +# + +option add *TCombobox*Listbox.font TkTextFont widgetDefault +option add *TCombobox*Listbox.relief flat widgetDefault +option add *TCombobox*Listbox.highlightThickness 0 widgetDefault + +## Platform-specific settings. +# +switch -- [tk windowingsystem] { + x11 { + option add *TCombobox*Listbox.background white widgetDefault + } + aqua { + option add *TCombobox*Listbox.borderWidth 0 widgetDefault + } +} + +### Binding procedures. +# + +## Press $mode $x $y -- ButtonPress binding for comboboxes. +# Either post/unpost the listbox, or perform Entry widget binding, +# depending on widget state and location of button press. +# +proc ttk::combobox::Press {mode w x y} { + variable State + + $w instate disabled { return } + + set State(entryPress) [expr { + [$w instate !readonly] + && [string match *textarea [$w identify element $x $y]] + }] + + focus $w + if {$State(entryPress)} { + switch -- $mode { + s { ttk::entry::Shift-Press $w $x ; # Shift } + 2 { ttk::entry::Select $w $x word ; # Double click} + 3 { ttk::entry::Select $w $x line ; # Triple click } + "" - + default { ttk::entry::Press $w $x } + } + } else { + Post $w + } +} + +## Drag -- B1-Motion binding for comboboxes. +# If the initial ButtonPress event was handled by Entry binding, +# perform Entry widget drag binding; otherwise nothing. +# +proc ttk::combobox::Drag {w x} { + variable State + if {$State(entryPress)} { + ttk::entry::Drag $w $x + } +} + +## Motion -- +# Set cursor. +# +proc ttk::combobox::Motion {w x y} { + if { [$w identify $x $y] eq "textarea" + && [$w instate {!readonly !disabled}] + } { + ttk::setCursor $w text + } else { + ttk::setCursor $w "" + } +} + +## TraverseIn -- receive focus due to keyboard navigation +# For editable comboboxes, set the selection and insert cursor. +# +proc ttk::combobox::TraverseIn {w} { + $w instate {!readonly !disabled} { + $w selection range 0 end + $w icursor end + } +} + +## SelectEntry $cb $index -- +# Set the combobox selection in response to a user action. +# +proc ttk::combobox::SelectEntry {cb index} { + $cb current $index + $cb selection range 0 end + $cb icursor end + event generate $cb <<ComboboxSelected>> -when mark +} + +## Scroll -- Mousewheel binding +# +proc ttk::combobox::Scroll {cb dir} { + $cb instate disabled { return } + set max [llength [$cb cget -values]] + set current [$cb current] + incr current $dir + if {$max != 0 && $current == $current % $max} { + SelectEntry $cb $current + } +} + +## LBSelected $lb -- Activation binding for listbox +# Set the combobox value to the currently-selected listbox value +# and unpost the listbox. +# +proc ttk::combobox::LBSelected {lb} { + set cb [LBMaster $lb] + LBSelect $lb + Unpost $cb + focus $cb +} + +## LBCancel -- +# Unpost the listbox. +# +proc ttk::combobox::LBCancel {lb} { + Unpost [LBMaster $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] + switch -- $dir { + next { set newFocus [tk_focusNext $cb] } + prev { set newFocus [tk_focusPrev $cb] } + } + + if {$newFocus ne ""} { + LBSelect $lb + Unpost $cb + # The [grab release] call in [Unpost] queues events that later + # re-set the focus (@@@ NOTE: this might not be true anymore). + # Set new focus later: + after 0 [list ttk::traverseTo $newFocus] + } +} + +## LBHover -- <Motion> binding for combobox listbox. +# Follow selection on mouseover. +# +proc ttk::combobox::LBHover {w x y} { + $w selection clear 0 end + $w activate @$x,$y + $w selection set @$x,$y +} + +## MapPopdown -- <Map> binding for ComboboxPopdown +# +proc ttk::combobox::MapPopdown {w} { + [winfo parent $w] state pressed + ttk::globalGrab $w +} + +## UnmapPopdown -- <Unmap> binding for ComboboxPopdown +# +proc ttk::combobox::UnmapPopdown {w} { + [winfo parent $w] state !pressed + ttk::releaseGrab $w +} + +## PopdownWindow -- +# Returns the popdown widget associated with a combobox, +# creating it if necessary. +# +proc ttk::combobox::PopdownWindow {cb} { + if {![winfo exists $cb.popdown]} { + set poplevel [PopdownToplevel $cb.popdown] + set popdown [ttk::frame $poplevel.f -style ComboboxPopdownFrame] + + ttk::scrollbar $popdown.sb \ + -orient vertical -command [list $popdown.l yview] + listbox $popdown.l \ + -listvariable ttk::combobox::Values($cb) \ + -yscrollcommand [list $popdown.sb set] \ + -exportselection false \ + -selectmode browse \ + -activestyle none \ + ; + + bindtags $popdown.l \ + [list $popdown.l ComboboxListbox Listbox $popdown all] + + grid $popdown.l -row 0 -column 0 -padx {1 0} -pady 1 -sticky nsew + grid $popdown.sb -row 0 -column 1 -padx {0 1} -pady 1 -sticky ns + grid columnconfigure $popdown 0 -weight 1 + grid rowconfigure $popdown 0 -weight 1 + + grid $popdown -sticky news -padx 0 -pady 0 + grid rowconfigure $poplevel 0 -weight 1 + grid columnconfigure $poplevel 0 -weight 1 + } + return $cb.popdown +} + +## PopdownToplevel -- Create toplevel window for the combobox popdown +# +# See also <<NOTE-WM-TRANSIENT>> +# +proc ttk::combobox::PopdownToplevel {w} { + toplevel $w -class ComboboxPopdown + wm withdraw $w + switch -- [tk windowingsystem] { + default - + x11 { + $w configure -relief flat -borderwidth 0 + wm attributes $w -type combo + wm overrideredirect $w true + } + win32 { + $w configure -relief flat -borderwidth 0 + wm overrideredirect $w true + wm attributes $w -topmost 1 + } + aqua { + $w configure -relief solid -borderwidth 0 + tk::unsupported::MacWindowStyle style $w \ + help {noActivates hideOnSuspend} + wm resizable $w 0 0 + } + } + return $w +} + +## ConfigureListbox -- +# Set listbox values, selection, height, and scrollbar visibility +# from current combobox values. +# +proc ttk::combobox::ConfigureListbox {cb} { + variable Values + + set popdown [PopdownWindow $cb].f + set values [$cb cget -values] + set current [$cb current] + if {$current < 0} { + set current 0 ;# no current entry, highlight first one + } + set Values($cb) $values + $popdown.l selection clear 0 end + $popdown.l selection set $current + $popdown.l activate $current + $popdown.l see $current + set height [llength $values] + if {$height > [$cb cget -height]} { + set height [$cb cget -height] + grid $popdown.sb + grid configure $popdown.l -padx {1 0} + } else { + grid remove $popdown.sb + grid configure $popdown.l -padx 1 + } + $popdown.l configure -height $height +} + +## PlacePopdown -- +# Set popdown window geometry. +# +# @@@TODO: factor with menubutton::PostPosition +# +proc ttk::combobox::PlacePopdown {cb popdown} { + set x [winfo rootx $cb] + set y [winfo rooty $cb] + set w [winfo width $cb] + set h [winfo height $cb] + set style [$cb cget -style] + set postoffset [ttk::style lookup $style -postoffset {} {0 0 0 0}] + foreach var {x y w h} delta $postoffset { + incr $var $delta + } + + set H [winfo reqheight $popdown] + if {$y + $h + $H > [winfo screenheight $popdown]} { + set Y [expr {$y - $H}] + } else { + set Y [expr {$y + $h}] + } + wm geometry $popdown ${w}x${H}+${x}+${Y} +} + +## Post $cb -- +# Pop down the associated listbox. +# +proc ttk::combobox::Post {cb} { + # Don't do anything if disabled: + # + $cb instate disabled { return } + + # ASSERT: ![$cb instate pressed] + + # Run -postcommand callback: + # + uplevel #0 [$cb cget -postcommand] + + set popdown [PopdownWindow $cb] + ConfigureListbox $cb + update idletasks ;# needed for geometry propagation. + PlacePopdown $cb $popdown + # See <<NOTE-WM-TRANSIENT>> + switch -- [tk windowingsystem] { + x11 - win32 { wm transient $popdown [winfo toplevel $cb] } + } + + # Post the listbox: + # + wm attribute $popdown -topmost 1 + wm deiconify $popdown + raise $popdown +} + +## Unpost $cb -- +# Unpost the listbox. +# +proc ttk::combobox::Unpost {cb} { + if {[winfo exists $cb.popdown]} { + wm withdraw $cb.popdown + } + grab release $cb.popdown ;# in case of stuck or unexpected grab [#1239190] +} + +## LBMaster $lb -- +# Return the combobox main widget that owns the listbox. +# +proc ttk::combobox::LBMaster {lb} { + winfo parent [winfo parent [winfo parent $lb]] +} + +## LBSelect $lb -- +# Transfer listbox selection to combobox value. +# +proc ttk::combobox::LBSelect {lb} { + set cb [LBMaster $lb] + set selection [$lb curselection] + if {[llength $selection] == 1} { + SelectEntry $cb [lindex $selection 0] + } +} + +## LBCleanup $lb -- +# <Destroy> binding for combobox listboxes. +# Cleans up by unsetting the linked textvariable. +# +# Note: we can't just use { unset [%W cget -listvariable] } +# because the widget command is already gone when this binding fires). +# [winfo parent] still works, fortunately. +# +proc ttk::combobox::LBCleanup {lb} { + variable Values + unset Values([LBMaster $lb]) +} + +#*EOF* diff --git a/Master/tlpkg/tltcl/lib/tk8.6/ttk/cursors.tcl b/Master/tlpkg/tltcl/lib/tk8.6/ttk/cursors.tcl new file mode 100644 index 00000000000..75f77915000 --- /dev/null +++ b/Master/tlpkg/tltcl/lib/tk8.6/ttk/cursors.tcl @@ -0,0 +1,186 @@ +# +# Map symbolic cursor names to platform-appropriate cursors. +# +# The following cursors are defined: +# +# standard -- default cursor for most controls +# "" -- inherit cursor from parent window +# none -- no cursor +# +# text -- editable widgets (entry, text) +# link -- hyperlinks within text +# crosshair -- graphic selection, fine control +# busy -- operation in progress +# forbidden -- action not allowed +# +# hresize -- horizontal resizing +# vresize -- vertical resizing +# +# Also resize cursors for each of the compass points, +# {nw,n,ne,w,e,sw,s,se}resize. +# +# Platform notes: +# +# Windows doesn't distinguish resizing at the 8 compass points, +# only horizontal, vertical, and the two diagonals. +# +# OSX doesn't have resize cursors for nw, ne, sw, or se corners. +# We use the Tk-defined X11 fallbacks for these. +# +# X11 doesn't have a "forbidden" cursor (usually a slashed circle); +# "pirate" seems to be the conventional cursor for this purpose. +# +# Windows has an IDC_HELP cursor, but it's not available from Tk. +# +# Tk does not support "none" on Windows. +# + +namespace eval ttk { + + variable Cursors + + # Use X11 cursor names as defaults, since Tk supplies these + # on all platforms. + # + array set Cursors { + "" "" + none none + + standard left_ptr + text xterm + link hand2 + crosshair crosshair + busy watch + forbidden pirate + + hresize sb_h_double_arrow + vresize sb_v_double_arrow + + nresize top_side + sresize bottom_side + wresize left_side + eresize right_side + nwresize top_left_corner + neresize top_right_corner + swresize bottom_left_corner + seresize bottom_right_corner + move fleur + + } + + # Platform-specific overrides for Windows and OSX. + # + switch [tk windowingsystem] { + "win32" { + array set Cursors { + none {} + + standard arrow + text ibeam + link hand2 + crosshair crosshair + busy wait + forbidden no + + vresize size_ns + nresize size_ns + sresize size_ns + + wresize size_we + eresize size_we + hresize size_we + + nwresize size_nw_se + swresize size_ne_sw + + neresize size_ne_sw + seresize size_nw_se + } + } + + "aqua" { + if {[package vsatisfies [package provide Tk] 8.5]} { + # appeared 2007-04-23, Tk 8.5a6 + array set Cursors { + standard arrow + text ibeam + link pointinghand + crosshair crosshair + busy watch + forbidden notallowed + + hresize resizeleftright + vresize resizeupdown + nresize resizeup + sresize resizedown + wresize resizeleft + eresize resizeright + } + } + } + } +} + +## ttk::cursor $cursor -- +# Return platform-specific cursor for specified symbolic cursor. +# +proc ttk::cursor {name} { + variable Cursors + return $Cursors($name) +} + +## ttk::setCursor $w $cursor -- +# Set the cursor for specified window. +# +# [ttk::setCursor] should be used in <Motion> bindings +# instead of directly calling [$w configure -cursor ...], +# as the latter always incurs a server round-trip and +# can lead to high CPU load (see [#1184746]) +# + +proc ttk::setCursor {w name} { + variable Cursors + if {[$w cget -cursor] ne $Cursors($name)} { + $w configure -cursor $Cursors($name) + } +} + +## Interactive test harness: +# +proc ttk::CursorSampler {f} { + ttk::frame $f + + set r 0 + foreach row { + {nwresize nresize neresize} + { wresize move eresize} + {swresize sresize seresize} + {text link crosshair} + {hresize vresize ""} + {busy forbidden ""} + {none standard ""} + } { + set c 0 + foreach cursor $row { + set w $f.${r}${c} + ttk::label $w -text $cursor -cursor [ttk::cursor $cursor] \ + -relief solid -borderwidth 1 -padding 3 + grid $w -row $r -column $c -sticky nswe + grid columnconfigure $f $c -uniform cols -weight 1 + incr c + } + grid rowconfigure $f $r -uniform rows -weight 1 + incr r + } + + return $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 .] + focus .f +} + +#*EOF* diff --git a/Master/tlpkg/tltcl/lib/tk8.6/ttk/defaults.tcl b/Master/tlpkg/tltcl/lib/tk8.6/ttk/defaults.tcl new file mode 100644 index 00000000000..a15d1d97f5d --- /dev/null +++ b/Master/tlpkg/tltcl/lib/tk8.6/ttk/defaults.tcl @@ -0,0 +1,143 @@ +# +# Settings for default theme. +# + +namespace eval ttk::theme::default { + variable colors + array set colors { + -frame "#d9d9d9" + -foreground "#000000" + -window "#ffffff" + -text "#000000" + -activebg "#ececec" + -selectbg "#4a6984" + -selectfg "#ffffff" + -darker "#c3c3c3" + -disabledfg "#a3a3a3" + -indicator "#4a6984" + -disabledindicator "#a3a3a3" + -altindicator "#9fbdd8" + -disabledaltindicator "#c0c0c0" + } + + ttk::style theme settings default { + + ttk::style configure "." \ + -borderwidth 1 \ + -background $colors(-frame) \ + -foreground $colors(-foreground) \ + -troughcolor $colors(-darker) \ + -font TkDefaultFont \ + -selectborderwidth 1 \ + -selectbackground $colors(-selectbg) \ + -selectforeground $colors(-selectfg) \ + -insertwidth 1 \ + -indicatordiameter 10 \ + ; + + ttk::style map "." -background \ + [list disabled $colors(-frame) active $colors(-activebg)] + ttk::style map "." -foreground \ + [list disabled $colors(-disabledfg)] + + ttk::style configure TButton \ + -anchor center -padding "3 3" -width -9 \ + -relief raised -shiftrelief 1 + ttk::style map TButton -relief [list {!disabled pressed} sunken] + + ttk::style configure TCheckbutton \ + -indicatorcolor "#ffffff" -indicatorrelief sunken -padding 1 + ttk::style map TCheckbutton -indicatorcolor \ + [list pressed $colors(-activebg) \ + {!disabled alternate} $colors(-altindicator) \ + {disabled alternate} $colors(-disabledaltindicator) \ + {!disabled selected} $colors(-indicator) \ + {disabled selected} $colors(-disabledindicator)] + ttk::style map TCheckbutton -indicatorrelief \ + [list alternate raised] + + ttk::style configure TRadiobutton \ + -indicatorcolor "#ffffff" -indicatorrelief sunken -padding 1 + ttk::style map TRadiobutton -indicatorcolor \ + [list pressed $colors(-activebg) \ + {!disabled alternate} $colors(-altindicator) \ + {disabled alternate} $colors(-disabledaltindicator) \ + {!disabled selected} $colors(-indicator) \ + {disabled selected} $colors(-disabledindicator)] + ttk::style map TRadiobutton -indicatorrelief \ + [list alternate raised] + + ttk::style configure TMenubutton \ + -relief raised -padding "10 3" + + ttk::style configure TEntry \ + -relief sunken -fieldbackground white -padding 1 + ttk::style map TEntry -fieldbackground \ + [list readonly $colors(-frame) disabled $colors(-frame)] + + ttk::style configure TCombobox -arrowsize 12 -padding 1 + ttk::style map TCombobox -fieldbackground \ + [list readonly $colors(-frame) disabled $colors(-frame)] \ + -arrowcolor [list disabled $colors(-disabledfg)] + + ttk::style configure TSpinbox -arrowsize 10 -padding {2 0 10 0} + ttk::style map TSpinbox -fieldbackground \ + [list readonly $colors(-frame) disabled $colors(-frame)] \ + -arrowcolor [list disabled $colors(-disabledfg)] + + ttk::style configure TLabelframe \ + -relief groove -borderwidth 2 + + ttk::style configure TScrollbar \ + -width 12 -arrowsize 12 + ttk::style map TScrollbar \ + -arrowcolor [list disabled $colors(-disabledfg)] + + ttk::style configure TScale \ + -sliderrelief raised + ttk::style configure TProgressbar \ + -background $colors(-selectbg) + + ttk::style configure TNotebook.Tab \ + -padding {4 2} -background $colors(-darker) + ttk::style map TNotebook.Tab \ + -background [list selected $colors(-frame)] + + # Treeview. + # + ttk::style configure Heading -font TkHeadingFont -relief raised + ttk::style configure Treeview \ + -background $colors(-window) \ + -foreground $colors(-text) ; + ttk::style map Treeview \ + -background [list disabled $colors(-frame)\ + selected $colors(-selectbg)] \ + -foreground [list disabled $colors(-disabledfg) \ + selected $colors(-selectfg)] + + # Combobox popdown frame + ttk::style layout ComboboxPopdownFrame { + ComboboxPopdownFrame.border -sticky nswe + } + ttk::style configure ComboboxPopdownFrame \ + -borderwidth 1 -relief solid + + # + # Toolbar buttons: + # + ttk::style layout Toolbutton { + Toolbutton.border -children { + Toolbutton.padding -children { + Toolbutton.label + } + } + } + + ttk::style configure Toolbutton \ + -padding 2 -relief flat + ttk::style map Toolbutton -relief \ + [list disabled flat selected sunken pressed sunken active raised] + ttk::style map Toolbutton -background \ + [list pressed $colors(-darker) active $colors(-activebg)] + } +} diff --git a/Master/tlpkg/tltcl/lib/tk8.6/ttk/entry.tcl b/Master/tlpkg/tltcl/lib/tk8.6/ttk/entry.tcl new file mode 100644 index 00000000000..45e35060406 --- /dev/null +++ b/Master/tlpkg/tltcl/lib/tk8.6/ttk/entry.tcl @@ -0,0 +1,625 @@ +# +# DERIVED FROM: tk/library/entry.tcl r1.22 +# +# Copyright (c) 1992-1994 The Regents of the University of California. +# Copyright (c) 1994-1997 Sun Microsystems, Inc. +# Copyright (c) 2004, Joe English +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# + +namespace eval ttk { + namespace eval entry { + variable State + + set State(x) 0 + set State(selectMode) none + set State(anchor) 0 + set State(scanX) 0 + set State(scanIndex) 0 + set State(scanMoved) 0 + + # Button-2 scan speed is (scanNum/scanDen) characters + # per pixel of mouse movement. + # The standard Tk entry widget uses the equivalent of + # scanNum = 10, scanDen = average character width. + # I don't know why that was chosen. + # + set State(scanNum) 1 + set State(scanDen) 1 + set State(deadband) 3 ;# #pixels for mouse-moved deadband. + } +} + +### Option database settings. +# +option add *TEntry.cursor [ttk::cursor text] widgetDefault + +### Bindings. +# +# Removed the following standard Tk bindings: +# +# <Control-Key-space>, <Control-Shift-Key-space>, +# <Key-Select>, <Shift-Key-Select>: +# Ttk entry widget doesn't use selection anchor. +# <Key-Insert>: +# Inserts PRIMARY selection (on non-Windows platforms). +# This is inconsistent with typical platform bindings. +# <Double-Shift-ButtonPress-1>, <Triple-Shift-ButtonPress-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>: +# 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>: +# Another judgment call. If anyone misses this, let me know +# and I'll put it back. +# + +## Clipboard events: +# +bind TEntry <<Cut>> { ttk::entry::Cut %W } +bind TEntry <<Copy>> { ttk::entry::Copy %W } +bind TEntry <<Paste>> { ttk::entry::Paste %W } +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 <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 <<ToggleSelection>> { + %W instate {!readonly !disabled} { %W icursor @%x ; focus %W } +} + +## Button2 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 } +bind TEntry <<PasteSelection>> { ttk::entry::ScanRelease %W %x } + +## Keyboard navigation bindings: +# +bind TEntry <<PrevChar>> { ttk::entry::Move %W prevchar } +bind TEntry <<NextChar>> { ttk::entry::Move %W nextchar } +bind TEntry <<PrevWord>> { ttk::entry::Move %W prevword } +bind TEntry <<NextWord>> { ttk::entry::Move %W nextword } +bind TEntry <<LineStart>> { ttk::entry::Move %W home } +bind TEntry <<LineEnd>> { ttk::entry::Move %W end } + +bind TEntry <<SelectPrevChar>> { ttk::entry::Extend %W prevchar } +bind TEntry <<SelectNextChar>> { ttk::entry::Extend %W nextchar } +bind TEntry <<SelectPrevWord>> { ttk::entry::Extend %W prevword } +bind TEntry <<SelectNextWord>> { ttk::entry::Extend %W nextword } +bind TEntry <<SelectLineStart>> { ttk::entry::Extend %W home } +bind TEntry <<SelectLineEnd>> { ttk::entry::Extend %W end } + +bind TEntry <<SelectAll>> { %W selection range 0 end } +bind TEntry <<SelectNone>> { %W selection clear } + +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 } + +# Ignore all Alt, Meta, and Control keypresses unless explicitly bound. +# Otherwise, the <KeyPress> 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} + +# Argh. Apparently on Windows, the NumLock modifier is interpreted +# as a Command modifier. +if {[tk windowingsystem] eq "aqua"} { + bind TEntry <Command-KeyPress> {# nothing} +} +# Tk-on-Cocoa generates characters for these two keys. [Bug 2971663] +bind TEntry <<PrevLine>> {# nothing} +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 } + +# 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. +# + +## EntrySelection -- Return the selected text of the entry. +# Raises an error if there is no selection. +# +proc ttk::entry::EntrySelection {w} { + set entryString [string range [$w get] [$w index sel.first] \ + [expr {[$w index sel.last] - 1}]] + if {[$w cget -show] ne ""} { + return [string repeat [string index [$w cget -show] 0] \ + [string length $entryString]] + } + return $entryString +} + +## Paste -- Insert clipboard contents at current insert point. +# +proc ttk::entry::Paste {w} { + catch { + set clipboard [::tk::GetSelection $w CLIPBOARD] + PendingDelete $w + $w insert insert $clipboard + See $w insert + } +} + +## Copy -- Copy selection to clipboard. +# +proc ttk::entry::Copy {w} { + if {![catch {EntrySelection $w} selection]} { + clipboard clear -displayof $w + clipboard append -displayof $w $selection + } +} + +## Clear -- Delete the selection. +# +proc ttk::entry::Clear {w} { + catch { $w delete sel.first sel.last } +} + +## Cut -- Copy selection to clipboard then delete it. +# +proc ttk::entry::Cut {w} { + Copy $w; Clear $w +} + +### Navigation procedures. +# + +## ClosestGap -- Find closest boundary between characters. +# Returns the index of the character just after the boundary. +# +proc ttk::entry::ClosestGap {w x} { + set pos [$w index @$x] + set bbox [$w bbox $pos] + if {$x - [lindex $bbox 0] > [lindex $bbox 2]/2} { + incr pos + } + return $pos +} + +## See $index -- Make sure that the character at $index is visible. +# +proc ttk::entry::See {w {index insert}} { + set c [$w index $index] + # @@@ OR: check [$w index left] / [$w index right] + if {$c < [$w index @0] || $c >= [$w index @[winfo width $w]]} { + $w xview $c + } +} + +## NextWord -- Find the next word position. +# Note: The "next word position" follows platform conventions: +# either the next end-of-word position, or the start-of-word +# position following the next end-of-word position. +# +set ::ttk::entry::State(startNext) \ + [string equal [tk windowingsystem] "win32"] + +proc ttk::entry::NextWord {w start} { + variable State + set pos [tcl_endOfWord [$w get] [$w index $start]] + if {$pos >= 0 && $State(startNext)} { + set pos [tcl_startOfNextWord [$w get] $pos] + } + if {$pos < 0} { + return end + } + return $pos +} + +## PrevWord -- Find the previous word position. +# +proc ttk::entry::PrevWord {w start} { + set pos [tcl_startOfPreviousWord [$w get] [$w index $start]] + if {$pos < 0} { + return 0 + } + return $pos +} + +## RelIndex -- Compute character/word/line-relative index. +# +proc ttk::entry::RelIndex {w where {index insert}} { + switch -- $where { + prevchar { expr {[$w index $index] - 1} } + nextchar { expr {[$w index $index] + 1} } + prevword { PrevWord $w $index } + nextword { NextWord $w $index } + home { return 0 } + end { $w index end } + default { error "Bad relative index $index" } + } +} + +## Move -- Move insert cursor to relative location. +# Also clears the selection, if any, and makes sure +# that the insert cursor is visible. +# +proc ttk::entry::Move {w where} { + $w icursor [RelIndex $w $where] + $w selection clear + See $w insert +} + +### Selection procedures. +# + +## ExtendTo -- Extend the selection to the specified index. +# +# The other end of the selection (the anchor) is determined as follows: +# +# (1) if there is no selection, the anchor is the insert cursor; +# (2) if the index is outside the selection, grow the selection; +# (3) if the insert cursor is at one end of the selection, anchor the other end +# (4) otherwise anchor the start of the selection +# +# The insert cursor is placed at the new end of the selection. +# +# Returns: selection anchor. +# +proc ttk::entry::ExtendTo {w index} { + set index [$w index $index] + set insert [$w index insert] + + # Figure out selection anchor: + if {![$w selection present]} { + set anchor $insert + } else { + set selfirst [$w index sel.first] + set sellast [$w index sel.last] + + if { ($index < $selfirst) + || ($insert == $selfirst && $index <= $sellast) + } { + set anchor $sellast + } else { + set anchor $selfirst + } + } + + # Extend selection: + if {$anchor < $index} { + $w selection range $anchor $index + } else { + $w selection range $index $anchor + } + + $w icursor $index + return $anchor +} + +## Extend -- Extend the selection to a relative position, show insert cursor +# +proc ttk::entry::Extend {w where} { + ExtendTo $w [RelIndex $w $where] + See $w +} + +### Button 1 binding procedures. +# +# Double-clicking followed by a drag enters "word-select" mode. +# Triple-clicking enters "line-select" mode. +# + +## Press -- ButtonPress-1 binding. +# Set the insertion cursor, claim the input focus, set up for +# future drag operations. +# +proc ttk::entry::Press {w x} { + variable State + + $w icursor [ClosestGap $w $x] + $w selection clear + $w instate !disabled { focus $w } + + # Set up for future drag, double-click, or triple-click. + set State(x) $x + set State(selectMode) char + set State(anchor) [$w index insert] +} + +## Shift-Press -- Shift-ButtonPress-1 binding. +# Extends the selection, sets anchor for future drag operations. +# +proc ttk::entry::Shift-Press {w x} { + variable State + + focus $w + set anchor [ExtendTo $w @$x] + + set State(x) $x + set State(selectMode) char + set State(anchor) $anchor +} + +## Select $w $x $mode -- Binding for double- and triple- clicks. +# Selects a word or line (according to mode), +# and sets the selection mode for subsequent drag operations. +# +proc ttk::entry::Select {w x mode} { + variable State + set cur [ClosestGap $w $x] + + switch -- $mode { + word { WordSelect $w $cur $cur } + line { LineSelect $w $cur $cur } + char { # no-op } + } + + set State(anchor) $cur + set State(selectMode) $mode +} + +## Drag -- Button1 motion binding. +# +proc ttk::entry::Drag {w x} { + variable State + set State(x) $x + DragTo $w $x +} + +## DragTo $w $x -- Extend selection to $x based on current selection mode. +# +proc ttk::entry::DragTo {w x} { + variable State + + set cur [ClosestGap $w $x] + switch $State(selectMode) { + char { CharSelect $w $State(anchor) $cur } + word { WordSelect $w $State(anchor) $cur } + line { LineSelect $w $State(anchor) $cur } + none { # no-op } + } +} + +## <B1-Leave> binding: +# Begin autoscroll. +# +proc ttk::entry::DragOut {w mode} { + variable State + if {$State(selectMode) ne "none" && $mode eq "NotifyNormal"} { + ttk::Repeatedly ttk::entry::AutoScroll $w + } +} + +## <B1-Enter> binding +# Suspend autoscroll. +# +proc ttk::entry::DragIn {w} { + ttk::CancelRepeat +} + +## <ButtonRelease-1> binding +# +proc ttk::entry::Release {w} { + variable State + set State(selectMode) none + ttk::CancelRepeat ;# suspend autoscroll +} + +## AutoScroll +# Called repeatedly when the mouse is outside an entry window +# with Button 1 down. Scroll the window left or right, +# depending on where the mouse left the window, and extend +# the selection according to the current selection mode. +# +# TODO: AutoScroll should repeat faster (50ms) than normal autorepeat. +# TODO: Need a way for Repeat scripts to cancel themselves. +# +proc ttk::entry::AutoScroll {w} { + variable State + if {![winfo exists $w]} return + set x $State(x) + if {$x > [winfo width $w]} { + $w xview scroll 2 units + DragTo $w $x + } elseif {$x < 0} { + $w xview scroll -2 units + DragTo $w $x + } +} + +## CharSelect -- select characters between index $from and $to +# +proc ttk::entry::CharSelect {w from to} { + if {$to <= $from} { + $w selection range $to $from + } else { + $w selection range $from $to + } + $w icursor $to +} + +## WordSelect -- Select whole words between index $from and $to +# +proc ttk::entry::WordSelect {w from to} { + if {$to < $from} { + set first [WordBack [$w get] $to] + set last [WordForward [$w get] $from] + $w icursor $first + } else { + set first [WordBack [$w get] $from] + set last [WordForward [$w get] $to] + $w icursor $last + } + $w selection range $first $last +} + +## WordBack, WordForward -- helper routines for WordSelect. +# +proc ttk::entry::WordBack {text index} { + if {[set pos [tcl_wordBreakBefore $text $index]] < 0} { return 0 } + return $pos +} +proc ttk::entry::WordForward {text index} { + if {[set pos [tcl_wordBreakAfter $text $index]] < 0} { return end } + return $pos +} + +## LineSelect -- Select the entire line. +# +proc ttk::entry::LineSelect {w _ _} { + variable State + $w selection range 0 end + $w icursor end +} + +### Button 2 binding procedures. +# + +## ScanMark -- ButtonPress-2 binding. +# Marks the start of a scan or primary transfer operation. +# +proc ttk::entry::ScanMark {w x} { + variable State + set State(scanX) $x + set State(scanIndex) [$w index @0] + set State(scanMoved) 0 +} + +## ScanDrag -- Button2 motion binding. +# +proc ttk::entry::ScanDrag {w x} { + variable State + + set dx [expr {$State(scanX) - $x}] + if {abs($dx) > $State(deadband)} { + set State(scanMoved) 1 + } + set left [expr {$State(scanIndex) + ($dx*$State(scanNum))/$State(scanDen)}] + $w xview $left + + if {$left != [set newLeft [$w index @0]]} { + # We've scanned past one end of the entry; + # reset the mark so that the text will start dragging again + # as soon as the mouse reverses direction. + # + set State(scanX) $x + set State(scanIndex) $newLeft + } +} + +## ScanRelease -- Button2 release binding. +# Do a primary transfer if the mouse has not moved since the button press. +# +proc ttk::entry::ScanRelease {w x} { + variable State + if {!$State(scanMoved)} { + $w instate {!disabled !readonly} { + $w icursor [ClosestGap $w $x] + catch {$w insert insert [::tk::GetSelection $w PRIMARY]} + } + } +} + +### Insertion and deletion procedures. +# + +## PendingDelete -- Delete selection prior to insert. +# If the entry currently has a selection, delete it and +# set the insert position to where the selection was. +# Returns: 1 if pending delete occurred, 0 if nothing was selected. +# +proc ttk::entry::PendingDelete {w} { + if {[$w selection present]} { + $w icursor sel.first + $w delete sel.first sel.last + return 1 + } + return 0 +} + +## Insert -- Insert text into the entry widget. +# If a selection is present, the new text replaces it. +# Otherwise, the new text is inserted at the insert cursor. +# +proc ttk::entry::Insert {w s} { + if {$s eq ""} { return } + PendingDelete $w + $w insert insert $s + See $w insert +} + +## Backspace -- Backspace over the character just before the insert cursor. +# If there is a selection, delete that instead. +# If the new insert position is offscreen to the left, +# scroll to place the cursor at about the middle of the window. +# +proc ttk::entry::Backspace {w} { + if {[PendingDelete $w]} { + See $w + return + } + set x [expr {[$w index insert] - 1}] + if {$x < 0} { return } + + $w delete $x + + if {[$w index @0] >= [$w index insert]} { + set range [$w xview] + set left [lindex $range 0] + set right [lindex $range 1] + $w xview moveto [expr {$left - ($right - $left)/2.0}] + } +} + +## Delete -- Delete the character after the insert cursor. +# If there is a selection, delete that instead. +# +proc ttk::entry::Delete {w} { + if {![PendingDelete $w]} { + $w delete insert + } +} + +#*EOF* diff --git a/Master/tlpkg/tltcl/lib/tk8.6/ttk/fonts.tcl b/Master/tlpkg/tltcl/lib/tk8.6/ttk/fonts.tcl new file mode 100644 index 00000000000..a2781c69bd1 --- /dev/null +++ b/Master/tlpkg/tltcl/lib/tk8.6/ttk/fonts.tcl @@ -0,0 +1,157 @@ +# +# Font specifications. +# +# This file, [source]d at initialization time, sets up the following +# symbolic fonts based on the current platform: +# +# TkDefaultFont -- default for GUI items not otherwise specified +# TkTextFont -- font for user text (entry, listbox, others) +# TkFixedFont -- standard fixed width font +# TkHeadingFont -- headings (column headings, etc) +# TkCaptionFont -- dialog captions (primary text in alert dialogs, etc.) +# TkTooltipFont -- font to use for tooltip windows +# TkIconFont -- font to use for icon captions +# TkMenuFont -- used to use for menu items +# +# In Tk 8.5, some of these fonts may be provided by the TIP#145 implementation +# (On Windows and Mac OS X as of Oct 2007). +# +# +++ Platform notes: +# +# Windows: +# The default system font changed from "MS Sans Serif" to "Tahoma" +# in Windows XP/Windows 2000. +# +# MS documentation says to use "Tahoma 8" in Windows 2000/XP, +# although many MS programs still use "MS Sans Serif 8" +# +# Should use SystemParametersInfo() instead. +# +# Mac OSX / Aqua: +# Quoth the Apple HIG: +# The _system font_ (Lucida Grande Regular 13 pt) is used for text +# in menus, dialogs, and full-size controls. +# [...] Use the _view font_ (Lucida Grande Regular 12pt) as the default +# font of text in lists and tables. +# [...] Use the _emphasized system font_ (Lucida Grande Bold 13 pt) +# sparingly. It is used for the message text in alerts. +# [...] The _small system font_ (Lucida Grande Regular 11 pt) [...] +# is also the default font for column headings in lists, for help tags, +# and for small controls. +# +# Note that the font for column headings (TkHeadingFont) is +# _smaller_ than the default font. +# +# There does not appear to be any recommendations for fixed-width fonts. +# +# X11: +# Need a way to tell if Xft is enabled or not. +# For now, assume patch #971980 applied. +# +# "Classic" look used Helvetica bold for everything except +# for entry widgets, which use Helvetica medium. +# 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 { + +variable tip145 [catch {font create TkDefaultFont}] +catch {font create TkTextFont} +catch {font create TkHeadingFont} +catch {font create TkCaptionFont} +catch {font create TkTooltipFont} +catch {font create TkFixedFont} +catch {font create TkIconFont} +catch {font create TkMenuFont} +catch {font create TkSmallCaptionFont} + +if {!$tip145} { +variable F ;# miscellaneous platform-specific font parameters +switch -- [tk windowingsystem] { + win32 { + # In safe interps there is no osVersion element. + if {[info exists tcl_platform(osVersion)]} { + if {$tcl_platform(osVersion) >= 5.0} { + set F(family) "Tahoma" + } else { + set F(family) "MS Sans Serif" + } + } else { + if {[lsearch -exact [font families] Tahoma] != -1} { + set F(family) "Tahoma" + } else { + set F(family) "MS Sans Serif" + } + } + set F(size) 8 + + font configure TkDefaultFont -family $F(family) -size $F(size) + font configure TkTextFont -family $F(family) -size $F(size) + font configure TkHeadingFont -family $F(family) -size $F(size) + font configure TkCaptionFont -family $F(family) -size $F(size) \ + -weight bold + font configure TkTooltipFont -family $F(family) -size $F(size) + font configure TkFixedFont -family Courier -size 10 + font configure TkIconFont -family $F(family) -size $F(size) + font configure TkMenuFont -family $F(family) -size $F(size) + font configure TkSmallCaptionFont -family $F(family) -size $F(size) + } + aqua { + set F(family) "Lucida Grande" + set F(fixed) "Monaco" + set F(menusize) 14 + set F(size) 13 + set F(viewsize) 12 + set F(smallsize) 11 + set F(labelsize) 10 + set F(fixedsize) 11 + + font configure TkDefaultFont -family $F(family) -size $F(size) + font configure TkTextFont -family $F(family) -size $F(size) + font configure TkHeadingFont -family $F(family) -size $F(smallsize) + font configure TkCaptionFont -family $F(family) -size $F(size) \ + -weight bold + font configure TkTooltipFont -family $F(family) -size $F(smallsize) + font configure TkFixedFont -family $F(fixed) -size $F(fixedsize) + font configure TkIconFont -family $F(family) -size $F(size) + font configure TkMenuFont -family $F(family) -size $F(menusize) + font configure TkSmallCaptionFont -family $F(family) -size $F(labelsize) + } + default - + x11 { + if {![catch {tk::pkgconfig get fontsystem} F(fs)] && $F(fs) eq "xft"} { + set F(family) "sans-serif" + set F(fixed) "monospace" + } else { + set F(family) "Helvetica" + set F(fixed) "courier" + } + set F(size) -12 + set F(ttsize) -10 + set F(capsize) -14 + set F(fixedsize) -12 + + font configure TkDefaultFont -family $F(family) -size $F(size) + font configure TkTextFont -family $F(family) -size $F(size) + font configure TkHeadingFont -family $F(family) -size $F(size) \ + -weight bold + font configure TkCaptionFont -family $F(family) -size $F(capsize) \ + -weight bold + font configure TkTooltipFont -family $F(family) -size $F(ttsize) + font configure TkFixedFont -family $F(fixed) -size $F(fixedsize) + font configure TkIconFont -family $F(family) -size $F(size) + font configure TkMenuFont -family $F(family) -size $F(size) + font configure TkSmallCaptionFont -family $F(family) -size $F(ttsize) + } +} +unset -nocomplain F +} + +} + +#*EOF* diff --git a/Master/tlpkg/tltcl/lib/tk8.6/ttk/menubutton.tcl b/Master/tlpkg/tltcl/lib/tk8.6/ttk/menubutton.tcl new file mode 100644 index 00000000000..43b3cd8ef27 --- /dev/null +++ b/Master/tlpkg/tltcl/lib/tk8.6/ttk/menubutton.tcl @@ -0,0 +1,243 @@ +# +# Bindings for Menubuttons. +# +# Menubuttons have three interaction modes: +# +# 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 +# +# (In addition, when menu system is active, "dropdown" -- menu posts +# on mouse-over. Ttk menubuttons don't implement this). +# +# For keyboard and popdown mode, we hand off to tk_popup and let +# the built-in Tk bindings handle the rest of the interaction. +# +# ON X11: +# +# Standard Tk menubuttons use a global grab on the menubutton. +# 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, +# and transition to popdown mode when the mouse is released +# or dragged outside the menubutton. +# +# ON WINDOWS: +# +# I'm not sure what the hell is going on here. [$menu post] apparently +# sets up some kind of internal grab for native menus. +# On this platform, just use [tk_popup] for all menu actions. +# +# ON MACOS: +# +# Same probably applies here. +# + +namespace eval ttk { + namespace eval menubutton { + variable State + array set State { + pulldown 0 + oldcursor {} + } + } +} + +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 <<Invoke>> { ttk::menubutton::Popdown %W } + +if {[tk windowingsystem] eq "x11"} { + bind TMenubutton <ButtonPress-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> \ + { %W state pressed ; ttk::menubutton::Popdown %W } + bind TMenubutton <ButtonRelease-1> \ + { if {[winfo exists %W]} { %W state !pressed } } +} + +# PostPosition -- +# Returns x and y coordinates and a menu item index. +# If the index is not an empty string the menu should +# be posted so that the upper left corner of the indexed +# menu item is located at the point (x, y). Otherwise +# the top left corner of the menu itself should be located +# at that point. +# +# TODO: adjust menu width to be at least as wide as the button +# for -direction above, below. +# + +if {[tk windowingsystem] eq "aqua"} { + proc ::ttk::menubutton::PostPosition {mb menu} { + set menuPad 5 + set buttonPad 1 + set bevelPad 4 + set mh [winfo reqheight $menu] + set bh [expr {[winfo height $mb]} + $buttonPad] + set bbh [expr {[winfo height $mb]} + $bevelPad] + set mw [winfo reqwidth $menu] + set bw [winfo width $mb] + set dF [expr {[winfo width $mb] - [winfo reqwidth $menu] - $menuPad}] + set entry "" + set entry [::tk::MenuFindName $menu [$mb cget -text]] + if {$entry eq ""} { + set entry 0 + } + set x [winfo rootx $mb] + set y [winfo rooty $mb] + switch [$mb cget -direction] { + above { + set entry "" + incr y [expr {-$mh + 2 * $menuPad}] + } + below { + set entry "" + incr y $bh + } + left { + incr y $menuPad + incr x -$mw + } + right { + incr y $menuPad + incr x $bw + } + default { + incr y $bbh + } + } + return [list $x $y $entry] + } +} else { + proc ::ttk::menubutton::PostPosition {mb menu} { + set mh [expr {[winfo reqheight $menu]}] + set bh [expr {[winfo height $mb]}] + set mw [expr {[winfo reqwidth $menu]}] + set bw [expr {[winfo width $mb]}] + set dF [expr {[winfo width $mb] - [winfo reqwidth $menu]}] + if {[tk windowingsystem] eq "win32"} { + incr mh 6 + incr mw 16 + } + set entry {} + set entry [::tk::MenuFindName $menu [$mb cget -text]] + if {$entry eq {}} { + set entry 0 + } + set x [winfo rootx $mb] + set y [winfo rooty $mb] + switch [$mb cget -direction] { + above { + set entry {} + incr y -$mh + # if we go offscreen to the top, show as 'below' + if {$y < [winfo vrooty $mb]} { + set y [expr {[winfo vrooty $mb] + [winfo rooty $mb]\ + + [winfo reqheight $mb]}] + } + } + below { + set entry {} + incr y $bh + # if we go offscreen to the bottom, show as 'above' + if {($y + $mh) > ([winfo vrooty $mb] + [winfo vrootheight $mb])} { + set y [expr {[winfo vrooty $mb] + [winfo vrootheight $mb] \ + + [winfo rooty $mb] - $mh}] + } + } + left { + incr x -$mw + } + right { + incr x $bw + } + default { + if {[$mb cget -style] eq ""} { + incr x [expr {([winfo width $mb] - \ + [winfo reqwidth $menu])/ 2}] + } else { + incr y $bh + } + } + } + return [list $x $y $entry] + } +} + +# Popdown -- +# Post the menu and set a grab on the menu. +# +proc ttk::menubutton::Popdown {mb} { + if {[$mb instate disabled] || [set menu [$mb cget -menu]] eq ""} { + return + } + foreach {x y entry} [PostPosition $mb $menu] { break } + tk_popup $menu $x $y $entry +} + +# Pulldown (X11 only) -- +# Called when Button1 is pressed on a menubutton. +# Posts the menu; a subsequent ButtonRelease +# or Leave event will set a grab on the menu. +# +proc ttk::menubutton::Pulldown {mb} { + variable State + if {[$mb instate disabled] || [set menu [$mb cget -menu]] eq ""} { + return + } + set State(pulldown) 1 + set State(oldcursor) [$mb cget -cursor] + + $mb state pressed + $mb configure -cursor [$menu cget -cursor] + foreach {x y entry} [PostPosition $mb $menu] { break } + if {$entry ne {}} { + $menu post $x $y $entry + } else { + $menu post $x $y + } + tk_menuSetFocus $menu +} + +# TransferGrab (X11 only) -- +# Switch from pulldown mode (menubutton has an implicit grab) +# to popdown mode (menu has an explicit grab). +# +proc ttk::menubutton::TransferGrab {mb} { + variable State + if {$State(pulldown)} { + $mb configure -cursor $State(oldcursor) + $mb state {!pressed !active} + set State(pulldown) 0 + + set menu [$mb cget -menu] + foreach {x y entry} [PostPosition $mb $menu] { break } + tk_popup $menu [winfo rootx $menu] [winfo rooty $menu] + } +} + +# FindMenuEntry -- +# Hack to support tk_optionMenus. +# Returns the index of the menu entry with a matching -label, +# -1 if not found. +# +proc ttk::menubutton::FindMenuEntry {menu s} { + set last [$menu index last] + if {$last eq "none"} { + return "" + } + for {set i 0} {$i <= $last} {incr i} { + if {![catch {$menu entrycget $i -label} label] + && ($label eq $s)} { + return $i + } + } + return "" +} + +#*EOF* diff --git a/Master/tlpkg/tltcl/lib/tk8.6/ttk/notebook.tcl b/Master/tlpkg/tltcl/lib/tk8.6/ttk/notebook.tcl new file mode 100644 index 00000000000..72b85e6f161 --- /dev/null +++ b/Master/tlpkg/tltcl/lib/tk8.6/ttk/notebook.tcl @@ -0,0 +1,197 @@ +# +# Bindings for TNotebook widget +# + +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 } +catch { +bind TNotebook <Control-ISO_Left_Tab> { ttk::notebook::CycleTab %W -1; break } +} +bind TNotebook <Destroy> { ttk::notebook::Cleanup %W } + +# ActivateTab $nb $tab -- +# Select the specified tab and set focus. +# +# Desired behavior: +# + take focus when reselecting the currently-selected tab; +# + keep focus if the notebook already has it; +# + otherwise set focus to the first traversable widget +# in the newly-selected tab; +# + do not leave the focus in a deselected tab. +# +proc ttk::notebook::ActivateTab {w tab} { + set oldtab [$w select] + $w select $tab + set newtab [$w select] ;# NOTE: might not be $tab, if $tab is disabled + + if {[focus] eq $w} { return } + if {$newtab eq $oldtab} { focus $w ; return } + + update idletasks ;# needed so focus logic sees correct mapped states + if {[set f [ttk::focusFirst $newtab]] ne ""} { + ttk::traverseTo $f + } else { + focus $w + } +} + +# Press $nb $x $y -- +# ButtonPress-1 binding for notebook widgets. +# Activate the tab under the mouse cursor, if any. +# +proc ttk::notebook::Press {w x y} { + set index [$w index @$x,$y] + if {$index ne ""} { + ActivateTab $w $index + } +} + +# CycleTab -- +# Select the next/previous tab in the list. +# +proc ttk::notebook::CycleTab {w dir} { + if {[$w index end] != 0} { + set current [$w index current] + set select [expr {($current + $dir) % [$w index end]}] + while {[$w tab $select -state] != "normal" && ($select != $current)} { + set select [expr {($select + $dir) % [$w index end]}] + } + if {$select != $current} { + ActivateTab $w $select + } + } +} + +# MnemonicTab $nb $key -- +# Scan all tabs in the specified notebook for one with the +# specified mnemonic. If found, returns path name of tab; +# otherwise returns "" +# +proc ttk::notebook::MnemonicTab {nb key} { + set key [string toupper $key] + foreach tab [$nb tabs] { + set label [$nb tab $tab -text] + set underline [$nb tab $tab -underline] + set mnemonic [string toupper [string index $label $underline]] + if {$mnemonic ne "" && $mnemonic eq $key} { + return $tab + } + } + return "" +} + +# +++ Toplevel keyboard traversal. +# + +# enableTraversal -- +# Enable keyboard traversal for a notebook widget +# by adding bindings to the containing toplevel window. +# +# TLNotebooks($top) keeps track of the list of all traversal-enabled +# notebooks contained in the toplevel +# +proc ttk::notebook::enableTraversal {nb} { + variable TLNotebooks + + set top [winfo toplevel $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} + catch { + bind $top <Control-Key-ISO_Left_Tab> {+ttk::notebook::TLCycleTab %W -1} + } + if {[tk windowingsystem] eq "aqua"} { + bind $top <Option-KeyPress> \ + +[list ttk::notebook::MnemonicActivation $top %K] + } else { + bind $top <Alt-KeyPress> \ + +[list ttk::notebook::MnemonicActivation $top %K] + } + bind $top <Destroy> {+ttk::notebook::TLCleanup %W} + } + + lappend TLNotebooks($top) $nb +} + +# TLCleanup -- <Destroy> binding for traversal-enabled toplevels +# +proc ttk::notebook::TLCleanup {w} { + variable TLNotebooks + if {$w eq [winfo toplevel $w]} { + unset -nocomplain -please TLNotebooks($w) + } +} + +# Cleanup -- <Destroy> binding for notebooks +# +proc ttk::notebook::Cleanup {nb} { + variable TLNotebooks + set top [winfo toplevel $nb] + if {[info exists TLNotebooks($top)]} { + set index [lsearch -exact $TLNotebooks($top) $nb] + set TLNotebooks($top) [lreplace $TLNotebooks($top) $index $index] + } +} + +# EnclosingNotebook $w -- +# Return the nearest traversal-enabled notebook widget +# that contains $w. +# +# BUGS: this only works properly for tabs that are direct children +# of the notebook widget. This routine should follow the +# geometry manager hierarchy, not window ancestry, but that +# information is not available in Tk. +# +proc ttk::notebook::EnclosingNotebook {w} { + variable TLNotebooks + + set top [winfo toplevel $w] + if {![info exists TLNotebooks($top)]} { return } + + while {$w ne $top && $w ne ""} { + if {[lsearch -exact $TLNotebooks($top) $w] >= 0} { + return $w + } + set w [winfo parent $w] + } + return "" +} + +# TLCycleTab -- +# toplevel binding procedure for Control-Tab / Control-Shift-Tab +# Select the next/previous tab in the nearest ancestor notebook. +# +proc ttk::notebook::TLCycleTab {w dir} { + set nb [EnclosingNotebook $w] + if {$nb ne ""} { + CycleTab $nb $dir + return -code break + } +} + +# MnemonicActivation $nb $key -- +# Alt-KeyPress 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. +# +proc ttk::notebook::MnemonicActivation {top key} { + variable TLNotebooks + foreach nb $TLNotebooks($top) { + if {[set tab [MnemonicTab $nb $key]] ne ""} { + ActivateTab $nb [$nb index $tab] + return -code break + } + } +} diff --git a/Master/tlpkg/tltcl/lib/tk8.6/ttk/panedwindow.tcl b/Master/tlpkg/tltcl/lib/tk8.6/ttk/panedwindow.tcl new file mode 100644 index 00000000000..a2e073b44dc --- /dev/null +++ b/Master/tlpkg/tltcl/lib/tk8.6/ttk/panedwindow.tcl @@ -0,0 +1,82 @@ +# +# Bindings for ttk::panedwindow widget. +# + +namespace eval ttk::panedwindow { + variable State + array set State { + pressed 0 + pressX - + pressY - + sash - + sashPos - + } +} + +## Bindings: +# +bind TPanedwindow <ButtonPress-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 } + +bind TPanedwindow <Motion> { ttk::panedwindow::SetCursor %W %x %y } +bind TPanedwindow <Enter> { ttk::panedwindow::SetCursor %W %x %y } +bind TPanedwindow <Leave> { ttk::panedwindow::ResetCursor %W } +# See <<NOTE-PW-LEAVE-NOTIFYINFERIOR>> +bind TPanedwindow <<EnteredChild>> { ttk::panedwindow::ResetCursor %W } + +## Sash movement: +# +proc ttk::panedwindow::Press {w x y} { + variable State + + set sash [$w identify $x $y] + if {$sash eq ""} { + set State(pressed) 0 + return + } + set State(pressed) 1 + set State(pressX) $x + set State(pressY) $y + set State(sash) $sash + set State(sashPos) [$w sashpos $sash] +} + +proc ttk::panedwindow::Drag {w x y} { + variable State + if {!$State(pressed)} { return } + switch -- [$w cget -orient] { + horizontal { set delta [expr {$x - $State(pressX)}] } + vertical { set delta [expr {$y - $State(pressY)}] } + } + $w sashpos $State(sash) [expr {$State(sashPos) + $delta}] +} + +proc ttk::panedwindow::Release {w x y} { + variable State + set State(pressed) 0 + SetCursor $w $x $y +} + +## Cursor management: +# +proc ttk::panedwindow::ResetCursor {w} { + variable State + if {!$State(pressed)} { + ttk::setCursor $w {} + } +} + +proc ttk::panedwindow::SetCursor {w x y} { + set cursor "" + if {[llength [$w identify $x $y]]} { + # Assume we're over a sash. + switch -- [$w cget -orient] { + horizontal { set cursor hresize } + vertical { set cursor vresize } + } + } + ttk::setCursor $w $cursor +} + +#*EOF* diff --git a/Master/tlpkg/tltcl/lib/tk8.6/ttk/progress.tcl b/Master/tlpkg/tltcl/lib/tk8.6/ttk/progress.tcl new file mode 100644 index 00000000000..34dce723ee4 --- /dev/null +++ b/Master/tlpkg/tltcl/lib/tk8.6/ttk/progress.tcl @@ -0,0 +1,49 @@ +# +# Ttk widget set: progress bar utilities. +# + +namespace eval ttk::progressbar { + variable Timers ;# Map: widget name -> after ID +} + +# Autoincrement -- +# Periodic callback procedure for autoincrement mode +# +proc ttk::progressbar::Autoincrement {pb steptime stepsize} { + variable Timers + + if {![winfo exists $pb]} { + # widget has been destroyed -- cancel timer + unset -nocomplain Timers($pb) + return + } + + set Timers($pb) [after $steptime \ + [list ttk::progressbar::Autoincrement $pb $steptime $stepsize] ] + + $pb step $stepsize +} + +# ttk::progressbar::start -- +# Start autoincrement mode. Invoked by [$pb start] widget code. +# +proc ttk::progressbar::start {pb {steptime 50} {stepsize 1}} { + variable Timers + if {![info exists Timers($pb)]} { + Autoincrement $pb $steptime $stepsize + } +} + +# ttk::progressbar::stop -- +# Cancel autoincrement mode. Invoked by [$pb stop] widget code. +# +proc ttk::progressbar::stop {pb} { + variable Timers + if {[info exists Timers($pb)]} { + after cancel $Timers($pb) + unset Timers($pb) + } + $pb configure -value 0 +} + + diff --git a/Master/tlpkg/tltcl/lib/tk8.6/ttk/scale.tcl b/Master/tlpkg/tltcl/lib/tk8.6/ttk/scale.tcl new file mode 100644 index 00000000000..62c85bf4c3a --- /dev/null +++ b/Master/tlpkg/tltcl/lib/tk8.6/ttk/scale.tcl @@ -0,0 +1,94 @@ +# scale.tcl - Copyright (C) 2004 Pat Thoyts <patthoyts@users.sourceforge.net> +# +# Bindings for the TScale widget + +namespace eval ttk::scale { + variable State + array set State { + dragging 0 + } +} + +bind TScale <ButtonPress-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 <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 <B3-Motion> { ttk::scale::Drag %W %x %y } +bind TScale <ButtonRelease-3> { ttk::scale::Release %W %x %y } + +## Keyboard navigation bindings: +# +bind TScale <<LineStart>> { %W set [%W cget -from] } +bind TScale <<LineEnd>> { %W set [%W cget -to] } + +bind TScale <<PrevChar>> { ttk::scale::Increment %W -1 } +bind TScale <<PrevLine>> { ttk::scale::Increment %W -1 } +bind TScale <<NextChar>> { ttk::scale::Increment %W 1 } +bind TScale <<NextLine>> { ttk::scale::Increment %W 1 } +bind TScale <<PrevWord>> { ttk::scale::Increment %W -10 } +bind TScale <<PrevPara>> { ttk::scale::Increment %W -10 } +bind TScale <<NextWord>> { ttk::scale::Increment %W 10 } +bind TScale <<NextPara>> { ttk::scale::Increment %W 10 } + +proc ttk::scale::Press {w x y} { + variable State + set State(dragging) 0 + + switch -glob -- [$w identify $x $y] { + *track - + *trough { + set inc [expr {([$w get $x $y] <= [$w get]) ^ ([$w cget -from] > [$w cget -to]) ? -1 : 1}] + ttk::Repeatedly Increment $w $inc + } + *slider { + set State(dragging) 1 + set State(initial) [$w get] + } + } +} + +# scale::Jump -- ButtonPress-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} { + variable State + set State(dragging) 0 + + switch -glob -- [$w identify $x $y] { + *track - + *trough { + $w set [$w get $x $y] + set State(dragging) 1 + set State(initial) [$w get] + } + *slider { + Press $w $x $y + } + } +} + +proc ttk::scale::Drag {w x y} { + variable State + if {$State(dragging)} { + $w set [$w get $x $y] + } +} + +proc ttk::scale::Release {w x y} { + variable State + set State(dragging) 0 + ttk::CancelRepeat +} + +proc ttk::scale::Increment {w delta} { + if {![winfo exists $w]} return + if {([$w cget -from] > [$w cget -to])} { + set delta [expr {-$delta}] + } + $w set [expr {[$w get] + $delta}] +} diff --git a/Master/tlpkg/tltcl/lib/tk8.6/ttk/scrollbar.tcl b/Master/tlpkg/tltcl/lib/tk8.6/ttk/scrollbar.tcl new file mode 100644 index 00000000000..d08e1e2aba4 --- /dev/null +++ b/Master/tlpkg/tltcl/lib/tk8.6/ttk/scrollbar.tcl @@ -0,0 +1,105 @@ +# +# Bindings for TScrollbar widget +# + +namespace eval ttk::scrollbar { + variable State + # State(xPress) -- + # State(yPress) -- initial position of mouse at start of drag. + # State(first) -- value of -first at start of drag. +} + +bind TScrollbar <ButtonPress-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 <B2-Motion> { ttk::scrollbar::Drag %W %x %y } +bind TScrollbar <ButtonRelease-2> { ttk::scrollbar::Release %W %x %y } + +proc ttk::scrollbar::Scroll {w n units} { + set cmd [$w cget -command] + if {$cmd ne ""} { + uplevel #0 $cmd scroll $n $units + } +} + +proc ttk::scrollbar::Moveto {w fraction} { + set cmd [$w cget -command] + if {$cmd ne ""} { + uplevel #0 $cmd moveto $fraction + } +} + +proc ttk::scrollbar::Press {w x y} { + variable State + + set State(xPress) $x + set State(yPress) $y + + switch -glob -- [$w identify $x $y] { + *uparrow - + *leftarrow { + ttk::Repeatedly Scroll $w -1 units + } + *downarrow - + *rightarrow { + ttk::Repeatedly Scroll $w 1 units + } + *thumb { + set State(first) [lindex [$w get] 0] + } + *trough { + set f [$w fraction $x $y] + if {$f < [lindex [$w get] 0]} { + # Clicked in upper/left trough + ttk::Repeatedly Scroll $w -1 pages + } elseif {$f > [lindex [$w get] 1]} { + # Clicked in lower/right trough + ttk::Repeatedly Scroll $w 1 pages + } else { + # Clicked on thumb (???) + set State(first) [lindex [$w get] 0] + } + } + } +} + +proc ttk::scrollbar::Drag {w x y} { + variable State + if {![info exists State(first)]} { + # Initial buttonpress was not on the thumb, + # or something screwy has happened. In either case, ignore: + return; + } + set xDelta [expr {$x - $State(xPress)}] + set yDelta [expr {$y - $State(yPress)}] + Moveto $w [expr {$State(first) + [$w delta $xDelta $yDelta]}] +} + +proc ttk::scrollbar::Release {w x y} { + variable State + unset -nocomplain State(xPress) State(yPress) State(first) + ttk::CancelRepeat +} + +# scrollbar::Jump -- ButtonPress-2 binding for scrollbars. +# Behaves exactly like scrollbar::Press, except that +# clicking in the trough jumps to the the selected position. +# +proc ttk::scrollbar::Jump {w x y} { + variable State + + switch -glob -- [$w identify $x $y] { + *thumb - + *trough { + set State(first) [$w fraction $x $y] + Moveto $w $State(first) + set State(xPress) $x + set State(yPress) $y + } + default { + Press $w $x $y + } + } +} diff --git a/Master/tlpkg/tltcl/lib/tk8.6/ttk/sizegrip.tcl b/Master/tlpkg/tltcl/lib/tk8.6/ttk/sizegrip.tcl new file mode 100644 index 00000000000..24a67c62865 --- /dev/null +++ b/Master/tlpkg/tltcl/lib/tk8.6/ttk/sizegrip.tcl @@ -0,0 +1,102 @@ +# +# Sizegrip widget bindings. +# +# Dragging a sizegrip widget resizes the containing toplevel. +# +# NOTE: the sizegrip widget must be in the lower right hand corner. +# + +switch -- [tk windowingsystem] { + x11 - + win32 { + option add *TSizegrip.cursor [ttk::cursor seresize] widgetDefault + } + aqua { + # Aqua sizegrips use default Arrow cursor. + } +} + +namespace eval ttk::sizegrip { + variable State + array set State { + pressed 0 + pressX 0 + pressY 0 + width 0 + height 0 + widthInc 1 + heightInc 1 + resizeX 1 + resizeY 1 + toplevel {} + } +} + +bind TSizegrip <ButtonPress-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 } + +proc ttk::sizegrip::Press {W X Y} { + variable State + + if {[$W instate disabled]} { return } + + set top [winfo toplevel $W] + + # If the toplevel is not resizable then bail + foreach {State(resizeX) State(resizeY)} [wm resizable $top] break + if {!$State(resizeX) && !$State(resizeY)} { + return + } + + # Sanity-checks: + # If a negative X or Y position was specified for [wm geometry], + # just bail out -- there's no way to handle this cleanly. + # + if {[scan [wm geometry $top] "%dx%d+%d+%d" width height x y] != 4} { + return; + } + + # Account for gridded geometry: + # + set grid [wm grid $top] + if {[llength $grid]} { + set State(widthInc) [lindex $grid 2] + set State(heightInc) [lindex $grid 3] + } else { + set State(widthInc) [set State(heightInc) 1] + } + + set State(toplevel) $top + set State(pressX) $X + set State(pressY) $Y + set State(width) $width + set State(height) $height + set State(x) $x + set State(y) $y + set State(pressed) 1 +} + +proc ttk::sizegrip::Drag {W X Y} { + variable State + if {!$State(pressed)} { return } + set w $State(width) + set h $State(height) + if {$State(resizeX)} { + set w [expr {$w + ($X - $State(pressX))/$State(widthInc)}] + } + if {$State(resizeY)} { + set h [expr {$h + ($Y - $State(pressY))/$State(heightInc)}] + } + if {$w <= 0} { set w 1 } + if {$h <= 0} { set h 1 } + set x $State(x) ; set y $State(y) + wm geometry $State(toplevel) ${w}x${h}+${x}+${y} +} + +proc ttk::sizegrip::Release {W X Y} { + variable State + set State(pressed) 0 +} + +#*EOF* diff --git a/Master/tlpkg/tltcl/lib/tk8.6/ttk/spinbox.tcl b/Master/tlpkg/tltcl/lib/tk8.6/ttk/spinbox.tcl new file mode 100644 index 00000000000..90a1572a3a4 --- /dev/null +++ b/Master/tlpkg/tltcl/lib/tk8.6/ttk/spinbox.tcl @@ -0,0 +1,175 @@ +# +# ttk::spinbox bindings +# + +namespace eval ttk::spinbox { } + +### Spinbox bindings. +# +# Duplicate the Entry bindings, override if needed: +# + +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 <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 <<Increment>> { ttk::spinbox::Spin %W +1 } +bind TSpinbox <<Decrement>> { ttk::spinbox::Spin %W -1 } + +ttk::bindMouseWheel TSpinbox [list ttk::spinbox::MouseWheel %W] + +## Motion -- +# Sets cursor. +# +proc ttk::spinbox::Motion {w x y} { + if { [$w identify $x $y] eq "textarea" + && [$w instate {!readonly !disabled}] + } { + ttk::setCursor $w text + } else { + ttk::setCursor $w "" + } +} + +## Press -- +# +proc ttk::spinbox::Press {w x y} { + if {[$w instate disabled]} { return } + focus $w + switch -glob -- [$w identify $x $y] { + *textarea { ttk::entry::Press $w $x } + *rightarrow - + *uparrow { ttk::Repeatedly event generate $w <<Increment>> } + *leftarrow - + *downarrow { ttk::Repeatedly event generate $w <<Decrement>> } + *spinbutton { + if {$y * 2 >= [winfo height $w]} { + set event <<Decrement>> + } else { + set event <<Increment>> + } + ttk::Repeatedly event generate $w $event + } + } +} + +## DoubleClick -- +# Select all if over the text area; otherwise same as Press. +# +proc ttk::spinbox::DoubleClick {w x y} { + if {[$w instate disabled]} { return } + + switch -glob -- [$w identify $x $y] { + *textarea { SelectAll $w } + * { Press $w $x $y } + } +} + +proc ttk::spinbox::Release {w} { + ttk::CancelRepeat +} + +## MouseWheel -- +# Mousewheel callback. Turn these into <<Increment>> (-1, up) +# or <<Decrement> (+1, down) events. +# +proc ttk::spinbox::MouseWheel {w dir} { + if {[$w instate disabled]} { return } + if {$dir < 0} { + event generate $w <<Increment>> + } else { + event generate $w <<Decrement>> + } +} + +## SelectAll -- +# Select widget contents. +# +proc ttk::spinbox::SelectAll {w} { + $w selection range 0 end + $w icursor end +} + +## Limit -- +# Limit $v to lie between $min and $max +# +proc ttk::spinbox::Limit {v min max} { + if {$v < $min} { return $min } + if {$v > $max} { return $max } + return $v +} + +## Wrap -- +# Adjust $v to lie between $min and $max, wrapping if out of bounds. +# +proc ttk::spinbox::Wrap {v min max} { + if {$v < $min} { return $max } + if {$v > $max} { return $min } + return $v +} + +## Adjust -- +# Limit or wrap spinbox value depending on -wrap. +# +proc ttk::spinbox::Adjust {w v min max} { + if {[$w cget -wrap]} { + return [Wrap $v $min $max] + } else { + return [Limit $v $min $max] + } +} + +## Spin -- +# Handle <<Increment>> and <<Decrement>> events. +# If -values is specified, cycle through the list. +# Otherwise cycle through numeric range based on +# -from, -to, and -increment. +# +proc ttk::spinbox::Spin {w dir} { + if {[$w instate disabled]} { return } + 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] + } else { + if {[catch { + set v [expr {[scan [$w get] %f] + $dir * [$w cget -increment]}] + }]} { + set v [$w cget -from] + } + $w set [FormatValue $w [Adjust $w $v [$w cget -from] [$w cget -to]]] + } + SelectAll $w + uplevel #0 [$w cget -command] +} + +## FormatValue -- +# Reformat numeric value based on -format. +# +proc ttk::spinbox::FormatValue {w val} { + set fmt [$w cget -format] + if {$fmt eq ""} { + # Try to guess a suitable -format based on -increment. + set delta [expr {abs([$w cget -increment])}] + if {0 < $delta && $delta < 1} { + # NB: This guesses wrong if -increment has more than 1 + # significant digit itself, e.g., -increment 0.25 + set nsd [expr {int(ceil(-log10($delta)))}] + set fmt "%.${nsd}f" + } else { + set fmt "%.0f" + } + } + return [format $fmt $val] +} + +#*EOF* diff --git a/Master/tlpkg/tltcl/lib/tk8.6/ttk/treeview.tcl b/Master/tlpkg/tltcl/lib/tk8.6/ttk/treeview.tcl new file mode 100644 index 00000000000..df188b72917 --- /dev/null +++ b/Master/tlpkg/tltcl/lib/tk8.6/ttk/treeview.tcl @@ -0,0 +1,379 @@ +# +# ttk::treeview widget bindings and utilities. +# + +namespace eval ttk::treeview { + variable State + + # Enter/Leave/Motion + # + set State(activeWidget) {} + set State(activeHeading) {} + + # Press/drag/release: + # + set State(pressMode) none + set State(pressX) 0 + + # For pressMode == "resize" + set State(resizeColumn) #0 + + # For pressmode == "heading" + set State(heading) {} +} + +### Widget bindings. +# + +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 <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> \ + { ttk::treeview::Select %W %x %y extend } +bind Treeview <<ToggleSelection>> \ + { ttk::treeview::Select %W %x %y toggle } + +ttk::copyBindings TtkScrollable Treeview + +### Binding procedures. +# + +## Keynav -- Keyboard navigation +# +# @@@ TODO: verify/rewrite up and down code. +# +proc ttk::treeview::Keynav {w dir} { + set focus [$w focus] + if {$focus eq ""} { return } + + switch -- $dir { + up { + if {[set up [$w prev $focus]] eq ""} { + set focus [$w parent $focus] + } else { + while {[$w item $up -open] && [llength [$w children $up]]} { + set up [lindex [$w children $up] end] + } + set focus $up + } + } + down { + if {[$w item $focus -open] && [llength [$w children $focus]]} { + set focus [lindex [$w children $focus] 0] + } else { + set up $focus + while {$up ne "" && [set down [$w next $up]] eq ""} { + set up [$w parent $up] + } + set focus $down + } + } + left { + if {[$w item $focus -open] && [llength [$w children $focus]]} { + CloseItem $w $focus + } else { + set focus [$w parent $focus] + } + } + right { + OpenItem $w $focus + } + } + + if {$focus != {}} { + SelectOp $w $focus choose + } +} + +## Motion -- pointer motion binding. +# Sets cursor, active element ... +# +proc ttk::treeview::Motion {w x y} { + set cursor {} + set activeHeading {} + + switch -- [$w identify region $x $y] { + separator { set cursor hresize } + heading { set activeHeading [$w identify column $x $y] } + } + + ttk::setCursor $w $cursor + ActivateHeading $w $activeHeading +} + +## ActivateHeading -- track active heading element +# +proc ttk::treeview::ActivateHeading {w heading} { + variable State + + if {$w != $State(activeWidget) || $heading != $State(activeHeading)} { + if {[winfo exists $State(activeWidget)] && $State(activeHeading) != {}} { + # 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 + } + set State(activeHeading) $heading + set State(activeWidget) $w + } +} + +## Select $w $x $y $selectop +# Binding procedure for selection operations. +# See "Selection modes", below. +# +proc ttk::treeview::Select {w x y op} { + if {[set item [$w identify row $x $y]] ne "" } { + SelectOp $w $item $op + } +} + +## DoubleClick -- Double-ButtonPress-1 binding. +# +proc ttk::treeview::DoubleClick {w x y} { + if {[set row [$w identify row $x $y]] ne ""} { + Toggle $w $row + } else { + Press $w $x $y ;# perform single-click action + } +} + +## Press -- ButtonPress binding. +# +proc ttk::treeview::Press {w x y} { + focus $w + switch -- [$w identify region $x $y] { + nothing { } + heading { heading.press $w $x $y } + separator { resize.press $w $x $y } + tree - + cell { + set item [$w identify item $x $y] + SelectOp $w $item choose + switch -glob -- [$w identify element $x $y] { + *indicator - + *disclosure { Toggle $w $item } + } + } + } +} + +## Drag -- B1-Motion binding +# +proc ttk::treeview::Drag {w x y} { + variable State + switch $State(pressMode) { + resize { resize.drag $w $x } + heading { heading.drag $w $x $y } + } +} + +proc ttk::treeview::Release {w x y} { + variable State + switch $State(pressMode) { + resize { resize.release $w $x } + heading { heading.release $w } + } + set State(pressMode) none + Motion $w $x $y +} + +### Interactive column resizing. +# +proc ttk::treeview::resize.press {w x y} { + variable State + set State(pressMode) "resize" + set State(resizeColumn) [$w identify column $x $y] +} + +proc ttk::treeview::resize.drag {w x} { + variable State + $w drag $State(resizeColumn) $x +} + +proc ttk::treeview::resize.release {w x} { + $w drop +} + +### Heading activation. +# + +proc ttk::treeview::heading.press {w x y} { + variable State + set column [$w identify column $x $y] + set State(pressMode) "heading" + set State(heading) $column + $w heading $column state pressed +} + +proc ttk::treeview::heading.drag {w x y} { + variable State + if { [$w identify region $x $y] eq "heading" + && [$w identify column $x $y] eq $State(heading) + } { + $w heading $State(heading) state pressed + } else { + $w heading $State(heading) state !pressed + } +} + +proc ttk::treeview::heading.release {w} { + variable State + if {[lsearch -exact [$w heading $State(heading) state] pressed] >= 0} { + after 0 [$w heading $State(heading) -command] + } + $w heading $State(heading) state !pressed +} + +### Selection modes. +# + +## SelectOp $w $item [ choose | extend | toggle ] -- +# Dispatch to appropriate selection operation +# depending on current value of -selectmode. +# +proc ttk::treeview::SelectOp {w item op} { + select.$op.[$w cget -selectmode] $w $item +} + +## -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 } + +## -selectmode browse: +# +proc ttk::treeview::select.choose.browse {w item} { BrowseTo $w $item } +proc ttk::treeview::select.toggle.browse {w item} { BrowseTo $w $item } +proc ttk::treeview::select.extend.browse {w item} { BrowseTo $w $item } + +## -selectmode multiple: +# +proc ttk::treeview::select.choose.extended {w item} { + BrowseTo $w $item +} +proc ttk::treeview::select.toggle.extended {w item} { + $w selection toggle [list $item] +} +proc ttk::treeview::select.extend.extended {w item} { + if {[set anchor [$w focus]] ne ""} { + $w selection set [between $w $anchor $item] + } else { + BrowseTo $w $item + } +} + +### Tree structure utilities. +# + +## between $tv $item1 $item2 -- +# Returns a list of all items between $item1 and $item2, +# in preorder traversal order. $item1 and $item2 may be +# in either order. +# +# NOTES: +# This routine is O(N) in the size of the tree. +# There's probably a way to do this that's O(N) in the number +# of items returned, but I'm not clever enough to figure it out. +# +proc ttk::treeview::between {tv item1 item2} { + variable between [list] + variable selectingBetween 0 + ScanBetween $tv $item1 $item2 {} + return $between +} + +## ScanBetween -- +# Recursive worker routine for ttk::treeview::between +# +proc ttk::treeview::ScanBetween {tv item1 item2 item} { + variable between + variable selectingBetween + + if {$item eq $item1 || $item eq $item2} { + lappend between $item + set selectingBetween [expr {!$selectingBetween}] + } elseif {$selectingBetween} { + lappend between $item + } + foreach child [$tv children $item] { + ScanBetween $tv $item1 $item2 $child + } +} + +### User interaction utilities. +# + +## OpenItem, CloseItem -- Set the open state of an item, generate event +# + +proc ttk::treeview::OpenItem {w item} { + $w focus $item + event generate $w <<TreeviewOpen>> + $w item $item -open true +} + +proc ttk::treeview::CloseItem {w item} { + $w item $item -open false + $w focus $item + event generate $w <<TreeviewClose>> +} + +## Toggle -- toggle opened/closed state of item +# +proc ttk::treeview::Toggle {w item} { + # don't allow toggling on indicators that + # are not present in front of leaf items + if {[$w children $item] == {}} { + return + } + # not a leaf, toggle! + if {[$w item $item -open]} { + CloseItem $w $item + } else { + OpenItem $w $item + } +} + +## ToggleFocus -- toggle opened/closed state of focus item +# +proc ttk::treeview::ToggleFocus {w} { + set item [$w focus] + if {$item ne ""} { + Toggle $w $item + } +} + +## BrowseTo -- navigate to specified item; set focus and selection +# +proc ttk::treeview::BrowseTo {w item} { + $w see $item + $w focus $item + $w selection set [list $item] +} + +#*EOF* diff --git a/Master/tlpkg/tltcl/lib/tk8.6/ttk/ttk.tcl b/Master/tlpkg/tltcl/lib/tk8.6/ttk/ttk.tcl new file mode 100644 index 00000000000..7bae211d205 --- /dev/null +++ b/Master/tlpkg/tltcl/lib/tk8.6/ttk/ttk.tcl @@ -0,0 +1,176 @@ +# +# Ttk widget set initialization script. +# + +### Source library scripts. +# + +namespace eval ::ttk { + variable library + if {![info exists library]} { + set library [file dirname [info script]] + } +} + +source [file join $::ttk::library fonts.tcl] +source [file join $::ttk::library cursors.tcl] +source [file join $::ttk::library utils.tcl] + +## ttk::deprecated $old $new -- +# Define $old command as a deprecated alias for $new command +# $old and $new must be fully namespace-qualified. +# +proc ttk::deprecated {old new} { + interp alias {} $old {} ttk::do'deprecate $old $new +} +## do'deprecate -- +# Implementation procedure for deprecated commands -- +# issue a warning (once), then re-alias old to new. +# +proc ttk::do'deprecate {old new args} { + deprecated'warning $old $new + interp alias {} $old {} $new + uplevel 1 [linsert $args 0 $new] +} + +## deprecated'warning -- +# Gripe about use of deprecated commands. +# +proc ttk::deprecated'warning {old new} { + puts stderr "$old deprecated -- use $new instead" +} + +### Backward-compatibility. +# +# +# Make [package require tile] an effective no-op; +# see SF#3016598 for discussion. +# +package ifneeded tile 0.8.6 { package provide tile 0.8.6 } + +# ttk::panedwindow used to be named ttk::paned. Keep the alias for now. +# +::ttk::deprecated ::ttk::paned ::ttk::panedwindow + +### ::ttk::ThemeChanged -- +# Called from [::ttk::style theme use]. +# Sends a <<ThemeChanged>> virtual event to all widgets. +# +proc ::ttk::ThemeChanged {} { + set Q . + while {[llength $Q]} { + set QN [list] + foreach w $Q { + event generate $w <<ThemeChanged>> + foreach child [winfo children $w] { + lappend QN $child + } + } + set Q $QN + } +} + +### Public API. +# + +proc ::ttk::themes {{ptn *}} { + set themes [list] + + foreach pkg [lsearch -inline -all -glob [package names] ttk::theme::$ptn] { + lappend themes [namespace tail $pkg] + } + + return $themes +} + +## ttk::setTheme $theme -- +# Set the current theme to $theme, loading it if necessary. +# +proc ::ttk::setTheme {theme} { + variable currentTheme ;# @@@ Temp -- [::ttk::style theme use] doesn't work + if {$theme ni [::ttk::style theme names]} { + package require ttk::theme::$theme + } + ::ttk::style theme use $theme + set currentTheme $theme +} + +### Load widget bindings. +# +source [file join $::ttk::library button.tcl] +source [file join $::ttk::library menubutton.tcl] +source [file join $::ttk::library scrollbar.tcl] +source [file join $::ttk::library scale.tcl] +source [file join $::ttk::library progress.tcl] +source [file join $::ttk::library notebook.tcl] +source [file join $::ttk::library panedwindow.tcl] +source [file join $::ttk::library entry.tcl] +source [file join $::ttk::library combobox.tcl] ;# dependency: entry.tcl +source [file join $::ttk::library spinbox.tcl] ;# dependency: entry.tcl +source [file join $::ttk::library treeview.tcl] +source [file join $::ttk::library sizegrip.tcl] + +## Label and Labelframe bindings: +# (not enough to justify their own file...) +# +bind TLabelframe <<Invoke>> { tk::TabToWindow [tk_focusNext %W] } +bind TLabel <<Invoke>> { tk::TabToWindow [tk_focusNext %W] } + +### Load settings for built-in themes: +# +proc ttk::LoadThemes {} { + variable library + + # "default" always present: + uplevel #0 [list source [file join $library defaults.tcl]] + + set builtinThemes [style theme names] + foreach {theme scripts} { + classic classicTheme.tcl + alt altTheme.tcl + clam clamTheme.tcl + winnative winTheme.tcl + xpnative {xpTheme.tcl vistaTheme.tcl} + aqua aquaTheme.tcl + } { + if {[lsearch -exact $builtinThemes $theme] >= 0} { + foreach script $scripts { + uplevel #0 [list source [file join $library $script]] + } + } + } +} + +ttk::LoadThemes; rename ::ttk::LoadThemes {} + +### Select platform-specific default theme: +# +# Notes: +# + On OSX, aqua theme is the default +# + On Windows, xpnative takes precedence over winnative if available. +# + On X11, users can use the X resource database to +# specify a preferred theme (*TkTheme: themeName); +# otherwise "default" is used. +# + +proc ttk::DefaultTheme {} { + set preferred [list aqua vista xpnative winnative] + + set userTheme [option get . tkTheme TkTheme] + if {$userTheme ne {} && ![catch { + uplevel #0 [list package require ttk::theme::$userTheme] + }]} { + return $userTheme + } + + foreach theme $preferred { + if {[package provide ttk::theme::$theme] ne ""} { + return $theme + } + } + return "default" +} + +ttk::setTheme [ttk::DefaultTheme] ; rename ttk::DefaultTheme {} + +#*EOF* diff --git a/Master/tlpkg/tltcl/lib/tk8.6/ttk/utils.tcl b/Master/tlpkg/tltcl/lib/tk8.6/ttk/utils.tcl new file mode 100644 index 00000000000..857f4cde97d --- /dev/null +++ b/Master/tlpkg/tltcl/lib/tk8.6/ttk/utils.tcl @@ -0,0 +1,345 @@ +# +# Utilities for widget implementations. +# + +### Focus management. +# +# See also: #1516479 +# + +## ttk::takefocus -- +# This is the default value of the "-takefocus" option +# for ttk::* widgets that participate in keyboard navigation. +# +# NOTES: +# tk::FocusOK (called by tk_focusNext) tests [winfo viewable] +# if -takefocus is 1, empty, or missing; but not if it's a +# script prefix, so we have to check that here as well. +# +# +proc ttk::takefocus {w} { + expr {[$w instate !disabled] && [winfo viewable $w]} +} + +## ttk::GuessTakeFocus -- +# This routine is called as a fallback for widgets +# with a missing or empty -takefocus option. +# +# It implements the same heuristics as tk::FocusOK. +# +proc ttk::GuessTakeFocus {w} { + # Don't traverse to widgets with '-state disabled': + # + if {![catch {$w cget -state} state] && $state eq "disabled"} { + return 0 + } + + # Allow traversal to widgets with explicit key or focus bindings: + # + if {[regexp {Key|Focus} [concat [bind $w] [bind [winfo class $w]]]]} { + return 1; + } + + # Default is nontraversable: + # + return 0; +} + +## ttk::traverseTo $w -- +# Set the keyboard focus to the specified window. +# +proc ttk::traverseTo {w} { + set focus [focus] + if {$focus ne ""} { + event generate $focus <<TraverseOut>> + } + focus $w + event generate $w <<TraverseIn>> +} + +## ttk::clickToFocus $w -- +# Utility routine, used in <ButtonPress-1> bindings -- +# Assign keyboard focus to the specified widget if -takefocus is enabled. +# +proc ttk::clickToFocus {w} { + if {[ttk::takesFocus $w]} { focus $w } +} + +## ttk::takesFocus w -- +# Test if the widget can take keyboard focus. +# +# See the description of the -takefocus option in options(n) +# for details. +# +proc ttk::takesFocus {w} { + if {![winfo viewable $w]} { + return 0 + } elseif {[catch {$w cget -takefocus} takefocus]} { + return [GuessTakeFocus $w] + } else { + switch -- $takefocus { + "" { return [GuessTakeFocus $w] } + 0 { return 0 } + 1 { return 1 } + default { + return [expr {[uplevel #0 $takefocus [list $w]] == 1}] + } + } + } +} + +## ttk::focusFirst $w -- +# Return the first descendant of $w, in preorder traversal order, +# that can take keyboard focus, "" if none do. +# +# See also: tk_focusNext +# + +proc ttk::focusFirst {w} { + if {[ttk::takesFocus $w]} { + return $w + } + foreach child [winfo children $w] { + if {[set c [ttk::focusFirst $child]] ne ""} { + return $c + } + } + return "" +} + +### Grabs. +# +# Rules: +# Each call to [grabWindow $w] or [globalGrab $w] must be +# matched with a call to [releaseGrab $w] in LIFO order. +# +# Do not call [grabWindow $w] for a window that currently +# appears on the grab stack. +# +# See #1239190 and #1411983 for more discussion. +# +namespace eval ttk { + variable Grab ;# map: window name -> grab token + + # grab token details: + # Two-element list containing: + # 1) a script to evaluate to restore the previous grab (if any); + # 2) a script to evaluate to restore the focus (if any) +} + +## SaveGrab -- +# Record current grab and focus windows. +# +proc ttk::SaveGrab {w} { + variable Grab + + if {[info exists Grab($w)]} { + # $w is already on the grab stack. + # This should not happen, but bail out in case it does anyway: + # + return + } + + set restoreGrab [set restoreFocus ""] + + set grabbed [grab current $w] + if {[winfo exists $grabbed]} { + switch [grab status $grabbed] { + global { set restoreGrab [list grab -global $grabbed] } + local { set restoreGrab [list grab $grabbed] } + none { ;# grab window is really in a different interp } + } + } + + set focus [focus] + if {$focus ne ""} { + set restoreFocus [list focus -force $focus] + } + + set Grab($w) [list $restoreGrab $restoreFocus] +} + +## RestoreGrab -- +# Restore previous grab and focus windows. +# If called more than once without an intervening [SaveGrab $w], +# does nothing. +# +proc ttk::RestoreGrab {w} { + variable Grab + + if {![info exists Grab($w)]} { # Ignore + return; + } + + # The previous grab/focus window may have been destroyed, + # unmapped, or some other abnormal condition; ignore any errors. + # + foreach script $Grab($w) { + catch $script + } + + unset Grab($w) +} + +## ttk::grabWindow $w -- +# Records the current focus and grab windows, sets an application-modal +# grab on window $w. +# +proc ttk::grabWindow {w} { + SaveGrab $w + grab $w +} + +## ttk::globalGrab $w -- +# Same as grabWindow, but sets a global grab on $w. +# +proc ttk::globalGrab {w} { + SaveGrab $w + grab -global $w +} + +## ttk::releaseGrab -- +# Release the grab previously set by [ttk::grabWindow] +# or [ttk::globalGrab]. +# +proc ttk::releaseGrab {w} { + grab release $w + RestoreGrab $w +} + +### Auto-repeat. +# +# NOTE: repeating widgets do not have -repeatdelay +# or -repeatinterval resources as in standard Tk; +# instead a single set of settings is applied application-wide. +# (TODO: make this user-configurable) +# +# (@@@ Windows seems to use something like 500/50 milliseconds +# @@@ for -repeatdelay/-repeatinterval) +# + +namespace eval ttk { + variable Repeat + array set Repeat { + delay 300 + interval 100 + timer {} + script {} + } +} + +## ttk::Repeatedly -- +# Begin auto-repeat. +# +proc ttk::Repeatedly {args} { + variable Repeat + after cancel $Repeat(timer) + set script [uplevel 1 [list namespace code $args]] + set Repeat(script) $script + uplevel #0 $script + set Repeat(timer) [after $Repeat(delay) ttk::Repeat] +} + +## Repeat -- +# Continue auto-repeat +# +proc ttk::Repeat {} { + variable Repeat + uplevel #0 $Repeat(script) + set Repeat(timer) [after $Repeat(interval) ttk::Repeat] +} + +## ttk::CancelRepeat -- +# Halt auto-repeat. +# +proc ttk::CancelRepeat {} { + variable Repeat + after cancel $Repeat(timer) +} + +### Bindings. +# + +## ttk::copyBindings $from $to -- +# Utility routine; copies bindings from one bindtag onto another. +# +proc ttk::copyBindings {from to} { + foreach event [bind $from] { + bind $to $event [bind $from $event] + } +} + +### Mousewheel bindings. +# +# Platform inconsistencies: +# +# On X11, the server typically maps the mouse wheel to Button4 and Button5. +# +# On OSX, Tk generates sensible values for the %D field in <MouseWheel> events. +# +# On Windows, %D must be scaled by a factor of 120. +# In addition, Tk redirects mousewheel events to the window with +# keyboard focus instead of sending them to the window under the pointer. +# We do not attempt to fix that here, see also TIP#171. +# +# OSX conventionally uses Shift+MouseWheel for horizontal scrolling, +# and Option+MouseWheel for accelerated scrolling. +# +# The Shift+MouseWheel behavior is not conventional on Windows or most +# X11 toolkits, but it's useful. +# +# MouseWheel scrolling is accelerated on X11, which is conventional +# for Tk and appears to be conventional for other toolkits (although +# Gtk+ and Qt do not appear to use as large a factor). +# + +## ttk::bindMouseWheel $bindtag $command... +# Adds basic mousewheel support to $bindtag. +# $command will be passed one additional argument +# specifying the mousewheel direction (-1: up, +1: down). +# + +proc ttk::bindMouseWheel {bindtag callback} { + if {[tk windowingsystem] eq "x11"} { + bind $bindtag <ButtonPress-4> "$callback -1" + bind $bindtag <ButtonPress-5> "$callback +1" + } + if {[tk windowingsystem] eq "aqua"} { + bind $bindtag <MouseWheel> [append callback { [expr {-(%D)}]} ] + bind $bindtag <Option-MouseWheel> [append callback { [expr {-10 *(%D)}]} ] + } else { + bind $bindtag <MouseWheel> [append callback { [expr {-(%D / 120)}]}] + } +} + +## Mousewheel bindings for standard scrollable widgets. +# +# Usage: [ttk::copyBindings TtkScrollable $bindtag] +# +# $bindtag should be for a widget that supports the +# standard scrollbar protocol. +# + +if {[tk windowingsystem] eq "x11"} { + bind TtkScrollable <ButtonPress-4> { %W yview scroll -5 units } + bind TtkScrollable <ButtonPress-5> { %W yview scroll 5 units } + bind TtkScrollable <Shift-ButtonPress-4> { %W xview scroll -5 units } + bind TtkScrollable <Shift-ButtonPress-5> { %W xview scroll 5 units } +} +if {[tk windowingsystem] eq "aqua"} { + bind TtkScrollable <MouseWheel> \ + { %W yview scroll [expr {-(%D)}] units } + bind TtkScrollable <Shift-MouseWheel> \ + { %W xview scroll [expr {-(%D)}] units } + bind TtkScrollable <Option-MouseWheel> \ + { %W yview scroll [expr {-10 * (%D)}] units } + bind TtkScrollable <Shift-Option-MouseWheel> \ + { %W xview scroll [expr {-10 * (%D)}] units } +} else { + bind TtkScrollable <MouseWheel> \ + { %W yview scroll [expr {-(%D / 120)}] units } + bind TtkScrollable <Shift-MouseWheel> \ + { %W xview scroll [expr {-(%D / 120)}] units } +} + +#*EOF* diff --git a/Master/tlpkg/tltcl/lib/tk8.6/ttk/vistaTheme.tcl b/Master/tlpkg/tltcl/lib/tk8.6/ttk/vistaTheme.tcl new file mode 100644 index 00000000000..094288ccc6f --- /dev/null +++ b/Master/tlpkg/tltcl/lib/tk8.6/ttk/vistaTheme.tcl @@ -0,0 +1,229 @@ +# +# Settings for Microsoft Windows Vista and Server 2008 +# + +# The Vista theme can only be defined on Windows Vista and above. The theme +# is created in C due to the need to assign a theme-enabled function for +# detecting when themeing is disabled. On systems that cannot support the +# Vista theme, there will be no such theme created and we must not +# evaluate this script. + +if {"vista" ni [ttk::style theme names]} { + return +} + +namespace eval ttk::theme::vista { + + ttk::style theme settings vista { + + ttk::style configure . \ + -background SystemButtonFace \ + -foreground SystemWindowText \ + -selectforeground SystemHighlightText \ + -selectbackground SystemHighlight \ + -insertcolor SystemWindowText \ + -font TkDefaultFont \ + ; + + ttk::style map "." \ + -foreground [list disabled SystemGrayText] \ + ; + + ttk::style configure TButton -anchor center -padding {1 1} -width -11 + ttk::style configure TRadiobutton -padding 2 + ttk::style configure TCheckbutton -padding 2 + ttk::style configure TMenubutton -padding {8 4} + + ttk::style element create Menubutton.dropdown vsapi \ + TOOLBAR 4 {{selected active} 6 {selected !active} 5 + disabled 4 pressed 3 active 2 {} 1} \ + -syssize {SM_CXVSCROLL SM_CYVSCROLL} + + ttk::style configure TNotebook -tabmargins {2 2 2 0} + 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 disabled SystemButtonFace \ + selected SystemHighlight] \ + -foreground [list disabled SystemGrayText \ + selected SystemHighlightText] + + # Label and Toolbutton + ttk::style configure TLabelframe.Label -foreground SystemButtonText + + ttk::style configure Toolbutton -padding {4 4} + + # Combobox + ttk::style configure TCombobox -padding 2 + ttk::style element create Combobox.border vsapi \ + COMBOBOX 4 {disabled 4 focus 3 active 2 hover 2 {} 1} + ttk::style element create Combobox.background vsapi \ + EDIT 3 {disabled 3 readonly 5 focus 4 hover 2 {} 1} + ttk::style element create Combobox.rightdownarrow vsapi \ + COMBOBOX 6 {disabled 4 pressed 3 active 2 {} 1} \ + -syssize {SM_CXVSCROLL SM_CYVSCROLL} + 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.background -sticky nswe -children { + Combobox.focus -expand 1 -sticky nswe -children { + Combobox.textarea -sticky nswe + } + } + } + } + } + # Vista.Combobox droplist frame + ttk::style element create ComboboxPopdownFrame.background vsapi\ + LISTBOX 3 {disabled 4 active 3 focus 2 {} 1} + ttk::style layout ComboboxPopdownFrame { + ComboboxPopdownFrame.background -sticky news -border 1 -children { + ComboboxPopdownFrame.padding -sticky news + } + } + ttk::style map TCombobox \ + -selectbackground [list !focus SystemWindow] \ + -selectforeground [list !focus SystemWindowText] \ + -foreground [list \ + disabled SystemGrayText \ + {readonly focus} SystemHighlightText \ + ] \ + -focusfill [list {readonly focus} SystemHighlight] \ + ; + + # Entry + ttk::style configure TEntry -padding {1 1 1 1} ;# Needs lookup + ttk::style element create Entry.field vsapi \ + EDIT 6 {disabled 4 focus 3 hover 2 {} 1} -padding {2 2 2 2} + ttk::style element create Entry.background vsapi \ + EDIT 3 {disabled 3 readonly 3 focus 4 hover 2 {} 1} + ttk::style layout TEntry { + Entry.field -sticky news -border 0 -children { + Entry.background -sticky news -children { + Entry.padding -sticky news -children { + Entry.textarea -sticky news + } + } + } + } + ttk::style map TEntry \ + -selectbackground [list !focus SystemWindow] \ + -selectforeground [list !focus SystemWindowText] \ + ; + + # Spinbox + ttk::style configure TSpinbox -padding 0 + ttk::style element create Spinbox.field vsapi \ + EDIT 9 {disabled 4 focus 3 hover 2 {} 1} -padding {1 1 1 2} + ttk::style element create Spinbox.background vsapi \ + EDIT 3 {disabled 3 readonly 3 focus 4 hover 2 {} 1} + ttk::style element create Spinbox.innerbg vsapi \ + EDIT 3 {disabled 3 readonly 3 focus 4 hover 2 {} 1}\ + -padding {2 0 15 2} + ttk::style element create Spinbox.uparrow vsapi \ + SPIN 1 {disabled 4 pressed 3 active 2 {} 1} \ + -padding 1 -halfheight 1 \ + -syssize { SM_CXVSCROLL SM_CYVSCROLL } + ttk::style element create Spinbox.downarrow vsapi \ + SPIN 2 {disabled 4 pressed 3 active 2 {} 1} \ + -padding 1 -halfheight 1 \ + -syssize { SM_CXVSCROLL SM_CYVSCROLL } + ttk::style layout TSpinbox { + Spinbox.field -sticky nswe -children { + Spinbox.background -sticky news -children { + Spinbox.padding -sticky news -children { + Spinbox.innerbg -sticky news -children { + Spinbox.textarea -expand 1 + } + } + Spinbox.uparrow -side top -sticky ens + Spinbox.downarrow -side bottom -sticky ens + } + } + } + ttk::style map TSpinbox \ + -selectbackground [list !focus SystemWindow] \ + -selectforeground [list !focus SystemWindowText] \ + ; + + + # SCROLLBAR elements (Vista includes a state for 'hover') + ttk::style element create Vertical.Scrollbar.uparrow vsapi \ + SCROLLBAR 1 {disabled 4 pressed 3 active 2 hover 17 {} 1} \ + -syssize {SM_CXVSCROLL SM_CYVSCROLL} + ttk::style element create Vertical.Scrollbar.downarrow vsapi \ + SCROLLBAR 1 {disabled 8 pressed 7 active 6 hover 18 {} 5} \ + -syssize {SM_CXVSCROLL SM_CYVSCROLL} + ttk::style element create Vertical.Scrollbar.trough vsapi \ + SCROLLBAR 7 {disabled 4 pressed 3 active 2 hover 5 {} 1} + ttk::style element create Vertical.Scrollbar.thumb vsapi \ + SCROLLBAR 3 {disabled 4 pressed 3 active 2 hover 5 {} 1} \ + -syssize {SM_CXVSCROLL SM_CYVSCROLL} + ttk::style element create Vertical.Scrollbar.grip vsapi \ + SCROLLBAR 9 {disabled 4 pressed 3 active 2 hover 5 {} 1} \ + -syssize {SM_CXVSCROLL SM_CYVSCROLL} + ttk::style element create Horizontal.Scrollbar.leftarrow vsapi \ + SCROLLBAR 1 {disabled 12 pressed 11 active 10 hover 19 {} 9} \ + -syssize {SM_CXHSCROLL SM_CYHSCROLL} + ttk::style element create Horizontal.Scrollbar.rightarrow vsapi \ + SCROLLBAR 1 {disabled 16 pressed 15 active 14 hover 20 {} 13} \ + -syssize {SM_CXHSCROLL SM_CYHSCROLL} + ttk::style element create Horizontal.Scrollbar.trough vsapi \ + SCROLLBAR 5 {disabled 4 pressed 3 active 2 hover 5 {} 1} + ttk::style element create Horizontal.Scrollbar.thumb vsapi \ + SCROLLBAR 2 {disabled 4 pressed 3 active 2 hover 5 {} 1} \ + -syssize {SM_CXHSCROLL SM_CYHSCROLL} + ttk::style element create Horizontal.Scrollbar.grip vsapi \ + SCROLLBAR 8 {disabled 4 pressed 3 active 2 hover 5 {} 1} + + # Progressbar + ttk::style element create Horizontal.Progressbar.pbar vsapi \ + PROGRESS 3 {{} 1} -padding 8 + ttk::style layout Horizontal.TProgressbar { + Horizontal.Progressbar.trough -sticky nswe -children { + Horizontal.Progressbar.pbar -side left -sticky ns + } + } + ttk::style element create Vertical.Progressbar.pbar vsapi \ + PROGRESS 3 {{} 1} -padding 8 + ttk::style layout Vertical.TProgressbar { + Vertical.Progressbar.trough -sticky nswe -children { + Vertical.Progressbar.pbar -side bottom -sticky we + } + } + + # Scale + ttk::style element create Horizontal.Scale.slider vsapi \ + 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 { + Horizontal.Scale.track -sticky we + Horizontal.Scale.slider -side left -sticky {} + } + } + } + ttk::style element create Vertical.Scale.slider vsapi \ + 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 { + Vertical.Scale.track -sticky ns + Vertical.Scale.slider -side top -sticky {} + } + } + } + + # Treeview + ttk::style configure Item -padding {4 0 0 0} + + package provide ttk::theme::vista 1.0 + } +} diff --git a/Master/tlpkg/tltcl/lib/tk8.6/ttk/winTheme.tcl b/Master/tlpkg/tltcl/lib/tk8.6/ttk/winTheme.tcl new file mode 100644 index 00000000000..db05b45c01e --- /dev/null +++ b/Master/tlpkg/tltcl/lib/tk8.6/ttk/winTheme.tcl @@ -0,0 +1,84 @@ +# +# Settings for 'winnative' theme. +# + +namespace eval ttk::theme::winnative { + ttk::style theme settings winnative { + + ttk::style configure "." \ + -background SystemButtonFace \ + -foreground SystemWindowText \ + -selectforeground SystemHighlightText \ + -selectbackground SystemHighlight \ + -fieldbackground SystemWindow \ + -insertcolor SystemWindowText \ + -troughcolor SystemScrollbar \ + -font TkDefaultFont \ + ; + + ttk::style map "." -foreground [list disabled SystemGrayText] ; + ttk::style map "." -embossed [list disabled 1] ; + + ttk::style configure TButton \ + -anchor center -width -11 -relief raised -shiftrelief 1 + ttk::style configure TCheckbutton -padding "2 4" + ttk::style configure TRadiobutton -padding "2 4" + ttk::style configure TMenubutton \ + -padding "8 4" -arrowsize 3 -relief raised + + ttk::style map TButton -relief {{!disabled pressed} sunken} + + ttk::style configure TEntry \ + -padding 2 -selectborderwidth 0 -insertwidth 1 + ttk::style map TEntry \ + -fieldbackground \ + [list readonly SystemButtonFace disabled SystemButtonFace] \ + -selectbackground [list !focus SystemWindow] \ + -selectforeground [list !focus SystemWindowText] \ + ; + + ttk::style configure TCombobox -padding 2 + ttk::style map TCombobox \ + -selectbackground [list !focus SystemWindow] \ + -selectforeground [list !focus SystemWindowText] \ + -fieldbackground [list \ + readonly SystemButtonFace \ + disabled SystemButtonFace] \ + -foreground [list \ + disabled SystemGrayText \ + {readonly focus} SystemHighlightText \ + ] \ + -focusfill [list {readonly focus} SystemHighlight] \ + ; + + ttk::style element create ComboboxPopdownFrame.border from default + ttk::style configure ComboboxPopdownFrame \ + -borderwidth 1 -relief solid + + ttk::style configure TSpinbox -padding {2 0 16 0} + + ttk::style configure TLabelframe -borderwidth 2 -relief groove + + ttk::style configure Toolbutton -relief flat -padding {8 4} + ttk::style map Toolbutton -relief \ + {disabled flat selected sunken pressed sunken active raised} + + ttk::style configure TScale -groovewidth 4 + + ttk::style configure TNotebook -tabmargins {2 2 2 0} + ttk::style configure TNotebook.Tab -padding {3 1} -borderwidth 1 + ttk::style map TNotebook.Tab -expand [list selected {2 2 2 0}] + + # Treeview: + ttk::style configure Heading -font TkHeadingFont -relief raised + ttk::style configure Treeview -background SystemWindow + ttk::style map Treeview \ + -background [list disabled SystemButtonFace \ + selected SystemHighlight] \ + -foreground [list disabled SystemGrayText \ + selected SystemHighlightText] + + ttk::style configure TProgressbar \ + -background SystemHighlight -borderwidth 0 ; + } +} diff --git a/Master/tlpkg/tltcl/lib/tk8.6/ttk/xpTheme.tcl b/Master/tlpkg/tltcl/lib/tk8.6/ttk/xpTheme.tcl new file mode 100644 index 00000000000..4c4f6806a42 --- /dev/null +++ b/Master/tlpkg/tltcl/lib/tk8.6/ttk/xpTheme.tcl @@ -0,0 +1,74 @@ +# +# Settings for 'xpnative' theme +# + +namespace eval ttk::theme::xpnative { + + ttk::style theme settings xpnative { + + ttk::style configure . \ + -background SystemButtonFace \ + -foreground SystemWindowText \ + -selectforeground SystemHighlightText \ + -selectbackground SystemHighlight \ + -insertcolor SystemWindowText \ + -font TkDefaultFont \ + ; + + ttk::style map "." \ + -foreground [list disabled SystemGrayText] \ + ; + + ttk::style configure TButton -anchor center -padding {1 1} -width -11 + ttk::style configure TRadiobutton -padding 2 + ttk::style configure TCheckbutton -padding 2 + ttk::style configure TMenubutton -padding {8 4} + + ttk::style configure TNotebook -tabmargins {2 2 2 0} + 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. + ttk::style configure TEntry -padding {2 2 2 4} + ttk::style map TEntry \ + -selectbackground [list !focus SystemWindow] \ + -selectforeground [list !focus SystemWindowText] \ + ; + ttk::style configure TCombobox -padding 2 + ttk::style map TCombobox \ + -selectbackground [list !focus SystemWindow] \ + -selectforeground [list !focus SystemWindowText] \ + -foreground [list \ + disabled SystemGrayText \ + {readonly focus} SystemHighlightText \ + ] \ + -focusfill [list {readonly focus} SystemHighlight] \ + ; + + ttk::style configure TSpinbox -padding {2 0 14 0} + ttk::style map TSpinbox \ + -selectbackground [list !focus SystemWindow] \ + -selectforeground [list !focus SystemWindowText] \ + ; + + ttk::style configure Toolbutton -padding {4 4} + + # Treeview: + ttk::style configure Heading -font TkHeadingFont -relief raised + ttk::style configure Treeview -background SystemWindow + ttk::style map Treeview \ + -background [list disabled SystemButtonFace \ + selected SystemHighlight] \ + -foreground [list disabled SystemGrayText \ + selected SystemHighlightText]; + } +} |