diff options
Diffstat (limited to 'library')
29 files changed, 5035 insertions, 7 deletions
diff --git a/library/demos/ttk_demo.tcl b/library/demos/ttk_demo.tcl new file mode 100644 index 0000000..0686b62 --- /dev/null +++ b/library/demos/ttk_demo.tcl @@ -0,0 +1,883 @@ +# +# $Id: ttk_demo.tcl,v 1.1 2006/10/31 01:42:26 hobbs Exp $ +# +# Tile widget set -- widget demo +# +package require Tk 8.5 + +eval destroy [winfo children .] ;# in case script is re-sourced + +### Load auxilliary scripts. +# +variable demodir [file dirname [info script]] +lappend auto_path . $demodir + +source [file join $demodir ttk_iconlib.tcl] +source [file join $demodir ttk_repeater.tcl] + +# This forces an update of the available packages list. +# It's required for package names to find the themes in demos/themes/*.tcl +eval [package unknown] Tcl [package provide Tcl] + +### Global options and bindings. +# +option add *Button.default normal +option add *Text.background white +option add *Entry.background white +option add *tearOff false + +# See toolbutton.tcl. +# +option add *Toolbar.relief groove +option add *Toolbar.borderWidth 2 +option add *Toolbar.Button.Pad 2 +option add *Toolbar.Button.default disabled +option add *Toolbar*takeFocus 0 + +# ... for debugging: +bind all <ButtonPress-3> { set ::W %W } +bind all <Control-ButtonPress-3> { focus %W } + +# Stealth feature: +# +if {![catch {package require Img 1.3}]} { + bind all <Control-Shift-Alt-KeyPress-S> screenshot + proc screenshot {} { + image create photo ScreenShot -format window -data . + bell + # Gamma looks off if we use PNG ... + # Looks even worse if we use GIF ... + ScreenShot write screenshot.png -format png + image delete ScreenShot + bell + } +} + +### Global data. +# + +# The descriptive names of the builtin themes: +# +set ::THEMELIST { + default "Default" + classic "Classic" + alt "Revitalized" + winnative "Windows native" + xpnative "XP Native" + aqua "Aqua" +} +array set ::THEMES $THEMELIST; + +# Add in any available loadable themes: +# +foreach name [ttk::themes] { + if {![info exists ::THEMES($name)]} { + lappend THEMELIST $name [set ::THEMES($name) [string totitle $name]] + } +} + +# Generate icons (see also: iconlib.tcl): +# +foreach {icon data} [array get ::ImgData] { + set ::ICON($icon) [image create photo -data $data] +} + +variable ROOT "." +variable BASE [ttk::frame .base] +pack $BASE -side top -expand true -fill both + +array set ::V { + COMPOUND top + CONSOLE 0 + MENURADIO1 One + PBMODE determinate + SELECTED 1 + CHOICE 2 + SCALE 50 + VSCALE 0 +} + +### Utilities. +# + +## foreachWidget varname widget script -- +# Execute $script with $varname set to each widget in the hierarchy. +# +proc foreachWidget {varname Q script} { + upvar 1 $varname w + while {[llength $Q]} { + set QN [list] + foreach w $Q { + uplevel 1 $script + foreach child [winfo children $w] { + lappend QN $child + } + } + set Q $QN + } +} + +## sbstub $sb -- stub -command option for a scrollbar. +# Updates the scrollbar's position. +# +proc sbstub {sb cmd number {units units}} { sbstub.$cmd $sb $number $units } +proc sbstub.moveto {sb number _} { $sb set $number [expr {$number + 0.5}] } +proc sbstub.scroll {sb number units} { + if {$units eq "pages"} { + set delta 0.2 + } else { + set delta 0.05 + } + set current [$sb get] + set new0 [expr {[lindex $current 0] + $delta*$number}] + set new1 [expr {[lindex $current 1] + $delta*$number}] + $sb set $new0 $new1 +} + +## sbset $sb -- auto-hide scrollbar +# Scrollable widget -[xy]scrollcommand prefix. +# Sets the scrollbar, auto-hides/shows. +# Scrollbar must be controlled by the grid geometry manager. +# +proc sbset {sb first last} { + if {$first <= 0 && $last >= 1} { + grid remove $sb + } else { + grid $sb + } + $sb set $first $last +} + +## scrolled -- create a widget with attached scrollbars. +# +proc scrolled {class w args} { + set sf "${w}_sf" + + frame $sf + eval [linsert $args 0 $class $w] + scrollbar $sf.hsb -orient horizontal -command [list $w xview] + scrollbar $sf.vsb -orient vertical -command [list $w yview] + + configure.scrolled $sf $w + return $sf +} + +## ttk::scrolled -- create a widget with attached Ttk scrollbars. +# +proc ttk::scrolled {class w args} { + set sf "${w}_sf" + + ttk::frame $sf + eval [linsert $args 0 $class $w] + ttk::scrollbar $sf.hsb -orient horizontal -command [list $w xview] + ttk::scrollbar $sf.vsb -orient vertical -command [list $w yview] + + configure.scrolled $sf $w + return $sf +} + +## configure.scrolled -- common factor of [scrolled] and [ttk::scrolled] +# +proc configure.scrolled {sf w} { + $w configure -xscrollcommand [list $sf.hsb set] + $w configure -yscrollcommand [list $sf.vsb set] + + grid $w -in $sf -row 0 -column 0 -sticky nwse + grid $sf.hsb -row 1 -column 0 -sticky we + grid $sf.vsb -row 0 -column 1 -sticky ns + + grid columnconfigure $sf 0 -weight 1 + grid rowconfigure $sf 0 -weight 1 +} + +### Toolbars. +# +proc makeToolbars {} { + set buttons [list open new save] + set checkboxes [list bold italic] + + # + # Ttk toolbar: + # + set tb [ttk::frame $::BASE.tbar_styled -class Toolbar] + set i 0 + foreach icon $buttons { + set b [ttk::button $tb.tb[incr i] \ + -text $icon -image $::ICON($icon) -compound $::V(COMPOUND) \ + -style Toolbutton] + grid $b -row 0 -column $i -sticky news + } + ttk::separator $tb.sep -orient vertical + grid $tb.sep -row 0 -column [incr i] -sticky news -padx 2 -pady 2 + foreach icon $checkboxes { + set b [ttk::checkbutton $tb.cb[incr i] \ + -variable ::V($icon) \ + -text $icon -image $::ICON($icon) -compound $::V(COMPOUND) \ + -style Toolbutton] + grid $b -row 0 -column $i -sticky news + } + + ttk::menubutton $tb.compound \ + -text "toolbar" -image $::ICON(file) -compound $::V(COMPOUND) + $tb.compound configure -menu [makeCompoundMenu $tb.compound.menu] + grid $tb.compound -row 0 -column [incr i] -sticky news + + grid columnconfigure $tb [incr i] -weight 1 + + # + # Standard toolbar: + # + set tb [frame $::BASE.tbar_orig -class Toolbar] + set i 0 + foreach icon $buttons { + set b [button $tb.tb[incr i] \ + -text $icon -image $::ICON($icon) -compound $::V(COMPOUND) \ + -relief flat -overrelief raised] + grid $b -row 0 -column $i -sticky news + } + frame $tb.sep -borderwidth 1 -width 2 -relief sunken + grid $tb.sep -row 0 -column [incr i] -sticky news -padx 2 -pady 2 + foreach icon $checkboxes { + set b [checkbutton $tb.cb[incr i] -variable ::V($icon) \ + -text $icon -image $::ICON($icon) -compound $::V(COMPOUND) \ + -indicatoron false \ + -selectcolor {} \ + -relief flat \ + -overrelief raised \ + -offrelief flat] + grid $b -row 0 -column $i -sticky news + } + + menubutton $tb.compound \ + -text "toolbar" -image $::ICON(file) -compound $::V(COMPOUND) \ + -indicatoron true + $tb.compound configure -menu [makeCompoundMenu $tb.compound.menu] + grid $tb.compound -row 0 -column [incr i] -sticky news + + grid columnconfigure $tb [incr i] -weight 1 +} + +# +# Toolbar -compound control: +# +proc makeCompoundMenu {menu} { + variable compoundStrings {text image none top bottom left right center} + menu $menu + foreach string $compoundStrings { + $menu add radiobutton \ + -label [string totitle $string] \ + -variable ::V(COMPOUND) -value $string \ + -command changeToolbars ; + } + return $menu +} + +proc changeToolbars {} { + foreachWidget w [list $::BASE.tbar_styled $::BASE.tbar_orig] { + catch { $w configure -compound $::V(COMPOUND) } + } +} + +makeToolbars + +### Theme control panel. +# +proc makeThemeControl {c} { + ttk::labelframe $c -text "Theme" + foreach {theme name} $::THEMELIST { + set b [ttk::radiobutton $c.s$theme -text $name \ + -variable ::ttk::currentTheme -value $theme \ + -command [list ttk::setTheme $theme]] + pack $b -side top -expand false -fill x + if {[lsearch -exact [package names] ttk::theme::$theme] == -1} { + $c.s$theme state disabled + } + } + return $c +} +makeThemeControl $::BASE.control + +### Notebook widget. +# +set nb [ttk::notebook $::BASE.nb] +ttk::notebook::enableTraversal $nb + +### Main demo pane. +# +# Side-by comparison of Ttk vs. core widgets. +# + + +set pw [ttk::panedwindow $nb.client -orient horizontal] +$nb add $pw -text "Demo" -underline 0 -padding 6 +set l [ttk::labelframe $pw.l -text "Themed" -padding 6 -underline 1] +set r [labelframe $pw.r -text "Standard" -padx 6 -pady 6] +$pw add $l -weight 1; $pw add $r -weight 1 + +## menubuttonMenu -- demo menu for menubutton widgets. +# +proc menubuttonMenu {menu} { + menu $menu + foreach dir {above below left right flush} { + $menu add command -label [string totitle $dir] \ + -command [list [winfo parent $menu] configure -direction $dir] + } + $menu add cascade -label "Submenu" -menu [set submenu [menu $menu.submenu]] + $submenu add command -label "Subcommand 1" + $submenu add command -label "Subcommand 2" + $submenu add command -label "Subcommand 3" + $menu add separator + $menu add command -label "Quit" -command [list destroy .] + + return $menu +} + +## Main demo pane - themed widgets. +# +ttk::checkbutton $l.cb -text "Checkbutton" -variable ::V(SELECTED) -underline 2 +ttk::radiobutton $l.rb1 -text "One" -variable ::V(CHOICE) -value 1 -underline 0 +ttk::radiobutton $l.rb2 -text "Two" -variable ::V(CHOICE) -value 2 +ttk::radiobutton $l.rb3 -text "Three" -variable ::V(CHOICE) -value 3 -under 0 +ttk::button $l.button -text "Button" -underline 0 + +ttk::menubutton $l.mb -text "Menubutton" -underline 2 +$l.mb configure -menu [menubuttonMenu $l.mb.menu] + +set ::entryText "Entry widget" +ttk::entry $l.e -textvariable ::entryText +$l.e selection range 6 end + +set ltext [ttk::scrolled text $l.t -width 12 -height 5 -wrap none] + +grid $l.cb -sticky ew +grid $l.rb1 -sticky ew +grid $l.rb2 -sticky ew +grid $l.rb3 -sticky ew +grid $l.button -sticky ew -padx 2 -pady 2 +grid $l.mb -sticky ew -padx 2 -pady 2 +grid $l.e -sticky ew -padx 2 -pady 2 +grid $ltext -sticky news + +grid columnconfigure $l 0 -weight 1 +grid rowconfigure $l 7 -weight 1 ; # text widget (grid is a PITA) + +## Main demo pane - core widgets. +# +checkbutton $r.cb -text "Checkbutton" -variable ::V(SELECTED) +radiobutton $r.rb1 -text "One" -variable ::V(CHOICE) -value 1 +radiobutton $r.rb2 -text "Two" -variable ::V(CHOICE) -value 2 -underline 1 +radiobutton $r.rb3 -text "Three" -variable ::V(CHOICE) -value 3 +button $r.button -text "Button" +menubutton $r.mb -text "Menubutton" -underline 3 -takefocus 1 +$r.mb configure -menu [menubuttonMenu $r.mb.menu] +# Add -indicatoron control: +set ::V(rmbIndicatoron) [$r.mb cget -indicatoron] +$r.mb.menu insert 0 checkbutton -label "Indicator?" \ + -variable ::V(rmbIndicatoron) \ + -command "$r.mb configure -indicatoron \$::V(rmbIndicatoron)" ; +$r.mb.menu insert 1 separator + +entry $r.e -textvariable ::entryText + +set rtext [scrolled text $r.t -width 12 -height 5 -wrap none] + +grid $r.cb -sticky ew +grid $r.rb1 -sticky ew +grid $r.rb2 -sticky ew +grid $r.rb3 -sticky ew +grid $r.button -sticky ew -padx 2 -pady 2 +grid $r.mb -sticky ew -padx 2 -pady 2 +grid $r.e -sticky ew -padx 2 -pady 2 +grid $rtext -sticky news + +grid columnconfigure $r 0 -weight 1 +grid rowconfigure $r 7 -weight 1 ; # text widget + +# +# Add some text to the text boxes: +# + +set cb $::BASE.tbar_orig.cb5 +set txt "checkbutton $cb \\\n" +foreach copt [$cb configure] { + if {[llength $copt] == 5} { + append txt " [lindex $copt 0] [lindex $copt 4] \\\n" + } +} +append txt " ;\n" + +$l.t insert end $txt +$r.t insert end $txt + +### Scales and sliders pane. +# +proc scales.pane {scales} { + ttk::frame $scales + + ttk::panedwindow $scales.pw -orient horizontal + set l [ttk::labelframe $scales.styled -text "Themed" -padding 6] + set r [labelframe $scales.orig -text "Standard" -padx 6 -pady 6] + + ttk::scale $l.scale -orient horizontal -from 0 -to 100 -variable ::V(SCALE) + ttk::scale $l.vscale -orient vertical -from 100 -to 0 -variable ::V(VSCALE) + ttk::progressbar $l.progress -orient horizontal -maximum 100 + ttk::progressbar $l.vprogress -orient vertical -maximum 100 + if {1} { + $l.scale configure -command [list $l.progress configure -value] + $l.vscale configure -command [list $l.vprogress configure -value] + } else { + # This would also work, but the Tk scale widgets + # in the right hand pane cause some interference when + # in autoincrement/indeterminate mode. + # + $l.progress configure -variable ::V(SCALE) + $l.vprogress configure -variable ::V(VSCALE) + } + + $l.scale set 50 + $l.vscale set 50 + + ttk::label $l.lmode -text "Progress bar mode:" + ttk::radiobutton $l.pbmode0 -variable ::V(PBMODE) \ + -text determinate -value determinate -command [list pbMode $l] + ttk::radiobutton $l.pbmode1 -variable ::V(PBMODE) \ + -text indeterminate -value indeterminate -command [list pbMode $l] + proc pbMode {l} { + variable V + $l.progress configure -mode $V(PBMODE) + $l.vprogress configure -mode $V(PBMODE) + } + + ttk::button $l.start -text "Start" -command [list pbStart $l] + proc pbStart {l} { + set ::V(PBMODE) indeterminate; pbMode $l + $l.progress start 10 + $l.vprogress start + } + + ttk::button $l.stop -text "Stop" -command [list pbStop $l] + proc pbStop {l} { + $l.progress stop + $l.vprogress stop + } + + grid $l.scale -columnspan 2 -sticky ew + grid $l.progress -columnspan 2 -sticky ew + grid $l.vscale $l.vprogress -sticky nws + + grid $l.lmode -sticky we -columnspan 2 + grid $l.pbmode0 -sticky we -columnspan 2 + grid $l.pbmode1 -sticky we -columnspan 2 + grid $l.start -sticky we -columnspan 2 + grid $l.stop -sticky we -columnspan 2 + + grid columnconfigure $l 0 -weight 1 + grid columnconfigure $l 1 -weight 1 + + grid rowconfigure $l 99 -weight 1 + + scale $r.scale -orient horizontal -from 0 -to 100 -variable ::V(SCALE) + scale $r.vscale -orient vertical -from 100 -to 0 -variable ::V(VSCALE) + grid $r.scale -sticky news + grid $r.vscale -sticky nws + + grid rowconfigure $r 99 -weight 1 + grid columnconfigure $r 0 -weight 1 + + ## + $scales.pw add $l -weight 1 + $scales.pw add $r -weight 1 + pack $scales.pw -expand true -fill both + + return $scales +} +$nb add [scales.pane $nb.scales] -text Scales -sticky nwes -padding 6 + +### Combobox demo pane. +# +proc combobox.pane {cbf} { + ttk::frame $cbf + set values [list abc def ghi jkl mno pqr stu vwx yz] + pack \ + [ttk::combobox $cbf.cb1 -values $values -textvariable ::COMBO] \ + [ttk::combobox $cbf.cb2 -values $values -textvariable ::COMBO ] \ + -side top -padx 2 -pady 2 -expand false -fill x; + $cbf.cb2 configure -state readonly + $cbf.cb1 current 3 + return $cbf +} +$nb add [combobox.pane $nb.combos] -text "Combobox" -underline 7 + +### Treeview widget demo pane. +# +proc tree.pane {w} { + ttk::frame $w + ttk::scrollbar $w.vsb -command [list $w.t yview] + ttk::treeview $w.t -columns [list Class] \ + -padding 4 \ + -yscrollcommand [list sbset $w.vsb] + + grid $w.t $w.vsb -sticky nwse + grid columnconfigure $w 0 -weight 1 + grid rowconfigure $w 0 -weight 1 + grid propagate $w 0 + + # + # Add initial tree node: + # Later nodes will be added in <<TreeviewOpen>> binding. + # + $w.t insert {} 0 -id . -text "Main Window" -open 0 \ + -values [list [winfo class .]] + $w.t heading \#0 -text "Widget" + $w.t heading Class -text "Class" + bind $w.t <<TreeviewOpen>> [list fillTree $w.t] + + return $w +} + +# fillTree -- <<TreeviewOpen>> binding for tree widget. +# +proc fillTree {tv} { + set id [$tv focus] + if {![winfo exists $id]} { + $tv delete $id + return + } + + # + # Replace tree item children with current list of child windows. + # + $tv delete [$tv children $id] + set children [winfo children $id] + foreach child $children { + $tv insert $id end -id $child -text [winfo name $child] -open 0 \ + -values [list [winfo class $child]] + if {[llength [winfo children $child]]} { + # insert dummy child to show [+] indicator + $tv insert $child end + } + } +} + +if {[llength [info commands ttk::treeview]]} { + $nb add [tree.pane $nb.tree] -text "Tree" -sticky news +} + +### Other demos. +# +$nb add [ttk::frame $nb.others] -text "Others" -underline 4 + +set Timers(StateMonitor) {} +set Timers(FocusMonitor) {} + +set others $::BASE.nb.others + +ttk::label $others.m -justify left -wraplength 300 +bind ShowDescription <Enter> { $BASE.nb.others.m configure -text $Desc(%W) } +bind ShowDescription <Leave> { $BASE.nb.others.m configure -text "" } + +foreach {command label description} { + trackStates "Widget states..." + "Display/modify widget state bits" + + scrollbarResizeDemo "Scrollbar resize behavior..." + "Shows how Ttk and standard scrollbars differ when they're sized too large" + + trackFocus "Track keyboard focus..." + "Display the name of the widget that currently has focus" + + repeatDemo "Repeating buttons" + "Demonstrates custom classes (see demos/repeater.tcl)" + +} { + set b [ttk::button $others.$command -text $label -command $command] + set Desc($b) $description + bindtags $b [lreplace [bindtags $b] end 0 ShowDescription] + + pack $b -side top -expand false -fill x -padx 6 -pady 6 +} + +pack $others.m -side bottom -expand true -fill both + + +### Scrollbar resize demo. +# +proc scrollbarResizeDemo {} { + set t .scrollbars + destroy $t + toplevel $t ; wm geometry $t 200x200 + frame $t.f -height 200 + grid \ + [ttk::scrollbar $t.f.tsb -command [list sbstub $t.f.tsb]] \ + [scrollbar $t.f.sb -command [list sbstub $t.f.sb]] \ + -sticky news + + $t.f.sb set 0 0.5 ;# prevent backwards-compatibility mode for old SB + + grid columnconfigure $t.f 0 -weight 1 + grid columnconfigure $t.f 1 -weight 1 + grid rowconfigure $t.f 0 -weight 1 + pack $t.f -expand true -fill both +} + +### Track focus demo. +# +proc trackFocus {} { + global Focus + set t .focus + destroy $t + toplevel $t + wm title $t "Keyboard focus" + set i 0 + foreach {label variable} { + "Focus widget:" Focus(Widget) + "Class:" Focus(WidgetClass) + "Next:" Focus(WidgetNext) + "Grab:" Focus(Grab) + "Status:" Focus(GrabStatus) + } { + grid [ttk::label $t.l$i -text $label -anchor e] \ + [ttk::label $t.v$i -textvariable $variable \ + -width 40 -anchor w -relief groove] \ + -sticky ew; + incr i + } + grid columnconfigure $t 1 -weight 1 + grid rowconfigure $t $i -weight 1 + + bind $t <Destroy> {after cancel $Timers(FocusMonitor)} + FocusMonitor +} + +proc FocusMonitor {} { + global Focus + + set Focus(Widget) [focus] + if {$::Focus(Widget) ne ""} { + set Focus(WidgetClass) [winfo class $Focus(Widget)] + set Focus(WidgetNext) [tk_focusNext $Focus(Widget)] + } else { + set Focus(WidgetClass) [set Focus(WidgetNext) ""] + } + + set Focus(Grab) [grab current] + if {$Focus(Grab) ne ""} { + set Focus(GrabStatus) [grab status $Focus(Grab)] + } else { + set Focus(GrabStatus) "" + } + + set ::Timers(FocusMonitor) [after 200 FocusMonitor] +} + +### Widget states demo. +# +variable Widget .tbar_styled.tb1 + +bind all <Control-Shift-ButtonPress-1> { TrackWidget %W ; break } + +proc TrackWidget {w} { + set ::Widget $w ; + if {[winfo exists .states]} { + UpdateStates + } else { + trackStates + } +} + +variable states [list \ + active disabled focus pressed selected readonly \ + background alternate invalid] + +proc trackStates {} { + variable states + set t .states + destroy $t; toplevel $t ; wm title $t "Widget states" + + set tf [ttk::frame $t.f] ; pack $tf -expand true -fill both + + ttk::label $tf.info -text "Press Control-Shift-Button-1 on any widget" + + ttk::label $tf.lw -text "Widget:" -anchor e -relief groove + ttk::label $tf.w -textvariable ::Widget -anchor w -relief groove + + grid $tf.info - -sticky ew -padx 6 -pady 6 + grid $tf.lw $tf.w -sticky ew + + foreach state $states { + ttk::checkbutton $tf.s$state \ + -text $state \ + -variable ::State($state) \ + -command [list ChangeState $state] ; + grid x $tf.s$state -sticky nsew + } + + grid columnconfigure $tf 1 -weight 1 + + grid x [ttk::frame $tf.cmd] -sticky nse + grid x \ + [ttk::button $tf.cmd.close -text Close -command [list destroy $t]] \ + -padx 4 -pady {6 4}; + grid columnconfigure $tf.cmd 0 -weight 1 + + bind $t <KeyPress-Escape> [list event generate $tf.cmd.close <<Invoke>>] + bind $t <Destroy> { after cancel $::Timers(StateMonitor) } + StateMonitor +} + +proc StateMonitor {} { + if {$::Widget ne ""} { UpdateStates } + set ::Timers(StateMonitor) [after 200 StateMonitor] +} + +proc UpdateStates {} { + variable states + variable State + variable Widget + + foreach state $states { + if {[catch {set State($state) [$Widget instate $state]}]} { + # Not a Ttk widget: + .states.f.s$state state disabled + } else { + .states.f.s$state state !disabled + } + } +} + +proc ChangeState {state} { + variable State + variable Widget + if {$Widget ne ""} { + if {$State($state)} { + $Widget state $state + } else { + $Widget state !$state + } + } +} + +### Repeating button demo. +# + +proc repeatDemo {} { + set top .repeatDemo + if {![catch { wm deiconify $top ; raise $top }]} { return } + toplevel $top + wm title $top "Repeating button" + keynav::enableMnemonics $top + + set f [ttk::frame .repeatDemo.f] + ttk::button $f.b -class Repeater -text "Press and hold" \ + -command [list $f.p step] + ttk::progressbar $f.p -orient horizontal -maximum 10 + + ttk::separator $f.sep -orient horizontal + set cmd [ttk::frame $f.cmd] + pack \ + [ttk::button $cmd.close -text Close -command [list destroy $top]] \ + -side right -padx 6; + + pack $f.cmd -side bottom -expand false -fill x -padx 6 -pady 6 + pack $f.sep -side bottom -expand false -fill x -padx 6 -pady 6 + pack $f.b -side left -expand false -fill none -padx 6 -pady 6 + pack $f.p -side right -expand true -fill x -padx 6 -pady 6 + + $f.b configure -underline 0 + $cmd.close configure -underline 0 + bind $top <KeyPress-Escape> [list event generate $cmd.close <<Invoke>>] + + pack $f -expand true -fill both +} + + +### Command box. +# +set cmd [ttk::frame $::BASE.command] +ttk::button $cmd.close -text Close -underline 0 -command [list destroy .] +ttk::button $cmd.help -text Help -command showHelp + +proc showHelp {} { + if {![winfo exists .helpDialog]} { + lappend detail "Tk version $::tk_version" + lappend detail "Ttk library: $::ttk::library" + ttk::dialog .helpDialog -type ok -icon info \ + -message "Ttk demo" -detail [join $detail \n] + } +} + +grid x $cmd.close $cmd.help -pady 6 -padx 6 +grid columnconfigure $cmd 0 -weight 1 + +## Status bar (to demonstrate size grip) +# +set statusbar [ttk::frame $BASE.statusbar] +pack [ttk::sizegrip $statusbar.grip] -side right -anchor se + +## Accelerators: +# +bind $::ROOT <KeyPress-Escape> [list event generate $cmd.close <<Invoke>>] +bind $::ROOT <<Help>> [list event generate $cmd.help <<Invoke>>] +keynav::enableMnemonics $::ROOT +keynav::defaultButton $cmd.help + +### Menubar. +# +set menu [menu $::BASE.menu] +$::ROOT configure -menu $menu +$menu add cascade -label "File" -underline 0 -menu [menu $menu.file] +$menu.file add command -label "Open" -underline 0 \ + -compound left -image $::ICON(open) +$menu.file add command -label "Save" -underline 0 \ + -compound left -image $::ICON(save) +$menu.file add separator +$menu.file add checkbutton -label "Checkbox" -underline 0 \ + -variable ::V(SELECTED) +$menu.file add cascade -label "Choices" -underline 1 \ + -menu [menu $menu.file.choices] +foreach {label value} {One 1 Two 2 Three 3} { + $menu.file.choices add radiobutton \ + -label $label -variable ::V(CHOICE) -value $value +} + +$menu.file insert end separator +if {[tk windowingsystem] ne "x11"} { + $menu.file insert end checkbutton -label Console -underline 5 \ + -variable ::V(CONSOLE) -command toggleconsole + proc toggleconsole {} { + if {$::V(CONSOLE)} {console show} else {console hide} + } +} +$menu.file add command -label "Exit" -underline 1 \ + -command [list event generate $cmd.close <<Invoke>>] + +# Add Theme menu. +# +proc makeThemeMenu {menu} { + menu $menu + foreach {theme name} $::THEMELIST { + $menu add radiobutton -label $name \ + -variable ::ttk::currentTheme -value $theme \ + -command [list ttk::setTheme $theme] + if {[lsearch -exact [package names] ttk::theme::$theme] == -1} { + $menu entryconfigure end -state disabled + } + } + return $menu +} + +$menu add cascade -label "Theme" -underline 3 -menu [makeThemeMenu $menu.theme] + +### Main window layout. +# + +pack $BASE.statusbar -side bottom -expand false -fill x +pack $BASE.command -side bottom -expand false -fill x +pack $BASE.tbar_styled -side top -expand false -fill x +pack $BASE.tbar_orig -side top -expand false -fill x +pack $BASE.control -side left -expand false -fill y -padx 6 -pady 6 +pack $BASE.nb -side left -expand true -fill both -padx 6 -pady 6 + +wm title $ROOT "Ttk demo" +wm iconname $ROOT "Ttk demo" +update; wm deiconify $ROOT diff --git a/library/demos/ttk_iconlib.tcl b/library/demos/ttk_iconlib.tcl new file mode 100644 index 0000000..9a93ece --- /dev/null +++ b/library/demos/ttk_iconlib.tcl @@ -0,0 +1,110 @@ +array set ImgData { +bold {R0lGODlhEAAQAJEAANnZ2QAAAP///////yH5BAEAAAAALAAAAAAQABAAAAI6hI+py60U3wj+ +RYQFJYRvEWFBCeFbRFhQQvhG8YPgX0RYUEL4FhEWlBC+RYQFJYQPFN8IPqYut/8hBQA7} +copy {R0lGODlhEAAQAJEAANnZ2QAAAP///wAAhCH5BAEAAAAALAAAAAAQABAAAAJUhI8JFJ/gY4iI +UEL4FyIiFIXgW0iEUDgfACBI9pzMAAGRiIghWSMDECR7JEKGtkFIRFBG+TIQKDQxtgzcDcmX +IfgwQrFlCD4MyZch+EDzj+Bj6mYBADs=} +cut {R0lGODlhEAAQAJEAANnZ2QAAAAAAhP///yH5BAEAAAAALAAAAAAQABAAAAJFhI+pcUHwEeIi +E0gACIKPEAFBIXy0gMg8EhM+YmQiKSL4eAIiJMI/EQEhQGYGYiQIQAg+iAkIATIzECMBIgT/ +RBARERlSADs=} +dragfile {R0lGODlhGAAYAKIAANnZ2TMzM////wAAAJmZmf///////////yH5BAEAAAAALAAAAAAYABgA +AAPACBi63IqgC4GiyxwogaAbKLrMgSKBoBoousyBogEACIGiyxwoKgGAECI4uiyCExMTOACB +osuNpDoAGCI4uiyCIkREOACBosutSDoAgSI4usyCIjQAGCi63Iw0ACEoOLrMgiI0ABgoutyM +NAAhKDi6zIIiNAAYKLrcjDQAISg4usyCIjQAGCi63Iw0AIGiiqPLIyhCA4CBosvNSAMQKKo4 +ujyCIjQAGCi63Iw0AIGiy81IAxCBpMu9GAMAgKPL3QgJADs=} +dragicon {R0lGODlhGAAYALMAANnZ2TMzM/////8zM8zMzGYAAAAAAJmZmQCZMwAzZgCZzGZmZv////// +/////////yH5BAEAAAAALAAAAAAYABgAAAT/EMAgJ60SAjlBgEJOSoMIEMgZoJCT0iADBFIG +KOSkNMwAAABhwiHnIEKIIIQQAQIZhBBwyDmKEMIEE0yABoAghIBDzlGEENDIaQAIQgg45BwF +CinPOccAECYcUiKEEBFCiHPgMQAEIcQYYyABBUGIQCHlMQCEScZAAhKEEApCECGOARAEIQQp +BRGIpAyCJCGOASBAISdEcqJAVBLiGABggELOAJGUKyiVhDgGABigkJMEhNAKSqkEhTgGgCCl +FCQEGIJSSiUhjgEgQCEnJVBJmYQ4BoAAhZyTQCVnEuIYAAIUckoCk5xSiGMACFDISSs9BoBg +rRXQMQAEKOSklR4DEUAI8MhJ6wwGAACgkZNWCkAEADs=} +error {R0lGODlhIAAgAKIAANnZ2YQAAP8AAISEhP///////////////yH5BAEAAAAALAAAAAAgACAA +AAP/CLoMGLqKoMvtGIqiqxEYCLrcioGiyxwIusyBgaLLLRiBoMsQKLrcjYGgu4Giy+2CAkFX +A0WX2wXFIOgGii7trkCEohsDCACBoktEKLpKhISiGwAIECiqSKooukiqKKoxgACBooukKiIo +SKooujGDECi6iqQqsopEV2MQAkV3kXQZRXdjEAJFl5F0FUWXY3ACRZcFSRdFlyVwJlB0WZB0 +UXRZAmcCRZeRdBVFl2NwAkV3kXQZRXdjcAJFV5FURVaR6GoMDgSKLpKqiKAgqaLoxgwOBIoq +kiqKLpIqimrM4ECg6BIRiq4SIaHoxgyCBoou7a5AhKIbMzgAAIGiy+2CTWJmBhAAAkWX2wXF +zCDoBooud2PMDIKuRqDocgtGzMwg6O4Eii5z4Kgi6DIMhqLoagQGjiqCLvPgYOgqji6CLrfi +6DIj6HI7jq4i6DIkADs=} +file {R0lGODlhCwANAJEAANnZ2QAAAP///////yH5BAEAAAAALAAAAAALAA0AAAIyhI9G8Q0AguSH +AMQdxQgxEyEFQfItICQokYgEBMm3gBCKLRIQJN8CQii2SECQfAug+FgAOw==} +folder {R0lGODlhEAANAKIAANnZ2YSEhMbGxv//AP///wAAAP///////yH5BAEAAAAALAAAAAAQAA0A +AANjCIqhiqDLITgyEgi6GoIjIyMYugCBpMsaWBA0giMjIzgyUYBBMjIoIyODEgVBODIygiMj +E1gQJIMyMjIoI1GAQSMjODIyghMFQSgjI4MyMhJYEDSCIyMjODJRgKHLXAiApcucADs=} +hourglass {R0lGODlhIAAgAKIAANnZ2YAAAAAAAP8AAP///8DAwICAgP///yH5BAEAAAAALAAAAAAgACAA +AAPZCLrc/jDKSau9OGcUuqyCoMvNGENVhaMrCLrcjaLLgqDL7WhFVIVVZoKgy+1oRUSFVWaC +oMvtaEVEhVVmgqDL7WhFRIVVZoKgy+1oVVaCJWaCoMvtgKxISrBMEHS5fZEVSRkKgi63NzIq +EwRdbndkVCYIutzeyIqqDAVBl9sXWRFJYZkg6HI7ICsiKqwyEwRdbkcrIhKsMhMEXW5HKyIp +lDITBF1uRysyEiwxEwRdbkcrIyuUEhMEXW5H0WVB0OVujKGqwtEVBF1uRtHlRdDl9odRTlrt +xRmjBAA7} +info {R0lGODlhIAAgAKIAANnZ2YSEhMbGxv///wAA/wAAAP///////yH5BAEAAAAALAAAAAAgACAA +AAP/CLoMGLqKoMvtGCo4uhKBgaDLDRghOLqsghEIuryBgqPLPSiBoMsQOLojhEQkOLpTCLob +OLqKpIujq4WgC4Gju0i6OLpbCKohOLorhEQkOLorhaAQOLrc3qgCIARHl9sbSQUEji4j6RKO +Lk9hQODosiKp4ujyFIbi6LIiqeLo8hSG4uiyIqni6PIUhuLosiKp4ujyFIYKji4PkiqOLkth +BASOLg+SKo4uV2AEhODoMpIqju5KYShA4Ogqku7i6E4FRgAAYOHocvugiohAUC0cXe7GiohA +0IUSHF3uQamICATdrULB0WUVrIqIQNBlCCwVHF2pwsJQRdDlDYyoKsHRPMLQDQRdbsDQqBmc +wlBF0OV2jJqZwggEXW5vVDMVgaDL7Y5qKgJBl9sfVUUg6HL7AxSKoMvtr1AEgi5DAgA7} +italic {R0lGODlhEAAQAJEAANnZ2QAAAP///////yH5BAEAAAAALAAAAAAQABAAAAIrhI+py+1A4hN8 +hIjINBITPlpEZBqJCR8tIjKNxISPFhGZQOITfExdbv9FCgA7} +new {R0lGODlhEAAQAJEAANnZ2QAAAP///////yH5BAEAAAAALAAAAAAQABAAAAJFhI95FN8IvgXJ +jyD4ECQ/JAh+kPyICIIdJP+CYAfJvyDYQfIvCHaQ/AuCHST/gmAHyb8g2EHyLwh2kPwLgk3x +MQg+pu4WADs=} +open {R0lGODlhEAAQAKIAANnZ2QAAAP//AP///4SEAP///////////yH5BAEAAAAALAAAAAAQABAA +AANZCLrczigUQZc1EDQgEHSZAwMgIhB0NQIDQkYwdANBNUZwZGQEJxBUQwZlZGRQAkE1RnAE +Q5dVcCSQdDcAYySQdDcAISSQdDcAASKQdDcAAQBDlwNBl9sfApQAOw==} +openfold {R0lGODlhEAANAKIAANnZ2YSEhP///8bGxv//AAAAAP///////yH5BAEAAAAALAAAAAAQAA0A +AANgCIqhiqDLgaIaCLoagkNDIxi6AIFCQ0M4KKpRgCFDQzg0NIQThaHLSxgVKLochRMVMkhD +Q4M0VBFYEDKEQ0NDOFFRgCE0NEhDQ4MVBRAoNDSEQ0NRWAAYuqyFBQBYurwJADs=} +overstrike {R0lGODlhEAAQAJEAANnZ2QAAAP///////yH5BAEAAAAALAAAAAAQABAAAAI3hI+py80Uh+Aj +RFhQCP8iMILgWwRGEHyLwAiCbxEYQfCB4iPBhwiMIPgXYREEHyEiguBj6nI7FQA7} +palette {R0lGODlhEAAQAKIAANnZ2QAAAP//AP////8A/4QAhP8AAAD//yH5BAEAAAAALAAAAAAQABAA +AANtCLrcjqGBoMsRKCMTgaALMSgDAYMSCKoxgAFBITgSAIAQEhUIARCAEgAQOBAwghMQEwga +MoIjIxAIEgCAEBEyKBAgg4GgGxAIYTGCgaALcRgQIIGgCwEYICODgaALITgyEoGguxiqCLrc +/lChBAA7} +passwd {R0lGODlhIAAgAMQAANnZ2QAAAICAgICAAP///7CwsMDAwMjIAPjIAOjo6Pj4AODg4HBwcMj4 +ANjY2JiYANDQ0MjIyPj4yKCgoMiYAMjImDAwAMjIMJiYmJCQkP////////////////////// +/yH5BAEAAAAALAAAAAAgACAAAAX/ICCOIhiIIgiII1maZSCMQnCeJyAIQiAIAiAMwxCcJwkk +EAQRCIUwGMSBDEEAAuJIlgKRJEEgGAMRBIGiDENQlqNAJAsYCEwgEEEgBAHSIEMAAuJIAgKR +LEsgGEMgCEJgBMqhHENQlgJILMsSCMRABEFgGAESHMcRgIA4kgKxOIsTBAOhKAITKEGDHMhD +kqIAEqAjisJAgIooBkpwNMcTgIA4jgLhOBAkEAOhKIoSKEGDIMcTkKQICgQEQQIxEIqiBEpw +IMdxPAEIiCMJCEQUMUQ0EIqiHIfSIM3xBGUpCiABCUQyEMqhHMiBHMjxBCAgjuQoEAKxRANB +HMqhHM1x/zxDUJajQIACsUTDQBAEIR3IcQRDAALiSIoCYQiEE03gII7HQR3BEICAOJICYRSC +QDjRNE1CAAzVQR3WE5AkAAqEUQiFQEARBAUAAAzHQR3BEICAOI4CUQhFIBAREwXjUFUHdQRD +QJJAABbCFAhEJBgBAADAMAwXdQRDAALiCAhEIRQCYRiCEZDjUFFHMAQkIBAFOAmTQBiFUAQg +II7AUFXUEQwBCQjEJExBkBRCEZCjMIBD9RxDAALiGEzCFBBYIRTBOI7AQB1DMIoCMQkYGAjL +JEwBCIgjOVDDEJCAQGACJiTTJEwBSY5BEJAiSCCwTAiCZBKmAATEkSzNQBCCYCDBJgELTNMk +g0AMEgwTAhAQR7I0zYARgvM8TyAIznMMAQA7} +paste {R0lGODlhEAAQAKIAANnZ2QAAAP//AISEAISEhP///wAAhP///yH5BAEAAAAALAAAAAAQABAA +AANwCLrcjqGBoKsYqiKrCDSGBkMiJJCGAgCDKBB0gwYDIKYwdJUIAyBokIaGBmloAhBiaAgH +TdcCEIKGBsmwVM0AIYaGcAxL1coQgoYGySoisMzMAoeGxrB01QJpaMiwMHTLAEPVsHTVEHTR +dBlBlxswAQA7} +print {R0lGODlhEAAQAKIAANnZ2QAAAP///4SEhP//AP///////////yH5BAEAAAAALAAAAAAQABAA +AANZCLrcjqG7CLqBoquBoBuCoSqBoBsouhoIuiEYqrKBoIGiqwEYEIChyxAIEYGgywEYgKHL +DAgRCLozgwABARgIukSEABEBGLq8gAEQCLobgAEAgKHLgaDLzZgAOw==} +question {R0lGODlhIAAgAKIAANnZ2YSEhMbGxv///wAAAAAA/////////yH5BAEAAAAALAAAAAAgACAA +AAP/CLoMGLqKoMvtGCo4uhKBgaDLDRghOLqsghEIuryBgqPLPSiBoMsQOLrcjYSgu4GjO4Kl +Kzi6Qwi6EDi6I4UyU1VYgqM7hKAagqM7VTg6VYWFoztCCAqBo6tVWDVThVU4ukqBACE4ulqF +VSNVWIWjq0IYEDi6K4UlU1VYOLpMgRA4uryCpTi6PIShOLq8hVU4uqyEoTi6vIUlOLqshKE4 +uryFhaPLSxgqOLrc3kgoAgJHl0ewSnB0eQhDIQRHl6uwCkeXhTAUIHB0uQqrcHSZAiMAAJBw +dFcKS3B0lwIjAkGVcHS5GykiAkEXSHB0uQeFIiIQdJcIBUeXVZAoIgJBT5chkFRwdIUICUMV +QZc3MIKIBEcJQzcQdLkBQ4NmcAhDFUGX2zFoZggjEHS5vRHNUASCLrc7oqEIBF1uf0QUgaDL +7Q9QKIIut79CEQi6DAkAOw==} +redo {R0lGODlhEAAQAJEAANnZ2QAAhP///////yH5BAEAAAAALAAAAAAQABAAAAIvhI+py+1vSByC +jxAYQXDMwsyAggQAQBB8iwgMgg8REQgUwqbYBDsIPqYutz+MgBQAOw==} +save {R0lGODlhEAAQAJEAANnZ2QAAAISEAP///yH5BAEAAAAALAAAAAAQABAAAAJWhI9pFB8RIIRC ++BYQFqQQvkWEBSmEbyFhQQrhW0hYkEL4FhIWpBC+hYQFSYxvIgFAoXy0AAiSGP8kAIIkxgcI +CSBEQvEBQgIIkVB8gJAAAhgfj+BjWgEAOw==} +underline {R0lGODlhEAAQAJEAANnZ2QAAAP///////yH5BAEAAAAALAAAAAAQABAAAAI3hI+py60UBy4I +vkVcBMG/iIsg+BdxEQT/Ii6C4F/ERRD8i7gIgn8RF0HwkWITfExFin8EH1OXCwA7} +undo {R0lGODlhEAAQAJEAANnZ2QAAhP///////yH5BAEAAAAALAAAAAAQABAAAAIuhI+py+2vSByC +HxdxQCHsCIg7oAAAEUHwLTAiKIQPgRSbYMfd3VEIH1OX2x8mUgA7} +warning {R0lGODlhIAAgAKIAANnZ2YSEAP//AMbGxgAAAISEhP///////yH5BAEAAAAALAAAAAAgACAA +AAP/CLq8gREIutz+KESGEHS5vVGIiAxSIehy+6JAUaUqBF1uBxQoukOFhaDL7RgoukKFhaDL +3RgoujqEVQi63IyBortUWAi63IuBostDWIWgy60YIjKERCMiSFUIutyAISKCpCoiOFSFoMsd +KCpIqiKCQlUIusyBooqkKiIoQ1UIuryBooqkiqJKVQi6rIGii6SKojpUWAi6DIGiG0RIgaJL +VQi6HCi6MoREg6I7VFgIuhsoukqEhKKrVFgIuhoouhuEgaKrQ1iFoAuBortDOCi6S4WFoBso +uiyEostDWIWgGii63K6IqgAAIVB0WQaJBkV3h7AKAAJFl4WQiFB0mQoLRyBQdFkJiQhFl4ew +CgJFl3WQaFB0WQirIFB0ud0RVVWg6HJ7o6GqAgwUXW5fNFRVhQCBpMvti0oVABCwdLndEehi +6XI7I4AEADs=} +} diff --git a/library/demos/ttk_repeater.tcl b/library/demos/ttk_repeater.tcl new file mode 100644 index 0000000..b515ed4 --- /dev/null +++ b/library/demos/ttk_repeater.tcl @@ -0,0 +1,117 @@ +# +# $Id: ttk_repeater.tcl,v 1.1 2006/10/31 01:42:26 hobbs Exp $ +# +# Demonstration of custom classes. +# +# The Ttk button doesn't have built-in support for autorepeat. +# Instead of adding -repeatdelay and -repeatinterval options, +# and all the extra binding scripts required to deal with them, +# we create a custom widget class for autorepeating buttons. +# +# Usage: +# ttk::button .b -class Repeater [... other options ...] +# +# TODO: +# Use system settings for repeat interval and initial delay. +# +# Notes: +# Repeater buttons work more like scrollbar arrows than +# Tk repeating buttons: they fire once immediately when +# first pressed, and $State(delay) specifies the initial +# interval before the button starts autorepeating. +# + +namespace eval ttk::Repeater { + variable State + set State(timer) {} ;# [after] id of repeat script + set State(interval) 100 ;# interval between repetitions + set State(delay) 300 ;# delay after initial invocation +} + +### Class bindings. +# + +bind Repeater <Enter> { %W state active } +bind Repeater <Leave> { %W state !active } + +bind Repeater <Key-space> { ttk::Repeater::Activate %W } +bind Repeater <<Invoke>> { ttk::Repeater::Activate %W } + +bind Repeater <ButtonPress-1> { ttk::Repeater::Press %W } +bind Repeater <ButtonRelease-1> { ttk::Repeater::Release %W } +bind Repeater <B1-Leave> { ttk::Repeater::Pause %W } +bind Repeater <B1-Enter> { ttk::Repeater::Resume %W } ;# @@@ see below + +# @@@ Workaround for metacity-induced bug: +bind Repeater <B1-Enter> \ + { if {"%d" ne "NotifyUngrab"} { ttk::Repeater::Resume %W } } + +### Binding procedures. +# + +## Activate -- Keyboard activation binding. +# Simulate clicking the button, and invoke the command once. +# +proc ttk::Repeater::Activate {w} { + $w instate disabled { return } + set oldState [$w state pressed] + update idletasks; after 100 + $w state $oldState + after idle [list $w invoke] +} + +## Press -- ButtonPress-1 binding. +# Invoke the command once and start autorepeating after +# $State(delay) milliseconds. +# +proc ttk::Repeater::Press {w} { + variable State + $w instate disabled { return } + $w state pressed + $w invoke + after cancel $State(timer) + set State(timer) [after $State(delay) [list ttk::Repeater::Repeat $w]] +} + +## Release -- ButtonRelease binding. +# Stop repeating. +# +proc ttk::Repeater::Release {w} { + variable State + $w state !pressed + after cancel $State(timer) +} + +## Pause -- B1-Leave binding +# Temporarily suspend autorepeat. +# +proc ttk::Repeater::Pause {w} { + variable State + $w state !pressed + after cancel $State(timer) +} + +## Resume -- B1-Enter binding +# Resume autorepeat. +# +proc ttk::Repeater::Resume {w} { + variable State + $w instate disabled { return } + $w state pressed + $w invoke + after cancel $State(timer) + set State(timer) [after $State(interval) [list ttk::Repeater::Repeat $w]] +} + +## Repeat -- Timer script +# Invoke the command and reschedule another repetition +# after $State(interval) milliseconds. +# +proc ttk::Repeater::Repeat {w} { + variable State + $w instate disabled { return } + $w invoke + set State(timer) [after $State(interval) [list ttk::Repeater::Repeat $w]] +} + +#*EOF* diff --git a/library/tk.tcl b/library/tk.tcl index c4e2b3d..09ac18a 100644 --- a/library/tk.tcl +++ b/library/tk.tcl @@ -3,7 +3,7 @@ # Initialization script normally executed in the interpreter for each # Tk-based application. Arranges class bindings for widgets. # -# RCS: @(#) $Id: tk.tcl,v 1.59 2006/10/23 20:31:48 dgp Exp $ +# RCS: @(#) $Id: tk.tcl,v 1.60 2006/10/31 01:42:26 hobbs Exp $ # # Copyright (c) 1992-1994 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. @@ -46,13 +46,20 @@ namespace eval ::tk { } namespace import ::tk::msgcat::* } +# and a ::ttk namespace +namespace eval ::ttk { + if {$::tk_library ne ""} { + # avoid file join to work in safe interps, but this is also x-plat ok + variable library $::tk_library/ttk + } +} -# Add Tk's directory to the end of the auto-load search path, if it +# Add Ttk & Tk's directory to the end of the auto-load search path, if it # isn't already on the path: -if {[info exists ::auto_path] && $::tk_library ne "" && \ - [lsearch -exact $::auto_path $::tk_library] < 0} { - lappend ::auto_path $::tk_library +if {[info exists ::auto_path] && ($::tk_library ne "") + && ($::tk_library ni $::auto_path)} { + lappend ::auto_path $::tk_library $::ttk::library } # Turn off strict Motif look and feel as a default. @@ -394,7 +401,7 @@ switch -- [tk windowingsystem] { if {$::tk_library ne ""} { proc ::tk::SourceLibFile {file} { namespace eval :: [list source [file join $::tk_library $file.tcl]] - } + } namespace eval ::tk { SourceLibFile button SourceLibFile entry @@ -472,7 +479,7 @@ proc ::tk::UnderlineAmpersand {text} { } if {$idx >= 0} { regsub -all -- {&([^&])} $text {\1} text - } + } return [list $text $idx] } @@ -584,3 +591,8 @@ if {[tk windowingsystem] eq "aqua"} { set useCustomMDEF 0 } } + +# Run the Ttk themed widget set initialization +if {$::ttk::library ne ""} { + uplevel \#0 [list source $::ttk::library/ttk.tcl] +} diff --git a/library/ttk/altTheme.tcl b/library/ttk/altTheme.tcl new file mode 100644 index 0000000..71fe23b --- /dev/null +++ b/library/ttk/altTheme.tcl @@ -0,0 +1,85 @@ +# +# $Id: altTheme.tcl,v 1.1 2006/10/31 01:42:26 hobbs Exp $ +# +# Ttk widget set: Alternate theme +# + +namespace eval ttk::theme::alt { + + variable colors + array set colors { + -frame "#d9d9d9" + -darker "#c3c3c3" + -activebg "#ececec" + -disabledfg "#a3a3a3" + -selectbg "#4a6984" + -selectfg "#ffffff" + } + + namespace import -force ::ttk::style + style theme settings alt { + + style configure "." \ + -background $colors(-frame) \ + -foreground black \ + -troughcolor $colors(-darker) \ + -selectbackground $colors(-selectbg) \ + -selectforeground $colors(-selectfg) \ + -font TkDefaultFont \ + ; + + style map "." -background \ + [list disabled $colors(-frame) active $colors(-activebg)] ; + style map "." -foreground [list disabled $colors(-disabledfg)] ; + style map "." -embossed [list disabled 1] ; + + style configure TButton \ + -width -11 -padding "1 1" -relief raised -shiftrelief 1 \ + -highlightthickness 1 -highlightcolor $colors(-frame) + + style map TButton -relief { + {pressed !disabled} sunken + {active !disabled} raised + } -highlightcolor {alternate black} + + style configure TCheckbutton -indicatorcolor "#ffffff" -padding 2 + style configure TRadiobutton -indicatorcolor "#ffffff" -padding 2 + style map TCheckbutton -indicatorcolor \ + [list disabled $colors(-frame) pressed $colors(-frame)] + style map TRadiobutton -indicatorcolor \ + [list disabled $colors(-frame) pressed $colors(-frame)] + + style configure TMenubutton -width -11 -padding "3 3" -relief raised + + style configure TEntry -padding 1 + style map TEntry -fieldbackground \ + [list readonly $colors(-frame) disabled $colors(-frame)] + style configure TCombobox -padding 1 + style map TCombobox -fieldbackground \ + [list readonly $colors(-frame) disabled $colors(-frame)] + + style configure Toolbutton -relief flat -padding 2 + style map Toolbutton -relief \ + {disabled flat selected sunken pressed sunken active raised} + style map Toolbutton -background \ + [list pressed $colors(-darker) active $colors(-activebg)] + + style configure TScrollbar -relief raised + + style configure TLabelframe -relief groove -borderwidth 2 + + style configure TNotebook -tabmargins {2 2 1 0} + style configure TNotebook.Tab \ + -padding {4 2} -background $colors(-darker) + style map TNotebook.Tab \ + -background [list selected $colors(-frame)] \ + -expand [list selected {2 2 1 0}] \ + ; + + style configure TScale \ + -groovewidth 4 -troughrelief sunken \ + -sliderwidth raised -borderwidth 2 + style configure TProgressbar \ + -background $colors(-selectbg) -borderwidth 0 + } +} diff --git a/library/ttk/aquaTheme.tcl b/library/ttk/aquaTheme.tcl new file mode 100644 index 0000000..4b4ad5e --- /dev/null +++ b/library/ttk/aquaTheme.tcl @@ -0,0 +1,60 @@ +# +# $Id: aquaTheme.tcl,v 1.1 2006/10/31 01:42:26 hobbs Exp $ +# +# Ttk widget set: Aqua theme (OSX native look and feel) +# +# +# TODO: panedwindow sashes should be 9 pixels (HIG:Controls:Split Views) +# + +namespace eval ttk { + + style theme settings aqua { + + style configure . \ + -font System \ + -background White \ + -foreground Black \ + -selectbackground SystemHighlight \ + -selectforeground SystemHighlightText \ + -selectborderwidth 0 \ + -insertwidth 1 \ + ; + style map . \ + -foreground [list disabled "#a3a3a3" background "#a3a3a3"] \ + -selectbackground [list background "#c3c3c3" !focus "#c3c3c3"] \ + -selectforeground [list background "#a3a3a3" !focus "#000000"] \ + ; + + # Workaround for #1100117: + # Actually, on Aqua we probably shouldn't stipple images in + # disabled buttons even if it did work... + # + style configure . -stipple {} + + style configure TButton -padding {0 2} -width -6 + style configure Toolbutton -padding 4 + # See Apple HIG figs 14-63, 14-65 + style configure TNotebook -tabposition n -padding {20 12} + style configure TNotebook.Tab -padding {10 2 10 2} + + # Enable animation for ttk::progressbar widget: + style configure TProgressbar -period 100 -maxphase 255 + + # Modify the the default Labelframe layout to use generic text element + # instead of Labelframe.text; the latter erases the window background + # (@@@ this still isn't right... want to fill with background pattern) + + style layout TLabelframe { + Labelframe.border + text + } + # + # 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) + # + style configure TLabelframe \ + -labeloutside true -labelmargins {14 0 14 4} + } +} diff --git a/library/ttk/button.tcl b/library/ttk/button.tcl new file mode 100644 index 0000000..ccc1fb4 --- /dev/null +++ b/library/ttk/button.tcl @@ -0,0 +1,85 @@ +# +# $Id: button.tcl,v 1.1 2006/10/31 01:42:26 hobbs Exp $ +# +# 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 !disabled} { %W state !pressed; %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 + $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/library/ttk/clamTheme.tcl b/library/ttk/clamTheme.tcl new file mode 100644 index 0000000..76e24fe --- /dev/null +++ b/library/ttk/clamTheme.tcl @@ -0,0 +1,119 @@ +# +# $Id: clamTheme.tcl,v 1.1 2006/10/31 01:42:26 hobbs Exp $ +# +# Ttk widget set: "Clam" theme +# +# Inspired by the XFCE family of Gnome themes. +# + +namespace eval ttk::theme::clam { + + package provide ttk::theme::clam 0.0.1 + + variable colors ; array set colors { + -disabledfg "#999999" + + -frame "#dcdad5" + -dark "#cfcdc8" + -darker "#bab5ab" + -darkest "#9e9a91" + -lighter "#eeebe7" + -lightest "#ffffff" + -selectbg "#4a6984" + -selectfg "#ffffff" + } + + namespace import -force ::ttk::style + style theme settings clam { + + 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 \ + ; + + 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"] + + style configure TButton -width -11 -padding 5 -relief raised + 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"] \ + ; + + style configure Toolbutton -padding 2 -relief flat + style map Toolbutton \ + -relief {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)] \ + ; + + style configure TCheckbutton \ + -indicatorbackground "#ffffff" \ + -indicatormargin {1 1 4 1} \ + -padding 2 ; + style configure TRadiobutton \ + -indicatorbackground "#ffffff" \ + -indicatormargin {1 1 4 1} \ + -padding 2 ; + style map TCheckbutton -indicatorbackground \ + [list disabled $colors(-frame) pressed $colors(-frame)] + style map TRadiobutton -indicatorbackground \ + [list disabled $colors(-frame) pressed $colors(-frame)] + + style configure TMenubutton -width -11 -padding 5 -relief raised + + style configure TEntry -padding 1 -insertwidth 1 + style map TEntry \ + -background [list readonly $colors(-frame)] \ + -bordercolor [list focus $colors(-selectbg)] \ + -lightcolor [list focus "#6f9dc6"] \ + -darkcolor [list focus "#6f9dc6"] \ + ; + + style configure TCombobox -padding 1 -insertwidth 1 + 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)] \ + ; + + style configure TNotebook.Tab -padding {6 2 6 2} + 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)] \ + ; + + style configure TLabelframe \ + -labeloutside true -labelmargins {0 0 0 4} \ + -borderwidth 2 -relief raised + + style configure TProgressbar -background $colors(-frame) + + style configure Sash -sashthickness 6 -gripcount 10 + } +} diff --git a/library/ttk/classicTheme.tcl b/library/ttk/classicTheme.tcl new file mode 100644 index 0000000..6376268 --- /dev/null +++ b/library/ttk/classicTheme.tcl @@ -0,0 +1,94 @@ +# +# $Id: classicTheme.tcl,v 1.1 2006/10/31 01:42:26 hobbs Exp $ +# +# Ttk widget set: Classic theme. +# Implements the classic Tk Motif-like look and feel. +# + +namespace eval ttk::theme::classic { + + font create TkClassicDefaultFont -family Helvetica -weight bold -size -12 + + variable colors; array set colors { + -frame "#d9d9d9" + -activebg "#ececec" + -troughbg "#c3c3c3" + -selectbg "#c3c3c3" + -selectfg "#000000" + -disabledfg "#a3a3a3" + -indicator "#b03060" + } + + namespace import -force ::ttk::style + style theme settings classic { + style configure "." \ + -font TkClassicDefaultFont \ + -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 \ + ; + + style map "." -background \ + [list disabled $colors(-frame) active $colors(-activebg)] + style map "." -foreground \ + [list disabled $colors(-disabledfg)] + + style map "." -highlightcolor [list focus black] + + style configure TButton -padding "3m 1m" -relief raised -shiftrelief 1 + style map TButton -relief [list {!disabled pressed} sunken] + + style configure TCheckbutton -indicatorrelief raised + style map TCheckbutton \ + -indicatorcolor [list \ + pressed $colors(-frame) selected $colors(-indicator)] \ + -indicatorrelief {selected sunken pressed sunken} \ + ; + + style configure TRadiobutton -indicatorrelief raised + style map TRadiobutton \ + -indicatorcolor [list \ + pressed $colors(-frame) selected $colors(-indicator)] \ + -indicatorrelief {selected sunken pressed sunken} \ + ; + + style configure TMenubutton -relief raised -padding "3m 1m" + + style configure TEntry -relief sunken -padding 1 -font TkTextFont + style map TEntry -fieldbackground \ + [list readonly $colors(-frame) disabled $colors(-frame)] + style configure TCombobox -padding 1 + style map TCombobox -fieldbackground \ + [list readonly $colors(-frame) disabled $colors(-frame)] + + style configure TLabelframe -borderwidth 2 -relief groove + + style configure TScrollbar -relief raised + style map TScrollbar -relief {{pressed !disabled} sunken} + + style configure TScale -sliderrelief raised + style map TScale -sliderrelief {{pressed !disabled} sunken} + + style configure TProgressbar -background SteelBlue + style configure TNotebook.Tab \ + -padding {3m 1m} \ + -background $colors(-troughbg) + style map TNotebook.Tab -background [list selected $colors(-frame)] + + # + # Toolbar buttons: + # + style configure Toolbutton -padding 2 -relief flat -shiftrelief 2 + style map Toolbutton -relief \ + {disabled flat selected sunken pressed sunken active raised} + style map Toolbutton -background \ + [list pressed $colors(-troughbg) active $colors(-activebg)] + } +} diff --git a/library/ttk/combobox.tcl b/library/ttk/combobox.tcl new file mode 100644 index 0000000..7df9f61 --- /dev/null +++ b/library/ttk/combobox.tcl @@ -0,0 +1,360 @@ +# +# $Id: combobox.tcl,v 1.1 2006/10/31 01:42:27 hobbs Exp $ +# +# Ttk widget set: combobox bindings. +# +# Each combobox $cb has a child $cb.popdown, which contains +# a listbox $cb.popdown.l and a scrollbar. The listbox -listvariable +# is set to a namespace variable, which is used to synchronize the +# combobox values with the listbox values. +# + +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 <MouseWheel> { ttk::combobox::Scroll %W [expr {%D/-120}] } +if {[tk windowingsystem] eq "x11"} { + bind TCombobox <ButtonPress-4> { ttk::combobox::Scroll %W -1 } + bind TCombobox <ButtonPress-5> { ttk::combobox::Scroll %W 1 } +} + +bind TCombobox <<TraverseIn>> { ttk::combobox::TraverseIn %W } + +### Combobox listbox bindings. +# +bind ComboboxListbox <ButtonPress-1> { focus %W ; continue } +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 } +# Default behavior is to follow selection on mouseover +bind ComboboxListbox <Motion> { + %W selection clear 0 end + %W activate @%x,%y + %W selection set @%x,%y +} + +# The combobox has a global grab active when the listbox is posted, +# but on Windows and OSX that doesn't prevent the user from interacting +# with other applications. We need to popdown the listbox when this happens. +# +# On OSX, the listbox gets a <Deactivate> event. This doesn't happen +# on Windows or X11, but it does get a <FocusOut> event. However on OSX +# in Tk 8.5, the listbox gets spurious <FocusOut> events when the listbox +# is posted (see #1349811). +# +# The following seems to work: +# + +switch -- [tk windowingsystem] { + win32 { + bind ComboboxListbox <FocusOut> { ttk::combobox::LBCancel %W } + } + aqua { + bind ComboboxListbox <Deactivate> { ttk::combobox::LBCancel %W } + } +} + +### Option database settings. +# + +if {[tk windowingsystem] eq "x11"} { + option add *TCombobox*Listbox.background white +} + +# The following ensures that the popdown listbox uses the same font +# as the combobox entry field (at least for the standard Ttk themes). +# +option add *TCombobox*Listbox.font TkTextFont + +### Binding procedures. +# + +## combobox::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 + set State(entryPress) [expr { + [$w instate {!readonly !disabled}] + && [string match *textarea [$w identify $x $y]] + }] + + if {$State(entryPress)} { + focus $w + 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 { + TogglePost $w + } +} + +## combobox::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 + } +} + +## 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>> +} + +## 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] + set selection [$lb curselection] + Unpost $cb + focus $cb + if {[llength $selection] == 1} { + SelectEntry $cb [lindex $selection 0] + } +} + +## 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 ""} { + LBSelected $lb + # The [grab release] call in [Unpost] queues events that later + # re-set the focus. [update] to make sure these get processed first: + update + tk::TabToWindow $newFocus + } +} + +## PopdownShell -- +# Returns the popdown shell widget associated with a combobox, +# creating it if necessary. +# +proc ttk::combobox::PopdownShell {cb} { + if {![winfo exists $cb.popdown]} { + set popdown [toplevel $cb.popdown -relief solid -bd 1] + wm withdraw $popdown + wm overrideredirect $popdown 1 + wm transient $popdown [winfo toplevel $cb] + + # XXX Until we have a proper native scrollbar on Aqua, use + # XXX the regular Tk one + if {[tk windowingsystem] eq "aqua"} { + scrollbar $popdown.sb -orient vertical \ + -command [list $popdown.l yview] + } else { + 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 \ + -borderwidth 2 -relief flat \ + -highlightthickness 0 \ + -activestyle none \ + ; + + bindtags $popdown.l \ + [list $popdown.l ComboboxListbox Listbox $popdown all] + + grid $popdown.l $popdown.sb -sticky news + grid columnconfigure $popdown 0 -weight 1 + grid rowconfigure $popdown 0 -weight 1 + } + return $cb.popdown +} + +## combobox::Post $cb -- +# Pop down the associated listbox. +# +proc ttk::combobox::Post {cb} { + variable State + variable Values + + # Don't do anything if disabled: + # + $cb instate disabled { return } + + # Run -postcommand callback: + # + uplevel #0 [$cb cget -postcommand] + + # Combobox is in 'pressed' state while listbox posted: + # + $cb state pressed + + set popdown [PopdownShell $cb] + 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 + # Should allow user to control listbox height + set height [llength $values] + if {$height > 10} { + set height 10 + } + $popdown.l configure -height $height + update idletasks + + # Position listbox (@@@ factor with menubutton::PostPosition + # + set x [winfo rootx $cb] + set y [winfo rooty $cb] + set w [winfo width $cb] + set h [winfo height $cb] + if {[tk windowingsystem] eq "aqua"} { + # Adjust for platform-specific bordering to ensure the box is + # directly under actual 'entry square' + set xoff 3 + set yoff 2 + incr x $xoff + set w [expr {$w - $xoff*2}] + } else { + set yoff 0 + } + + set H [winfo reqheight $popdown] + if {$y + $h + $H > [winfo screenheight $popdown]} { + set Y [expr {$y - $H - $yoff}] + } else { + set Y [expr {$y + $h - $yoff}] + } + wm geometry $popdown ${w}x${H}+${x}+${Y} + + # Post the listbox: + # + wm deiconify $popdown + raise $popdown + # @@@ Workaround for TrackElementState bug: + event generate $cb <ButtonRelease-1> + # /@@@ + ttk::globalGrab $cb + focus $popdown.l +} + +## combobox::Unpost $cb -- +# Unpost the listbox, restore focus to combobox widget. +# +proc ttk::combobox::Unpost {cb} { + $cb state !pressed + ttk::releaseGrab $cb + if {[winfo exists $cb.popdown]} { + wm withdraw $cb.popdown + } + focus $cb +} + +## combobox::TogglePost $cb -- +# Post the listbox if unposted, unpost otherwise. +# +proc ttk::combobox::TogglePost {cb} { + if {[$cb instate pressed]} { Unpost $cb } { Post $cb } +} + +## LBMaster $lb -- +# Return the combobox main widget that owns the listbox. +# +proc ttk::combobox::LBMaster {lb} { + winfo parent [winfo parent $lb] +} + +## 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/library/ttk/cursors.tcl b/library/ttk/cursors.tcl new file mode 100644 index 0000000..a151194 --- /dev/null +++ b/library/ttk/cursors.tcl @@ -0,0 +1,35 @@ +# +# $Id: cursors.tcl,v 1.1 2006/10/31 01:42:27 hobbs Exp $ +# +# Ttk package: Symbolic cursor names. +# +# @@@ TODO: Figure out appropriate platform-specific cursors +# for the various functions. +# + +namespace eval ttk { + + variable Cursors + + switch -glob $::tcl_platform(platform) { + "windows" { + array set Cursors { + hresize sb_h_double_arrow + vresize sb_v_double_arrow + seresize size_nw_se + } + } + + "unix" - + * { + array set Cursors { + hresize sb_h_double_arrow + vresize sb_v_double_arrow + seresize bottom_right_corner + } + } + + } +} + +#*EOF* diff --git a/library/ttk/defaults.tcl b/library/ttk/defaults.tcl new file mode 100644 index 0000000..a370e65 --- /dev/null +++ b/library/ttk/defaults.tcl @@ -0,0 +1,95 @@ +# +# $Id: defaults.tcl,v 1.1 2006/10/31 01:42:27 hobbs Exp $ +# +# Ttk widget set: Default theme +# + +namespace eval ttk { + # XXX do we want to separate Tk version from theme version? + package provide ttk::theme::default $::tk_version + + variable colors + array set colors { + -frame "#d9d9d9" + -activebg "#ececec" + -selectbg "#4a6984" + -selectfg "#ffffff" + -darker "#c3c3c3" + -disabledfg "#a3a3a3" + -indicator "#4a6984" + } + + style theme settings default { + + style configure "." \ + -borderwidth 1 \ + -background $colors(-frame) \ + -foreground black \ + -troughcolor $colors(-darker) \ + -font TkDefaultFont \ + -selectborderwidth 1 \ + -selectbackground $colors(-selectbg) \ + -selectforeground $colors(-selectfg) \ + -insertwidth 1 \ + -indicatordiameter 10 \ + ; + + style map "." -background \ + [list disabled $colors(-frame) active $colors(-activebg)] + style map "." -foreground \ + [list disabled $colors(-disabledfg)] + + style configure TButton \ + -padding "3 3" -width -9 -relief raised -shiftrelief 1 + style map TButton -relief [list {!disabled pressed} sunken] + + style configure TCheckbutton \ + -indicatorcolor "#ffffff" -indicatorrelief sunken -padding 1 + style map TCheckbutton -indicatorcolor \ + [list pressed $colors(-activebg) selected $colors(-indicator)] + + style configure TRadiobutton \ + -indicatorcolor "#ffffff" -indicatorrelief sunken -padding 1 + style map TRadiobutton -indicatorcolor \ + [list pressed $colors(-activebg) selected $colors(-indicator)] + + style configure TMenubutton -relief raised -padding "10 3" + + style configure TEntry -relief sunken -fieldbackground white -padding 1 + style map TEntry -fieldbackground \ + [list readonly $colors(-frame) disabled $colors(-frame)] + + style configure TCombobox -arrowsize 12 -padding 1 + style map TCombobox -fieldbackground \ + [list readonly $colors(-frame) disabled $colors(-frame)] + + style configure TLabelframe -relief groove -borderwidth 2 + + style configure TScrollbar -width 12 -arrowsize 12 + style map TScrollbar -arrowcolor [list disabled $colors(-disabledfg)] + + style configure TScale -sliderrelief raised + style configure TProgressbar -background $colors(-selectbg) + + style configure TNotebook.Tab \ + -padding {4 2} -background $colors(-darker) + style map TNotebook.Tab -background [list selected $colors(-frame)] + + # + # Toolbar buttons: + # + style layout Toolbutton { + Toolbutton.border -children { + Toolbutton.padding -children { + Toolbutton.label + } + } + } + + style configure Toolbutton -padding 2 -relief flat + style map Toolbutton -relief \ + {disabled flat selected sunken pressed sunken active raised} + style map Toolbutton -background \ + [list pressed $colors(-darker) active $colors(-activebg)] + } +} diff --git a/library/ttk/dialog.tcl b/library/ttk/dialog.tcl new file mode 100644 index 0000000..cb3db47 --- /dev/null +++ b/library/ttk/dialog.tcl @@ -0,0 +1,272 @@ +# +# $Id: dialog.tcl,v 1.1 2006/10/31 01:42:27 hobbs Exp $ +# +# Copyright (c) 2005, Joe English. Freely redistributable. +# +# Ttk widget set: dialog boxes. +# +# TODO: option to keep dialog onscreen ("persistent" / "transient") +# TODO: accelerator keys. +# TODO: use message catalogs for button labels +# TODO: routines to selectively enable/disable individual command buttons +# TODO: use megawidgetoid API [$dlg dismiss] vs. [ttk::dialog::dismiss $dlg] +# TODO: MAYBE: option for app-modal dialogs +# TODO: MAYBE: [wm withdraw] dialog on dismiss instead of self-destructing +# + +namespace eval ttk::dialog { + + variable Config + # + # Spacing parameters: + # (taken from GNOME HIG 2.0, may need adjustment for other platforms) + # (textwidth just a guess) + # + set Config(margin) 12 ;# space between icon and text + set Config(interspace) 6 ;# horizontal space between buttons + set Config(sepspace) 24 ;# vertical space above buttons + set Config(textwidth) 400 ;# width of dialog box text (pixels) + + variable DialogTypes ;# map -type => list of dialog options + variable ButtonOptions ;# map button name => list of button options + + # stockButton -- define new built-in button + # + proc stockButton {button args} { + variable ButtonOptions + set ButtonOptions($button) $args + } + + # Built-in button types: + # + stockButton ok -text OK + stockButton cancel -text Cancel + stockButton yes -text Yes + stockButton no -text No + stockButton retry -text Retry + + # stockDialog -- define new dialog type. + # + proc stockDialog {type args} { + variable DialogTypes + set DialogTypes($type) $args + } + + # Built-in dialog types: + # + stockDialog ok \ + -icon info -buttons {ok} -default ok + stockDialog okcancel \ + -icon info -buttons {ok cancel} -default ok -cancel cancel + stockDialog retrycancel \ + -icon question -buttons {retry cancel} -cancel cancel + stockDialog yesno \ + -icon question -buttons {yes no} + stockDialog yesnocancel \ + -icon question -buttons {yes no cancel} -cancel cancel +} + +## ttk::dialog::nop -- +# Do nothing (used as a default callback command). +# +proc ttk::dialog::nop {args} { } + +## ttk::dialog -- dialog box constructor. +# +interp alias {} ttk::dialog {} ttk::dialog::Constructor + +proc ttk::dialog::Constructor {dlg args} { + upvar #0 $dlg D + variable Config + variable ButtonOptions + variable DialogTypes + + # + # Option processing: + # + array set defaults { + -title "" + -message "" + -detail "" + -command ttk::dialog::nop + -icon "" + -buttons {} + -labels {} + -default {} + -cancel {} + -parent #AUTO + } + + array set options [array get defaults] + + foreach {option value} $args { + if {$option eq "-type"} { + array set options $DialogTypes($value) + } elseif {![info exists options($option)]} { + set validOptions [join [lsort [array names options]] ", "] + return -code error \ + "Illegal option $option: must be one of $validOptions" + } + } + array set options $args + + # ... + # + array set buttonOptions [array get ::ttk::dialog::ButtonOptions] + foreach {button label} $options(-labels) { + lappend buttonOptions($button) -text $label + } + + # + # Initialize dialog private data: + # + foreach option {-command -message -detail} { + set D($option) $options($option) + } + + toplevel $dlg -class Dialog; wm withdraw $dlg + + # + # Determine default transient parent. + # + # NB: menus (including menubars) are considered toplevels, + # so skip over those. + # + if {$options(-parent) eq "#AUTO"} { + set parent [winfo toplevel [winfo parent $dlg]] + while {[winfo class $parent] eq "Menu" && $parent ne "."} { + set parent [winfo toplevel [winfo parent $parent]] + } + set options(-parent) $parent + } + + # + # Build dialog: + # + if {$options(-parent) ne ""} { + wm transient $dlg $options(-parent) + } + wm title $dlg $options(-title) + wm protocol $dlg WM_DELETE_WINDOW { } + + set f [ttk::frame $dlg.f] + + ttk::label $f.icon + if {$options(-icon) ne ""} { + $f.icon configure -image [ttk::stockIcon dialog/$options(-icon)] + } + ttk::label $f.message -textvariable ${dlg}(-message) \ + -font TkCaptionFont -wraplength $Config(textwidth)\ + -anchor w -justify left + ttk::label $f.detail -textvariable ${dlg}(-detail) \ + -font TkTextFont -wraplength $Config(textwidth) \ + -anchor w -justify left + + # + # Command buttons: + # + set cmd [ttk::frame $f.cmd] + set column 0 + grid columnconfigure $f.cmd 0 -weight 1 + + foreach button $options(-buttons) { + incr column + eval [linsert $buttonOptions($button) 0 ttk::button $cmd.$button] + $cmd.$button configure -command [list ttk::dialog::Done $dlg $button] + grid $cmd.$button -row 0 -column $column \ + -padx [list $Config(interspace) 0] -sticky ew + grid columnconfigure $cmd $column -uniform buttons + } + + if {$options(-default) ne ""} { + keynav::defaultButton $cmd.$options(-default) + focus $cmd.$options(-default) + } + if {$options(-cancel) ne ""} { + bind $dlg <KeyPress-Escape> \ + [list event generate $cmd.$options(-cancel) <<Invoke>>] + wm protocol $dlg WM_DELETE_WINDOW \ + [list event generate $cmd.$options(-cancel) <<Invoke>>] + } + + # + # Assemble dialog. + # + pack $f.cmd -side bottom -expand false -fill x \ + -pady [list $Config(sepspace) $Config(margin)] -padx $Config(margin) + + if {0} { + # GNOME and Apple HIGs say not to use separators. + # But in case we want them anyway: + # + pack [ttk::separator $f.sep -orient horizontal] \ + -side bottom -expand false -fill x \ + -pady [list $Config(sepspace) 0] \ + -padx $Config(margin) + } + + if {$options(-icon) ne ""} { + pack $f.icon -side left -anchor n -expand false \ + -pady $Config(margin) -padx $Config(margin) + } + + pack $f.message -side top -expand false -fill x \ + -padx $Config(margin) -pady $Config(margin) + if {$options(-detail) != ""} { + pack $f.detail -side top -expand false -fill x \ + -padx $Config(margin) + } + + # Client area goes here. + + pack $f -expand true -fill both + keynav::enableMnemonics $dlg + wm deiconify $dlg +} + +## ttk::dialog::clientframe -- +# Returns the widget path of the dialog client frame, +# creating and managing it if necessary. +# +proc ttk::dialog::clientframe {dlg} { + variable Config + set client $dlg.f.client + if {![winfo exists $client]} { + pack [ttk::frame $client] -side top -expand true -fill both \ + -pady $Config(margin) -padx $Config(margin) + lower $client ;# so it's first in keyboard traversal order + } + return $client +} + +## ttk::dialog::Done -- +# -command callback for dialog command buttons (internal) +# +proc ttk::dialog::Done {dlg button} { + upvar #0 $dlg D + set rc [catch [linsert $D(-command) end $button] result] + if {$rc == 1} { + return -code $rc -errorinfo $::errorInfo -errorcode $::errorCode $result + } elseif {$rc == 3 || $rc == 4} { + # break or continue -- don't dismiss dialog + return + } + dismiss $dlg +} + +## ttk::dialog::activate $dlg $button -- +# Simulate a button press. +# +proc ttk::dialog::activate {dlg button} { + event generate $dlg.f.cmd.$button <<Invoke>> +} + +## dismiss -- +# Dismiss the dialog (without invoking any actions). +# +proc ttk::dialog::dismiss {dlg} { + uplevel #0 [list unset $dlg] + destroy $dlg +} + +#*EOF* diff --git a/library/ttk/entry.tcl b/library/ttk/entry.tcl new file mode 100644 index 0000000..65fdf90 --- /dev/null +++ b/library/ttk/entry.tcl @@ -0,0 +1,580 @@ +# +# $Id: entry.tcl,v 1.1 2006/10/31 01:42:27 hobbs Exp $ +# +# 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) char + 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. + } +} + +### 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::Repeatedly ttk::entry::AutoScroll %W } +bind TEntry <B1-Enter> { ttk::CancelRepeat } +bind TEntry <ButtonRelease-1> { ttk::CancelRepeat } + +bind TEntry <Control-ButtonPress-1> { + %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 <Key-Left> { ttk::entry::Move %W prevchar } +bind TEntry <Key-Right> { ttk::entry::Move %W nextchar } +bind TEntry <Control-Key-Left> { ttk::entry::Move %W prevword } +bind TEntry <Control-Key-Right> { ttk::entry::Move %W nextword } +bind TEntry <Key-Home> { ttk::entry::Move %W home } +bind TEntry <Key-End> { ttk::entry::Move %W end } + +bind TEntry <Shift-Key-Left> { ttk::entry::Extend %W prevchar } +bind TEntry <Shift-Key-Right> { ttk::entry::Extend %W nextchar } +bind TEntry <Shift-Control-Key-Left> { ttk::entry::Extend %W prevword } +bind TEntry <Shift-Control-Key-Right> { ttk::entry::Extend %W nextword } +bind TEntry <Shift-Key-Home> { ttk::entry::Extend %W home } +bind TEntry <Shift-Key-End> { ttk::entry::Extend %W end } + +bind TEntry <Control-Key-slash> { %W selection range 0 end } +bind TEntry <Control-Key-backslash> { %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} +} + +## Additional emacs-like bindings: +# +bind TEntry <Control-Key-a> { ttk::entry::Move %W home } +bind TEntry <Control-Key-b> { ttk::entry::Move %W prevchar } +bind TEntry <Control-Key-d> { ttk::entry::Delete %W } +bind TEntry <Control-Key-e> { ttk::entry::Move %W end } +bind TEntry <Control-Key-f> { ttk::entry::Move %W nextchar } +bind TEntry <Control-Key-h> { ttk::entry::Backspace %W } +bind TEntry <Control-Key-k> { %W delete insert end } + +### 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}} { + update idletasks ;# ensure scroll data up-to-date + 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 $tcl_platform(platform) "windows"] + +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 } + } +} + +## 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 is, and extend the selection +# according to the current selection mode. +# +# TODO: AutoScroll should repeat faster (50ms) than normal autorepeat. +# TODO: Need a way for ttk::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 WordBack {text index} { + if {[set pos [tcl_wordBreakBefore $text $index]] < 0} { return 0 } + return $pos +} +proc 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/library/ttk/fonts.tcl b/library/ttk/fonts.tcl new file mode 100644 index 0000000..c3d4d50 --- /dev/null +++ b/library/ttk/fonts.tcl @@ -0,0 +1,132 @@ +# +# $Id: fonts.tcl,v 1.1 2006/10/31 01:42:27 hobbs Exp $ +# +# Ttk package: Font specifications. +# +# This file, [source]d from ttk.tcl when the package is loaded, +# 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). [not in #145] +# TkHeadingFont -- headings (column headings, etc) [not in #145] +# TkCaptionFont -- dialog captions (primary text in alert dialogs, etc.) +# TkTooltipFont -- font to use for tooltip windows +# +# This is a temporary solution until TIP #145 is implemented. +# +# Symbolic fonts listed in TIP #145: +# +# TkDefaultFont -- the default for all GUI items not otherwise specified. +# TkFixedFont -- standard fixed width font [not used in Ttk] +# TkMenuFont -- used for menu items [not used in Ttk] +# TkCaptionFont -- used for window and dialog caption bars [different in Ttk] +# TkSmallCaptionFont -- captions on contained windows or tool dialogs [not used] +# TkIconFont -- font in use for icon captions [not used in Ttk] +# TkTooltipFont -- font to use for tooltip windows +# +# +# +++ 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 +# +# There's also a GetThemeFont() Appearance Manager API call +# for looking up kThemeSystemFont dynamically. +# +# Mac classic: +# Don't know, can't find *anything* on the Web about Mac pre-OSX. +# Might have used Geneva. Doesn't matter, this platform +# isn't supported anymore anyway. +# +# 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 { + +catch {font create TkDefaultFont} +catch {font create TkTextFont} +catch {font create TkHeadingFont} +catch {font create TkCaptionFont} +catch {font create TkTooltipFont} + +switch -- [tk windowingsystem] { + win32 { + if {$tcl_platform(osVersion) >= 5.0} { + variable family "Tahoma" + } else { + variable family "MS Sans Serif" + } + variable size 8 + + font configure TkDefaultFont -family $family -size $size + font configure TkTextFont -family $family -size $size + font configure TkHeadingFont -family $family -size $size + font configure TkCaptionFont -family $family -size $size -weight bold + font configure TkTooltipFont -family $family -size $size + } + classic - + aqua { + variable family "Lucida Grande" + variable size 13 + variable viewsize 12 + variable smallsize 11 + + font configure TkDefaultFont -family $family -size $size + font configure TkTextFont -family $family -size $size + font configure TkHeadingFont -family $family -size $smallsize + font configure TkCaptionFont -family $family -size $size -weight bold + font configure TkTooltipFont -family $family -size $viewsize + } + x11 { + if {![catch {tk::pkgconfig get fontsystem} fs] && $fs eq "xft"} { + variable family "sans-serif" + } else { + variable family "Helvetica" + } + variable size -12 + variable ttsize -10 + variable capsize -14 + + font configure TkDefaultFont -family $family -size $size + font configure TkTextFont -family $family -size $size + font configure TkHeadingFont -family $family -size $size -weight bold + font configure TkCaptionFont -family $family -size $capsize -weight bold + font configure TkTooltipFont -family $family -size $ttsize + } +} + +} + +#*EOF* diff --git a/library/ttk/icons.tcl b/library/ttk/icons.tcl new file mode 100644 index 0000000..493bb0a --- /dev/null +++ b/library/ttk/icons.tcl @@ -0,0 +1,105 @@ +# +# $Id: icons.tcl,v 1.1 2006/10/31 01:42:27 hobbs Exp $ +# +# Ttk package -- stock icons. +# +# Usage: +# $w configure -image [ttk::stockIcon $context/$icon] +# +# At present, only includes icons for dialog boxes, +# dialog/info, dialog/warning, dialog/error, etc. +# +# This list should be expanded. +# +# See the Icon Naming Specification from the Tango project: +# http://standards.freedesktop.org/icon-naming-spec/ +# They've finally gotten around to publishing something. +# + +namespace eval ttk { + variable Icons ;# Map: icon name -> image + namespace eval icons {} ;# container namespace for images +} + +# stockIcon $name -- +# Returns a Tk image for built-in icon $name. +# +proc ttk::stockIcon {name} { + variable Icons + return $Icons($name) +} + +# defineImage -- +# Define a new stock icon. +# +proc ttk::defineImage {name args} { + variable Icons + set iconName ::ttk::icons::$name + eval [linsert $args 0 image create photo $iconName] + set Icons($name) $iconName +} + +# +# Stock icons for dialogs +# +# SOURCE: dialog icons taken from BWidget toolkit. +# +ttk::defineImage dialog/error -data { + R0lGODlhIAAgALMAAIQAAISEhPf/Mf8AAP////////////////////////// + /////////////////////yH5BAEAAAIALAAAAAAgACAAAASwUMhJBbj41s0n + HmAIYl0JiCgKlNWVvqHGnnA9mnY+rBytw4DAxhci2IwqoSdFaMKaSBFPQhxA + nahrdKS0MK8ibSoorBbBVvS4XNOKgey2e7sOmLPvGvkezsPtR3M2e3JzdFIB + gC9vfohxfVCQWI6PII1pkZReeIeWkzGJS1lHdV2bPy9koaKopUOtSatDfECq + phWKOra3G3YuqReJwiwUiRkZwsPEuMnNycslzrIdEQAAOw== +} + +ttk::defineImage dialog/info -data { + R0lGODlhIAAgALMAAAAAAAAA/4SEhMbGxvf/Mf////////////////////// + /////////////////////yH5BAEAAAQALAAAAAAgACAAAAStkMhJibj41s0n + HkUoDljXXaCoqqRgUkK6zqP7CvQQ7IGsAiYcjcejFYAb4ZAYMB4rMaeO51sN + kBKlc/uzRbng0NWlnTF3XAAZzExj2ET3BV7cqufctv2Tj0vvFn11RndkVSt6 + OYVZRmeDXRoTAGFOhTaSlDOWHACHW2MlHQCdYFebN6OkVqkZlzcXqTKWoS8w + GJMhs7WoIoC7v7i+v7uTwsO1o5HHu7TLtcodEQAAOw== +} + +ttk::defineImage dialog/question -data { + R0lGODlhIAAgALMAAAAAAAAA/4SEhMbGxvf/Mf////////////////////// + /////////////////////yH5BAEAAAQALAAAAAAgACAAAAS2kMhJibj41s0n + HkUoDljXXaCoqqRgUkK6zqP7CnS+AiY+D4GgUKbibXwrYEoYIIqMHmcoqGLS + BlBLzlrgzgC22FZYAJKvYG3ODPLS0khd+awDX+Qieh2Dnzb7dnE6VIAffYdl + dmo6bHiBFlJVej+PizRuXyUTAIxBkSGBNpuImZoVAJ9roSYAqH1Yqzetrkmz + GaI3F7MyoaYvHhicoLe/sk8axcnCisnKBczNxa3I0cW+1bm/EQAAOw== +} + +ttk::defineImage dialog/warning -data { + R0lGODlhIAAgALMAAAAAAISEAISEhMbGxv//AP////////////////////// + /////////////////////yH5BAEAAAUALAAAAAAgACAAAASrsMhJZ7g16y0D + IQPAjZr3gYBAroV5piq7uWcoxHJFv3eun0BUz9cJAmHElhFow8lcIQBgwHOu + aNJsDfk8ZgHH4TX4BW/Fo12ZjJ4Z10wuZ0cIZOny0jI6NTbnSwRaS3kUdCd2 + h0JWRYEhVIGFSoEfZo6FipRvaJkfUZB7cp2Cg5FDo6RSmn+on5qCPaivYTey + s4sqtqswp2W+v743whTCxcbHyG0FyczJEhEAADs= +} + +ttk::defineImage dialog/auth -data { + R0lGODlhIAAgAIQAAAAA/wAAAICAgICAAP///7CwsMDAwMjIAPjIAOjo6Pj4 + AODg4HBwcMj4ANjY2JiYANDQ0MjIyPj4yKCgoMiYAMjImDAwAMjIMJiYmJCQ + kAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAgACAAAAX+ICCOYmCa + ZKquZCCMQsDOqWC7NiAMvEyvAoLQVdgZCAfEAPWDERIJk8AwIJwUil5T91y4 + GC6ry4RoKH2zYGLhnS5tMUNAcaAvaUF2m1A9GeQIAQeDaEAECw6IJlVYAmAK + AWZJD3gEDpeXOwRYnHOCCgcPhTWWDhAQQYydkGYIoaOkp6h8m1ieSYOvP0ER + EQwEEap0dWagok1BswmMdbiursfIBHnBQs10oKF30tQ8QkISuAcB25UGQQ4R + EzzsA4MU4+WGBkXo6hMTMQADFQfwFtHmFSlCAEKEU2jc+YsHy8nAML4iJKzQ + Dx65hiWKTIA4pRC7CxblORRA8E/HFfxfQo4KUiBfPgL0SDbkV0ElKZcmEjwE + wqPCgwMiAQTASQDDzhkD4IkMkg+DiwU4aSTVQiIIBgFXE+ATsPHHCRVWM8QI + oJUrxi04TCzA0PQsWh9kMVx1u6UFA3116zLJGwIAOw== +} + +ttk::defineImage dialog/busy -data { + R0lGODlhIAAgALMAAAAAAIAAAACAAICAAAAAgIAAgACAgMDAwICAgP8AAAD/ + AP//AAAA//8A/wD//////yH5BAEAAAsALAAAAAAgACAAAASAcMlJq7046827 + /2AYBmRpkoC4BMlzvEkspypg3zitIsfjvgcEQifi+X7BoUpi9AGFxFATCV0u + eMEDQFu1GrdbpZXZC0e9LvF4gkifl8aX2tt7bIPvz/Q5l9btcn0gTWBJeR1G + bWBdO0EPPIuHHDmUSyxIMjM1lJVrnp+goaIfEQAAOw== +} + +#*EOF* diff --git a/library/ttk/keynav.tcl b/library/ttk/keynav.tcl new file mode 100644 index 0000000..090c8f5 --- /dev/null +++ b/library/ttk/keynav.tcl @@ -0,0 +1,163 @@ +######################################################################## +# keynav package - Enhanced keyboard navigation +# Copyright (C) 2003 Joe English +# Freely redistributable; see the file license.terms for details. +# +# $Id: keynav.tcl,v 1.1 2006/10/31 01:42:27 hobbs Exp $ +# +######################################################################## +# +# Usage: +# +# package require keynav +# +# keynav::enableMnemonics $toplevel -- +# Enable mnemonic accelerators for toplevel widget. Pressing Alt-K, +# where K is any alphanumeric key, will send an <<Invoke>> event to the +# widget with mnemonic K (as determined by the -underline and -text +# options). +# +# Side effects: adds a binding for <Alt-KeyPress> to $toplevel +# +# keynav::defaultButton $button -- +# Enables default activation for the toplevel window in which $button +# appears. Pressing <Key-Return> invokes the default widget. The +# default widget is set to the widget with keyboard focus if it is +# defaultable, otherwise $button. A widget is _defaultable_ if it has +# a -default option which is not set to "disabled". +# +# Side effects: adds <FocusIn> and <KeyPress-Return> bindings +# to the toplevel containing $button, and a <Destroy> binding +# to $button. +# +# $button must be a defaultable widget. +# + +namespace eval keynav {} + +package require Tcl 8.4 +package require Tk 8.4 +package provide keynav 1.0 + +event add <<Help>> <KeyPress-F1> + +# +# Bindings for stock Tk widgets: +# (NB: for 8.3 use tkButtonInvoke, tkMbPost instead) +# +bind Button <<Invoke>> { tk::ButtonInvoke %W } +bind Checkbutton <<Invoke>> { tk::ButtonInvoke %W } +bind Radiobutton <<Invoke>> { tk::ButtonInvoke %W } +bind Menubutton <<Invoke>> { tk::MbPost %W } + +proc keynav::enableMnemonics {w} { + bind [winfo toplevel $w] <Alt-KeyPress> {+ keynav::Alt-KeyPress %W %K } +} + +# mnemonic $w -- +# Return the mnemonic character for widget $w, +# as determined by the -text and -underline resources. +# +proc keynav::mnemonic {w} { + if {[catch { + set label [$w cget -text] + set underline [$w cget -underline] + }]} { return "" } + return [string index $label $underline] +} + +# FindMnemonic $w $key -- +# Locate the descendant of $w with mnemonic $key. +# +proc keynav::FindMnemonic {w key} { + if {[string length $key] != 1} { return } + set Q [list [set top [winfo toplevel $w]]] + while {[llength $Q]} { + set QN [list] + foreach w $Q { + if {[string equal -nocase $key [mnemonic $w]]} { + return $w + } + foreach c [winfo children $w] { + if {[winfo ismapped $c] && [winfo toplevel $c] eq $top} { + lappend QN $c + } + } + } + set Q $QN + } + return {} +} + +# Alt-KeyPress -- +# Alt-KeyPress binding for toplevels with mnemonic accelerators enabled. +# +proc keynav::Alt-KeyPress {w k} { + set w [FindMnemonic $w $k] + if {$w ne ""} { + event generate $w <<Invoke>> + return -code break + } +} + +# defaultButton $w -- +# Enable default activation for the toplevel containing $w, +# and make $w the default default widget. +# +proc keynav::defaultButton {w} { + variable DefaultButton + + $w configure -default active + set top [winfo toplevel $w] + set DefaultButton(current.$top) $w + set DefaultButton(default.$top) $w + + bind $w <Destroy> [list keynav::CleanupDefault $top] + bind $top <FocusIn> [list keynav::ClaimDefault $top %W] + bind $top <KeyPress-Return> [list keynav::ActivateDefault $top] +} + +proc keynav::CleanupDefault {top} { + variable DefaultButton + unset DefaultButton(current.$top) + unset DefaultButton(default.$top) +} + +# ClaimDefault $top $w -- +# <FocusIn> binding for default activation. +# Sets the default widget to $w if it is defaultable, +# otherwise set it to the default default. +# +proc keynav::ClaimDefault {top w} { + variable DefaultButton + if {![info exists DefaultButton(current.$top)]} { + # Someone destroyed the default default, but not + # the rest of the toplevel. + return; + } + + set default $DefaultButton(default.$top) + if {![catch {$w cget -default} dstate] && $dstate ne "disabled"} { + set default $w + } + + if {$default ne $DefaultButton(current.$top)} { + # Ignore errors -- someone may have destroyed the current default + catch { $DefaultButton(current.$top) configure -default normal } + $default configure -default active + set DefaultButton(current.$top) $default + } +} + +# ActivateDefault -- +# Invoke the default widget for toplevel window, if any. +# +proc keynav::ActivateDefault {top} { + variable DefaultButton + if {[info exists DefaultButton(current.$top)] + && [winfo exists $DefaultButton(current.$top)]} { + event generate $DefaultButton(current.$top) <<Invoke>> + } +} + +#*EOF* diff --git a/library/ttk/menubutton.tcl b/library/ttk/menubutton.tcl new file mode 100644 index 0000000..fec276e --- /dev/null +++ b/library/ttk/menubutton.tcl @@ -0,0 +1,171 @@ +# +# $Id: menubutton.tcl,v 1.1 2006/10/31 01:42:27 hobbs Exp $ +# +# 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> \ + { %W state !pressed } +} + +# PostPosition -- +# Returns the x and y coordinates where the menu +# should be posted, based on the menubutton and menu size +# and -direction option. +# +# TODO: adjust menu width to be at least as wide as the button +# for -direction above, below. +# +proc ttk::menubutton::PostPosition {mb menu} { + set x [winfo rootx $mb] + set y [winfo rooty $mb] + set dir [$mb cget -direction] + + set bw [winfo width $mb] + set bh [winfo height $mb] + set mw [winfo reqwidth $menu] + set mh [winfo reqheight $menu] + set sw [expr {[winfo screenwidth $menu] - $bw - $mw}] + set sh [expr {[winfo screenheight $menu] - $bh - $mh}] + + switch -- $dir { + above { if {$y >= $mh} { incr y -$mh } { incr y $bh } } + below { if {$y <= $sh} { incr y $bh } { incr y -$mh } } + left { if {$x >= $mw} { incr x -$mw } { incr x $bw } } + right { if {$x <= $sw} { incr x $bw } { incr x -$mw } } + flush { + # post menu atop menubutton. + # If there's a menu entry whose label matches the + # menubutton -text, assume this is an optionmenu + # and place that entry over the menubutton. + set index [FindMenuEntry $menu [$mb cget -text]] + if {$index ne ""} { + incr y -[$menu yposition $index] + } + } + } + + return [list $x $y] +} + +# 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} [PostPosition $mb $menu] { break } + tk_popup $menu $x $y +} + +# 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 + } + foreach {x y} [PostPosition $mb $menu] { break } + set State(pulldown) 1 + set State(oldcursor) [$mb cget -cursor] + + $mb state pressed + $mb configure -cursor [$menu cget -cursor] + $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] + 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/library/ttk/notebook.tcl b/library/ttk/notebook.tcl new file mode 100644 index 0000000..d2edddc --- /dev/null +++ b/library/ttk/notebook.tcl @@ -0,0 +1,205 @@ +# +# $Id: notebook.tcl,v 1.1 2006/10/31 01:42:27 hobbs Exp $ +# +# 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. +# +# If $tab was already the current tab, set the focus to the +# notebook widget. Otherwise, set the focus to the first +# traversable widget in the pane. The behavior is that the +# notebook takes focus when the user selects the same tab +# a second time. This mirrors Windows tab behavior. +# +proc ttk::notebook::ActivateTab {w tab} { + if {[$w index $tab] eq [$w index current]} { + focus $w + } else { + $w select $tab + update ;# needed so focus logic sees correct mapped/unmapped states + if {[set f [ttk::focusFirst [$w select]]] ne ""} { + tk::TabToWindow $f + } + } +} + +# 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 "" +} + +# 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-Tab> {+ttk::notebook::TLCycleTab %W 1} + bind $top <Shift-Control-Key-Tab> {+ttk::notebook::TLCycleTab %W -1} + catch { + bind $top <Control-Key-ISO_Left_Tab> {+ttk::notebook::TLCycleTab %W -1} + } + 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 / Shift-Control-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/library/ttk/panedwindow.tcl b/library/ttk/panedwindow.tcl new file mode 100644 index 0000000..451e5c4 --- /dev/null +++ b/library/ttk/panedwindow.tcl @@ -0,0 +1,87 @@ +# +# $Id: panedwindow.tcl,v 1.1 2006/10/31 01:42:27 hobbs Exp $ +# +# Ttk widget set: bindings for TPanedwindow 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 PanedEventProc in ttkPanedwindow.c: +bind TPanedwindow <<EnteredChild>> { ttk::panedwindow::ResetCursor %W } + + +## Sash movement: +# +proc ttk::panedwindow::Press {w x y} { + variable State + + lassign [$w identify $x $y] sash element + if {![info exists sash]} { + 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)} { + $w configure -cursor {} + } +} + +proc ttk::panedwindow::SetCursor {w x y} { + variable ::ttk::Cursors + + if {![llength [$w identify $x $y]]} { + ResetCursor $w + } else { + # Assume we're over a sash. + switch -- [$w cget -orient] { + horizontal { $w configure -cursor $Cursors(hresize) } + vertical { $w configure -cursor $Cursors(vresize) } + } + } +} + +#*EOF* diff --git a/library/ttk/progress.tcl b/library/ttk/progress.tcl new file mode 100644 index 0000000..f457bbe --- /dev/null +++ b/library/ttk/progress.tcl @@ -0,0 +1,51 @@ +# +# $Id: progress.tcl,v 1.1 2006/10/31 01:42:27 hobbs Exp $ +# +# 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 + } + + $pb step $stepsize + + set Timers($pb) [after $steptime \ + [list ttk::progressbar::Autoincrement $pb $steptime $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/library/ttk/scale.tcl b/library/ttk/scale.tcl new file mode 100644 index 0000000..2a5cf2e --- /dev/null +++ b/library/ttk/scale.tcl @@ -0,0 +1,54 @@ +# scale.tcl - Copyright (C) 2004 Pat Thoyts <patthoyts@users.sourceforge.net> +# +# Bindings for the TScale widget +# +# $Id: scale.tcl,v 1.1 2006/10/31 01:42:27 hobbs Exp $ + +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 } + +proc ttk::scale::Press {w x y} { + variable State + set State(dragging) 0 + + switch -glob -- [$w identify $x $y] { + *track - + *trough { + if {[$w get $x $y] <= [$w get]} { + ttk::Repeatedly Increment $w -1 + } else { + ttk::Repeatedly Increment $w 1 + } + } + *slider { + set State(dragging) 1 + set State(initial) [$w get] + } + } +} + +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 + $w set [expr {[$w get] + $delta}] +} diff --git a/library/ttk/scrollbar.tcl b/library/ttk/scrollbar.tcl new file mode 100644 index 0000000..6b37b24 --- /dev/null +++ b/library/ttk/scrollbar.tcl @@ -0,0 +1,107 @@ +# +# $Id: scrollbar.tcl,v 1.1 2006/10/31 01:42:27 hobbs Exp $ +# +# 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/library/ttk/sizegrip.tcl b/library/ttk/sizegrip.tcl new file mode 100644 index 0000000..f1b87b1 --- /dev/null +++ b/library/ttk/sizegrip.tcl @@ -0,0 +1,77 @@ +# +# $Id: sizegrip.tcl,v 1.1 2006/10/31 01:42:27 hobbs Exp $ +# +# Ttk widget set -- sizegrip widget bindings. +# +# Dragging a sizegrip widget resizes the containing toplevel. +# +# NOTE: the sizegrip widget must be in the lower right hand corner. +# + +option add *TSizegrip.cursor $::ttk::Cursors(seresize) + +namespace eval ttk::sizegrip { + variable State + array set State { + pressed 0 + pressX 0 + pressY 0 + width 0 + height 0 + widthInc 1 + heightInc 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 + + set top [winfo toplevel $W] + + # 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(pressed) 1 +} + +proc ttk::sizegrip::Drag {W X Y} { + variable State + if {!$State(pressed)} { return } + set w [expr {$State(width) + ($X - $State(pressX))/$State(widthInc)}] + set h [expr {$State(height) + ($Y - $State(pressY))/$State(heightInc)}] + if {$w <= 0} { set w 1 } + if {$h <= 0} { set h 1 } + wm geometry $State(toplevel) ${w}x${h} +} + +proc ttk::sizegrip::Release {W X Y} { + variable State + set State(pressed) 0 +} + +#*EOF* diff --git a/library/ttk/treeview.tcl b/library/ttk/treeview.tcl new file mode 100644 index 0000000..265f34c --- /dev/null +++ b/library/ttk/treeview.tcl @@ -0,0 +1,423 @@ +# +# $Id: treeview.tcl,v 1.1 2006/10/31 01:42:27 hobbs Exp $ +# +# Ttk widget set -- bindings for Treeview widget. +# + +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(minWidth) 24 + set State(resizeColumn) #0 + set State(resizeWidth) 0 + + # For pressmode == "heading" + set State(heading) {} + + # Provide [lassign] if not already present + # (@@@ TODO: check if this is still needed after horrible-identify purge) + # + if {![llength [info commands lassign]]} { + proc lassign {vals args} { + uplevel 1 [list foreach $args $vals break] + } + } +} + +### 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 <Control-ButtonPress-1> \ + { ttk::treeview::Select %W %x %y toggle } + +# Standard mousewheel bindings: +# +bind Treeview <MouseWheel> { %W yview scroll [expr {- (%D / 120) * 4}] units } +if {[string equal "x11" [tk windowingsystem]]} { + bind Treeview <ButtonPress-4> { %W yview scroll -5 units } + bind Treeview <ButtonPress-5> { %W yview scroll 5 units } +} + +### 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} { + variable ::ttk::Cursors + variable State + + set cursor {} + set activeHeading {} + + lassign [$w identify $x $y] what where detail + switch -- $what { + separator { set cursor $Cursors(hresize) } + heading { set activeHeading $where } + } + + if {[$w cget -cursor] ne $cursor} { + $w configure -cursor $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 {$State(activeHeading) != {}} { + $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} { + lassign [$w identify $x $y] what where detail + focus $w ;# or: ClickToFocus? + + switch -- $what { + nothing { } + heading { heading.press $w $where } + separator { resize.press $w $x $where } + cell - + row - + item { SelectOp $w $where choose } + } + if {$what eq "item" && [string match *indicator $detail]} { + Toggle $w $where + } +} + +## 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. +# +# @@@ needs work. +# +proc ttk::treeview::resize.press {w x column} { + variable State + + set State(pressMode) "resize" + set State(pressX) $x + set State(resizeColumn) $column + set State(resizeWidth) [$w column $column -width] +} + +proc ttk::treeview::resize.drag {w x} { + variable State + set newWidth [expr {$State(resizeWidth) + $x - $State(pressX)}] + if {$newWidth < $State(minWidth)} { + set newWidth $State(minWidth) + } + $w column $State(resizeColumn) -width $newWidth +} + +proc ttk::treeview::resize.release {w x} { + # no-op +} + +### Heading activation. +# + +proc ttk::treeview::heading.press {w column} { + variable State + set State(pressMode) "heading" + set State(heading) $column + $w heading $column state pressed +} + +proc ttk::treeview::heading.drag {w x y} { + variable State + lassign [$w identify $x $y] what where detail + if {$what eq "heading" && $where 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 idle [$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 $item +} +proc ttk::treeview::select.extend.extended {w item} { + if {[set anchor [$w focus]] ne ""} { + $w selection set [between $w $anchor $item] + } else { + BrowseTo $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} { + 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] +} + +### Style settings for selected built-in themes. +# +# Do this here instead of in the theme definitions since the details are +# likely to change; it's better to keep this all in one place for now. +# +namespace eval ::ttk::treeview { + variable theme + namespace import -force ::ttk::style + foreach theme [style theme names] { + style theme settings $theme { + style map Item -foreground [list selected "#FFFFFF"] + style configure Row -background "#EEEEEE" + style configure Heading -relief raised -font TkHeadingFont + style configure Item -justify left + style map Heading -relief { + pressed sunken + } + style map Row -background { + selected #4a6984 + focus #ccccff + alternate #FFFFFF + } + style map Cell -foreground { + selected #FFFFFF + } + } + } +} + +#*EOF* diff --git a/library/ttk/ttk.tcl b/library/ttk/ttk.tcl new file mode 100644 index 0000000..f573bfc --- /dev/null +++ b/library/ttk/ttk.tcl @@ -0,0 +1,200 @@ +# +# $Id: ttk.tcl,v 1.1 2006/10/31 01:42:27 hobbs Exp $ +# +# 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 keynav.tcl] +source [file join $::ttk::library fonts.tcl] +source [file join $::ttk::library cursors.tcl] +source [file join $::ttk::library icons.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 + eval [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" +} + +### Forward-compatibility. +# +# ttk::panedwindow used to be named ttk::paned. Keep the alias for now. +# +::ttk::deprecated ::ttk::paned ::ttk::panedwindow + +if {[info exists ::ttk::deprecrated] && $::ttk::deprecated} { + ### Deprecated bits. + # + + namespace eval ::tile { + # Deprecated namespace. Define these only when requested + variable library + if {![info exists library]} { + set library [file dirname [info script]] + } + + variable version 0.7.8 + variable patchlevel 0.7.8 + } + package provide tile $::tile::version + + ### Widgets. + # Widgets are all defined in the ::ttk namespace. + # + # For compatibility with earlier Tile releases, we temporarily + # create aliases ::tile::widget, and ::t$widget. + # Using any of the aliases will issue a warning. + # + + namespace eval ttk { + variable widgets { + button checkbutton radiobutton menubutton label entry + frame labelframe scrollbar + notebook progressbar combobox separator + scale + } + + variable wc + foreach wc $widgets { + namespace export $wc + + deprecated ::t$wc ::ttk::$wc + deprecated ::tile::$wc ::ttk::$wc + namespace eval ::tile [list namespace export $wc] + } + } +} + +### ::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 treeview.tcl] +source [file join $::ttk::library sizegrip.tcl] +source [file join $::ttk::library dialog.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 themes. +# +source [file join $::ttk::library defaults.tcl] +source [file join $::ttk::library classicTheme.tcl] +source [file join $::ttk::library altTheme.tcl] +source [file join $::ttk::library clamTheme.tcl] + +### Choose platform-specific default theme. +# +# Notes: +# + xpnative takes precedence over winnative if available. +# + On X11, users can use the X resource database to +# specify a preferred theme (*TkTheme: themeName) +# + +set ::ttk::defaultTheme "default" + +if {[package provide ttk::theme::winnative] != {}} { + source [file join $::ttk::library winTheme.tcl] + set ::ttk::defaultTheme "winnative" +} +if {[package provide ttk::theme::xpnative] != {}} { + source [file join $::ttk::library xpTheme.tcl] + set ::ttk::defaultTheme "xpnative" +} +if {[package provide ttk::theme::aqua] != {}} { + source [file join $::ttk::library aquaTheme.tcl] + set ::ttk::defaultTheme "aqua" +} + +set ::ttk::userTheme [option get . tkTheme TkTheme] +if {$::ttk::userTheme != {}} { + if {($::ttk::userTheme in [::ttk::style theme names]) + || ![catch {package require ttk::theme::$ttk::userTheme}]} { + set ::ttk::defaultTheme $::ttk::userTheme + } +} + +::ttk::setTheme $::ttk::defaultTheme + +#*EOF* diff --git a/library/ttk/utils.tcl b/library/ttk/utils.tcl new file mode 100644 index 0000000..b8059ae --- /dev/null +++ b/library/ttk/utils.tcl @@ -0,0 +1,234 @@ +# +# $Id: utils.tcl,v 1.1 2006/10/31 01:42:27 hobbs Exp $ +# +# Ttk widget set: utilities for widget implementations. +# + +### Focus management. +# + +## ttk::takefocus -- +# This is the default value of the "-takefocus" option +# for widgets that participate in keyboard navigation. +# +# See also: tk::FocusOK +# +proc ttk::takefocus {w} { + expr {[$w instate !disabled] && [winfo viewable $w]} +} + +## 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: +# +# + widget is viewable, AND: +# - if -takefocus is missing or empty, return 0, OR +# - if -takefocus is 0 or 1, return that value, OR +# - append the widget name to -takefocus and evaluate it +# as a script. +# +# See also: tk::FocusOK +# +# Note: This routine doesn't implement the same fallback heuristics +# as tk::FocusOK. +# +proc ttk::takesFocus {w} { + + if {![winfo viewable $w]} { return 0 } + + if {![catch {$w cget -takefocus} takefocus]} { + switch -- $takefocus { + 0 - + 1 { return $takefocus } + "" { return 0 } + default { + set value [uplevel #0 $takefocus [list $w]] + return [expr {$value eq 1}] + } + } + } + + return 0 +} + +### 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 + + 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) +} + +### Miscellaneous. +# + +## 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] + } +} + +## ttk::LoadImages $imgdir ?$patternList? -- +# Utility routine for pixmap themes +# +# Loads all image files in $imgdir matching $patternList. +# Returns: a paired list of filename/imagename pairs. +# +proc ttk::LoadImages {imgdir {patterns {*.gif}}} { + foreach pattern $patterns { + foreach file [glob -directory $imgdir $pattern] { + set img [file tail [file rootname $file]] + if {![info exists images($img)]} { + set images($img) [image create photo -file $file] + } + } + } + return [array get images] +} + +#*EOF* diff --git a/library/ttk/winTheme.tcl b/library/ttk/winTheme.tcl new file mode 100644 index 0000000..ac4cba9 --- /dev/null +++ b/library/ttk/winTheme.tcl @@ -0,0 +1,61 @@ +# +# $Id: winTheme.tcl,v 1.1 2006/10/31 01:42:27 hobbs Exp $ +# +# Ttk widget set: Windows Native theme +# + +namespace eval ttk { + + style theme settings winnative { + + style configure "." \ + -background SystemButtonFace \ + -foreground SystemWindowText \ + -selectforeground SystemHighlightText \ + -selectbackground SystemHighlight \ + -troughcolor SystemScrollbar \ + -font TkDefaultFont \ + ; + + style map "." -foreground [list disabled SystemGrayText] ; + style map "." -embossed [list disabled 1] ; + + style configure TButton -width -11 -relief raised -shiftrelief 1 + style configure TCheckbutton -padding "2 4" + style configure TRadiobutton -padding "2 4" + style configure TMenubutton -padding "8 4" -arrowsize 3 -relief raised + + style map TButton -relief {{!disabled pressed} sunken} + + style configure TEntry \ + -padding 2 -selectborderwidth 0 -insertwidth 1 + style map TEntry \ + -fieldbackground \ + [list readonly SystemButtonFace disabled SystemButtonFace] \ + -selectbackground [list !focus SystemWindow] \ + -selectforeground [list !focus SystemWindowText] \ + ; + + style configure TCombobox -padding 2 + style map TCombobox \ + -selectbackground [list !focus SystemWindow] \ + -selectforeground [list !focus SystemWindowText] \ + -foreground [list {readonly focus} SystemHighlightText] \ + -focusfill [list {readonly focus} SystemHighlight] \ + ; + + style configure TLabelframe -borderwidth 2 -relief groove + + style configure Toolbutton -relief flat -padding {8 4} + style map Toolbutton -relief \ + {disabled flat selected sunken pressed sunken active raised} + + style configure TScale -groovewidth 4 + + style configure TNotebook -tabmargins {2 2 2 0} + style configure TNotebook.Tab -padding {3 1} -borderwidth 1 + style map TNotebook.Tab -expand [list selected {2 2 2 0}] + + style configure TProgressbar -borderwidth 0 -background SystemHighlight + } +} diff --git a/library/ttk/xpTheme.tcl b/library/ttk/xpTheme.tcl new file mode 100644 index 0000000..7749e56 --- /dev/null +++ b/library/ttk/xpTheme.tcl @@ -0,0 +1,51 @@ +# +# $Id: xpTheme.tcl,v 1.1 2006/10/31 01:42:27 hobbs Exp $ +# +# Ttk widget set: XP Native theme +# +# @@@ todo: spacing and padding needs tweaking + +namespace eval ttk { + + style theme settings xpnative { + + style configure . \ + -background SystemButtonFace \ + -foreground SystemWindowText \ + -selectforeground SystemHighlightText \ + -selectbackground SystemHighlight \ + -font TkDefaultFont \ + ; + + style map "." \ + -foreground [list disabled SystemGrayText] \ + ; + + style configure TButton -padding {1 1} -width -11 + style configure TRadiobutton -padding 2 + style configure TCheckbutton -padding 2 + style configure TMenubutton -padding {8 4} + + style configure TNotebook -tabmargins {2 2 2 0} + style map TNotebook.Tab \ + -expand [list selected {2 2 2 2}] + + style configure TLabelframe -foreground "#0046d5" + + # OR: -padding {3 3 3 6}, which some apps seem to use. + style configure TEntry -padding {2 2 2 4} + style map TEntry \ + -selectbackground [list !focus SystemWindow] \ + -selectforeground [list !focus SystemWindowText] \ + ; + style configure TCombobox -padding 2 + style map TCombobox \ + -selectbackground [list !focus SystemWindow] \ + -selectforeground [list !focus SystemWindowText] \ + -foreground [list {readonly focus} SystemHighlightText] \ + -focusfill [list {readonly focus} SystemHighlight] \ + ; + + style configure Toolbutton -padding {4 4} + } +} |