diff options
Diffstat (limited to 'library')
105 files changed, 5306 insertions, 1927 deletions
diff --git a/library/bgerror.tcl b/library/bgerror.tcl index fe8dfe0..812e44a 100644 --- a/library/bgerror.tcl +++ b/library/bgerror.tcl @@ -6,10 +6,10 @@ # trace (like save it to a log). This is adapted from work done by # Donal K. Fellows. # -# Copyright (c) 1998-2000 by Ajuba Solutions. -# Copyright (c) 2007 by ActiveState Software Inc. -# Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net> -# Copyright (c) 2009 Pat Thoyts <patthoyts@users.sourceforge.net> +# Copyright © 1998-2000 Ajuba Solutions. +# Copyright © 2007 ActiveState Software Inc. +# Copyright © 2007 Daniel A. Steffen <das@users.sourceforge.net> +# Copyright © 2009 Pat Thoyts <patthoyts@users.sourceforge.net> namespace eval ::tk::dialog::error { namespace import -force ::tk::msgcat::* @@ -207,7 +207,7 @@ proc ::tk::dialog::error::bgerror {err {flag 1}} { foreach {name caption} $buttons { ttk::button $dlg.$name -text $caption -default normal \ -command [namespace code [list set button $i]] - grid $dlg.$name -in $dlg.bot -column $i -row 0 -sticky ew -padx 10 + grid $dlg.$name -in $dlg.bot -column $i -row 0 -sticky ew -padx 7.5p grid columnconfigure $dlg.bot $i -weight 1 # We boost the size of some Mac buttons for l&f if {$windowingsystem eq "aqua"} { diff --git a/library/button.tcl b/library/button.tcl index 9b13607..4be16b1 100644 --- a/library/button.tcl +++ b/library/button.tcl @@ -4,9 +4,9 @@ # checkbutton, and radiobutton widgets and provides procedures # that help in implementing those bindings. # -# Copyright (c) 1992-1994 The Regents of the University of California. -# Copyright (c) 1994-1996 Sun Microsystems, Inc. -# Copyright (c) 2002 ActiveState Corporation. +# Copyright © 1992-1994 The Regents of the University of California. +# Copyright © 1994-1996 Sun Microsystems, Inc. +# Copyright © 2002 ActiveState Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -21,7 +21,7 @@ if {[tk windowingsystem] eq "aqua"} { bind Radiobutton <Enter> { tk::ButtonEnter %W } - bind Radiobutton <1> { + bind Radiobutton <Button-1> { tk::ButtonDown %W } bind Radiobutton <ButtonRelease-1> { @@ -30,7 +30,7 @@ if {[tk windowingsystem] eq "aqua"} { bind Checkbutton <Enter> { tk::ButtonEnter %W } - bind Checkbutton <1> { + bind Checkbutton <Button-1> { tk::ButtonDown %W } bind Checkbutton <ButtonRelease-1> { @@ -41,16 +41,16 @@ if {[tk windowingsystem] eq "aqua"} { } } if {"win32" eq [tk windowingsystem]} { - bind Checkbutton <equal> { + bind Checkbutton <=> { tk::CheckRadioInvoke %W select } - bind Checkbutton <plus> { + bind Checkbutton <+> { tk::CheckRadioInvoke %W select } bind Checkbutton <minus> { tk::CheckRadioInvoke %W deselect } - bind Checkbutton <1> { + bind Checkbutton <Button-1> { tk::CheckRadioDown %W } bind Checkbutton <ButtonRelease-1> { @@ -63,7 +63,7 @@ if {"win32" eq [tk windowingsystem]} { tk::ButtonLeave %W } - bind Radiobutton <1> { + bind Radiobutton <Button-1> { tk::CheckRadioDown %W } bind Radiobutton <ButtonRelease-1> { @@ -84,10 +84,10 @@ if {"x11" eq [tk windowingsystem]} { tk::CheckRadioInvoke %W } } - bind Checkbutton <1> { + bind Checkbutton <Button-1> { tk::CheckInvoke %W } - bind Radiobutton <1> { + bind Radiobutton <Button-1> { tk::CheckRadioInvoke %W } bind Checkbutton <Enter> { @@ -127,7 +127,7 @@ bind Button <Enter> { bind Button <Leave> { tk::ButtonLeave %W } -bind Button <1> { +bind Button <Button-1> { tk::ButtonDown %W } bind Button <ButtonRelease-1> { diff --git a/library/choosedir.tcl b/library/choosedir.tcl index 33a66b1..c583215 100644 --- a/library/choosedir.tcl +++ b/library/choosedir.tcl @@ -2,7 +2,7 @@ # # Choose directory dialog implementation for Unix/Mac. # -# Copyright (c) 1998-2000 by Scriptics Corporation. +# Copyright © 1998-2000 Scriptics Corporation. # All rights reserved. # Make sure the tk::dialog namespace, in which all dialogs should live, exists diff --git a/library/clrpick.tcl b/library/clrpick.tcl index cc38005..3ab4b13 100644 --- a/library/clrpick.tcl +++ b/library/clrpick.tcl @@ -3,7 +3,7 @@ # Color selection dialog for platforms that do not support a # standard color selection dialog. # -# Copyright (c) 1996 Sun Microsystems, Inc. +# Copyright © 1996 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -50,17 +50,19 @@ proc ::tk::dialog::color:: {args} { set data(NUM_COLORBARS) 16 # BARS_WIDTH is the number of pixels wide the color bar portion of the - # canvas is. This number must be a multiple of NUM_COLORBARS - set data(BARS_WIDTH) 160 + # canvas is. BARS_WIDTH, BARS_WIDTH * 1.25, BARS_WIDTH * 1.5, and + # BARS_WIDTH * 1.75 must be multiples of NUM_COLORBARS. + set data(BARS_WIDTH) [::tk::ScaleNum 192] # PLGN_WIDTH is the number of pixels wide of the triangular selection # polygon. This also results in the definition of the padding on the - # left and right sides which is half of PLGN_WIDTH. Make this number even. - set data(PLGN_HEIGHT) 10 + # left and right sides which is half of PLGN_WIDTH. PLGN_WIDTH, + # PLGN_WIDTH * 1.25, PLGN_WIDTH * 1.5, and PLGN_WIDTH * 1.75 must be even. + set data(PLGN_WIDTH) [::tk::ScaleNum 8] # PLGN_HEIGHT is the height of the selection polygon and the height of the # selection rectangle at the bottom of the color bar. No restrictions. - set data(PLGN_WIDTH) 10 + set data(PLGN_HEIGHT) [::tk::ScaleNum 8] Config $dataName $args InitValues $dataName @@ -235,7 +237,7 @@ proc ::tk::dialog::color::BuildDialog {w} { entry $box.entry -textvariable \ ::tk::dialog::color::[winfo name $w]($color,intensity) \ -width 4 - pack $box.label -side left -fill y -padx 2 -pady 3 + pack $box.label -side left -fill y -padx 1.5p -pady 2p pack $box.entry -side left -anchor n -pady 0 pack $box -side left -fill both @@ -251,7 +253,7 @@ proc ::tk::dialog::color::BuildDialog {w} { pack $f.color -expand yes -fill both pack $f.sel -expand yes -fill both - pack $f -side top -fill x -padx 0 -pady 2 + pack $f -side top -fill x -padx 0 -pady 1.5p set data($color,entry) $box.entry set data($color,col) $f.color @@ -272,7 +274,7 @@ proc ::tk::dialog::color::BuildDialog {w} { bind $box.entry <Return> [list tk::dialog::color::HandleRGBEntry $w] } - pack $stripsFrame -side left -fill both -padx 4 -pady 10 + pack $stripsFrame -side left -fill both -padx 3p -pady 7.5p # The selFrame contains a frame that demonstrates the currently # selected color @@ -284,10 +286,10 @@ proc ::tk::dialog::color::BuildDialog {w} { -textvariable ::tk::dialog::color::[winfo name $w](selection) \ -width 16] set f1 [frame $selFrame.f1 -relief sunken -bd 2] - set data(finalCanvas) [frame $f1.demo -bd 0 -width 100 -height 70] + set data(finalCanvas) [frame $f1.demo -bd 0 -width 75p -height 51p] - pack $lab $ent -side top -fill x -padx 4 -pady 2 - pack $f1 -expand yes -anchor nw -fill both -padx 6 -pady 10 + pack $lab $ent -side top -fill x -padx 3p -pady 1.5p + pack $f1 -expand yes -anchor nw -fill both -padx 4.5p -pady 7.5p pack $data(finalCanvas) -expand yes -fill both bind $ent <Return> [list tk::dialog::color::HandleSelEntry $w] @@ -308,7 +310,7 @@ proc ::tk::dialog::color::BuildDialog {w} { set data(cancelBtn) $botFrame.cancel grid x $botFrame.ok x $botFrame.cancel x -sticky ew - grid configure $botFrame.ok $botFrame.cancel -padx 10 -pady 10 + grid configure $botFrame.ok $botFrame.cancel -padx 7.5p -pady 7.5p grid columnconfigure $botFrame {0 4} -weight 1 -uniform space grid columnconfigure $botFrame {1 3} -weight 1 -uniform button grid columnconfigure $botFrame 2 -weight 2 -uniform space diff --git a/library/comdlg.tcl b/library/comdlg.tcl index b4d8978..0a7f65b 100644 --- a/library/comdlg.tcl +++ b/library/comdlg.tcl @@ -3,7 +3,7 @@ # Some functions needed for the common dialog boxes. Probably need to go # in a different file. # -# Copyright (c) 1996 Sun Microsystems, Inc. +# Copyright © 1996 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. diff --git a/library/console.tcl b/library/console.tcl index 83723f1..2ff0029 100644 --- a/library/console.tcl +++ b/library/console.tcl @@ -4,9 +4,9 @@ # can be used by non-unix systems that do not have built-in support # for shells. # -# Copyright (c) 1995-1997 Sun Microsystems, Inc. -# Copyright (c) 1998-2000 Ajuba Solutions. -# Copyright (c) 2007-2008 Daniel A. Steffen <das@users.sourceforge.net> +# Copyright © 1995-1997 Sun Microsystems, Inc. +# Copyright © 1998-2000 Ajuba Solutions. +# Copyright © 2007-2008 Daniel A. Steffen <das@users.sourceforge.net> # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -215,7 +215,7 @@ proc ::tk::ConsoleSource {} { [list [mc "Tcl Scripts"] .tcl] \ [list [mc "All Files"] *]]] if {$filename ne ""} { - set cmd [list source $filename] + set cmd [list source -encoding utf-8 $filename] if {[catch {consoleinterp eval $cmd} result]} { ConsoleOutput stderr "$result\n" } @@ -424,7 +424,7 @@ proc ::tk::ConsoleBind {w} { # gets and overhaul of how it handles input -- hobbs bind Console <Control-t> {} - # Ignore all Alt, Meta, and Control keypresses unless explicitly bound. + # Ignore all Alt, Meta, Control, Command, and Fn keypresses unless explicitly bound. # Otherwise, if a widget binding for one of these is defined, the # <Keypress> class binding will also fire and insert the character # which is wrong. @@ -432,10 +432,8 @@ proc ::tk::ConsoleBind {w} { bind Console <Alt-Key> {# nothing } bind Console <Meta-Key> {# nothing} bind Console <Control-Key> {# nothing} - if {[tk windowingsystem] eq "aqua"} { - bind Console <Command-Key> {# nothing} - bind Console <Mod4-Key> {# nothing} - } + bind Console <Command-Key> {# nothing} + bind Console <Fn-Key> {# nothing} foreach {ev key} { <<Console_NextImmediate>> <Control-n> @@ -458,23 +456,16 @@ proc ::tk::ConsoleBind {w} { <<Console_Transpose>> <Control-t> <<Console_ClearLine>> <Control-u> <<Console_SaveCommand>> <Control-z> - <<Console_FontSizeIncr>> <Control-plus> + <<Console_FontSizeIncr>> <Control-+> <<Console_FontSizeDecr>> <Control-minus> + <<Console_FontSizeIncr>> <Command-+> + <<Console_FontSizeDecr>> <Command-minus> } { event add $ev $key bind Console $key {} } - if {[tk windowingsystem] eq "aqua"} { - foreach {ev key} { - <<Console_FontSizeIncr>> <Command-plus> - <<Console_FontSizeDecr>> <Command-minus> - } { - event add $ev $key - bind Console $key {} - } - if {$::tk::console::useFontchooser} { - bind Console <Command-t> [list ::tk::console::FontchooserToggle] - } + if {$::tk::console::useFontchooser} { + bind Console <Command-t> [list ::tk::console::FontchooserToggle] } bind Console <<Console_Expand>> { if {[%W compare insert > promptEnd]} { @@ -598,10 +589,8 @@ proc ::tk::ConsoleBind {w} { eval destroy [winfo child .] source -encoding utf-8 [file join $tk_library console.tcl] } - if {[tk windowingsystem] eq "aqua"} { - bind Console <Command-q> { - exit - } + bind Console <Command-q> { + exit } bind Console <<Cut>> { ::tk::console::Cut %W } bind Console <<Copy>> { ::tk::console::Copy %W } diff --git a/library/demos/combo.tcl b/library/demos/combo.tcl index 8631904..acab497 100644 --- a/library/demos/combo.tcl +++ b/library/demos/combo.tcl @@ -43,7 +43,8 @@ set secondValue unchangable set ozCity Sydney ttk::labelframe $w.c1 -text "Fully Editable" -ttk::combobox $w.c1.c -textvariable firstValue +ttk::combobox $w.c1.c -textvariable firstValue -placeholder {Enter text here} +ttk::style configure TEntry -placeholderforeground gray50 ttk::labelframe $w.c2 -text Disabled ttk::combobox $w.c2.c -textvariable secondValue -state disabled ttk::labelframe $w.c3 -text "Defined List Only" diff --git a/library/demos/en.msg b/library/demos/en.msg index 05d4a64..ca1da22 100644 --- a/library/demos/en.msg +++ b/library/demos/en.msg @@ -9,40 +9,31 @@ ::msgcat::mcset en "Meta-q" ;# Actual binding sequence ::msgcat::mcset en "Ctrl+Q" ;# Displayed hotkey ::msgcat::mcset en "Control-q" ;# Actual binding sequence +::msgcat::mcset en "See Variables" ::msgcat::mcset en "Variable values" ::msgcat::mcset en "Variable values:" ::msgcat::mcset en "OK" ::msgcat::mcset en "Run the \"%s\" sample program" ::msgcat::mcset en "Dismiss" ::msgcat::mcset en "Rerun Demo" +::msgcat::mcset en "Print Code" ::msgcat::mcset en "Demo code: %s" ::msgcat::mcset en "About Widget Demo" -::msgcat::mcset en "Tk widget demonstration application" +::msgcat::mcset en "Tk widget demonstration" ::msgcat::mcset en "Copyright © %s" -::msgcat::mcset en " - @@title - Tk Widget Demonstrations - @@newline - @@normal - @@newline - This application provides a front end for several short scripts - that demonstrate what you can do with Tk widgets. Each of the - numbered lines below describes a demonstration; you can click on - it to invoke the demonstration. Once the demonstration window - appears, you can click the - @@bold - See Code - @@normal - button to see the Tcl/Tk code that created the demonstration. If - you wish, you can edit the code and click the - @@bold - Rerun Demo - @@normal - button in the code window to reinvoke the demonstration with the - modified code. - @@newline -" +::msgcat::mcset en "Tk Widget Demonstrations" +::msgcat::mcset en "This application provides a front end for several short scripts" +::msgcat::mcset en "that demonstrate what you can do with Tk widgets. Each of the" +::msgcat::mcset en "numbered lines below describes a demonstration; you can click on" +::msgcat::mcset en "it to invoke the demonstration. Once the demonstration window" +::msgcat::mcset en "appears, you can click the" +::msgcat::mcset en "See Code" "See Code" ;# This is also button text! +::msgcat::mcset en "button to see the Tcl/Tk code that created the demonstration. If" +::msgcat::mcset en "you wish, you can edit the code and click the" +::msgcat::mcset en "button in the code window to reinvoke the demonstration with the" +::msgcat::mcset en "modified code." + ::msgcat::mcset en "Labels, buttons, checkbuttons, and radiobuttons" ::msgcat::mcset en "Labels (text and bitmaps)" ::msgcat::mcset en "Labels and UNICODE text" @@ -54,22 +45,26 @@ ::msgcat::mcset en "Two labels displaying images" ::msgcat::mcset en "A simple user interface for viewing images" ::msgcat::mcset en "Labelled frames" + ::msgcat::mcset en "Listboxes" ::msgcat::mcset en "The 50 states" ::msgcat::mcset en "Colors: change the color scheme for the application" ::msgcat::mcset en "A collection of famous and infamous sayings" + ::msgcat::mcset en "Entries and Spin-boxes" ::msgcat::mcset en "Entries without scrollbars" ::msgcat::mcset en "Entries with scrollbars" ::msgcat::mcset en "Validated entries and password fields" ::msgcat::mcset en "Spin-boxes" ::msgcat::mcset en "Simple Rolodex-like form" + ::msgcat::mcset en "Text" ::msgcat::mcset en "Basic editable text" ::msgcat::mcset en "Text display styles" ::msgcat::mcset en "Hypertext (tag bindings)" ::msgcat::mcset en "A text widget with embedded windows" ::msgcat::mcset en "A search tool built with a text widget" + ::msgcat::mcset en "Canvases" ::msgcat::mcset en "The canvas item types" ::msgcat::mcset en "A simple 2-D plot" @@ -78,9 +73,11 @@ ::msgcat::mcset en "A ruler with adjustable tab stops" ::msgcat::mcset en "A building floor plan" ::msgcat::mcset en "A simple scrollable canvas" + ::msgcat::mcset en "Scales" ::msgcat::mcset en "Horizontal scale" ::msgcat::mcset en "Vertical scale" + ::msgcat::mcset en "Paned Windows" ::msgcat::mcset en "Horizontal paned window" ::msgcat::mcset en "Vertical paned window" @@ -91,7 +88,16 @@ ::msgcat::mcset en "Message boxes" ::msgcat::mcset en "File selection dialog" ::msgcat::mcset en "Color picker" +::msgcat::mcset en "Font selection dialog" +::msgcat::mcset en "System tray icon and notification" +::msgcat::mcset en "Printing from canvas and text widgets" +::msgcat::mcset en "Animation" +::msgcat::mcset en "Animated labels" +::msgcat::mcset en "Animated wave" +::msgcat::mcset en "Pendulum simulation" +::msgcat::mcset en "A celebration of Rube Goldberg" ::msgcat::mcset en "Miscellaneous" ::msgcat::mcset en "The built-in bitmaps" ::msgcat::mcset en "A dialog box with a local grab" ::msgcat::mcset en "A dialog box with a global grab" +::msgcat::mcset en "Window icons and badges" diff --git a/library/demos/entry1.tcl b/library/demos/entry1.tcl index 7365fc7..58eda03 100644 --- a/library/demos/entry1.tcl +++ b/library/demos/entry1.tcl @@ -25,7 +25,7 @@ pack $btns -side bottom -fill x entry $w.e1 entry $w.e2 -entry $w.e3 +entry $w.e3 -placeholder {Enter text here} -placeholderforeground gray75 pack $w.e1 $w.e2 $w.e3 -side top -pady 5 -padx 10 -fill x $w.e1 insert 0 "Initial value" diff --git a/library/demos/entry2.tcl b/library/demos/entry2.tcl index a4009a7..1b143bc 100644 --- a/library/demos/entry2.tcl +++ b/library/demos/entry2.tcl @@ -44,3 +44,4 @@ $w.frame.e1 insert 0 "Initial value" $w.frame.e2 insert end "This entry contains a long value, much too long " $w.frame.e2 insert end "to fit in the window at one time, so long in fact " $w.frame.e2 insert end "that you'll have to scan or scroll to see the end." +$w.frame.e3 configure -placeholder {Enter text here} -placeholderforeground gray75 diff --git a/library/demos/entry3.tcl b/library/demos/entry3.tcl index acde1b3..f229de6 100644 --- a/library/demos/entry3.tcl +++ b/library/demos/entry3.tcl @@ -64,13 +64,13 @@ proc focusAndFlash {W fg bg {count 9}} { labelframe $w.l1 -text "Integer Entry" # Alternatively try using {string is digit} for arbitrary length numbers, # and not just 32-bit ones. -entry $w.l1.e -validate focus -vcmd {string is integer %P} +entry $w.l1.e -validate focus -validatecommand {string is integer %P} $w.l1.e configure -invalidcommand \ "focusAndFlash %W [$w.l1.e cget -fg] [$w.l1.e cget -bg]" pack $w.l1.e -fill x -expand 1 -padx 1m -pady 1m labelframe $w.l2 -text "Length-Constrained Entry" -entry $w.l2.e -validate key -invcmd bell -vcmd {expr {[string length %P]<10}} +entry $w.l2.e -validate key -invcmd bell -validatecommand {expr {[string length %P]<10}} pack $w.l2.e -fill x -expand 1 -padx 1m -pady 1m ### PHONE NUMBER ENTRY ### @@ -161,7 +161,7 @@ proc phoneSkipRight {W {add 0}} { labelframe $w.l3 -text "US Phone-Number Entry" entry $w.l3.e -validate key -invcmd bell -textvariable entry3content \ - -vcmd {validatePhoneChange %W %v %i %S} + -validatecommand {validatePhoneChange %W %v %i %S} # Click to focus goes to the first editable character... bind $w.l3.e <FocusIn> { if {"%d" ne "NotifyAncestor"} { @@ -174,7 +174,7 @@ bind $w.l3.e <<NextChar>> {phoneSkipRight %W} pack $w.l3.e -fill x -expand 1 -padx 1m -pady 1m labelframe $w.l4 -text "Password Entry" -entry $w.l4.e -validate key -show "*" -vcmd {expr {[string length %P]<=8}} +entry $w.l4.e -validate key -show "*" -validatecommand {expr {[string length %P]<=8}} pack $w.l4.e -fill x -expand 1 -padx 1m -pady 1m lower [frame $w.mid] diff --git a/library/demos/goldberg.tcl b/library/demos/goldberg.tcl index 90815fb..be64050 100644 --- a/library/demos/goldberg.tcl +++ b/library/demos/goldberg.tcl @@ -113,9 +113,9 @@ proc DoDisplay {w} { DoCtrlFrame $w DoDetailFrame $w if {[tk windowingsystem] ne "aqua"} { - ttk::button $w.show -text "\u00bb" -command [list ShowCtrl $w] -width 2 + ttk::button $w.show -text "»" -command [list ShowCtrl $w] -width 2 } else { - button $w.show -text "\u00bb" -command [list ShowCtrl $w] -width 2 -highlightbackground $C(bg) + button $w.show -text "»" -command [list ShowCtrl $w] -width 2 -highlightbackground $C(bg) } place $w.show -in $w.c -relx 1 -rely 0 -anchor ne update @@ -204,10 +204,10 @@ proc DoDetailFrame {w} { proc ShowCtrl {w} { if {[winfo ismapped $w.ctrl]} { pack forget $w.ctrl - $w.show config -text "\u00bb" + $w.show config -text "»" } else { pack $w.ctrl -side right -fill both -ipady 5 - $w.show config -text "\u00ab" + $w.show config -text "»" } } diff --git a/library/demos/image2.tcl b/library/demos/image2.tcl index 7af52be..34c94a4 100644 --- a/library/demos/image2.tcl +++ b/library/demos/image2.tcl @@ -94,7 +94,7 @@ labelframe $w.f -text "File:" -padx 2m -pady 2m listbox $w.f.list -width 20 -height 10 -yscrollcommand "$w.f.scroll set" ttk::scrollbar $w.f.scroll -command "$w.f.list yview" pack $w.f.list $w.f.scroll -side left -fill y -expand 1 -$w.f.list insert 0 earth.gif earthris.gif teapot.ppm +$w.f.list insert 0 earth.gif earthris.gif teapot.ppm Tcl.svg bind $w.f.list <Double-Button-1> "loadImage $w %x %y" catch {image delete image2a} diff --git a/library/demos/images/Tcl.svg b/library/demos/images/Tcl.svg new file mode 100644 index 0000000..2c18ec1 --- /dev/null +++ b/library/demos/images/Tcl.svg @@ -0,0 +1,75 @@ +<?xml version="1.0" encoding="UTF-8" standalone="no"?> +<!-- Created with Inkscape (http://www.inkscape.org/) --> +<svg + xmlns:dc="http://purl.org/dc/elements/1.1/" + xmlns:cc="http://web.resource.org/cc/" + xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#" + xmlns:svg="http://www.w3.org/2000/svg" + xmlns="http://www.w3.org/2000/svg" + xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd" + xmlns:inkscape="http://www.inkscape.org/namespaces/inkscape" + width="124.98526" + height="264.6875" + id="svg2309" + sodipodi:version="0.32" + inkscape:version="0.45" + sodipodi:modified="true" + version="1.0"> + <defs + id="defs2311" /> + <sodipodi:namedview + id="base" + pagecolor="#ffffff" + bordercolor="#666666" + borderopacity="1.0" + gridtolerance="10000" + guidetolerance="10" + objecttolerance="10" + inkscape:pageopacity="0.0" + inkscape:pageshadow="2" + inkscape:zoom="0.35" + inkscape:cx="375" + inkscape:cy="520" + inkscape:document-units="px" + inkscape:current-layer="layer1" + inkscape:window-width="910" + inkscape:window-height="626" + inkscape:window-x="5" + inkscape:window-y="49" /> + <metadata + id="metadata2314"> + <rdf:RDF> + <cc:Work + rdf:about=""> + <dc:format>image/svg+xml</dc:format> + <dc:type + rdf:resource="http://purl.org/dc/dcmitype/StillImage" /> + </cc:Work> + </rdf:RDF> + </metadata> + <g + inkscape:label="Layer 1" + inkscape:groupmode="layer" + id="layer1" + transform="translate(-311.79308,-365.73272)"> + <g + style="opacity:1;display:inline" + id="g2244" + transform="translate(308.95998,366.42022)"> + <path + id="path4426" + d="M 445.52492,372.22514 C 445.90652,395.55723 445.21415,418.63757 425.02492,440.56889 L 424.27492,441.41264 L 425.39992,441.41264 L 433.64992,441.53764 C 420.24442,469.42405 411.52244,497.23134 392.24367,525.00639 L 391.55617,526.00639 L 392.74367,525.78764 L 402.93117,523.85014 C 395.71427,542.16045 383.37359,554.28293 369.99367,558.35014 C 366.31107,506.78151 392.04593,461.26308 413.89992,415.88139 C 413.92002,415.83965 413.94233,415.79813 413.96242,415.75639 L 413.14992,415.19389 C 377.36425,455.2074 361.23872,511.6427 355.14992,558.19389 C 343.02146,551.34666 338.97913,542.28079 334.86867,529.94389 L 343.33742,533.50639 L 344.21242,533.88139 L 344.02492,532.94389 C 337.58858,504.32416 347.5814,483.78143 357.27492,456.78764 L 364.24367,461.44389 L 365.05617,462.00639 L 365.02492,461.03764 C 364.47892,439.10645 379.24595,417.08983 398.83742,397.44389 L 401.55617,404.72514 L 401.93117,405.69389 L 402.46242,404.78764 L 408.43117,394.85014 L 408.46242,394.78764 C 418.31429,381.21812 428.72988,376.80082 445.52492,372.22514 z " + style="fill:#c3b15f;fill-opacity:1;fill-rule:evenodd;stroke:none;stroke-width:1px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1;display:inline" + transform="translate(-324.02492,-364.63139)" /> + <path + sodipodi:nodetypes="ccccccccccccccccccccccc" + id="path7600" + d="M 121.54988,7.5808058 C 104.81215,12.147023 94.270242,16.613077 84.4375,30.15625 L 84.40625,30.21875 L 78.4375,40.15625 L 77.90625,41.0625 L 77.53125,40.09375 L 74.8125,32.8125 C 55.22103,52.45844 40.454,74.47506 41,96.40625 L 41.03125,97.375 L 40.21875,96.8125 L 33.25,92.15625 C 23.55648,119.15004 13.56366,139.69277 20,168.3125 L 20.1875,169.25 L 19.3125,168.875 L 10.9375,165.34375 C 10.96447,165.51523 11.003113,165.67421 11.03125,165.84375 C 15.080346,177.9015 19.176955,186.81713 31.125,193.5625 C 31.596616,189.95681 32.122231,186.27456 32.71875,182.5625 C 18.12816,148.39836 30.79293,123.2814 36.5625,100.6875 L 45.4375,105.8125 C 44.211577,84.657017 56.63174,61.842112 72.78125,41.9375 L 77.46875,50.1875 C 89.477498,25.486664 98.97512,15.57175 121.54988,7.5808058 z " + style="opacity:1;fill:#eff1cb;fill-opacity:1;fill-rule:evenodd;stroke:#eff1cb;stroke-width:1px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1;display:inline" /> + <path + style="fill:#000000;fill-opacity:1;fill-rule:evenodd;stroke:none;stroke-width:1px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1;display:inline" + d="M 126.9375,-0.6875 L 126.40625,-0.59375 C 106.72165,2.83976 87.4508,10.07244 79,27.375 L 75.4375,21.15625 L 75.125,20.59375 L 74.65625,21.0625 C 64.96254,30.33838 54.55574,42.35306 46.875,54.15625 C 39.66528,65.23562 34.88327,76.07934 35.40625,84.375 L 30.375,78.09375 L 29.875,77.46875 L 29.53125,78.1875 C 23.40732,91.41649 17.22694,107.69157 13.53125,122.625 C 10.02725,136.78385 8.77244,149.67206 12.03125,157.78125 L 3.75,152.96875 L 3.0625,152.5625 L 3,153.375 C 1.44089,176.99202 11.0382,188.26833 22.0625,199.15625 L 12.875,201.4375 L 11.03125,201.90625 L 12.875,202.40625 C 18.14953,203.83558 23.15023,205.44485 26.625,208.125 C 30.09977,210.80515 32.09598,214.49082 31.5,220.375 L 31.5,220.40625 L 31.5,245.90625 L 31.5,246.0625 L 31.59375,246.1875 L 43.09375,262.6875 L 44,264 L 44,262.40625 L 44,223.53125 C 45.52181,216.98735 47.30807,212.4833 49.875,209.5 C 52.44193,206.5167 55.78211,204.98483 60.5625,204.40625 L 62.28125,204.1875 L 60.71875,203.46875 L 54.65625,200.59375 C 69.11174,191.89001 85.3013,170.55445 89.5625,150.28125 L 89.75,149.46875 L 88.96875,149.6875 L 81.46875,151.71875 C 88.13174,145.46249 94.84392,133.06721 101.21875,118.625 C 107.9798,103.3078 114.29247,85.96032 119.46875,72.09375 L 119.75,71.34375 L 118.96875,71.40625 L 113.1875,71.8125 C 120.3346,64.22669 124.30703,51.6996 126.25,38.46875 C 128.27227,24.69793 128.13035,10.1977 127,-0.15625 L 126.9375,-0.6875 z M 121.5,7.59375 C 121.8816,30.92584 121.18923,54.00618 101,75.9375 L 100.25,76.78125 L 101.375,76.78125 L 109.625,76.90625 C 96.2195,104.79266 87.49752,132.59995 68.21875,160.375 L 67.53125,161.375 L 68.71875,161.15625 L 78.90625,159.21875 C 71.68935,177.52906 59.34867,189.65154 45.96875,193.71875 C 42.28615,142.15012 68.02101,96.63169 89.875,51.25 C 89.8951,51.20826 89.91741,51.16674 89.9375,51.125 L 89.125,50.5625 C 53.33933,90.57601 37.2138,147.01131 31.125,193.5625 C 18.99654,186.71527 14.95421,177.6494 10.84375,165.3125 L 19.3125,168.875 L 20.1875,169.25 L 20,168.3125 C 13.56366,139.69277 23.55648,119.15004 33.25,92.15625 L 40.21875,96.8125 L 41.03125,97.375 L 41,96.40625 C 40.454,74.47506 55.22103,52.45844 74.8125,32.8125 L 77.53125,40.09375 L 77.90625,41.0625 L 78.4375,40.15625 L 84.40625,30.21875 L 84.4375,30.15625 C 94.28937,16.58673 104.70496,12.16943 121.5,7.59375 z " + id="path2177" /> + </g> + </g> +</svg> diff --git a/library/demos/images/Tk_feather.png b/library/demos/images/Tk_feather.png Binary files differnew file mode 100644 index 0000000..cb80203 --- /dev/null +++ b/library/demos/images/Tk_feather.png diff --git a/library/demos/images/plowed_field.png b/library/demos/images/plowed_field.png Binary files differnew file mode 100644 index 0000000..ef3b218 --- /dev/null +++ b/library/demos/images/plowed_field.png diff --git a/library/demos/images/starry_night.png b/library/demos/images/starry_night.png Binary files differnew file mode 100644 index 0000000..331ea1d --- /dev/null +++ b/library/demos/images/starry_night.png diff --git a/library/demos/knightstour.tcl b/library/demos/knightstour.tcl index 11b3b5c..09ceff0 100644 --- a/library/demos/knightstour.tcl +++ b/library/demos/knightstour.tcl @@ -1,4 +1,4 @@ -# Copyright (C) 2008 Pat Thoyts <patthoyts@users.sourceforge.net> +# Copyright © 2008 Pat Thoyts <patthoyts@users.sourceforge.net> # # Calculate a Knight's tour of a chessboard. # @@ -205,10 +205,10 @@ proc CreateGUI {} { } if {[tk windowingsystem] ne "x11"} { catch {eval font create KnightFont -size -24} - $c create text 0 0 -font KnightFont -text "\u265e" \ + $c create text 0 0 -font KnightFont -text "♞" \ -anchor nw -tags knight -fill black -activefill "#600000" } else { - # On X11 we cannot reliably tell if the \u265e glyph is available + # On X11 we cannot reliably tell if the ♞ glyph is available # so just use a polygon set pts { 2 25 24 25 21 19 20 8 14 0 10 0 0 13 0 16 diff --git a/library/demos/mac_styles.tcl b/library/demos/mac_styles.tcl new file mode 100644 index 0000000..33fa888 --- /dev/null +++ b/library/demos/mac_styles.tcl @@ -0,0 +1,268 @@ +# mac_styles.tcl -- +# +# This demonstration script creates a toplevel window containing a notebook +# whose pages provide examples of the various mac-specific widgets that are +# provided via special values for the -style option. + +if {![info exists widgetDemo]} { + error "This script should be run from the \"widget\" demo." +} + +package require Tk + +set w .mac_styles +catch {destroy $w} +toplevel $w +package require Tk +wm title $w "Tk Aqua Widgets" +wm iconname $w "mac_styles" +positionWindow $w +## +# System images we use in our buttons + +set featherImg [file join $tk_demoDirectory images Tk_feather.png] +set starryImg [file join $tk_demoDirectory images starry_night.png] +set fieldImg [file join $tk_demoDirectory images plowed_field.png] +image create nsimage action -source NSAction -width 48 -height 48 +image create nsimage bonjour -source NSBonjour -width 48 -height 48 +image create nsimage bonjour1 -source NSBonjour -width 48 -height 48 -pressed 1 +image create nsimage tkfeather -source $featherImg -as file -width 48 -height 48 +image create nsimage tkfeather1 -source $featherImg -as file -width 48 -height 48 -pressed 1 +image create nsimage starry -source $starryImg -as file -width 96 -radius 10 +image create nsimage starry1 -source $starryImg -as file -width 96 -radius 10 -pressed 1 +image create nsimage starry2 -source $starryImg -as file -width 96 -radius 10 -ring 3 +image create nsimage field -source $fieldImg -as file -width 96 -radius 10 +image create nsimage field1 -source $fieldImg -as file -width 96 -radius 10 -pressed 1 +image create nsimage field2 -source $fieldImg -as file -width 96 -radius 10 -ring 3 +image create nsimage add -source NSAddTemplate -width 20 -height 20 +image create nsimage remove -source NSRemoveTemplate -width 18 -height 4 + +# Off state and variables for checkbuttons and radio buttons +set off {!selected !alternate} +variable $w.checkVar +variable $w.radioVar +variable $w.triangleVar +variable $w.popupVar +variable $w.stepVar +variable $w.comboVar + +# Make a disclosure triangle change state when clicked. +proc toggleTriangle {tri} { + $tri instate {user1} { + $tri state {!user1} + return + } + $tri instate {!user1} { + $tri state {user1} + } +} + +proc popupButton {win varName firstValue args} { + upvar #0 $varName var + if {![info exists var]} { + set var $firstValue + } + ttk::menubutton $win -textvariable $varName -menu $win.menu -direction flush + menu $win.menu -tearoff 0 + $win.menu add radiobutton -label $firstValue -variable $varName + foreach i $args { + $win.menu add radiobutton -label $i -variable $varName + } + return $win.menu +} + +set mag [encoding convertfrom utf-8 "\xf0\x9f\x94\x8d"] + +proc searchFocusOut {e} { + global mag + if {[$e get] eq ""} { + $e configure -foreground gray60 + $e insert 0 "Search" + } +} + +proc searchFocusIn {e} { + if {[$e cget -foreground] == {gray60}} { + $e delete 0 end + $e configure -foreground black + } +} + +## Make the notebook and set up Ctrl+Tab traversal +ttk::notebook $w.notebook +ttk::notebook::enableTraversal $w.notebook + +# Frames pane +set framesFrame [ttk::frame $w.notebook.frames -padding {40 35 40 50}] +$w.notebook add $framesFrame -text "Frames" +pack [ttk::labelframe $framesFrame.darker -text Darker -padding {50 30 50 50}] \ + -fill both -expand 1 +pack [ttk::label $framesFrame.darker.label -padding {0 0 0 6} \ + -text "This Group Box is nested to depth 2"] \ + -fill x +pack [ttk::labelframe $framesFrame.darker.darker -text "Darker Still" -padding 24] \ + -fill both -expand 1 +pack [ttk::label $framesFrame.darker.darker.label \ + -text "This Group Box is nested to depth 3"] -fill x +pack [button $framesFrame.darker.darker.tkbutton -text "Tk Button" -width 7 \ + -highlightbackground systemWindowBackgroundColor3] -pady 10 +pack [ttk::button $framesFrame.darker.darker.ttkbutton -text "Ttk Button" \ + -width 7 -padding {-4 0 -4 0}] \ + -pady 3 +# Button pane +set buttonFrame [ttk::frame $w.notebook.buttons -padding {100 20 0 20}] +$w.notebook add $buttonFrame -text "Buttons" +grid columnconfigure $buttonFrame 0 -minsize 100 +grid columnconfigure $buttonFrame 1 -minsize 100 + +set plain [ttk::button $buttonFrame.plain -text Button -padding {-12 0}] +popupButton $buttonFrame.options .popupVar "Item 1" "Item 2" "Item 3" +set options $buttonFrame.options +set check [ttk::checkbutton $buttonFrame.check -text Check -variable .checkVar] +set radio [ttk::frame $buttonFrame.radio] +pack [ttk::radiobutton $radio.r1 -text "Radio 1" -variable .radioVar -value 1] -pady 4 +pack [ttk::radiobutton $radio.r2 -text "Radio 2" -variable .radioVar -value 2] -pady 4 +set triangle [ttk::checkbutton $buttonFrame.triangle -style Item -variable TriangleVar] +bind $triangle <Button-1> {toggleTriangle %W} +set bonjour [ttk::button $buttonFrame.bonjour -style ImageButton -text Bonjour \ + -image {bonjour pressed bonjour1}] +set feather [ttk::button $buttonFrame.feather -style ImageButton -text Tk \ + -image {tkfeather pressed tkfeather1}] +set gradient [ttk::frame $buttonFrame.gradient] +pack [ttk::button $buttonFrame.gradient.add -style GradientButton \ + -image add -padding {2 0}] -side left +pack [ttk::button $buttonFrame.gradient.remove -style GradientButton \ + -image remove -padding {2 8}] -side left +set disclosure [ttk::checkbutton $buttonFrame.disclosure -style DisclosureButton] +set help [ttk::button $buttonFrame.help -style HelpButton]; + +$check state $off +$radio.r1 state $off +$radio.r2 state $off + +grid [ttk::label $buttonFrame.plainLabel -text "Push Button:"]\ + -row 0 -column 0 -padx 4 -sticky e +grid $plain -pady 4 -row 0 -column 1 -sticky w +grid [ttk::label $buttonFrame.optionsLabel -text "Pop-up Button:"]\ + -row 1 -column 0 -padx 4 -sticky e +grid $options -pady 4 -row 1 -column 1 -sticky w +grid [ttk::label $buttonFrame.checkLabel -text "Check Button:"]\ + -row 2 -column 0 -padx 4 -sticky e +grid $check -pady 4 -row 2 -column 1 -sticky w +grid [ttk::label $buttonFrame.radioLabel -text "Radio Buttons:"]\ + -row 3 -column 0 -padx 4 -sticky e +grid $radio -pady 4 -row 3 -column 1 -sticky w +grid [ttk::label $buttonFrame.triangleLabel -text "Disclosure Triangle:"]\ + -row 4 -column 0 -padx 4 -sticky e +grid $triangle -pady 4 -row 4 -column 1 -sticky w +grid [ttk::label $buttonFrame.disclosureLabel -text "Disclosure Button:"]\ + -row 5 -column 0 -padx 4 -sticky e +grid $disclosure -row 5 -column 1 -sticky w +grid [ttk::label $buttonFrame.imageLabel -text "Image Buttons:"]\ + -row 7 -column 0 -padx 4 -sticky e +grid $bonjour -pady 4 -row 6 -rowspan 4 -column 1 -sticky w +grid $feather -padx 10 -pady 4 -row 6 -rowspan 4 -column 2 +grid [ttk::label $buttonFrame.gradentLabel -text "Gradient Buttons:"]\ +-row 10 -column 0 -padx 4 -sticky e +grid $gradient -pady 4 -row 10 -column 1 -sticky w +grid [ttk::label $buttonFrame.helpLabel -text "Help Button:"]\ +-row 11 -column 0 -padx 4 -sticky e +grid $help -row 11 -column 1 -sticky w + +#ttk::button .f.b1 -style Toolbutton -image action +#pack $buttonFrame + +# Entries Frame +set entryFrame [ttk::frame $w.notebook.entries -padding {0 30 80 0}] +grid columnconfigure $entryFrame 0 -minsize 200 +$w.notebook add $entryFrame -text "Entries" + +set textfield [ttk::entry $entryFrame.text -width 17] +set searchfield [ttk::entry $entryFrame.search -width 1] +set combo [ttk::combobox $entryFrame.combo -width 1 -textvariable comboVar \ + -values {"Item 1" "Item 2" "Item 3"}] +set stepper [ttk::spinbox $entryFrame.stepper -width 1 -textvariable stepVar \ + -from 99000 -to 101000 -increment 1] +set stepVar 100000 +searchFocusOut $searchfield +bind $searchfield <FocusIn> {searchFocusIn %W} +bind $searchfield <FocusOut> {searchFocusOut %W} + +grid [ttk::label $entryFrame.l0 -text "Text Field"] -row 0 -column 0 -padx 20 -sticky e +grid $textfield -sticky ew -row 0 -column 1 -pady 13 +grid [ttk::label $entryFrame.l1 -text "Search Field"] -row 1 -column 0 -padx 20 -sticky e +grid $searchfield -sticky ew -row 1 -column 1 -pady 13 +grid [ttk::label $entryFrame.l2 -text "Combo Box"] -row 2 -column 0 -padx 20 -sticky e +grid $combo -sticky ew -row 2 -column 1 -pady 13 +grid [ttk::label $entryFrame.l3 -text "Stepper"] -row 3 -column 0 -padx 20 -sticky e +grid $stepper -sticky ew -row 3 -column 1 -pady 13 + +#Scales Frame +set scaleFrame [ttk::frame $w.notebook.scales -padding {0 40 0 80}] +$w.notebook add $scaleFrame -text "Scales" + +variable topVar 50 +set topSlider [ttk::scale $scaleFrame.topSlider -from 0 -to 100 \ + -length 280 -variable topVar] +set topProgress [ttk::progressbar $scaleFrame.topProgress \ + -maximum 100 -variable topVar] + +variable bottomVar 50 +set bottomSlider [ttk::scale $scaleFrame.bottomSlider -from 0 -to 100 \ + -length 280 -variable bottomVar] +$bottomSlider state alternate +set bottomProgress [ttk::progressbar $scaleFrame.bottomProgress \ + -maximum 100 -variable bottomVar] + + +grid $topSlider -padx 80 -pady 12 -sticky ew -row 0 -column 0 -columnspan 2 +grid $topProgress -padx 120 -pady 15 -sticky ew -row 1 -column 0 -columnspan 2 +grid [ttk::frame $scaleFrame.spacer] -row 2 -column 0 -columnspan 2 -pady 32 + +grid $bottomSlider -padx 80 -sticky new -row 3 -column 0 -columnspan 2 +grid [ttk::label $scaleFrame.low -text Low -padding {70 0 0 0}] \ + -row 4 -column 0 -sticky sw +grid [ttk::label $scaleFrame.high -text High -padding {0 0 70 0}] \ + -row 4 -column 1 -sticky se +grid $bottomProgress -padx 120 -pady 15 -sticky ew -row 5 -column 0 -columnspan 2 + +#Appearance Frame +set appearanceFrame [ttk::frame $w.notebook.appearance -padding {0 40 0 80}] +grid [ttk::label $w.notebook.appearance.info -justify left -padding {0 20 0 40}\ + -text "Use the image buttons below to view this demo in light or dark mode."] \ + -row 0 -column 0 -columnspan 3 +set light [ttk::button $appearanceFrame.light -style ImageButton -text Light \ + -image {field pressed field1 selected field2} \ + -command "beLight $appearanceFrame $w"] +grid columnconfigure $appearanceFrame 1 -minsize 10 +grid $light -row 1 -column 0 -sticky e +set dark [ttk::button $appearanceFrame.dark -style ImageButton -text Dark \ + -image {starry pressed starry1 selected starry2} \ + -command "beDark $appearanceFrame $w"] +grid $dark -row 1 -column 2 -sticky w +if { [wm attributes $w -isdark] } { + $dark state selected +} else { + $light state selected +} +proc beLight {f w} { + wm attributes $w -appearance aqua + $f.dark state !selected + $f.light state selected + after 10 $f.light state !hover +} + +proc beDark {f w} { + wm attributes $w -appearance darkaqua + $f.light state !selected + $f.dark state selected + after 10 $f.dark state !hover +} +$w.notebook add $appearanceFrame -text "Appearance" + +## See Code / Dismiss +pack [addSeeDismiss $w.buttons $w] -side bottom -fill x + +## Notebook +pack $w.notebook -side bottom -fill both -expand 1 -padx 16 -pady 16 + diff --git a/library/demos/mac_tabs.tcl b/library/demos/mac_tabs.tcl new file mode 100644 index 0000000..16771a8 --- /dev/null +++ b/library/demos/mac_tabs.tcl @@ -0,0 +1,77 @@ +# mac_tabs.tcl -- +# +# This demonstration script creates three tabbable windows and allows the +# wm attributes tabbingid and tabbingmode to be manipulated for the third +# window, to demonstrate the effects of those attributes. + +if {![info exists widgetDemo]} { + error "This script should be run from the \"widget\" demo." +} + +package require Tk +catch {font create giant -family {Times New Roman} -size 64} +set w .mac_tabs +catch {destroy $w} +toplevel $w +package require Tk +wm title $w "Tabbed Windows in Aqua" +wm iconname $w "mac_tabs" +positionWindow $w +set suffix 0 +set winlist {} +## + +## See Code / Dismiss +pack [addSeeDismiss $w.buttons $w] -side bottom -fill x +## +set info "\ +This demo shows 3 toplevels, A, B, and C. \ +Each of these has tabbingmode set to preferred. \ +The tabbingid of Window A is groupA, the \ +tabbingid of Window B is groupB and the tabbingid \ +of Window C is groupC. Use the menubuttons below \ +to see the effect of changing the tabbingid and \ +tabbingmode attributes for Window C. \ +" +pack [message $w.info -text $info -width 300] +wm geometry $w +450+350 + +ttk::frame $w.f +menu $w.idmenu -tearoff 0 +foreach id {groupA groupB groupC} { + $w.idmenu add command -label $id \ + -command [list wm attributes $w.c -tabbingid $id] +} +menu $w.modemenu -tearoff 0 +foreach mode {auto preferred disallowed} { + $w.modemenu add command -label $mode \ + -command [list wm attributes $w.c -tabbingmode $mode] +} +ttk::menubutton $w.f.idbutton -menu $w.idmenu -text "tabbingid"\ + -direction below +grid $w.f.idbutton -row 0 -column 0 +ttk::menubutton $w.f.modebutton -menu $w.modemenu -text "tabbingmode"\ + -direction below +grid $w.f.modebutton -row 1 -column 0 +pack $w.f + +wm attributes $w.a -tabbingid groupA +wm attributes $w.a -tabbingmode preferred +toplevel $w.a +wm geometry $w.a +50+100 +wm title $w.a "Window A" +pack [ttk::label $w.a.l -text A -font giant] -padx 100 -pady 30 + +wm attributes $w.b -tabbingid groupB +wm attributes $w.b -tabbingmode preferred +toplevel $w.b +wm geometry $w.b +400+100 +wm title $w.b "Window B" +pack [ttk::label $w.b.l -text B -font giant] -padx 100 -pady 30 + +wm attributes $w.c -tabbingid groupC +wm attributes $w.c -tabbingmode preferred +toplevel $w.c +wm geometry $w.c +750+100 +wm title $w.c "Window C" +pack [ttk::label $w.c.l -text C -font giant] -padx 100 -pady 30 diff --git a/library/demos/mac_wm.tcl b/library/demos/mac_wm.tcl new file mode 100644 index 0000000..3272623 --- /dev/null +++ b/library/demos/mac_wm.tcl @@ -0,0 +1,228 @@ +# mac_window_styles.tcl -- +# +# This demonstration script creates a toplevel window containing a notebook +# whose pages provide examples of the various mac-specific widgets that are +# provided via special values for the -style option. + +if {![info exists widgetDemo]} { + error "This script should be run from the \"widget\" demo." +} + +package require Tk + +set w .mac_wm +catch {destroy $w} +toplevel $w +package require Tk +wm title $w "Tk Aqua Window Styles" +wm iconname $w "mac_wm" +positionWindow $w +set suffix 0 +set winlist {} +## + +## See Code / Dismiss +pack [addSeeDismiss $w.buttons $w] -side bottom -fill x + +proc launch {name windowInfo class} { + if {[winfo exists $name]} { + wm deiconify $name + focus -force $name + return + } + wm attributes $name -class $class; toplevel $name + wm title $name $class + set f $name.f + ttk::frame $f + set t $f.t + text $t -background systemWindowBackgroundColor \ + -highlightcolor systemWindowBackgroundColor \ + -font systemDefaultFont\ + -wrap word -width 50 -height 6 + $t insert insert $windowInfo + $t configure -state disabled + grid columnconfigure $f 0 -weight 1 + grid $t -row 0 -column 0 -columnspan 2 -sticky NSEW + ttk::labelframe $f.stylemask -text "styleMask bits" + # titled + if {$class == "nswindow"} { + ttk::checkbutton $f.stylemask.titled -text titled -variable $name.titled \ + -command [list setbit $name $f.stylemask.titled titled] + $f.stylemask.titled state selected + grid $f.stylemask.titled -row 0 -column 0 -sticky w + } + # closable + ttk::checkbutton $f.stylemask.closable -text closable -variable $name.closable \ + -command [list setbit $name $f.stylemask.closable closable] + $f.stylemask.closable state selected + grid $f.stylemask.closable -row 1 -column 0 -sticky w + # miniaturizableable + ttk::checkbutton $f.stylemask.miniaturizable -text miniaturizable \ + -variable $name.miniaturizable \ + -command [list setbit $name $f.stylemask.miniaturizable miniaturizable] + if {$class == "nswindow"} { + $f.stylemask.miniaturizable state selected + } else { + $f.stylemask.miniaturizable state !alternate + } + grid $f.stylemask.miniaturizable -row 2 -column 0 -sticky w + # resizable + ttk::checkbutton $f.stylemask.resizable -text resizable -variable $name.resizable \ + -command [list setbit $name $f.stylemask.resizable resizable] + $f.stylemask.resizable state selected + grid $f.stylemask.resizable -row 3 -column 0 -sticky w + # docmodal + ttk::checkbutton $f.stylemask.docmodal -text docmodal -variable $name.docmodal \ + -command [list setbit $name $f.stylemask.docmodal docmodal] + $f.stylemask.docmodal state !alternate + grid $f.stylemask.docmodal -row 4 -column 0 -sticky w + + grid $f.stylemask -row 1 -column 0 + pack $name.f -side bottom -fill both -expand 1 -padx 16 -pady 16 +} + +set info "The command wm attributes window -stylemask ?bitnames? can \ +be used to modify bits in the stylemask property of the NSWindow or \ +NSPanel underlying a Tk Window. Changing these bits causes the \ +style of the window to change. This demo allows you to see the \ +effects of changing the bits. (Note that buttons in the title bar \ +can also be enabled or disabled with the ::tk::unsupported::MacWindowStyle \ +command.)" + +set panelInfo "A toplevel based on an NSPanel has a narrower title bar\ +than one based on an NSWindow. In addition the panel remains above all\ +windows on the screen, regardless of which app is active. These are\ +intended to be used as modal windows." + +set windowInfo "This is a standard Apple document window, based on an\ +NSWindow. It has a larger title bar and behaves normally with respect\ +to other windows from the same or another app." + +## background frame +set f $w.f +ttk::frame $f +set t $f.t +text $t -background systemWindowBackgroundColor \ + -highlightcolor systemWindowBackgroundColor \ + -font systemDefaultFont\ + -wrap word -width 50 -height 8 +$t insert insert $info +$t configure -state disabled +grid columnconfigure $f 0 -weight 1 +grid $t -row 0 -column 0 -columnspan 2 -sticky NSEW +ttk::labelframe $f.stylemask -text "styleMask" +grid $f.stylemask -row 1 -column 0 +grid [ttk::button $f.wbw -text "Open an NSWindow" -width 20 \ + -command [list launch .nswindow $windowInfo nswindow]] -row 2 -column 0 +grid [ttk::button $f.wbp -text "Open an NSPanel" -width 20 \ + -command [list launch .nspanel $panelInfo nspanel]] -row 3 -column 0 +grid [ttk::button $f.wbm -text "Open a modern window" -width 20 \ + -command launchModernWindow] -row 4 -column 0 +pack $w.f -side bottom -fill both -expand 1 -padx 16 -pady 16 + +proc setbit {win cb bitname} { + set state [$cb instate selected] + set bits [wm attributes $win -stylemask] + set index [lsearch $bits $bitname] + if {$index >= 0 && !$state} { + set bits [lreplace $bits $index $index] + } + if {$index < 0 && $state} { + lappend bits $bitname + } + wm attributes $win -stylemask $bits +} + +set aboutText \ +"Most of the apps which ship with a contemporary version of macOS \ +feature a window similar to this one, with a left sidebar that \ +allows selecting the content to be shown on the right hand side of \ +the window. These windows do not have a (visible) titlebar.\ +\n\nApps that use such windows include the Finder and the App Store as \ +well as Notes, Messages, Books, Maps and many others.\ +\n\nTo create a window like this one in Tk simply set the fullsizecontent bit \ +in the stylemask. For example:\n\n" + +set aboutCode \ +"wm attributes .t -stylemask {titled \\\ +\nfullsizecontent closable miniaturizable \\\ +\nresizable}\n\n" + +set detailsText \ +"(1) In the Apple API, setting the fullsizecontent bit in the stylemask \ +only allows content to be drawn in the part of the window covered by \ +the titlebar. In order for that content to be visible the title bar \ +must be transparent. Since it would be pointless to draw content under \ +an opaque title bar, Tk makes the title bar transparent whenever the \ +fullsizecontent bit is set.\ + +\n\n\(2) Each radio button in the sidebar is a standard ttk::radiobutton \ +but created with a special value for its -style option. The value of the \ +-style option used to create these buttons is SidebarButton.\n" + +set whichPage 1 +trace add variable whichPage write "flipPage whichPage" +proc flipPage {varname args} { + global whichPage + set newpage [set $varname] + grid remove [grid content .mod.right -row 0 -column 0] + switch $newpage\ + 1 {grid .mod.right.about -padx 30 -pady 30 -row 0 -column 0 -sticky nsew}\ + 2 {grid .mod.right.details -padx 30 -pady 30 -row 0 -column 0 -sticky nsew} + update idletasks +} + +proc launchModernWindow {} { + global whichPage + global aboutText + global aboutCode + global detailsText + if {[winfo exists .mod]} { + wm deiconify .mod + focus -force .mod + return + } + toplevel .mod + wm title .mod {} + wm attributes .mod -stylemask {titled fullsizecontent closable \ + miniaturizable resizable} + .mod configure -background white + grid columnconfigure .mod 0 -weight 0 + grid columnconfigure .mod 1 -weight 1 + grid rowconfigure .mod 0 -weight 1 + frame .mod.left -width 220 -height 400 -background systemWindowBackgroundColor + catch { + font create leftFont -family .AppleSystemUIFont -size 11 + font create rightFont -family .AppleSystemUIFont -size 16 + font create codeFont -family Courier -size 16 + } + grid [ttk::label .mod.left.spacer -padding {220 30 0 0}] -row 0 -column 0 + grid [ttk::radiobutton .mod.left.about -text About -style SidebarButton \ + -variable whichPage -value 1] \ + -row 1 -column 0 -sticky nsew -padx 14 + grid [ttk::radiobutton .mod.left.details -text Details -style SidebarButton \ + -variable whichPage -value 2] \ + -row 2 -column 0 -sticky nsew -padx 14 + grid .mod.left -row 0 -column 0 -sticky nsew + frame .mod.right -width 500 -background systemTextBackgroundColor + grid rowconfigure .mod.right 0 -weight 0 + text .mod.right.about -highlightcolor systemTextBackgroundColor \ + -background systemTextBackgroundColor -font rightFont \ + -highlightthickness 0 -wrap word -width 40 + .mod.right.about tag configure code -font codeFont + .mod.right.about insert end $aboutText + .mod.right.about insert end $aboutCode code + .mod.right.about configure -state disabled + + text .mod.right.details -highlightcolor systemTextBackgroundColor \ + -background systemTextBackgroundColor -font rightFont\ + -highlightthickness 0 -wrap word -width 40 + .mod.right.details insert end $detailsText + .mod.right.details configure -state disabled + + grid .mod.right.about -padx 30 -pady 30 -row 0 -column 0 -sticky nsew + grid .mod.right -row 0 -column 1 -sticky nsew + wm geometry .mod 800x500 + update idletasks +} + diff --git a/library/demos/mclist.tcl b/library/demos/mclist.tcl index 7a4dd4c..f0136be 100644 --- a/library/demos/mclist.tcl +++ b/library/demos/mclist.tcl @@ -21,7 +21,10 @@ ttk::label $w.msg -font $font -wraplength 4i -justify left -anchor n -padding {1 pack $w.msg -fill x ## See Code / Dismiss -pack [addSeeDismiss $w.seeDismiss $w] -side bottom -fill x +pack [addSeeDismiss $w.seeDismiss $w {} { + ttk::checkbutton $w.seeDismiss.cb1 -text Grid -variable mclistGrid -command tglGrid +}] -side bottom -fill x + ttk::frame $w.container ttk::treeview $w.tree -columns {country capital currency} -show headings \ @@ -117,3 +120,18 @@ proc SortBy {tree col direction} { $tree heading $col -image [expr {$direction?"upArrow":"downArrow"}] } } + +set mclistGrid 0 +proc tglGrid {} { + if {$::mclistGrid} { + .mclist.tree configure -stripe 1 + foreach col [.mclist.tree cget -columns] { + .mclist.tree column $col -separator 1 + } + } else { + .mclist.tree configure -stripe 0 + foreach col [.mclist.tree cget -columns] { + .mclist.tree column $col -separator 0 + } + } +} diff --git a/library/demos/menu.tcl b/library/demos/menu.tcl index 4f5d703..d43a374 100644 --- a/library/demos/menu.tcl +++ b/library/demos/menu.tcl @@ -130,7 +130,7 @@ $m entryconfigure 2 -columnbreak 1 set m $w.menu.more $w.menu add cascade -label "More" -menu $m -underline 0 menu $m -tearoff 0 -foreach i {{An entry} {Another entry} {Does nothing} {Does almost nothing} {Make life meaningful}} { +foreach i {{An entry} {Another entry} {Does nothing} {Does almost nothing} {Does almost nothing also} {Make life meaningful}} { $m add command -label $i -command [list puts "You invoked \"$i\""] } set emojiLabel [encoding convertfrom utf-8 "\xF0\x9F\x98\x8D Make friends"] @@ -142,6 +142,13 @@ $m entryconfigure "Does almost nothing" -bitmap questhead -compound left \ text string. Other than this, it is just like any other\ menu entry." {} 0 OK ] +$m entryconfigure "Does almost nothing also" -image lilearth -compound left \ + -command [list \ + tk_dialog $w.compound {Compound Menu Entry} \ + "The menu entry you invoked displays both a image and a\ + text string. Other than this, it is just like any other\ + menu entry." {} 0 OK ] + set m $w.menu.colors $w.menu add cascade -label "Colors" -menu $m -underline 1 menu $m -tearoff 1 diff --git a/library/demos/nl.msg b/library/demos/nl.msg index cd52630..dc80c15 100644 --- a/library/demos/nl.msg +++ b/library/demos/nl.msg @@ -1,5 +1,5 @@ ::msgcat::mcset nl "Widget Demonstration" "Demonstratie van widgets" -::msgcat::mcset nl "tkWidgetDemo" "tkWidgetDemo" +::msgcat::mcset nl "tkWidgetDemo" ::msgcat::mcset nl "&File" "&Bestand" ::msgcat::mcset nl "About..." "Info..." ::msgcat::mcset nl "&About..." "&Info..." @@ -9,11 +9,13 @@ ::msgcat::mcset nl "Meta-q" "Meta-e" ;# Actual binding sequence ::msgcat::mcset nl "Ctrl+Q" "Ctrl+E" ;# Displayed hotkey ::msgcat::mcset nl "Control-q" "Control-e" ;# Actual binding sequence -::msgcat::mcset nl "Dismiss" "Sluiten" ::msgcat::mcset nl "See Variables" "Bekijk Variabelen" -::msgcat::mcset nl "Variable Values" "Waarden Variabelen" -::msgcat::mcset nl "OK" "OK" +::msgcat::mcset nl "Variable values" "Waarden variabelen" +::msgcat::mcset nl "Variable values:" "Waarden variabelen" +::msgcat::mcset nl "OK" ::msgcat::mcset nl "Run the \"%s\" sample program" "Start voorbeeld \"%s\"" +::msgcat::mcset nl "Dismiss" "Sluiten" +::msgcat::mcset nl "Rerun Demo" "Herstart Demo" ;# This is also button text! ::msgcat::mcset nl "Print Code" "Code Afdrukken" ::msgcat::mcset nl "Demo code: %s" "Code van Demo %s" ::msgcat::mcset nl "About Widget Demo" "Over deze demonstratie" @@ -36,7 +38,6 @@ "drukken om de achterliggende Tcl/Tk code te zien. Als je dat wilt," ::msgcat::mcset nl "you wish, you can edit the code and click the" \ "kun je de code wijzigen en op de knop" -::msgcat::mcset nl "Rerun Demo" "Herstart Demo" ;# This is also button text! ::msgcat::mcset nl "button in the code window to reinvoke the demonstration with the" \ "drukken in het codevenster om de demonstratie uit te voeren met de" ::msgcat::mcset nl "modified code." \ @@ -44,7 +45,6 @@ ::msgcat::mcset nl "Labels, buttons, checkbuttons, and radiobuttons" \ "Labels, knoppen, vinkjes/aankruishokjes en radioknoppen" - ::msgcat::mcset nl "Labels (text and bitmaps)" "Labels (tekst en plaatjes)" ::msgcat::mcset nl "Labels and UNICODE text" "Labels en tekst in UNICODE" ::msgcat::mcset nl "Buttons" "Buttons (drukknoppen)" @@ -106,20 +106,27 @@ ::msgcat::mcset nl "Paned Windows" "Vensters opgedeeld in stukken" ::msgcat::mcset nl "Horizontal paned window" "Horizontaal gedeeld venster" ::msgcat::mcset nl "Vertical paned window" "Verticaal gedeeld venster" - ::msgcat::mcset nl "Menus" "Menu's" ::msgcat::mcset nl "Menus and cascades (sub-menus)" \ "Menu's en cascades (submenu's)" ::msgcat::mcset nl "Menu-buttons" "Menu-buttons" - ::msgcat::mcset nl "Common Dialogs" "Veel voorkomende dialoogvensters" ::msgcat::mcset nl "Message boxes" "Mededeling (message box)" ::msgcat::mcset nl "File selection dialog" "Selectie van bestanden" ::msgcat::mcset nl "Color picker" "Kleurenpalet" - +::msgcat::mcset nl "Font selection dialog" "Selectie van fonts" +::msgcat::mcset nl "System tray icon and notification" "Systeemvakpictogram en melding" +::msgcat::mcset nl "Printing from canvas and text widgets" "Afdrukken van canvas en tekst widgets" +::msgcat::mcset nl "Animation" "Animaties" +::msgcat::mcset nl "Animated labels" "Geanimeerde labels" +::msgcat::mcset nl "Animated wave" "Geanimeerde golf" +::msgcat::mcset nl "Pendulum simulation" "Pendulum simulatie" +::msgcat::mcset nl "A celebration of Rube Goldberg" "Een viering van Rube Goldberg" ::msgcat::mcset nl "Miscellaneous" "Diversen" ::msgcat::mcset nl "The built-in bitmaps" "Ingebouwde plaatjes" ::msgcat::mcset nl "A dialog box with a local grab" \ "Een dialoogvenster met een locale \"grab\"" ::msgcat::mcset nl "A dialog box with a global grab" \ "Een dialoogvenster met een globale \"grab\"" +::msgcat::mcset nl "Window icons and badges" "Vensterpictogrammen en badges" + diff --git a/library/demos/pendulum.tcl b/library/demos/pendulum.tcl index 9833e8f..50760c1 100644 --- a/library/demos/pendulum.tcl +++ b/library/demos/pendulum.tcl @@ -50,8 +50,8 @@ for {set i 90} {$i>=0} {incr i -10} { $w.k create line 0 0 1 1 -smooth true -tags graph$i -fill grey$i } -$w.k create text 0 0 -anchor ne -text "\u03b8" -tags label_theta -$w.k create text 0 0 -anchor ne -text "\u03b4\u03b8" -tags label_dtheta +$w.k create text 0 0 -anchor ne -text "θ" -tags label_theta +$w.k create text 0 0 -anchor ne -text "δθ" -tags label_dtheta pack $w.k -in $w.p.l2 -fill both -expand true # Initialize some variables @@ -94,7 +94,7 @@ proc showPhase {canvas} { global Theta dTheta points psw psh lappend points [expr {$Theta+$psw}] [expr {-20*$dTheta+$psh}] if {[llength $points] > 100} { - set points [lrange $points end-99 end] + set points [lrange $points end-99 end] } for {set i 0} {$i<100} {incr i 10} { set list [lrange $points end-[expr {$i-1}] end-[expr {$i-12}]] diff --git a/library/demos/print.tcl b/library/demos/print.tcl new file mode 100644 index 0000000..ebe6553 --- /dev/null +++ b/library/demos/print.tcl @@ -0,0 +1,53 @@ +# print.tcl -- +# +# This demonstration script showcases the tk print commands. +# + +if {![info exists widgetDemo]} { + error "This script should be run from the \"widget\" demo." +} + +set w .print +destroy $w +toplevel $w +wm title $w "Printing Demonstration" +positionWindow $w + +image create photo logo -data {R0lGODlhMABLAPUAAP//////zP//mf//AP/MzP/Mmf/MAP+Zmf+ZZv+ZAMz//8zM/8zMzMyZzMyZmcyZZsyZAMxmZsxmM8xmAMwzM8wzAJnMzJmZzJmZmZlmmZlmZplmM5kzZpkzM5kzAGaZzGZmzGZmmWYzZmYzMzNmzDNmmTMzmTMzZgAzmQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH+BSAtZGwtACH5BAEKAAIALAAAAAAwAEsAAAb+QIFwSCwahY9HRMI8Op/JJVNSqVqv2OvjyRU8slbIJGwYg60S5ZR6jRi/4ITBOhkYIOd8dltEnAdmFQMJeoVXCEd/VnKGjRVOZ3NVgHlsjpBxVRCEYBIEAAARl4lgZmVgEQAKFx8Mo0ZnpqgAFyi2JqKGmGebWRIAILbCIo27cYFWASTCtievRXqSVwQfzLYeeYESxlnSVRIW1igjWHJmjBXbpKXeFQTizlh1eJNVHbYf0LGc39XW2PIoVZE0whasWPSqFBBHrkKEA3QG0DFTEMXBUsjCWesg4oMFAGwgtKsiwqA+jGiCiRPGAM6pLCVLGKHQ6EGJlc0IuDxzAgX+CCOW9DjAaUsEyAoT+GHpeSRoHgxEUWgAUEUpFhMWgTbKEPUBAU15TBZxekYD0RMEqCDLIpYIWTAcmGEd9rWQBxQyjeQqdK/ZTWEO3mK5l+9No75SrcHhm9WwnlzNoA5zdM+JHz0HCPQdUauZowoFnSw+c2CBvw6dUXT4LMKE6EIHUqMexgCiIREknOwl7Q+FhNQoLuzOc6Kw3kIIVOLqjYKBYCwinmgo9CBEswfMAziK7mRDoQhcUZxwoBKFibq3n3jXI0GyCPLC0DrS8GR1oaEoRBRYVhT99/qG4DcCA/yNU4Ajbjhhnx4P2DJggR3YZog6RyyYxwM9PSgMBaP+sQdgIRL0JAKBwnTooRMAFWLdiPyJ8JwvTnyQoh5midCASh149ZkTIFAmHnzOZOBfIU6U4Mhd4zF34DNEoDAhARGY50BvJkioyxFOGkKAShGkFsJwejiR5Xf8aZAaBp89coQJjuDXAQOApekEm45ANaAtIbyYxREf0OlICCK841uaahZBQjyfjXCACYjuaASjhFagRKSFNtloHg+hYWIxRohnBQWCSSAhBVZ+hkgRnlbxwJIVgIqGlaU6wkeTxHxjm6gVLImrFbHWVEQ1taZjWxJX7KqqnqgUEUxDwtqajrOaRkqhEDcxWwECbEjxTYe9gojqOJQ6JO231ob72bSqAjh4RgfsjiDCCfDCK8K8I9TL7r33nvGtCO7CO1dUAONk3LcBFxzwwEMwZ/DC4iAsRIE+CWNCbzeV8FfEtoDwVwnlacxMkcKQYIE/F5TQ2QcedUZCagyc3NsFGrXVZMipWVBCzKv4Q0JvCviDsjAwf4ylxBeX0KcwGs81ccgqGS3MBxc3RjDDVAvdBRcfeFy1MFd3bcQHJEQdlddkP5E1Cf9yXfbaV2d9RBAAOw== +} + + +pack [label $w.l -text "This demonstration showcases + the tk print command. Clicking the buttons below + print the data from the canvas and text widgets + using platform-native dialogs."] -side top + +pack [frame $w.m] -fill both -expand yes -side top + +set c [canvas $w.m.c -bg white] +pack $c -fill both -expand no -side left + +$c create rectangle 30 10 200 50 -fill blue -outline black +$c create oval 30 60 200 110 -fill green +$c create image 130 150 -image logo +$c create text 150 250 -anchor n -font {Helvetica 12} \ + -text "A short demo of simple canvas elements." + +set txt { +Tcl, or Tool Command Language, is an open-source multi-purpose C library which includes a powerful dynamic scripting language. Together they provide ideal cross-platform development environment for any programming project. It has served for decades as an essential system component in organizations ranging from NASA to Cisco Systems, is a must-know language in the fields of EDA, and powers companies such as FlightAware and F5 Networks. + +Tcl is fit for both the smallest and largest programming tasks, obviating the need to decide whether it is overkill for a given job or whether a system written in Tcl will scale up as needed. Wherever a shell script might be used Tcl is a better choice, and entire web ecosystems and mission-critical control and testing systems have also been written in Tcl. Tcl excels in all these roles due to the minimal syntax of the language, the unique programming paradigm exposed at the script level, and the careful engineering that has gone into the design of the Tcl internals. +} + +set t [text $w.m.t -wrap word] +pack $t -side right -fill both -expand no +$t insert end $txt + +pack [frame $w.f] -side top -fill both -expand no +pack [button $w.f.b -text "Print Canvas" -command [list tk print $w.m.c]] -expand no +pack [button $w.f.x -text "Print Text" -command [list tk print $w.m.t]] -expand no + +## See Code / Dismiss buttons +pack [addSeeDismiss $w.buttons $w] -side bottom -fill x + + diff --git a/library/demos/spin.tcl b/library/demos/spin.tcl index d897e6d..72f3aa4 100644 --- a/library/demos/spin.tcl +++ b/library/demos/spin.tcl @@ -38,7 +38,7 @@ set australianCities { } spinbox $w.s1 -from 1 -to 10 -width 10 -validate key \ - -vcmd {string is integer %P} + -validatecommand {string is integer %P} spinbox $w.s2 -from 0 -to 3 -increment .5 -format %05.2f -width 10 spinbox $w.s3 -values $australianCities -width 10 diff --git a/library/demos/square b/library/demos/square index 9f200ba..ee6dd31 100644 --- a/library/demos/square +++ b/library/demos/square @@ -11,8 +11,8 @@ exec wish "$0" ${1+"$@"} # Button-1 press/drag: moves square to mouse # "a": toggle size animation on/off -package require Tk ;# We use Tk generally, and... -package require Tktest ;# ... we use the square widget too. +package require tk ;# We use Tk generally, and... +package require tk::test ;# ... we use the square widget too. square .s pack .s -expand yes -fill both diff --git a/library/demos/systray.tcl b/library/demos/systray.tcl new file mode 100644 index 0000000..05315bb --- /dev/null +++ b/library/demos/systray.tcl @@ -0,0 +1,89 @@ +# systray.tcl -- +# +# This demonstration script showcases the tk systray and tk sysnotify commands. +# + +if {![info exists widgetDemo]} { + error "This script should be run from the \"widget\" demo." +} + +set w .systray +destroy $w +toplevel $w +wm title $w "System Tray Demonstration" +positionWindow $w + +catch {tk systray destroy} +set trayIconExists false + +set iconmenu .menubar +destroy $iconmenu +menu $iconmenu +$iconmenu add command -label "Status" -command { puts "status icon clicked" } +$iconmenu add command -label "Exit" -command exit + +pack [label $w.l -text "This demonstration showcases + the tk systray and tk sysnotify commands. + Running this demo creates the systray icon. + Clicking the buttons below modifies and destroys the icon + and displays the notification."] + +image create photo book -data R0lGODlhDwAPAKIAAP//////AP8AAMDAwICAgAAAAAAAAAAAACwAAAAADwAPAAADSQhA2u5ksPeKABKSCaya29d4WKgERFF0l1IMQCAKatvBJ0OTdzzXI1xMB3TBZAvATtB6NSLKleXi3OBoLqrVgc0yv+DVSEUuFxIAOw== + +labelframe $w.f -text "Tray Icon" +button $w.f.b0 -text "Create" -command create +button $w.f.b1 -text "Modify" -command modify +button $w.f.b2 -text "Destroy" -command remove +pack $w.f.b0 $w.f.b1 $w.f.b2 -padx 5 -pady 3 -side left -expand true -fill x + +button $w.b3 -text "Display Notification" -command notify +pack $w.f $w.b3 -expand true -fill x -padx 5 -pady 5 + +proc create {} { + global trayIconExists + if {$trayIconExists} { + tk_messageBox -message "Systray icon already exists" + return + } + tk systray create -image book -text "Systray sample" \ + -button1 {puts "foo"} \ + -button3 {tk_popup $iconmenu [winfo pointerx .] [winfo pointery .]} + set trayIconExists true +} + +proc modify {} { + global trayIconExists + if {!$trayIconExists} { + tk_messageBox -message "Please create systray icon first" + return + } + image create photo page -data R0lGODlhCwAPAKIAAP//////AMDAwICAgAAA/wAAAAAAAAAAACwAAAAACwAPAAADMzi6CzAugiAgDGE68aB0RXgRJBFVX0SNpQlUWfahQOvSsgrX7eZJMlQMWBEYj8iQchlKAAA7 + tk systray configure -image page + tk systray configure -text "Modified text" + tk systray configure -button1 {puts "this is a different output"} + tk systray configure -button3 {puts "hello yall"} +} + +proc notify {} { + global trayIconExists + if {!$trayIconExists} { + tk_messageBox -message "Please create systray icon first" + return + } + tk sysnotify "Alert" "This is an alert" +} + +proc remove {} { + global trayIconExists + if {!$trayIconExists} { + tk_messageBox -message "Systray icon was already destroyed" + return + } + tk systray destroy + set trayIconExists false +} + +create + +## See Code / Dismiss buttons +pack [addSeeDismiss $w.buttons $w] -side bottom -fill x diff --git a/library/demos/tclIndex b/library/demos/tclIndex index cdb2f2c..85be67d 100644 --- a/library/demos/tclIndex +++ b/library/demos/tclIndex @@ -65,3 +65,6 @@ set auto_index(showMessageBox) [list source -encoding utf-8 [file join $dir msgb set auto_index(setColor) [list source -encoding utf-8 [file join $dir clrpick.tcl]] set auto_index(setColor_helper) [list source -encoding utf-8 [file join $dir clrpick.tcl]] set auto_index(fileDialog) [list source -encoding utf-8 [file join $dir filebox.tcl]] +set auto_index(systray) [list source -encoding utf-8 [file join $dir systray.tcl]] +set auto_index(windoicons [list source -encoding utf-8 [file join $dir windowicons.tcl]] + diff --git a/library/demos/toolbar.tcl b/library/demos/toolbar.tcl index cb2a495..a53e390 100644 --- a/library/demos/toolbar.tcl +++ b/library/demos/toolbar.tcl @@ -17,7 +17,7 @@ positionWindow $w ttk::label $w.msg -wraplength 4i -text "This is a demonstration of how to do\ a toolbar that is styled correctly and which can be torn off. The\ - buttons are configured to be \u201Ctoolbar style\u201D buttons by\ + buttons are configured to be “toolbar style” buttons by\ telling them that they are to use the Toolbutton style. At the left\ end of the toolbar is a simple marker that the cursor changes to a\ movement icon over; drag that away from the toolbar to tear off the\ diff --git a/library/demos/ttkbut.tcl b/library/demos/ttkbut.tcl index ab49cf4..f6d94ac 100644 --- a/library/demos/ttkbut.tcl +++ b/library/demos/ttkbut.tcl @@ -17,7 +17,7 @@ wm title $w "Simple Ttk Widgets" wm iconname $w "ttkbut" positionWindow $w -ttk::label $w.msg -font $font -wraplength 4i -justify left -text "Ttk is the new Tk themed widget set. This is a Ttk themed label, and below are three groups of Ttk widgets in Ttk labelframes. The first group are all buttons that set the current application theme when pressed. The second group contains three sets of checkbuttons, with a separator widget between the sets. Note that the \u201cEnabled\u201d button controls whether all the other themed widgets in this toplevel are in the disabled state. The third group has a collection of linked radiobuttons." +ttk::label $w.msg -font $font -wraplength 4i -justify left -text "Ttk is the new Tk themed widget set. This is a Ttk themed label, and below are three groups of Ttk widgets in Ttk labelframes. The first group are all buttons that set the current application theme when pressed. The second group contains three sets of checkbuttons, with a separator widget between the sets. Note that the “Enabled” button controls whether all the other themed widgets in this toplevel are in the disabled state. The third group has a collection of linked radiobuttons." pack $w.msg -side top -fill x ## See Code / Dismiss diff --git a/library/demos/ttkprogress.tcl b/library/demos/ttkprogress.tcl index 8a72cf9..29ac508 100644 --- a/library/demos/ttkprogress.tcl +++ b/library/demos/ttkprogress.tcl @@ -15,7 +15,7 @@ wm title $w "Progress Bar Demonstration" wm iconname $w "ttkprogress" positionWindow $w -ttk::label $w.msg -font $font -wraplength 4i -justify left -text "Below are two progress bars. The top one is a \u201Cdeterminate\u201D progress bar, which is used for showing how far through a defined task the program has got. The bottom one is an \u201Cindeterminate\u201D progress bar, which is used to show that the program is busy but does not know how long for. Both are run here in self-animated mode, which can be turned on and off using the buttons underneath." +ttk::label $w.msg -font $font -wraplength 4i -justify left -text "Below are two progress bars. The top one is a “determinate” progress bar, which is used for showing how far through a defined task the program has got. The bottom one is an “indeterminate” progress bar, which is used to show that the program is busy but does not know how long for. Both are run here in self-animated mode, which can be turned on and off using the buttons underneath." pack $w.msg -side top -fill x ## See Code / Dismiss buttons diff --git a/library/demos/unicodeout.tcl b/library/demos/unicodeout.tcl index 759dc00..1ecc064 100644 --- a/library/demos/unicodeout.tcl +++ b/library/demos/unicodeout.tcl @@ -21,9 +21,7 @@ label $w.msg -font $font -wraplength 4i -anchor w -justify left \ non-Western character sets. However, what you will actually see\ below depends largely on what character sets you have installed,\ and what you see for characters that are not present varies greatly\ - between platforms as well. The strings are written in Tcl using\ - UNICODE characters using the \\uXXXX escape so as to do so in a\ - portable fashion." + between platforms as well." pack $w.msg -side top ## See Code / Dismiss buttons @@ -98,46 +96,29 @@ update ## Add the samples... if {[usePresentationFormsFor Arabic]} { # Using presentation forms (pre-layouted) - addSample $w Arabic \ - "\uFE94\uFEF4\uFE91\uFEAE\uFECC\uFEDF\uFE8D " \ - "\uFE94\uFEE4\uFEE0\uFEDC\uFEDF\uFE8D" + addSample $w Arabic "ﺔﻴﺑﺮﻌﻟﺍ ﺔﻤﻠﻜﻟﺍ" } else { # Using standard text characters - addSample $w Arabic \ - "\u0627\u0644\u0643\u0644\u0645\u0629 " \ - "\u0627\u0644\u0639\u0631\u0628\u064A\u0629" + addSample $w Arabic "الكلمة العربية" } -addSample $w "Trad. Chinese" "\u4E2D\u570B\u7684\u6F22\u5B57" -addSample $w "Simpl. Chinese" "\u6C49\u8BED" -addSample $w French "Langue fran\xE7aise" -addSample $w Greek \ - "\u0395\u03BB\u03BB\u03B7\u03BD\u03B9\u03BA\u03AE " \ - "\u03B3\u03BB\u03CE\u03C3\u03C3\u03B1" +addSample $w "Trad. Chinese" "中國的漢字" +addSample $w "Simpl. Chinese" "汉语" +addSample $w French "Langue française" +addSample $w Greek "Ελληνική γλώσσα" if {[usePresentationFormsFor Hebrew]} { # Visual order (pre-layouted) - addSample $w Hebrew \ - "\u05EA\u05D9\u05E8\u05D1\u05E2 \u05D1\u05EA\u05DB" + addSample $w Hebrew "תירבע בתכ" } else { # Standard logical order - addSample $w Hebrew \ - "\u05DB\u05EA\u05D1 \u05E2\u05D1\u05E8\u05D9\u05EA" + addSample $w Hebrew "כתב עברית" } -addSample $w Hindi \ - "\u0939\u093F\u0928\u094D\u0926\u0940 \u092D\u093E\u0937\u093E" -addSample $w Icelandic "\xCDslenska" -addSample $w Japanese \ - "\u65E5\u672C\u8A9E\u306E\u3072\u3089\u304C\u306A, " \ - "\u6F22\u5B57\u3068\u30AB\u30BF\u30AB\u30CA" -addSample $w Korean "\uB300\uD55C\uBBFC\uAD6D\uC758 \uD55C\uAE00" -addSample $w Russian \ - "\u0420\u0443\u0441\u0441\u043A\u0438\u0439 \u044F\u0437\u044B\u043A" +addSample $w Hindi "हिन्दी भाषा" +addSample $w Icelandic "Íslenska" +addSample $w Japanese "日本語のひらがな, 漢字とカタカナ" +addSample $w Korean "대한민국의 한글" +addSample $w Russian "Русский язык" if {([tk windowingsystem] ne "x11") || (![catch {tk::pkgconfig get fontsystem} fs] && ($fs eq "xft"))} { - if {[package vsatisfies [package provide Tcl] 8.7-]} { - addSample $w Emoji "😀💩👍🇳🇱" - } else { - addSample $w Emoji \ - "\uD83D\uDE00\uD83D\uDCA9\uD83D\uDC4D\uD83C\uDDF3\uD83C\uDDF1" - } + addSample $w Emoji "😀💩👍🇳🇱" } ## We're done processing, so change things back to normal running... diff --git a/library/demos/widget b/library/demos/widget index 13b8d0e..f96e778 100644 --- a/library/demos/widget +++ b/library/demos/widget @@ -10,7 +10,7 @@ exec wish "$0" ${1+"$@"} # separate ".tcl" files is this directory, which are sourced by this script as # needed. -package require Tk 8.5 +package require Tk 8.6- package require msgcat eval destroy [winfo child .] @@ -57,47 +57,40 @@ if {"defaultFont" ni [font names]} { set widgetDemo 1 set font mainFont -image create photo ::img::refresh -format GIF -data { - R0lGODlhEAAQAJEDAP///wAAACpnKv///yH5BAEAAAMALAAAAAAQABAAAAI63IKp - xgcPH2ouwgBCw1HIxHCQ4F3hSJKmwZXqWrmWxj7lKJ2dndcon9EBUq+gz3brVXAR - 2tICU0gXBQA7 -} +# The SVG images used below are based on some icons provided by the +# official open source SVG icon library for the Bootstrap project, +# licensed under the MIT license (https://opensource.org/licenses/MIT). +# +# See https://github.com/twbs/icons. -image create photo ::img::view -format GIF -data { - R0lGODlhEAAQAKIHAP///wwMDAAAAMDAwNnZ2SYmJmZmZv///yH5BAEAAAcALAAA - AAAQABAAAANMKLos90+ASamDRxJCgw9YVnlDOXiQBgRDBRgHKE6sW8QR3doPKK27 - yg33q/GIOhdg6OsEJzeZykiBSUcs06e56Xx6np8ScIkFGuhQAgA7 +image create photo ::img::refresh -format $::tk::svgFmt -data { + <?xml version="1.0" encoding="UTF-8"?> + <svg width="16" height="16" version="1.1" xmlns="http://www.w3.org/2000/svg"> + <path d="M11 5.466V4H5a4 4 0 0 0-3.584 5.777.5.5 0 1 1-.896.446A5 5 0 0 1 5 3h6V1.534a.25.25 0 0 1 .41-.192l2.36 1.966c.12.1.12.284 0 .384l-2.36 1.966a.25.25 0 0 1-.41-.192Zm3.81.086a.5.5 0 0 1 .67.225A5 5 0 0 1 11 13H5v1.466a.25.25 0 0 1-.41.192l-2.36-1.966a.25.25 0 0 1 0-.384l2.36-1.966a.25.25 0 0 1 .41.192V12h6a4 4 0 0 0 3.585-5.777.5.5 0 0 1 .225-.67Z"/> + </svg> } -image create photo ::img::delete -format GIF -data { - R0lGODlhEAAQAIABAIQAAP///yH5BAEAAAEALAAAAAAQABAAAAIjjI+pmwAc3HGy - PUSvqYpuvWQg40FfSVacBa5nN6JYDI3mzRQAOw== +image create photo ::img::view -format $::tk::svgFmt -data { + <?xml version="1.0" encoding="UTF-8"?> + <svg width="16" height="16" version="1.1" xmlns="http://www.w3.org/2000/svg"> + <path d="M11.742 10.344a6.5 6.5 0 1 0-1.397 1.398h-.001c.03.04.062.078.098.115l3.85 3.85a1 1 0 0 0 1.415-1.414l-3.85-3.85a1.007 1.007 0 0 0-.115-.1zM12 6.5a5.5 5.5 0 1 1-11 0 5.5 5.5 0 0 1 11 0z"/> + </svg> } -image create photo ::img::print -format GIF -data { - R0lGODlhEAAQALMKAAAAAP///52VunNkl8C82Yl+qldBgq+pyrOzs1fYAP///wAA - AAAAAAAAAAAAAAAAACH5BAEAAAoALAAAAAAQABAAAARGUMlJKwU4AztB+ODGeUiJ - fGLlgeEYmGWQXmx7aXgmAUTv/74N4EAsGhOJg1DAbDqbwoJ0Sp0KB9isNis0eL/g - ryhH5pgnEQA7 +image create photo ::img::delete -format $::tk::svgFmt -data { + <?xml version="1.0" encoding="UTF-8"?> + <svg width="16" height="16" version="1.1" xmlns="http://www.w3.org/2000/svg"> + <path d="M2.146 2.854a.5.5 0 1 1 .708-.708L8 7.293l5.146-5.147a.5.5 0 0 1 .708.708L8.707 8l5.147 5.146a.5.5 0 0 1-.708.708L8 8.707l-5.146 5.147a.5.5 0 0 1-.708-.708L7.293 8 2.146 2.854Z" fill="#800000"/> + </svg> } -# Note that this is run through the message catalog! This is because this is -# actually an image of a word. -image create photo ::img::new -format PNG -data [mc { - iVBORw0KGgoAAAANSUhEUgAAAB4AAAAOCAYAAAA45qw5AAACMElEQVR4AeVTAwxd - QRCc2tZHGtQ2w9q2bdsOa9u2bUW1bdt2Z372JZe6DapJLqtb3h7+T8yKi5j4CsYD - EUQXxETclT7kWOlH2VV+tFkdQHPSwksSISF+BauCqL0qgOcMWgGfgEkaMsHxqUBk - 3plE/sOnh/qDPAPJH/CKFBivGHWzFwBRnHhlqbu1Mh6CoFNnC/JshQ9p4YC2lrKt - DCAV+THiVejyhMjAbrNSrroiEfKR9g7ZfCgOog8QfnUQV62wAk68ndQ9ZbyoWO1H - Y6eDY1LCQL6a9ApOp9Hi1T0+gQq2JKMlky/oTKQliKWxEZvyG575kpW4pl1aZnQK - CLOVt45Lkp8uXp2SL8KO6uitNTZLdpK6s+I/eZbhpmsmWeOGOVQNKYLITzpKPAO3 - tY7LSNZ7ccSLxX9y3uuOxRkg3dKESMoCHvL+GRVCutXsB3guLgDCeXOv4iWWkvwG - BaS+PmlpK6SI9ApI2oC2UtrwZQEkhkH+NtolVlQXJl1I+QltuU3XEc721bIRFpa8 - IA5iqTo6vNNWmkNBLQbPeXwF2g17Q94nTQAfY3YzeY+WSu8MDzQ2kpELUhSGJUHE - 0zeR3rY1L+Xl5G/re+jbiK6KhThwwInsts1fbMUUcpZszKeVtggZEiGdZDe5AtHh - 7vL4CGiRvvKPS8FAvq9Nr4ZkFadR2y6kggu1z4vlyIbBp6BugQ8JLEg4bTkD9eMZ - QZ8hpJ3VvTtuvbWrY/ElvP/9R+Aj3603+iE3fkEAAAAASUVORK5CYII= -}] +image create photo ::img::print -format $::tk::svgFmt -data { + <?xml version="1.0" encoding="UTF-8"?> + <svg width="16" height="16" version="1.1" xmlns="http://www.w3.org/2000/svg"> + <path d="M2.5 8a.5.5 0 1 0 0-1 .5.5 0 0 0 0 1z"/> + <path d="M5 1a2 2 0 0 0-2 2v2H2a2 2 0 0 0-2 2v3a2 2 0 0 0 2 2h1v1a2 2 0 0 0 2 2h6a2 2 0 0 0 2-2v-1h1a2 2 0 0 0 2-2V7a2 2 0 0 0-2-2h-1V3a2 2 0 0 0-2-2H5zM4 3a1 1 0 0 1 1-1h6a1 1 0 0 1 1 1v2H4V3zm1 5a2 2 0 0 0-2 2v1H2a1 1 0 0 1-1-1V7a1 1 0 0 1 1-1h12a1 1 0 0 1 1 1v3a1 1 0 0 1-1 1h-1v-1a2 2 0 0 0-2-2H5zm7 2v3a1 1 0 0 1-1 1H5a1 1 0 0 1-1-1v-3a1 1 0 0 1 1-1h6a1 1 0 0 1 1 1z"/> + </svg> +} #---------------------------------------------------------------- # The code below creates the main window, consisting of a menu bar and a text @@ -200,6 +193,11 @@ if {[winfo depth .] == 1} { } .t tag configure hot -foreground red -underline 1 } + +# The tag "new" must be the one having the highest priority. +# +.t tag configure new -foreground #c00000 -underline 0 -font boldFont + .t tag bind demo <ButtonRelease-1> { invoke [.t index {@%x,%y}] } @@ -275,7 +273,7 @@ proc addFormattedText {formattedText} { .t insert end "[incr demoCount]. [mc $description]" \ [list demo demo-$name] if {$new} { - .t image create end -image ::img::new -padx 5 + .t insert end " [mc NEW]" new set new 0 } .t insert end " \n " demospace @@ -329,7 +327,21 @@ addFormattedText { @@demo image2 A simple user interface for viewing images @@demo labelframe Labelled frames @@demo ttkbut The simple Themed Tk widgets +} + +if {[tk windowingsystem] eq "aqua"} { + addFormattedText { + @@subtitle Mac-Specific Widgets and Window Styles + @@new + @@demo mac_styles Special widgets for macOS + @@new + @@demo mac_wm Window styles for macOS + @@new + @@demo mac_tabs Tabbed Windows on macOS + } +} +addFormattedText { @@subtitle Listboxes and Trees @@demo states The 50 states @@demo colors Colors: change the color scheme for the application @@ -366,7 +378,6 @@ addFormattedText { @@subtitle Scales and Progress Bars @@demo hscale Horizontal scale @@demo vscale Vertical scale - @@new @@demo ttkscale Themed scale linked to a label with traces @@demo ttkprogress Progress bar @@ -387,6 +398,10 @@ addFormattedText { @@demo filebox File selection dialog @@demo clrpick Color picker @@demo fontchoose Font selection dialog + @@new + @@demo systray System tray icon and notification + @@new + @@demo print Printing from canvas and text widgets @@subtitle Animation @@demo anilabel Animated labels @@ -398,6 +413,8 @@ addFormattedText { @@demo bitmap The built-in bitmaps @@demo dialog1 A dialog box with a local grab @@demo dialog2 A dialog box with a global grab + @@new + @@demo windowicons Window icons and badges } ############################################################################## @@ -640,80 +657,7 @@ proc showCode w { # file - Name of the original file (implicitly for title) proc printCode {w file} { - set code [$w get 1.0 end-1c] - - set dir "." - if {[info exists ::env(HOME)]} { - set dir "$::env(HOME)" - } - if {[info exists ::env(TMP)]} { - set dir $::env(TMP) - } - if {[info exists ::env(TEMP)]} { - set dir $::env(TEMP) - } - - set filename [file join $dir "tkdemo-$file"] - set outfile [open $filename "w"] - puts $outfile $code - close $outfile - - switch -- $::tcl_platform(platform) { - unix { - if {[catch {exec lp -c $filename} msg]} { - tk_messageBox -title "Print spooling failure" \ - -message "Print spooling probably failed: $msg" - } - } - windows { - if {[catch {PrintTextWin32 $filename} msg]} { - tk_messageBox -title "Print spooling failure" \ - -message "Print spooling probably failed: $msg" - } - } - default { - tk_messageBox -title "Operation not Implemented" \ - -message "Wow! Unknown platform: $::tcl_platform(platform)" - } - } - - # - # Be careful to throw away the temporary file in a gentle manner ... - # - if {[file exists $filename]} { - catch {file delete $filename} - } -} - -# PrintTextWin32 -- -# Print a file under Windows using all the "intelligence" necessary -# -# Arguments: -# filename - Name of the file -# -# Note: -# Taken from the Wiki page by Keith Vetter, "Printing text files under -# Windows". -# Note: -# Do not execute the command in the background: that way we can dispose of the -# file smoothly. -# -proc PrintTextWin32 {filename} { - package require registry - set app [auto_execok notepad.exe] - set pcmd "$app /p %1" - catch { - set app [registry get {HKEY_CLASSES_ROOT\.txt} {}] - set pcmd [registry get \ - {HKEY_CLASSES_ROOT\\$app\\shell\\print\\command} {}] - } - - regsub -all {%1} $pcmd $filename pcmd - puts $pcmd - - regsub -all {\\} $pcmd {\\\\} pcmd - set command "[auto_execok start] /min $pcmd" - eval exec $command + tk print $w } # tkAboutDialog -- @@ -723,10 +667,11 @@ proc PrintTextWin32 {filename} { proc tkAboutDialog {} { tk_messageBox -icon info -type ok -title [mc "About Widget Demo"] \ -message [mc "Tk widget demonstration application"] -detail \ -"[mc "Copyright \xA9 %s" {1996-1997 Sun Microsystems, Inc.}] -[mc "Copyright \xA9 %s" {1997-2000 Ajuba Solutions, Inc.}] -[mc "Copyright \xA9 %s" {2001-2009 Donal K. Fellows}] -[mc "Copyright \xA9 %s" {2002-2007 Daniel A. Steffen}]" +"[mc "Copyright © %s" {1996-1997 Sun Microsystems, Inc.}] +[mc "Copyright © %s" {1997-2000 Ajuba Solutions, Inc.}] +[mc "Copyright © %s" {2001-2009 Donal K. Fellows}] +[mc "Copyright © %s" {2002-2007 Daniel A. Steffen}] +[mc "Copyright © %s" {2021 Kevin Walzer}]" } # Local Variables: diff --git a/library/demos/windowicons.tcl b/library/demos/windowicons.tcl new file mode 100644 index 0000000..f89d252 --- /dev/null +++ b/library/demos/windowicons.tcl @@ -0,0 +1,99 @@ +# windowicons.tcl -- +# +# This demonstration script showcases the wm iconphoto and wm iconbadge commands. +# + +if {![info exists widgetDemo]} { + error "This script should be run from the \"widget\" demo." +} + +set w .windowicons +destroy $w +toplevel $w +wm title $w "Window Icon Demonstration" +positionWindow $w + +image create photo icon -data { + iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAAABGdBTUEAALGP + C/xhBQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3Cc + ulE8AAAABmJLR0QA/wD/AP+gvaeTAAAACXBIWXMAArQNAAK0DQEdFIm+AAAJ + QElEQVRYw+WXW2xdV5nHf/ty7lcf2/FxYsdOnMSNC0HTpDiRKJWAQjWCEQNU + SEAFfUOiQqrEC2+IxwpemDLSzNBBCCQeQEKqRJgBSikiuGlN22TqhsR27OPL + 8eWc43Pdt7X22osHHydOm4FBPM6Slr69paX9/32Xtb614f/7MP6vC3O5f8L3 + G7HJyZPHBwfz5wrF7HQ6nRwxLTOhQuU4PW+z3eq9Xa+33rq9cms7k8pHjvfS + 3w8wOfk52u1u8oHpiUff897JJ8+dO/nI6LHho6OjQ3ahkMYwTTZ2O2zXutS3 + G/7ayubq7Vtr/7Ve2f7RytLam4ViXq1t/vRvB0ilPsjzz3+LZ5/9j7MzM5Nf + /8hj5//5H97/YNbK5hkfTFLMxAEQQvD766v0yBGIEBEEuPUGi9dv7lx77cb3 + Vm9vfqc0WNi9evUKWr/xLh3rfuLj45+l0bjM7m768U98/OJ/fulLH/3wiemx + eCafxRcKw7TJxKC+12RpbYdAx7HsOCrSRNpg+sQQj1w8nS0N5h8JAvm+rWr9 + 9ZmZB2qWdZq9vWt/GWBm5im+9rUn6HRGPv7EE4/++2P/eOFkV0FkJTDQgCaX + TbO1tcV2R2EmCxBJQixs2+R9EwV00MFAceJE2ZiZOT7VaTsPLyxU5orFTK1c + fphq9bX7A8zOfoV8Ps3c3NsXPvWpD37vc5//0ETNt8gNjDAzlsdAE0vliTCR + xEhnC2CaRIZNMmZiaonv9mh1PcrDJQZzCfK5OGNjQ8e2tvZO37y5+ctk0naq + 1fn7A4yOnmd5uVp4/PGHn/vylz8xe+zoEIP5JAMpA0OHeK6DG4TEk2li8Tha + QxRpIg0q6DGUNjg6UuLYSInhYoYoigiCgHQ6TrGYnlpd3Q1ffvk3L128+ITe + 2Hj1XoBLl55menqcbDb1haeeevyrDz102tJaE7ctLBMqG1X23Ag7kcKOJzAA + DSilCVWEZdmMDaXJJCxSiRimaaK1RkqJ7/uUSlk6Hed0oxG9HI9bm+Pjs2xs + vIp5AKC15oUX/lA8f/7MF2dnz8YADMNASslypYqrUxSHyqSy+f31hzaRZRpM + DKVYr+7y4usVri1WWavWCWSIZZkYhoFSIRcuTI1MTAw9OTf33Tu7zz54SCRi + nD17/Pzs7AMPFQqZPlTE8vo2DlmGhgbo12BffD/8SmukitiuNxHKoDwyzPJG + nTdXmtiWwdnRNCN5GxWGDA/nOH26/NGpqSfHgPU7AJcuPc0nP/kBrl698YGZ + mYmMEIJmx6Hn+my0DUZGC6gIzEOnhu4Lh2GEbRocGyxRSO/7c3QgiRuEVOtd + EvEQrSN8IVEq5MSJ4YlSKX3OMKJ14G4KnnnmM9bkZPk92VyKy3M3eentJjd3 + FUYyjxuEeELt7/NoP+eBVAipCFXEsYE4xcydYFIeSHKynOXhUwM0mh32egH1 + tsdL16oo007kcskHs7kYly49fRcALqby+fQopklkZ4jHY3g6gQgjHF/QcgQd + V+7DHJoGmnzSQuvD0QGlIsJQkU4luLXR4kgxxcRgjM1mQCyZHrv0sUe4JwKF + XMmu7/VSXV9xaXqI0YzC8328QOJ4gq4raHQDGt2AtitwfIEbSAwibOvdJ7pS + CiElR3IxGh2X5Y0GV66v0wnAsq3MN5759L1FqKMoCkQoX19u0QkkD47lKSYi + Th1NoSLYafu0ehrTNNBaE2mNUop2z+DEUJKBbPxecSEIgoAoUjwwmmZpdZPl + muL4oIFWkbx8rXIvQMfZ9p2e1xBCstOJcFe6nB1NcWokhW1ZHMkazK90qXXD + fZFII0NFIBW/XQiZHraoNbsU81mmjhbxfZ8gCAiCgELKQitJGCoIQ6SQO//2 + ze/fm4Kf/Px50dzr3Aoch1Ap2o4kn8tgW/sHynAxzcVTBQYzFp4v6boBjidw + fcFCpcmPf7/Oz+ZrvPBalb12D9/370DUGk1evr6NacWIfD/yveDmXq3F3Nxz + dwH+5dkfUq8155rb9dA2QcqQcjFx57DRGgaySR47d4RHZ0pYeh/C9QSOJ3EE + CGWw3fJZ323j+x6e5xH4Pgu3d6g0FMWUjdvu7bo9/5oK1d0IzM09hwhCGrvN + ubXFylI2pum4AZXtDqEURFGE1hoNxGMW5ZyB22nS8wQ9r1+QvsDzBc1uQGW7 + jee6eN4+RMfxMdHkYgatWmtur9ZaOnD8TgQMA27c+uH68s3KT8O9BoYBv3pj + kxuVGo7Tw+1/MAh83lreYm1P9r3fT4XjSVxf4voC1/NwHAfXdXFcB891KGVj + hO2e16q3fzR2cjQwDPPeZrSx8SqXL2/RqDU2EnH7I8dPjQ8v7Tqs1RwmSzEs + QoQQSBHw1lKVha0AEUb4IiQQIb4I8YUkkCHTQwa5WIjne9xY2mT+VouRfI7N + xfVfrK8sfTuRSAavXP3Xd7fjavWPRq1+3TeiQTVcGnh0oHwktlZzmBq0SNsR + QgiuXLvNL/+nQU/aBFL1xSW+kAghEb5PEkE5q3Bdl7dv72LGCrTXdzf+9Nb8 + N5dXfrG6Wf1jeNDP3nkjigOFWm2xpvx0+tjI8LnMYMnMxQT5eIjruVye36LS + TRAqRSD3vZdCIqUgEj5R4CEDj2O5kMZei3rHoLXV6Sy88cp3Fhf/ew6IAAGE + 9wOIARmtw9Tu7vKa1yY+Wiqeee+ZYdsi4HdvrjK/HiKUiZQhoZREQhDJAC18 + tPSIhEfouwSuQ9cx2VxpNK/PX/n+4uKvXwQdAAHgA/J+AAaQABJRJOydnVsr + zZ1O13eMcSuezC61LJzQRgY+KvCJhI+WPpH0IAywIkEhaVIupAhdHS0t3F66 + Nv/iD9bW/nAFtAM4QA9wAXX3RnEvQBoYODSL+fzEmalTsx+emjl3YWjsaMlM + pcwg0ggZEimFoSNsI8JSCtF1wtpmdWt1aeGVSuW133leYwNoA01gr297BzVw + v/8CA0gBBaDYtzkw87ns6PhI+czM0JHjp/PFUjmZSmUM07RCKUPP6XVae/Vq + fbdys1ZbvOX5ja2+ULcP0Opbt18H/G8Ah+shDWQPzVQ/RSnLTGRsO5U0TMuM + VKjC0PUjLd1+fgPAOxTybl9YcvdC9VcBDobV3x0JINm3MfYbmdX/hu57FfZF + Dgot6Fe8eqfw3wLwzvVmX9jsvx8AHEAcnn91/BlySEFKTpuCtgAAABN0RVh0 + QXV0aG9yAHdhcnN6YXdpYW5rYQy+S5cAAABYdEVYdENvcHlyaWdodABDQzAg + UHVibGljIERvbWFpbiBEZWRpY2F0aW9uIGh0dHA6Ly9jcmVhdGl2ZWNvbW1v + bnMub3JnL3B1YmxpY2RvbWFpbi96ZXJvLzEuMC/G4735AAAAIXRFWHRDcmVh + dGlvbiBUaW1lADIwMTAtMDMtMjlUMDg6MDg6MzD47LxwAAAAJXRFWHRkYXRl + OmNyZWF0ZQAyMDIxLTA4LTE1VDIwOjU0OjM5LTA0OjAwNBT3DQAAACV0RVh0 + ZGF0ZTptb2RpZnkAMjAyMS0wOC0xNVQyMDo1NDoxMS0wNDowMDSDBqsAAADI + elRYdERlc2NyaXB0aW9uAAAY042OwQqCQBCGn6B3GOy+Cl0qTAjEc1HRJVhW + HXUrd2pmLXr7tDrVpcMP838w/F+wxxxyprsgB2ALclAxtRAbaBirRdB4f5mH + oTeuJlUxYoly8nRRxHW4HahO30SvmI5Y+CCBF4dPhzg0CYwOLs45GdKfG+sK + hBuy2H4xUlM1i76+BhcBwwirLj/bAlJqjXXzP9UyxmuHzp8feiknLPW6Q/H9 + moy3yK1oqvROUE2yH99suX45PwEyf2MTOoCNrQAAABl0RVh0U29mdHdhcmUA + d3d3Lmlua3NjYXBlLm9yZ5vuPBoAAABWdEVYdFNvdXJjZQBodHRwczovL29w + ZW5jbGlwYXJ0Lm9yZy9kZXRhaWwvMzUyMzMvdGFuZ28taW5ldHJuZXQtd2Vi + LWJyb3dzZXItYnktd2Fyc3phd2lhbmth5nAuRgAAACB0RVh0VGl0bGUAdGF + uZ28gaW5ldHJuZXQgd2ViIGJyb3dzZXLyr62TAAAAAElFTkSuQmCC +} + +set ::tk::icons::base_icon(.) icon + +pack [button $w.i -text "Set Window Icon to Globe" -image $::tk::icons::base_icon(.) \ + -compound top -command {wm iconphoto . $::tk::icons::base_icon(.) }] +pack [button $w.b -text "Set Badge to 3" -command {wm iconbadge . 3}] +pack [button $w.e -text "Set Badge to 11" -command {wm iconbadge . 11}] +pack [button $w.f -text "Reset Badge" -command {wm iconbadge . ""}] + +## See Code / Dismiss buttons +pack [addSeeDismiss $w.buttons $w] -side bottom -fill x diff --git a/library/dialog.tcl b/library/dialog.tcl index a099d90..16ba128 100644 --- a/library/dialog.tcl +++ b/library/dialog.tcl @@ -3,8 +3,8 @@ # This file defines the procedure tk_dialog, which creates a dialog # box containing a bitmap, a message, and one or more buttons. # -# Copyright (c) 1992-1993 The Regents of the University of California. -# Copyright (c) 1994-1997 Sun Microsystems, Inc. +# Copyright © 1992-1993 The Regents of the University of California. +# Copyright © 1994-1997 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -109,7 +109,7 @@ proc ::tk_dialog {w title text bitmap default args} { $w.button$i configure -default normal } grid $w.button$i -in $w.bot -column $i -row 0 -sticky ew \ - -padx 10 -pady 4 + -padx 7.5p -pady 3p grid columnconfigure $w.bot $i # We boost the size of some Mac buttons for l&f if {$windowingsystem eq "aqua"} { diff --git a/library/entry.tcl b/library/entry.tcl index 4140c92..593daa6 100644 --- a/library/entry.tcl +++ b/library/entry.tcl @@ -3,8 +3,8 @@ # This file defines the default bindings for Tk entry widgets and provides # procedures that help in implementing those bindings. # -# Copyright (c) 1992-1994 The Regents of the University of California. -# Copyright (c) 1994-1997 Sun Microsystems, Inc. +# Copyright © 1992-1994 The Regents of the University of California. +# Copyright © 1994-1997 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -119,17 +119,17 @@ bind Entry <Control-Button-1> { } bind Entry <<PrevChar>> { - tk::EntrySetCursor %W [expr {[%W index insert]-1}] + tk::EntrySetCursor %W [tk::EntryPreviousChar %W insert] } bind Entry <<NextChar>> { - tk::EntrySetCursor %W [expr {[%W index insert]+1}] + tk::EntrySetCursor %W [tk::EntryNextChar %W insert] } bind Entry <<SelectPrevChar>> { - tk::EntryKeySelect %W [expr {[%W index insert]-1}] + tk::EntryKeySelect %W [tk::EntryPreviousChar %W insert] tk::EntrySeeInsert %W } bind Entry <<SelectNextChar>> { - tk::EntryKeySelect %W [expr {[%W index insert]+1}] + tk::EntryKeySelect %W [tk::EntryNextChar %W insert] tk::EntrySeeInsert %W } bind Entry <<PrevWord>> { @@ -165,7 +165,8 @@ bind Entry <Delete> { if {[%W selection present]} { %W delete sel.first sel.last } else { - %W delete insert + %W delete [tk::startOfCluster [%W get] [%W index insert]] \ + [tk::endOfCluster [%W get] [%W index insert]] } } bind Entry <BackSpace> { @@ -195,7 +196,7 @@ bind Entry <Key> { tk::EntryInsert %W %A } -# Ignore all Alt, Meta, and Control keypresses unless explicitly bound. +# Ignore all Alt, Meta, Control, Command, and Fn keypresses unless explicitly bound. # Otherwise, if a widget binding for one of these is defined, the # <Key> class binding will also fire and insert the character, # which is wrong. Ditto for Escape, Return, and Tab. @@ -209,10 +210,8 @@ bind Entry <KP_Enter> {# nothing} bind Entry <Tab> {# nothing} bind Entry <Prior> {# nothing} bind Entry <Next> {# nothing} -if {[tk windowingsystem] eq "aqua"} { - bind Entry <Command-Key> {# nothing} - bind Entry <Mod4-Key> {# nothing} -} +bind Entry <Command-Key> {# nothing} +bind Entry <Fn-Key> {# nothing} # Tk-on-Cocoa generates characters for these two keys. [Bug 2971663] bind Entry <<NextLine>> {# nothing} bind Entry <<PrevLine>> {# nothing} @@ -279,11 +278,7 @@ bind Entry <<TkStartIMEMarkedText>> { dict set ::tk::Priv(IMETextMark) "%W" [%W index insert] } bind Entry <<TkEndIMEMarkedText>> { - if {[catch {dict get $::tk::Priv(IMETextMark) "%W"} mark]} { - bell - } else { - %W selection range $mark insert - } + ::tk::EntryEndIMEMarkedText %W } bind Entry <<TkClearIMEMarkedText>> { %W delete [dict get $::tk::Priv(IMETextMark) "%W"] [%W index insert] @@ -292,30 +287,34 @@ bind Entry <<TkAccentBackspace>> { tk::EntryBackspace %W } -# A few additional bindings of my own. +# ::tk::EntryEndIMEMarkedText -- +# Handles input method text marking in an entry +# +# Arguments: +# w - The entry window. -if {[tk windowingsystem] ne "aqua"} { - bind Entry <Button-2> { - if {!$tk_strictMotif} { - ::tk::EntryScanMark %W %x - } - } - bind Entry <B2-Motion> { - if {!$tk_strictMotif} { - ::tk::EntryScanDrag %W %x - } +proc ::tk::EntryEndIMEMarkedText {w} { + variable Priv + if {[catch { + set mark [dict get $Priv(IMETextMark) $w] + }]} { + bell + return } -} else { - bind Entry <Button-3> { - if {!$tk_strictMotif} { + $w selection range $mark insert +} + +# A few additional bindings of my own. + +bind Entry <Button-2> { + if {!$tk_strictMotif} { ::tk::EntryScanMark %W %x - } } - bind Entry <B3-Motion> { - if {!$tk_strictMotif} { +} +bind Entry <B2-Motion> { + if {!$tk_strictMotif} { ::tk::EntryScanDrag %W %x - } - } + } } # ::tk::EntryClosestGap -- @@ -391,17 +390,17 @@ proc ::tk::EntryMouseSelect {w x} { } word { if {$cur < $anchor} { - set before [tcl_wordBreakBefore [$w get] $cur] - set after [tcl_wordBreakAfter [$w get] $anchor-1] + set before [tk::wordBreakBefore [$w get] $cur] + set after [tk::wordBreakAfter [$w get] $anchor-1] } elseif {$cur > $anchor} { - set before [tcl_wordBreakBefore [$w get] $anchor] - set after [tcl_wordBreakAfter [$w get] $cur-1] + set before [tk::wordBreakBefore [$w get] $anchor] + set after [tk::wordBreakAfter [$w get] $cur-1] } else { if {[$w index @$Priv(pressX)] < $anchor} { incr anchor -1 } - set before [tcl_wordBreakBefore [$w get] $anchor] - set after [tcl_wordBreakAfter [$w get] $anchor] + set before [tk::wordBreakBefore [$w get] $anchor] + set after [tk::wordBreakAfter [$w get] $anchor] } if {$before < 0} { set before 0 @@ -519,9 +518,10 @@ proc ::tk::EntryBackspace w { if {[$w selection present]} { $w delete sel.first sel.last } else { - set x [$w index insert] - if {$x > 0} { - $w delete [expr {$x-1}] + set x [expr {[$w index insert] - 1}] + if {$x >= 0} { + $w delete [tk::startOfCluster [$w get] $x] \ + [tk::endOfCluster [$w get] $x] } if {[$w index @0] >= [$w index insert]} { set range [$w xview] @@ -579,7 +579,7 @@ proc ::tk::EntryTranspose w { if {$i < 2} { return } - set first [expr {$i-2}] + set first $i-2 set data [$w get] set new [string index $data $i-1][string index $data $first] $w delete $first $i @@ -599,9 +599,9 @@ proc ::tk::EntryTranspose w { if {[tk windowingsystem] eq "win32"} { proc ::tk::EntryNextWord {w start} { - set pos [tcl_endOfWord [$w get] [$w index $start]] + set pos [tk::endOfWord [$w get] [$w index $start]] if {$pos >= 0} { - set pos [tcl_startOfNextWord [$w get] $pos] + set pos [tk::startOfNextWord [$w get] $pos] } if {$pos < 0} { return end @@ -610,7 +610,7 @@ if {[tk windowingsystem] eq "win32"} { } } else { proc ::tk::EntryNextWord {w start} { - set pos [tcl_endOfWord [$w get] [$w index $start]] + set pos [tk::endOfWord [$w get] [$w index $start]] if {$pos < 0} { return end } @@ -628,13 +628,30 @@ if {[tk windowingsystem] eq "win32"} { # start - Position at which to start search. proc ::tk::EntryPreviousWord {w start} { - set pos [tcl_startOfPreviousWord [$w get] [$w index $start]] + set pos [tk::startOfPreviousWord [$w get] [$w index $start]] if {$pos < 0} { return 0 } return $pos } +proc ::tk::EntryNextChar {w start} { + set pos [tk::endOfCluster [$w get] [$w index $start]] + if {$pos < 0} { + return end + } + return $pos +} + +proc ::tk::EntryPreviousChar {w start} { + set pos [tk::startOfCluster [$w get] [expr {[$w index $start]-1}]] + if {$pos < 0} { + return 0 + } + return $pos +} + + # ::tk::EntryScanMark -- # # Marks the start of a possible scan drag operation diff --git a/library/focus.tcl b/library/focus.tcl index 640406e..2cf5ad7 100644 --- a/library/focus.tcl +++ b/library/focus.tcl @@ -3,7 +3,7 @@ # This file defines several procedures for managing the input # focus. # -# Copyright (c) 1994-1995 Sun Microsystems, Inc. +# Copyright © 1994-1995 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. diff --git a/library/fontchooser.tcl b/library/fontchooser.tcl index 27c8def..7cd01fb 100644 --- a/library/fontchooser.tcl +++ b/library/fontchooser.tcl @@ -2,8 +2,8 @@ # # A themeable Tk font selection dialog. See TIP #324. # -# Copyright (C) 2008 Keith Vetter -# Copyright (C) 2008 Pat Thoyts <patthoyts@users.sourceforge.net> +# Copyright © 2008 Keith Vetter +# Copyright © 2008 Pat Thoyts <patthoyts@users.sourceforge.net> # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -178,13 +178,10 @@ proc ::tk::fontchooser::Create {} { wm title $S(W) $S(-title) wm transient $S(W) [winfo toplevel $S(-parent)] - set scaling [tk scaling] - set sizeWidth [expr {int([string length [::msgcat::mc "&Size:"]] * $scaling)}] - - set outer [::ttk::frame $S(W).outer -padding {10 10}] + set outer [::ttk::frame $S(W).outer -padding {7.5p 7.5p}] ::tk::AmpWidget ::ttk::label $S(W).font -text [::msgcat::mc "&Font:"] ::tk::AmpWidget ::ttk::label $S(W).style -text [::msgcat::mc "Font st&yle:"] - ::tk::AmpWidget ::ttk::label $S(W).size -text [::msgcat::mc "&Size:"] -width $sizeWidth + ::tk::AmpWidget ::ttk::label $S(W).size -text [::msgcat::mc "&Size:"] ttk::entry $S(W).efont -width 18 \ -textvariable [namespace which -variable S](font) ttk::entry $S(W).estyle -width 10 \ @@ -226,7 +223,7 @@ proc ::tk::fontchooser::Create {} { ttk::scrollbar $S(W).tmpvs set scroll_width [winfo reqwidth $S(W).tmpvs] destroy $S(W).tmpvs - set minsize(gap) 10 + set minsize(gap) [::tk::ScaleNum 10] set minsize(bbox) [winfo reqwidth $S(W).ok] set minsize(fonts) \ [expr {[font measure TkDefaultFont "Helvetica"] + $scroll_width}] @@ -238,7 +235,7 @@ proc ::tk::fontchooser::Create {} { foreach {what width} [array get minsize] { incr min $width } - wm minsize $S(W) $min 260 + wm minsize $S(W) $min [::tk::ScaleNum 260] bind $S(W) <Return> [namespace code [list Done 1]] bind $S(W) <Escape> [namespace code [list Done 0]] @@ -261,24 +258,24 @@ proc ::tk::fontchooser::Create {} { ::ttk::label $WS.sample -relief sunken -anchor center \ -textvariable [namespace which -variable S](sampletext) set S(sample) $WS.sample - grid $WS.sample -sticky news -padx 6 -pady 4 + grid $WS.sample -sticky news -padx 4.5p -pady 3p grid rowconfigure $WS 0 -weight 1 grid columnconfigure $WS 0 -weight 1 grid propagate $WS 0 - grid $S(W).ok -in $bbox -sticky new -pady {0 2} - grid $S(W).cancel -in $bbox -sticky new -pady 2 - grid $S(W).apply -in $bbox -sticky new -pady 2 + grid $S(W).ok -in $bbox -sticky new -pady {0 1.5p} + grid $S(W).cancel -in $bbox -sticky new -pady 1.5p + grid $S(W).apply -in $bbox -sticky new -pady 1.5p grid columnconfigure $bbox 0 -weight 1 - grid $WE.strike -sticky w -padx 10 - grid $WE.under -sticky w -padx 10 -pady {0 30} + grid $WE.strike -sticky w -padx 7.5p + grid $WE.under -sticky w -padx 7.5p -pady {0 22.5p} grid columnconfigure $WE 1 -weight 1 grid $S(W).font x $S(W).style x $S(W).size x -in $outer -sticky w grid $S(W).efont x $S(W).estyle x $S(W).esize x $bbox -in $outer -sticky ew grid $S(W).lfonts x $S(W).lstyles x $S(W).lsizes x ^ -in $outer -sticky news - grid $WE x $WS - - x ^ -in $outer -sticky news -pady {15 30} + grid $WE x $WS - - x ^ -in $outer -sticky news -pady {11p 22.5p} grid configure $bbox -sticky n grid rowconfigure $outer 2 -weight 1 grid columnconfigure $outer {1 3 5} -minsize $minsize(gap) @@ -497,7 +494,7 @@ proc ::tk::fontchooser::Visibility {w visible} { # This is exactly right on XP but may need adjusting on other platforms. # proc ::tk::fontchooser::ttk_slistbox {w args} { - set f [ttk::frame $w -style FontchooserFrame -padding 2] + set f [ttk::frame $w -style FontchooserFrame -padding 1.5p] if {[catch { listbox $f.list -relief flat -highlightthickness 0 -borderwidth 0 {*}$args ttk::scrollbar $f.vs -command [list $f.list yview] diff --git a/library/iconbadges.tcl b/library/iconbadges.tcl new file mode 100644 index 0000000..fd249a0 --- /dev/null +++ b/library/iconbadges.tcl @@ -0,0 +1,254 @@ +# iconbadges.tcl -- +# +# Notification badges for Tk applications. +# +# +# Copyright © 2021 Kevin Walzer/WordTech Communications LLC + +namespace eval ::tk::icons {} + +image create photo ::tk::icons::1-badge -data { + iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA + kFBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/AAD/AAD/AAD/HBz/V1f/Rkb/BQX/Dw//oKD/////y8v/Bgb/Pz//ra3/+/v/ + zMz/Li7/5ub/+vr/8fH/Ly//uLj/Zmb/n5//Bwf/Dg7/kpL/YWH/rq7/h4f/Cgr/ + AQH/AgLXmjE+AAAAEXRSTlMAAA5Vq9/4NK/0St3cDa7z4Pnet34AAAABYktHRBib + aYUeAAAAnElEQVQY022Q5w6DMBCD78hi03RQuvegg77/25ULCakq/MenT4piGwAQ + A8aFlIKzABGAiAojbRSFihhinOheSdwyVKn+UaoQsry7x5PpjDzPgBWGlPNqUdJR + MODky9V6U20N0hwE2W5/ODokQJKdzperQ7JDt7uuPRL299o/5P+IuxA9akO4qI/n + 622jukLNp3GFBmoPjOMnHNkJv3kDExXHctm+AAAAJXRFWHRkYXRlOmNyZWF0ZQAy + MDIxLTA4LTEwVDA4OjM1OjE0LTA0OjAw0aX6GwAAACV0RVh0ZGF0ZTptb2RpZnkA + MjAyMS0wOC0xMFQwODozNToxNC0wNDowMKD4QqcAAAAASUVORK5CYII= +} +image create photo ::tk::icons::2-badge -data { + iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA + 21BMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/AAD/AAD/AAD/Cwv/ODj/UlL/UFD/MjL/CAj/ExP/oKD/8fH//v7//f3/7u7/ + kJD/DAz/ZWX/9fX/jIz/lpb/+vr/9/f/TEz/TU3/m5v/iYn/Ly//6+v/////YmL/ + nJz/5OT/MDD/KSn/srL/7Oz/ZGT/AQH/Nzf/zs7/zc3/SUn/AgL/ICD/ysr/7e3/ + gYH/VVX/WVn/Kir/fX3/eXn/AwP/dnb/rKz/qan/q6vjChO4AAAAEXRSTlMAAA5V + q9/4NK/0St3cDa7z4Pnet34AAAABYktHRCy63XGrAAAAwElEQVQY021Q1xLCMAxz + uktpS9hQoOwZ9t57/P8XUSesB/RinXz2SQIAQiRZUTVNVWSJEABUdMOkHKaho0ZI + yKIfWKFAI3qY/iCsE7AdZNFYPJFMIXNskN1gpjNZL5cv+AF1ZVBwVfRK5Uq1Vkeu + gIqj0Wz57Q7rIldBe/1N91h/gER7S8ORN55MhcQP6WzOFssVFYf8/XrDtrv94Sje + cxMnxnEWJtDq5Xq7B3gkhFUeaCUwFYH+xP5TzrfCyKvCJ3EzGUFH/1QDAAAAJXRF + WHRkYXRlOmNyZWF0ZQAyMDIxLTA4LTEwVDA4OjM1OjE0LTA0OjAw0aX6GwAAACV0 + RVh0ZGF0ZTptb2RpZnkAMjAyMS0wOC0xMFQwODozNToxNC0wNDowMKD4QqcAAAAA + SUVORK5CYII= +} +image create photo ::tk::icons::3-badge -data { + iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA + +VBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/AAD/AAD/AAD/CQn/NTX/UlL/Tk7/Kir/BAT/ERH/mZn/8PD/+Pj/+vr/5ub/ + cHD/AgL/Vlb/9PT/5eX/X1//nZ3/////29v/HR3/Fhb/QED/RET/Cwv/f3//1dX/ + Ghr/Bwf/mpr/9vb/+fn/b2//lZX/2tr//Pz/wsL/Jyf/Dg7/Bgb/MzP/c3P/XV3/ + wMD/qqr/ExP/KSn/4+P/bm7/Q0P/6ur/vb3/x8f/19f/KCj/SEj/qan/zc3/y8v/ + oKD/ODj/BQX/DQ3/AwON+4wDAAAAEXRSTlMAAA5Vq9/4NK/0St3cDa7z4Pnet34A + AAABYktHRCXDAckPAAAAx0lEQVQY021Q1RLCQBDbo4qW4l7ssOLu7g7//zH07oo8 + kJfNZGczyQIAQhaOF0RR4DkLQgBEkWSrSmGVJaIhZLOrH9hthoYkh/oDh4TA6SLM + 4/X5A0HCXE7gFGOGwpFoLJ7QDKpwwJNVMpXOZHEuTzgPAhmFYkkv40qVcAFEZlur + N5otysS3pLc73V6fSfRQ8wyGozges0NqP5nO5oslXjF7GmK96W53eH9gIWhU7Xg6 + X643M6pZ6D54PN+F/tT+85zvC93mC1+z9hl5VNGhJwAAACV0RVh0ZGF0ZTpjcmVh + dGUAMjAyMS0wOC0xMFQwODozNToxNC0wNDowMNGl+hsAAAAldEVYdGRhdGU6bW9k + aWZ5ADIwMjEtMDgtMTBUMDg6MzU6MTQtMDQ6MDCg+EKnAAAAAElFTkSuQmCC +} +image create photo ::tk::icons::4-badge -data { + iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA + 1VBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/AAD/AAD/AAD/AgL/OTn/W1v/ODj/QED/4uL/////oaH/AQH/KSn/zs7/oqL/ + Fhb/tbX/9PT/1NT/Cgr/l5f//Pz/h4f/fHz/dXX/+/v/trb/HBz/fX3/qKj/DAz/ + EBD/ysr/4eH/zc3/5eX/8fH/lJT/BAT/Dw//uLj/5+f/5ub/8vL/+vr/paX/BQX/ + HR3/JCT/ISH/iYn/sLD/Ghr/Tk7/rq7/a2vT0ZXAAAAAEXRSTlMAAA5Vq9/4NK/0 + St3cDa7z4Pnet34AAAABYktHRBibaYUeAAAAvklEQVQY022QVRPCMBCEL1RSg5Ji + Ibi7W9Hi//8n0aRBHtiXvflm7mZvAQChmKJquq6pSgwhAE6wYRIh08CcIWTZ5CPb + ChnCDvmRgxHEE9HspdIZ7ok4KG6EsjmaZ6G7CqgRKRQpLXFEVNAEKVeqNYk00LnV + G81WWyJdINbp9voDOhxFiC+OJ3Q6m9PFciUW+fn1xt/6O7o/HMV5HsI7BcH5Qq83 + JkK8o5L74ymjfh5iHpMP/Xn7TznfCpOywhdM6Ra8aC+AYwAAACV0RVh0ZGF0ZTpj + cmVhdGUAMjAyMS0wOC0xMFQwODozNToxNS0wNDowMHfS8a8AAAAldEVYdGRhdGU6 + bW9kaWZ5ADIwMjEtMDgtMTBUMDg6MzU6MTUtMDQ6MDAGj0kTAAAAAElFTkSuQmCC +} +image create photo ::tk::icons::5-badge -data { + iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA + 7VBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/AAD/AAD/AAD/ICD/MjL/Li7/CQn/Bgb/q6v/8/P/8vL/9PT/4uL/FRX/0tL/ + ////wsL/xcX/uLj/Jib/Kyv/6ur/8fH/aGj/XV3/SUn/Fhb/AQH/+Pj//Pz/7Oz/ + +fn/l5f/Dg7/ODj/qan/sLD/W1v/fn7/9/f/+vr/WVn/EBD/Ghr/2dn/gID/X1// + oKD/EhL/5OT/Y2P/S0v/7e3/vb3/ycn/yMj/HR3/AwP/Skr/zc3/LCz/BQX/DAz/ + AgKLBoLHAAAAEXRSTlMAAA5Vq9/4NK/0St3cDa7z4Pnet34AAAABYktHRB5yCiAr + AAAAyUlEQVQY021Q1RLDMAxzVhp1XcbYMXXMzIz//zmLk9HD9GKdzvZJAgBCbJKs + qKoiSzZCAFDR7A7K4bBrqBHidNEPXE6mEc1Nf+DWCOgeZD4/QyDImEcHyWAzFI5E + I7F4gFFDAhmXEkkzmUpnsshlUHDk8oViqVyxkCug4ihXa/VGtNlCrgqp3en2+oPh + SEj80AqO6WRqzsQhfz/PLJa5lbkW77mJzba225uHozDBrZ7Oncu+eaXC6ivQrXV/ + vAP9if2nnG+F3leFT2jDGOnV8F/uAAAAJXRFWHRkYXRlOmNyZWF0ZQAyMDIxLTA4 + LTEwVDA4OjM1OjE1LTA0OjAwd9LxrwAAACV0RVh0ZGF0ZTptb2RpZnkAMjAyMS0w + OC0xMFQwODozNToxNS0wNDowMAaPSRMAAAAASUVORK5CYII= +} +image create photo ::tk::icons::6-badge -data { + iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA + 9lBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/AAD/AAD/AAD/AQH/ICD/S0v/UlL/NDT/CAj/WVn/2dn/+Pj/+fn/8PD/jY3/ + Cgr/LCz/4OD//f3/hob/cHD/5eX/1NT/NTX/bGz/////39//T0//Bwf/j4//5ub/ + wcH/7+//4uL/f3//CQn/lpb/+/v/n5//iIj/8vL/9/f/UVH/hYX/3t7/Hx//vb3/ + VVX/6Oj/MzP/ExP/x8f/e3v/EhL/t7f/0tL/wMD/MTH/IiL/xsb/zc3/qKj/QkL/ + AgL/Cwv/Dg7/BQWiS7IgAAAAEXRSTlMAAA5Vq9/4NK/0St3cDa7z4Pnet34AAAAB + YktHRCi9sLWyAAAAyklEQVQY021Q1RLCQBDbowalBYq7y+FWirs7/P/PwPawB/Ky + mezsThIAIMTC8YIoCjxnIQQAFclq00zYrBJqhMh27QO7/NSIpGg/UCQCqgOZ2+P1 + +QPIHCpwTlSCoXAkGos/qZMDHleJZCqdyebyyHkQcBRoMeEvecrIBRBxVGi1Vm80 + W8hFJrWp3jG6vT6TzMMBHY4CY2qwQ/P9RJ/O5gu6ZO9NE6s13Wz14o6ZYFb3scPx + dHYzq69Al+vt/g70J/afcr4Vul4VPgDLCRmO3FuJegAAACV0RVh0ZGF0ZTpjcmVh + dGUAMjAyMS0wOC0xMFQwODozNToxNS0wNDowMHfS8a8AAAAldEVYdGRhdGU6bW9k + aWZ5ADIwMjEtMDgtMTBUMDg6MzU6MTUtMDQ6MDAGj0kTAAAAAElFTkSuQmCC +} +image create photo ::tk::icons::7-badge -data { + iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA + xlBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/AAD/AAD/AAD/Hh7/Njb/NTX/Ghr/i4v/9/f/8/P/8vL/8fH/9PT/eHj/fHz/ + 3Nz/2Nj/19f/6Oj/////+Pj/YGD/DQ3/Fxf/FRX/IiL/trb/j4//CQn/Zmb/+/v/ + xsb/GBj/HR3/0tL//f3/Xl7/ZGT/1dX/BAT/p6f/n5//AQH/Fhb/09P/c3P/GRn/ + mZn/qqr/PT3/AgKXVg1iAAAAEXRSTlMAAA5Vq9/4NK/0St3cDa7z4Pnet34AAAAB + YktHRCJdZVysAAAAu0lEQVQY022Q1xKCMBBFN5LQixFR7Bp77wU7//9TJgTFB+7L + njmTydxdAECooGCiqgQrBYQAhNF0gyYxdE04hEyL/mKZ3CHNpn+xNQSOy6Hkl3n8 + gKPrgOLxWamGYa3eaHL0FMDieavd6fZYfyAYAxFjOBpPpmw2F0xATf9dLFfrBNSv + 2mx3e5oqIuHAjoEkIr+npzO7RFJhWYJeb+wuDS+RVKWP5+stFa8qF4riOFsoZ+2c + 42QnLKYn/ADYChWCRPB9rQAAACV0RVh0ZGF0ZTpjcmVhdGUAMjAyMS0wOC0xMFQw + ODozNToxNS0wNDowMHfS8a8AAAAldEVYdGRhdGU6bW9kaWZ5ADIwMjEtMDgtMTBU + MDg6MzU6MTUtMDQ6MDAGj0kTAAAAAElFTkSuQmCC +} +image create photo ::tk::icons::8-badge -data { + iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA + 6lBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/AAD/AAD/AAD/Bwf/MjL/UVH/TU3/Kir/BAT/DAz/j4//7e3/+Pj/5+f/eXn/ + BQX/Skr/9/f/7+//Z2f/fn7/+/v/6ur/MDD/UFD/4uL/Jib/QUH/9PT/NTX/EhL/ + srL/////09P/2tr/m5v/CAj/ycn//f3/y8v/1dX/s7P/GBj/hYX/HR3/Zmb/0dH/ + LCz/5eX/dHT/S0v/wsL/NDT/V1f/sLD/zc3/ysr/paX/RUX/AQH/Bgb/Dg7/DQ3m + iTf5AAAAEXRSTlMAAA5Vq9/4NK/0St3cDa7z4Pnet34AAAABYktHRC8j1CARAAAA + yklEQVQY021Q1RLCQBDbowZFSpEWh+J+xd3d/v936N5hD+QlmezsTrIAQIhLECVZ + lkTBRQgAOorbozN43Ap6hKhe/QOv6nhE8ek/8CkE/AFUoXAkapioAn4QNIdj8UQy + mUpnHKkJIOIom7PyhWKpjFoECalSrNbqDauJWgIZqdWmdod2e6hlbhn9wXBExxNu + scUptWfhFJ3zRXY+TheT5Yqu+XkWYmMNtkNa3fEQLGpmfziezpcrj/oqdLs/zHeh + P7X/POf7wuDrhU+46hlBGTVCQgAAACV0RVh0ZGF0ZTpjcmVhdGUAMjAyMS0wOC0x + MFQwODozNToxNS0wNDowMHfS8a8AAAAldEVYdGRhdGU6bW9kaWZ5ADIwMjEtMDgt + MTBUMDg6MzU6MTUtMDQ6MDAGj0kTAAAAAElFTkSuQmCC +} +image create photo ::tk::icons::9-badge -data { + iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA + 8FBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/AAD/AAD/AAD/DAz/OTn/U1P/R0f/HBz/AQH/Fhb/oqL/8/P/+fn/+Pj/1NT/ + S0v/cXH/////29v/W1v/mJj/0ND/AgL/paX/np7/Ly//7e3//Pz/lZX/vr7/GBj/ + VVX/9fX/c3P/QED/5ub//f3/19f/4OD/+/v/eXn/Pz//mZn/oaH/dXX/6Oj/Z2f/ + Kir/cHD/enr/FRX/TU3/8PD/Ojr/Ozv/2tr/nJz/CAj/Tk7/sbH/z8//wcH/Bgb/ + Dw//CgoJOUsyAAAAEXRSTlMAAA5Vq9/4NK/0St3cDa7z4Pnet34AAAABYktHRCCz + az2AAAAAy0lEQVQY022Q1RLCQAxFs9QovlAozuLu7u72/39D0y3yQB6SO2cmmXsD + AITYBFGSZUkUbIQAIFHsKjVLtSvICHE46aecDoMRxUV/yqUQcHtQ+QNaMKSj8rhB + 8BozHInG4okkIq8AIs4US2eyLBdCLYJk9HyBFWmpXNEQSSDjqLJavdFkLdQyR+1O + t9cfsCFHuEj10XgynbE5XzTPL5ar9Sa+3fHzpon9rFI7sOOJmzCt5s+X6221tqxa + ge6Pp/4O9Cf2n+d8X+izXvgCm5cZM7QQ1AwAAAAldEVYdGRhdGU6Y3JlYXRlADIw + MjEtMDgtMTBUMDg6MzU6MTUtMDQ6MDB30vGvAAAAJXRFWHRkYXRlOm1vZGlmeQAy + MDIxLTA4LTEwVDA4OjM1OjE1LTA0OjAwBo9JEwAAAABJRU5ErkJggg== +} + +image create photo ::tk::icons::9plus-badge -data { + iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAB + OFBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/ERH/AAD/NDT/AQH/AAD/AAD/Cgr/Nzf/U1P/SUn/Hx//AQH/mJj/8fH/+fn/ + 2dn/VFT/BAT/YmL//f3/4uL/YGD/j4//IyP/GBj/xsb/xcX/Fxf/lZX/////rKz/ + JSX/5eX/3t7/3Nz/AgL/hob/yMj/Hh7/Skr/fn7/MTH/srL/vr7/9fX/NDT/NTX/ + 39///v7/3d3/+vr/g4P/RET/9PT/+/v/8/P/R0f/OTn/lpb/pKT/c3P/4eH/dHT/ + Dw//Pz//VVX/5ub/ExP/JCT/bW3/fX3/Ghr/QUH/Rkb/Gxv/wsL/1dX/p6f/DAz/ + e3v/enr/Dg7/ra3/zs7/w8P/gYH/GRn/Bgb/CwuphzIHAAAAFHRSTlMAAA5Vq9/4 + NK/0St3cDa7z8/Ou4A5hHfoAAAABYktHRCy63XGrAAAA+ElEQVQY02NgYGBkZGJm + YWVjY2VhZmJkZGAAibBzcIqAAScHO0iMkZGLWwQOuLmAYozsPCJIgIedkYGXT1RM + XEJSCibGx8vAzC8tIysrJw/kKUhKKogIMDOwKCopq6gqyamJiKhraGqJiLAwsGrr + 6Erp6euoABUZGEoqGLEysBnrmJiayeiYW1haWVtbWdqwMbDZ2tnLOTjqODm7uNrb + u7q5szGwinh4enn76Pj6+QcE6gf4B7EysASHhIaFu1lHiIhEGhiGgYxnFvSxj4rW + iYkVEfGLi08AOYJXKCIxKTklFcmpQA+lJaRLIXsIi7exBA4iCIWhQQgAiNMk9J5+ + e/MAAAAldEVYdGRhdGU6Y3JlYXRlADIwMjEtMDgtMTBUMDg6MzU6MTYtMDQ6MDBG + OusyAAAAJXRFWHRkYXRlOm1vZGlmeQAyMDIxLTA4LTEwVDA4OjM1OjE2LTA0OjAw + N2dTjgAAAABJRU5ErkJggg== +} +image create photo ::tk::icons::!-badge -data { + iVBORw0KGgoAAAANSUhEUgAAABIAAAASCAMAAABhEH5lAAAABGdBTUEAALGPC/xh + BQAAACBjSFJNAAB6JgAAgIQAAPoAAACA6AAAdTAAAOpgAAA6mAAAF3CculE8AAAA + olBMVEUAAAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/AAD/ + AAD/AAD/AAD/AAD/Fhb/QED/Pj7/ExP/VVX/9PT/8PD/SUn/WFj//v7/+fn/S0v/ + SEj/PDz/MjL/6Oj/Jyf/ICD/4+P/2Nj/Fxf/Dw//qKj/nZ3/Cgr/IyP/hIT/gYH/ + Hh7/PT3/Ly//paX/oqL/KCj/AgL///8V6AjgAAAAEXRSTlMAAA5Vq9/4NK/0St3c + Da7z4Pnet34AAAABYktHRDXettlrAAAAoElEQVQY022QxxKCQBBEZ9hERkygophz + lv//NmF3Bz0wp1dd1V3dAwCIDuNCSsGZgwjQKMr1Un2eqxoN0Q/S9gK/1lCF6d+F + CiGKNfYHw5GGOAKWaBpn+URDwoAbw3RWzA1xEAYWRVYaEiANLPPV2pAkabPd7Umy + xsPxdCajjb9cb3eKtyXq+AeVsFWfr/eHqtKgqmoHdczueM7vhT37wi9PRRMHXNeq + aAAAACV0RVh0ZGF0ZTpjcmVhdGUAMjAyMS0wOC0xMFQwODozNToxNi0wNDowMEY6 + 6zIAAAAldEVYdGRhdGU6bW9kaWZ5ADIwMjEtMDgtMTBUMDg6MzU6MTYtMDQ6MDA3 + Z1OOAAAAAElFTkSuQmCC +} + + +if {[tk windowingsystem] eq "x11"} { + + # ::tk::icons::IconBadge -- + # This procedure creates an icon with an overlay badge on systems that + # do not have a native icon/badge API. + # + # Arguments: + # win - window name + # badgenumber - badge number to draw over the window icon + + proc ::tk::icons::IconBadge {win badgenumber} { + + variable ::tk::icons::base_icon + + if {![info exists ::tk::icons::base_icon]} { + return -code error "::tk::icons::base_icon($win) must be set on X11" + } + + if {![info exists ::tk::icons::base_icon($win)]} { + return -code error "::tk::icons::base_icon($win) must be set on X11" + } + + if {[lsearch -exact [image names] $::tk::icons::base_icon($win)] <= 0} { + return -code error "can't use \"$::tk::icons::base_icon($win)\" as iconphoto: not a photo image" + } + + if {!([string is integer $badgenumber] && $badgenumber > 0) + && [string match $badgenumber "!"] == 0 + && $badgenumber ne ""} { + return -code error "can't use \"$badgenumber\" as icon badge" + } + + wm iconphoto $win $::tk::icons::base_icon($win) + + if {$badgenumber eq ""} { + return + } + + image create photo overlay + + switch -glob -- $badgenumber { + ! { + set badge ::tk::icons::!-badge + } + [1-9] { + set badge ::tk::icons::$badgenumber-badge + } + default { + set badge ::tk::icons::9plus-badge + } + + } + + overlay copy $::tk::icons::base_icon($win) + overlay copy $badge -from 0 0 18 18 -to 18 0 + wm iconphoto $win overlay + + } +} diff --git a/library/iconlist.tcl b/library/iconlist.tcl index 6f46ba4..efcd63b 100644 --- a/library/iconlist.tcl +++ b/library/iconlist.tcl @@ -3,8 +3,8 @@ # Implements the icon-list megawidget used in the "Tk" standard file # selection dialog boxes. # -# Copyright (c) 1994-1998 Sun Microsystems, Inc. -# Copyright (c) 2009 Donal K. Fellows +# Copyright © 1994-1998 Sun Microsystems, Inc. +# Copyright © 2009 Donal K. Fellows # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -26,7 +26,7 @@ # <path> selection includes <item> # <path> selection set <first> ?<last>? -package require Tk +package require tk ::tk::Megawidget create ::tk::IconList ::tk::FocusableWidget { variable w canvas sbar accel accelCB fill font index \ @@ -377,7 +377,7 @@ package require Tk method DrawSelection {} { $canvas delete selection - $canvas itemconfigure selectionText -fill black + $canvas itemconfigure selectionText -fill $fill $canvas dtag selectionText set cbg [ttk::style lookup TEntry -selectbackground focus] set cfg [ttk::style lookup TEntry -selectforeground focus] @@ -405,9 +405,10 @@ package require Tk set sbar [ttk::scrollbar $hull.sbar -orient horizontal -takefocus 0] catch {$sbar configure -highlightthickness 0} set canvas [canvas $hull.canvas -highlightthick 0 -takefocus 1 \ - -width 400 -height 120 -background white] - pack $sbar -side bottom -fill x -padx 2 -pady {0 2} - pack $canvas -expand yes -fill both -padx 2 -pady {2 0} + -width 300p -height 90p \ + -background [ttk::style lookup Treeview -background {} white]] + pack $sbar -side bottom -fill x -padx 1.5p -pady {0 1.5p} + pack $canvas -expand yes -fill both -padx 1.5p -pady {1.5p 0} $sbar configure -command [list $canvas xview] $canvas configure -xscrollcommand [list $sbar set] @@ -422,12 +423,7 @@ package require Tk set noScroll 1 set selection {} set index(anchor) "" - set fg [option get $canvas foreground Foreground] - if {$fg eq ""} { - set fill black - } else { - set fill $fg - } + set fill [ttk::style lookup Treeview -foreground {} black] # Creates the event bindings. # @@ -446,18 +442,9 @@ package require Tk bind $canvas <Control-B1-Motion> {;} bind $canvas <Shift-B1-Motion> [namespace code {my ShiftMotion1 %x %y}] - if {[tk windowingsystem] eq "aqua"} { - bind $canvas <Shift-MouseWheel> [namespace code {my MouseWheel [expr {40 * (%D)}]}] - bind $canvas <Option-Shift-MouseWheel> [namespace code {my MouseWheel [expr {400 * (%D)}]}] - bind $canvas <Command-Key> {# nothing} - bind $canvas <Mod4-Key> {# nothing} - } else { - bind $canvas <Shift-MouseWheel> [namespace code {my MouseWheel %D}] - } - if {[tk windowingsystem] eq "x11"} { - bind $canvas <Shift-Button-4> [namespace code {my MouseWheel 120}] - bind $canvas <Shift-Button-5> [namespace code {my MouseWheel -120}] - } + bind $canvas <Shift-MouseWheel> [namespace code {my MouseWheel %D}] + bind $canvas <Option-Shift-MouseWheel> [namespace code {my MouseWheel %D -12}] + bind $canvas <<PrevLine>> [namespace code {my UpDown -1}] bind $canvas <<NextLine>> [namespace code {my UpDown 1}] @@ -468,6 +455,8 @@ package require Tk bind $canvas <Alt-Key> {# nothing} bind $canvas <Meta-Key> {# nothing} bind $canvas <Control-Key> {# nothing} + bind $canvas <Command-Key> {# nothing} + bind $canvas <Fn-Key> {# nothing} bind $canvas <FocusIn> [namespace code {my FocusIn}] bind $canvas <FocusOut> [namespace code {my FocusOut}] @@ -506,15 +495,11 @@ package require Tk # ---------------------------------------------------------------------- # Event handlers - method MouseWheel {amount} { + method MouseWheel {amount {factor -120.0}} { if {$noScroll || $::tk_strictMotif} { return } - if {$amount > 0} { - $canvas xview scroll [expr {(-119-$amount) / 120}] units - } else { - $canvas xview scroll [expr {-($amount / 120)}] units - } + $canvas xview scroll [expr {$amount/$factor}] units } method Btn1 {x y} { focus $canvas diff --git a/library/icons.tcl b/library/icons.tcl index 87af75a..da3e9f4 100644 --- a/library/icons.tcl +++ b/library/icons.tcl @@ -1,153 +1,54 @@ # icons.tcl -- # # A set of stock icons for use in Tk dialogs. The icons used here -# were provided by the Tango Desktop project which provides a +# were provided by the Vimix Icon Theme project, which provides a # unified set of high quality icons licensed under the # Creative Commons Attribution Share-Alike license -# (https://creativecommons.org/licenses/by-sa/3.0/) +# (https://creativecommons.org/licenses/by-sa/4.0/) # -# See http://tango.freedesktop.org/Tango_Desktop_Project +# See https://github.com/vinceliuice/vimix-icon-theme # -# Copyright (c) 2009 Pat Thoyts <patthoyts@users.sourceforge.net> +# Copyright © 2009 Pat Thoyts <patthoyts@users.sourceforge.net> +# Copyright © 2022 Harald Oehlmann <harald.oehlmann@elmicron.de> +# Copyright © 2022 Csaba Nemethi <csaba.nemethi@t-online.de> namespace eval ::tk::icons {} -image create photo ::tk::icons::warning -data { - iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAAABHNCSVQICAgIfAhkiAAABSZJREFU - WIXll1toVEcYgL+Zc87u2Yu7MYmrWRuTJuvdiMuqiJd4yYKXgMQKVkSjFR80kFIVJfWCWlvpg4h9 - 8sXGWGof8iKNICYSo6JgkCBEJRG8ImYThNrNxmaTeM7pQ5IlJkabi0/9YZhhZv7///4z/8zPgf+7 - KCNRLgdlJijXwRyuDTlcxV9hbzv8nQmxMjg+XDtiOEplkG9PSfkztGmTgmFQd+FCVzwa3fYN/PHZ - AcpBaReicW5xcbb64IEQqko8Lc26d/58cxS+/BY6hmJvyEfQBoUpwWCmW1FErKaGWHU13uRk4QkE - UtxQNFR7QwIoB4eiKD9PWbVKbb10CZmaCqmpxCormRYO26QQx85B0mcD+AeK0xYvHqu1tNDx+DH6 - gQM4jh0j3tCA3tGBLyfHLuD7zwJwAcYqun44sHy51nr5MsqsWWj5+djCYdS5c4ldvUr24sU2qarf - lUL6qAN0wqH0vDy7+fAhXZEI+v79CNmt7igpofPVK5SmJvyhkJBwYlQBSiHd7vUWZ86bp8WqqtCW - LkVbuBAhBEIItGAQ2+rVxG7cICMY1KTDsekc5IwagIQTmStXis47dzBiMfR9+xCi+wb39s79+zFi - MczGRjLmzTMlnBoVgLMwyzF+/Cb/lClq2/Xr2AoKUKdPxzAMWltbiUajmKaJkpGBY8sW3tbW4g8E - VNXrXVEKK0YMoMKp7Px8K15Tg2VZOHbvBiASiRAMBgkGg0QiEYQQOIuLsRSFrnv3yJo/HxVOW594 - 7D4KUAa57qysvNSUFOVtbS32rVuRfj9CCFwuV2Kfy+VCCIFMScFVVET7/fukJidLm883rQy+HhaA - BUII8cvUNWt4W1WFcLvRd+5MnHl/AOjOB+eOHchx44jX1ZEdCqkSTpaDbcgA5+GrpNmzc9ymKdvr - 67Hv2oVMSko4cjgcKIqCoijoup64EdLpxLV3Lx1PnuCVUrgmTfK9hV1DAjgKqlSUk1PCYdl25QrS - 70cvLEw4SWS+04nT6XxvXgiBc8MGtKlTaa+rIysnR1Ok/OF38PxngAzY4VuwYKL99WvR8fQpjj17 - kLqeiL6393g8eDyeAWBSVfEcOkRXczOOaBRvVpZuDPJEDwD4DVyKrv+UlZurxSorUWfMQC8oGOBc - CDHgC/Rdc4TD2BctIl5fT+bkyTahaXvOw8RPApiwd2Ju7hjZ2EhXSwvOkhKQcoADgIqKCioqKgYc - QW9LOnIEIxZDbWpiXCCABT9+FKAUxtm83pKMUEiLVVejLVqEtmTJB50LIdi2bRuFPbnRd7232efM - wbVuHR2PHjHR77dJXS8sg5mDAihweFJenmrevYvR1oazpGTQ6IQQaJqG7ClI/dd655IOHsSyLMSL - F6QFAib9nugEQClk2Xy+orTsbK3t1i3sa9ei5eQMGr0QgvLyci5evDiocyEEtsxMPNu30/nsGRO8 - XlVzu8NlkNvrV+0T/fHMZcusrtu3MeNx9PXrobUVq8cYQrw3TrRub1h9+v573Bs3Ej1zBvP5c/zp - 6dbLhoaTwPy+ANKCfF92thq7dg2A6JYt/fNlxGK8eUNSerryHEJHQT8K8V4A5ztojty8OeaLzZul - 1DSwLCzDANPEMozusWFgmWZ33288YK3/nGlixuM0v3xpWfDX0Z4i1VupXEWwIgRnJfhGPfQ+YsLr - +7DzNFwCuvqWyiRg7DSYoIBu9smPkYqEd4AwIN4ITUAL0A4Da7UC6ICdEfy2fUBMoAvo7GnWKNoe - mfwLcAuinuFNL7QAAAAASUVORK5CYII= +variable ::tk::svgFmt [list svg -scale [expr {[::tk::ScalingPct] / 100.0}]] + +image create photo ::tk::icons::error -format $::tk::svgFmt -data { + <?xml version="1.0" encoding="UTF-8"?> + <svg width="32" height="32" version="1.1" xmlns="http://www.w3.org/2000/svg"> + <circle cx="16" cy="16" r="16" fill="#d32f2f"/> + <g transform="rotate(45,16,16)" fill="#fff"> + <rect x="6" y="14" width="20" height="4"/> + <rect x="14" y="6" width="4" height="20"/> + </g> + </svg> } -image create photo ::tk::icons::error -data { - iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAAABHNCSVQICAgIfAhkiAAABiRJREFU - WIXFl11sHFcVgL97Z/bX693sbtd2ipOqCU7sQKukFYUigQgv/a+hoZGoqipvfQKpAsEDD0hIvCHE - j/pQ3sIDUdOiIqUyqXioEFSUhqit7cRJFJpEruxs1mt77Z3d2Z259/KwM5vZXTtOERJXOrozZ+6e - 852fuXcW/s9D3O3Cs1Bow1Nx234BKQ9qpYpK6yFLSseScsVoveApdUrAzNOw9j8DOAMTtmX9RsM3 - SqOjevcXDqUzu8dI5AvEc8O0axu4q6s4yzdZvnCxUSmXLWHMXzxjXpmGq/81wGmIZ6T8NXDi8w8d - id//+GPS8j1YWQXHgVYbfA/sGCRiMDQExTzKtvn3zDv6k9m5FsacXNT6+y+D95kAZqCEEO/cMzIy - 9eBLLybjyodrN6DpDqw1/dfpFNw3TtuSfPz7P7irlZUL2pjHn4GVuwJ4G/JCiLl9U1OjB58/ZnP5 - Mqxv3NGpMWZAz64cHNzHlTf/5N9YuHzTMeaLx6HW78+K3pwGKynEu/snJycOHPuWzdw81BuDUQZO - dfQ+MmvAuC1MdY3i178izUo15VZXj07DyTf6OGX0Jivlz0vFwgMTz3/bNnMXO0ZCo8b0iIk4C0WF - zsP1TRc1e4l9x56N5YuFwxkpf9afgW4J/gi7M1IuHH3lezm5uAQbmwOpjc79ujArA2uMgWwGMz7K - P377u/WW1pPTUB7IQFrKXx44NJWRbQ9d2+hGqbeRMEoTZEQFJdERfVgmvVFH+D57Jw9k4lL+YqAE - pyGnjZm+95knLHVjcVvHA6WIPgtLE+hVH4i6vsS9T3zTVsY8NwPZHoAUPFUs5JVQCt1q9zqORKm3 - iLKrF6IjkfSHOiUlqu0hhCSXHdYePNYDEBPiu6MT+zOquo6JGNGhESkxUnYNmkCnLQtjWRgpMRG9 - CtZ3JdD7axsU9+3N2EK8EALYQcNMpvfuQTcaXUMIAa+/Hi0Xgs9weASjefx4p5mFQDdbpD63G/HR - hakeAA2l+EgJU652iIMMyO2sRoYxBq1191oIgZQSITqooT0A7fnEirswUAp/LwG0MZlYIY9WqpPa - IHU7Da01Sqluo4UQSil830dr3emVsBeMIZbLoI0Z7gGQQtTbjoOOxW/XewcApVQ38jsBNs6fx6tW - O70Si+GWKwghNsM1NoCAW81KJTeUjKNbrR2N7uS4B7TRwJ+fR6TTxO4fxzUeAio9AMCl+tVrE0NH - DmM2nU4DAu6JE53UGoNfLuNdv45xnO4OF/ZKz+4X2T179I6D5To0NupouNgD4Btzqjx/8WjpS0cy - PU1Tr6MqFfylpc4bss1W26/rBwyfybECtcvXNrUxp3oAXJjZ2Kxb7cVP8P61gDGgWy2M624Z5d1E - 3wNkDDKdwMQkjtuygbMhgAQ4DjUhxFvL/5z15X1jeLUaynW7p1u484WiuL3V9m/NoV6F50Ogjx3Y - Q/mDBV8a3piGzR4AAFfrHy4vlesmm0bks7edRQ6aAafcPoZVH2AUXOYzkI5TvbVa9+FHREYX4Bgs - I8RrV9/9oJF4eBKTjO8YvdoCJgqujcGkEqQemmDxb7OOFOLV6FHcAwBQ1/onTtOd/fTvH3rJRx/A - pBIDqd0q+p5sRaInnWDoywdZem+u7bbaH9W1/il9Y2Brfwt22TBfKOVHxr92JOacv4S/UuttuC06 - PKoHsEs5hg7vZ/m9eW+zWltuwoNbfRNuebacgXsEnE2lkof2Hn04ZRouzQvXUU5z29cwFGs4TWpy - HJGK8+lfP256bnuuDU8+B9WtfG17uL0GsTF4VQrxYn60kBh55JDEbdG6uYq/7qDdFtpTELOQyQRW - Lk1sLI+MW9w6d8Wv3Vrz2nDyJPzgDDS287MVgAAywBCQ+Q5MTsOPs/BIMpVQ2bFCKlnMYg+nsYeS - eE6TVq1Be3WD9ZtrTc9tWetw7k341dtwBagDTmTeESAdAAxH5z0w9iQ8ehi+moWxBGRsiPvguVBf - h8qH8P6f4dxSp9PrdN73cN6k859R3U0J0nS+28JMpIM5FUgCiNP5X2ECox7gAk06KQ8ldLzZ7/xO - ANHnscBhCkgGjuOB3gb8CEAbaAWO3UA34DQ6/gPnmhBFs5mqXAAAAABJRU5ErkJggg== +image create photo ::tk::icons::warning -format $::tk::svgFmt -data { + <?xml version="1.0" encoding="UTF-8"?> + <svg width="32" height="32" version="1.1" xmlns="http://www.w3.org/2000/svg"> + <circle cx="16" cy="16" r="16" fill="#f67400"/> + <circle cx="16" cy="24" r="2" fill="#fff"/> + <path d="m14 20h4v-14h-4z" fill="#fff"/> + </svg> } -image create photo ::tk::icons::information -data { - iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAAABmJLR0QA/wD/AP+gvaeTAAAACXBI - WXMAAAsTAAALEwEAmpwYAAAAB3RJTUUH1gUdFDM4pWaDogAABwNJREFUWMPFlltsVNcVhv+199ln - bh7PjAdfMGNDcA04EKMkJlIsBVJVbRqlEVUrqyW0QAtFTVWpjVpFfamUF6K+tCTKQyXn0jaiShOr - bRqRoHJpEEoIEBucENuk2OViPB5f5j5zrvuc3YcMFQ8FPBFVj7S0paN91v+tf1/OAv7PD9UzeeCp - p0KRCrYyHtymoPrgySYAANdyBBr2Peu1agP+NrR/v3nHAb6/52d7wfivWlet11NdvZG21laEwzo0 - RvA9F4uLi7h08bxxaWLUVp78xSsv/XrwjgAMDDyjRxPWUGOy5Uu9/VsjEA3I5KvIVQ240gHIh9CA - 5YkwelIJRATw94NvGpnpK0fL+eDA0NAzzq3ya7cDjCbsoWWr1j+y4f4vB/41Z8JTeaxqE7hndSNi - EeELzn3LkapQdfzJTE5JV/GBb28LHz327lcnzp4ZAvB1AOpmAvyWtv/g6R9GW1c+uf6Bx0Kfzpjo - TmnYtDaKtkTAj4aEFBqTnJPUOfciIeG3N4XVQtmyzl/JuY8/fH9wOjO/smvVmuy5s+8P1w2wa9dP - 46SLN3sf2ha7uiixaU0Qna06NA6PMXIZQRJBMiIXRBKABygv3hBQV+bK1dmcoR7d3Bc5c/pk/8YN - fYOjo6es/6bDbgbAdLa9uXNj2PYF2pOEloQGAiRIuUTkME42J7IZweYES+NkckZWWNfseEPAKJtO - oWxLu69/c5jpbPtNdW7qPwvsbO1cF8pVLKxs0+HD94gpl0AOQTlEsDkjizFmMk4WESyNM4NzMgOC - VYI6q17OlIp9992ngek769+EvtfVEI3jWqaKgAgAIAlFLuOwGZHDiTnElGQgF4DvM1LKV7Bdz2NE - xaCuhQpVm1Y0p5qhvNV1AyjlRTWhwVM2TMdzgkJzieAQyGGMbMZgfwZBEiBPA3xX+VSouAvBAFeM - yDddD7rgpHw/WjcAMa0EZScZk5heqFrxiO4BzCGCzYgsBrI4I5sYcxlBKl/5WdOdd6S0gxoLEZEi - Iq4AnzGq1r0HiPhYuZRFU1R3FgqWkS1aZQA2gWzOyGQcJudkaAwVR3qz8yXzvCXlzJoViaagrlWC - jJnLm8Jarli2GNMm6wbwPPO31y6Ollc2N3pcI+fyYjW/8a5EKqQTz5WtdLHsTi1W7Im5vDlcMdxx - wVk2Ys9/pTI3+WhAaIauM+MLbYnlH46MVKVyX6v7Hhg9e2ps3doN32ld0Rlrb1nmmK4stCdCSCUj - Le1NwW6uXJ08m/t2OarBXh0ie0syHu0plKtTFGw8n4o33q1z1XngD7+X3C/uHBkZces7hoAi1946 - fPSvtpDlYFdLPDI8mR03HC87frXwFpgqLYuFuzrbkg8m49EeDsqDa+cizXcNpppia5ui+sYXnn+O - 29LbOTg4aHzun9GOPT/pDemhf3xzx25DicjkiqaAIs4zhumMRUJaPhzgJZ0LQ5C7gXjQL1kS0YD+ - o337nhWlYvHJV178zZ9vlZ/dDuDVl57/2HWt755894hINoYSmZx11TYKCUZKCs4cnQuDmGtfvDiR - dD3n04aA6J4YHzeLhfLg7cSXBAAA5NPpufS1WFjwkFSelZ6ZLWfn0kliTDJdue8dO9qenp2d1DVR - 4cTarlyZJgV5dim5lwTw8sv7c1L6H89cm6FlDcHVhlOJffThsa9d+ud72y5+cnTn2PjJJ1avjOoE - SnBiPadOfRDTGT5YSm5tqR2R7Zp7//L6gRPf27NjVaolqS9MCzh28W6mgDXdKxCNRb/oOlV18O3D - 1xzXGXpx8LnZO94Tbt/x+MFYouexh7dsQU/PWjRGI+BcAyMgm1vAO28fxvj4xOX5jL7u0KEX7Dvq - AAC0Nucf2rLZhq8Y3njjT8gulOBKDw0NAQjNQT435eQWL3iHDk3YS81ZF0B6psI/GbuAXbu+gQf7 - H4ArPeQWC5jLZKCUhQvjWb2QD3bVk5PVM9nz5LML8waOH38fekBHIhFDqqMFXd0pnDhxGmMTU3Bd - 9/X/GQDntO/eezswMPBjaFwAABxH4sKFq+jt7cX6ni6EQuJbdeWsZ3J3d/PTmqaEYUyhXDZBTEOh - WIIQwOi5jzA1eRnZXPFSPO7/bmbGlLfqhus5BVotRH9/x7rGxtBeIQJPACrMOYNSPpRiUIpnlTIO - nzmT+eX8fLH8WZMKF4Csje7ncUAHEKhFcHq6ZE5OZoc7O3tlc3N33+7dP9c2bXoE09NlO52uHDhy - ZOTVatUWte+otsTXg2pQSwagG6r/jwsAQul0erqjo+OesbGx1tHRUT+fz48dP378j57neQD8mtB1 - B1TtnV9zo64loJqoXhtFDUQHEGhvb2/2fZ9nMpliTcAFYNdC1sIBYN1sCeq5Ca9bqtWcu9Fe3FDl - 9Uqvu3HLjfhvTUo85WzjhogAAAAASUVORK5CYII= +image create photo ::tk::icons::information -format $::tk::svgFmt -data { + <?xml version="1.0" encoding="UTF-8"?> + <svg width="32" height="32" version="1.1" xmlns="http://www.w3.org/2000/svg"> + <circle cx="16" cy="16" r="16" fill="#2091df"/> + <circle cx="16" cy="8" r="2" fill="#fff"/> + <path d="m14 12h4v14h-4z" fill="#fff"/> + </svg> } -image create photo ::tk::icons::question -data { - iVBORw0KGgoAAAANSUhEUgAAACAAAAAgCAYAAABzenr0AAAABHNCSVQICAgIfAhkiAAACG5JREFU - WIXFl3twVdUVxn97n3Nubm7euZcghEdeBBICEQUFIgVECqIo1uJMp3WodqyjMzpjZ7TTh20cK31N - /2jL2FYdKXaqRcbnDKGpoBFaAY1BHgHMgyRKQkJy87yv3Nyzd/84594k1RlppzPumTXn3Dl3r/Wd - b31rrbPhS17iSv+4bl2t2ZFhrRGI7QKxRkMAyHEfjwgYEOgjNnpfcXjiSENDbeL/AqBoW22uGE/7 - MYL7yubN4MYVpVkrquaKqwJZ+LPTARgcjdIbHKOx+aI+9EH7WGvnZdA8q9PGf9b5eu3w/wygaPPO - h6Uhntxcsyj9/q+vtMrnBa6Is7ZPgzzzyvGJ/YfPRpWWj3fWff93/xWAonW1Xu3z/nVx6cxNTz74 - 1YzK4gIQjuN/nfyEEx9fIjgaYXAkhhAQyE3Hn5PBsvJZrF46l5I5+QB83NnP40+/FT7d1ltPOPrN - zoba2BcCWLy91hMOp72/bX1VxU/u3+BJ91i0fhrkuTcaaTzbjTQkhpQIIZBSIBApL1prtNYsryhk - xy1XUzonn1g8wVPPvh1/5dDpcz5f7LrmfbXxqfGM6eG1yCw+9uq2G6tW7nxoU5plGrzecJYnnnub - SwMhTNPAmmKmYWCaBoYpMQyJaRhIQ3IpGOKt4+1k+dKoLJ7BjStKjb6hcN7JloFrhlsO7oUnPh9A - 8Rbvo6uuLrr3N4/ckm4Ykt/vPcqe/R9hGAamaWJZbnDL+W2axqRJA8NlxzAkAI3newhF4lxbMZs1 - y4rNM+19c0PZ++NDLQff+0wKCu/Y6c/UVsubv/12/ryZubxUf5Ln3vgQ0zKnvK1kadkMlpQUUFEU - oCDPR25WOuPxBH2DYZpa+qg/3kEoGsdWCttWJGzF3ZuXcuf6Ci5eHmXrw7sHR4mXd7/2w+A0Bvyl - N+265/bl19+8eqE8c6GPn+85jGkYWC4Ay3Luf/3AV1g038+MXB8+rwfDkKR5TPKyvCyan8+qqtmc - au8nFrcdnQCn2vuoLptJSWEeE7bynDjdXTDUcvBNAAmweF1tpmXKu+65bYWh0Ty97zhSyGkUO0BM - hBAI4RAXTyjiCYWUEukKMz/Ly/b1C7EsE49lYlkmhjTYvf8jNHD3lmsM0zTuWryuNhPABIj4vFvW - Xl0s87PTOdXWS8snQTwec4ro3DSYBglbcfx8P+8199I7FMEQgg3L53N7TWkKXOV8Px7LJCFtXKx0 - dA9zrnOAyqIAa68tkQePtm4BXpaO9vWOm65b4EPAkY+6HDEZTt4NN/dJML946QSv/fMCA6PjpHks - LI/F2a5BtNYpMUtJirGpLL7f3A3AxpXlPiHFjhQDaJZVlc0EoPWT4DQ1m8ZkKizTJDRuY1mmC04i - pWDNksJUD9Bac7E/jGUZrmuN1qCU5sKlIQAqSwrQWi+bBCDwF+RnAk5fl27wqeYAkZM9wLWaxVex - qnJmKritFO+e7sMyDdBOc1JKYxiSkdA4CMGM3Aw02j+VAfLcwTIWibuiEpNApJMSw208ydJcu3QW - axZPCW7bHGjspmcwimkYTmAlMWzHTyTmDMiczLRU/ctkNxgajboPvUghppuUGFJMY6O6OJ/ViwIo - pVBKYds2dR9e4uPuMbc7Tm9MUgqyM70AjITHUy1IAghNsH8oDEAgz4cQOIqWjkkpEC4rSYfXL/Sn - giulONYyRFd/1GXKAZxkUrgvkp/tAAgORxAQnAQg5InmC5cBWDgv4NS5EAhAINzyIlVmUgiy040U - 9Uop2voiKYakEAiRvDp7EYKS2XkAnOvsR0h5IqUBrfWeQ8fb1t2xvtJXs3QuB462TfZokbxMGZxC - 8If6DtI8Fh6PhcdjojSpBuXin7Kc3csXzQLgrWOtEWWrPSkAvkis7kjTBTU8FqOypIAF8/x09Y6Q - FGjyTdHJstLsWDsnNZIBXj7Wj1LKYSS5B412nRTNymHBnHxGQ+O8836r8kVidakUNDfUhhIJtfcv - dU22AO69dRlCCNeZU8fJe6U0ylZYBlgGmNKx+ESCiYRNwlYoWzn/UxqtHOB3ra8AAX/7x0nbttXe - 5oba0GQVAPGE9dju1z4Y7u4fY9F8P9/YWOUEV06O7eTVnXBTBaiUIj4xwcSETSJhk7BtbNtOPdta - U0ZpYS59wRB/2ndsOBa3HkvGTU3D0fb6aE7ZBt3RM1yzuabcqiwKEI5N0N495ChaSKcihJPRa0pz - sbUmYTugPmgbJmErB4DLxETC5oYlhWxdXUrCVvxgV32krav/qa4Djx76D4kllxalt/7q9e2bqjf9 - 9Lsb0oQQHGrsYO+hc0gp3emW/Bhxm5NbZlqD0g79CTcFt60u4YYlhWhg5/MN4y/WNdW3vfnoNhD6 - Mww46wlmV9/w6snzA1sHRqKBVUvnGQvm+qkuKyA4GqVvKOJAdrcn8zz14yNh2ywozOVbGyuoKg4w - PmHzyxcOx1+sazqTlhbZ3H92vT29Pj5nzVn1SLqVH3ipunzOxqceutlX6n7lXrw8yqn2flq7hxgL - TzAWiyOFICfTS44vjbLCXKqK/cwOOHOl49IwP9r192hT84V3e4+9cF90sC0IRL8QAOADsgvXfu9B - b3bgkTs3LPN+52srzPlX5V7RUerTy6M8/0Zj4uUDH45Hg13PdB/9425gzLUhQH0RgDQgC8hKLyid - 7a/c9oCV4d9WVTpLbF5TmX5tRaGYkecjJ8MLAkZD4wyMRGg636PrDjfHzrT26NhYT33w1Kt/Hh/u - 6XUDh4BBIHwlDIBTohlANpBhWb6s7PKNK30FCzZa6dnVYORoIX2OExVF26Px8NCZSN/5d0bb3mlK - JGIhHLpDwLAL4jPnxSs9nBqABXhddrw4XdRygSrABuKuxYBx9/6KDqlf2vo3PYe56vmkuwMAAAAA - SUVORK5CYII= +image create photo ::tk::icons::question -format $::tk::svgFmt -data { + <?xml version="1.0" encoding="UTF-8"?> + <svg width="32" height="32" version="1.1" xmlns="http://www.w3.org/2000/svg"> + <circle cx="16" cy="16" r="16" fill="#5c6bc0"/> + <path d="m17.6 27.2h-3.2v-3.2h3.2zm3.312-12.4-1.44 1.472c-1.152 1.168-1.872 2.128-1.872 4.528h-3.2v-0.8c0-1.76 0.72-3.36 1.872-4.528l1.984-2.016a3.128 3.128 0 0 0 0.944-2.256c0-1.76-1.44-3.2-3.2-3.2s-3.2 1.44-3.2 3.2h-3.2c0-3.536 2.864-6.4 6.4-6.4s6.4 2.864 6.4 6.4c0 1.408-0.576 2.688-1.488 3.6z" fill="#fff"/> + </svg> } diff --git a/library/images/logo.eps b/library/images/logo.eps index 0d05d34..006e72a 100644 --- a/library/images/logo.eps +++ b/library/images/logo.eps @@ -28,7 +28,7 @@ %%BeginProlog %%BeginResource: procset Adobe_level2_AI5 1.0 0 %%Title: (Adobe Illustrator (R) Version 5.0 Level 2 Emulation) -%%Version: 1.0 +%%Version: 1.0 %%CreationDate: (04/10/93) () %%Copyright: ((C) 1987-1993 Adobe Systems Incorporated All Rights Reserved) userdict /Adobe_level2_AI5 21 dict dup begin @@ -77,7 +77,7 @@ userdict /Adobe_level2_AI5 21 dict dup begin } def } if - + /gt38? mark {version cvx exec} stopped {cleartomark true} {38 gt exch pop} ifelse def userdict /deviceDPI 72 0 matrix defaultmatrix dtransform dup mul exch dup mul add sqrt put userdict /level2? @@ -178,7 +178,7 @@ userdict /Adobe_level2_AI5 21 dict dup begin %%EndResource %%BeginResource: procset Adobe_IllustratorA_AI5 1.1 0 %%Title: (Adobe Illustrator (R) Version 5.0 Abbreviated Prolog) -%%Version: 1.1 +%%Version: 1.1 %%CreationDate: (3/7/1994) () %%Copyright: ((C) 1987-1994 Adobe Systems Incorporated All Rights Reserved) currentpacking true setpacking @@ -1062,7 +1062,7 @@ end } { /clipForward? true def - + /Tx /pop load def /Tj /pop load def currentdict end clipRenderOff begin begin @@ -1089,7 +1089,7 @@ end end end begin - + /clipForward? false ddef } if } ifelse diff --git a/library/images/pwrdLogo.eps b/library/images/pwrdLogo.eps index e11d9e9..674250f 100644 --- a/library/images/pwrdLogo.eps +++ b/library/images/pwrdLogo.eps @@ -28,7 +28,7 @@ %%BeginProlog %%BeginResource: procset Adobe_level2_AI5 1.0 0 %%Title: (Adobe Illustrator (R) Version 5.0 Level 2 Emulation) -%%Version: 1.0 +%%Version: 1.0 %%CreationDate: (04/10/93) () %%Copyright: ((C) 1987-1993 Adobe Systems Incorporated All Rights Reserved) userdict /Adobe_level2_AI5 21 dict dup begin @@ -77,7 +77,7 @@ userdict /Adobe_level2_AI5 21 dict dup begin } def } if - + /gt38? mark {version cvx exec} stopped {cleartomark true} {38 gt exch pop} ifelse def userdict /deviceDPI 72 0 matrix defaultmatrix dtransform dup mul exch dup mul add sqrt put userdict /level2? @@ -178,7 +178,7 @@ userdict /Adobe_level2_AI5 21 dict dup begin %%EndResource %%BeginResource: procset Adobe_IllustratorA_AI5 1.1 0 %%Title: (Adobe Illustrator (R) Version 5.0 Abbreviated Prolog) -%%Version: 1.1 +%%Version: 1.1 %%CreationDate: (3/7/1994) () %%Copyright: ((C) 1987-1994 Adobe Systems Incorporated All Rights Reserved) currentpacking true setpacking @@ -1062,7 +1062,7 @@ end } { /clipForward? true def - + /Tx /pop load def /Tj /pop load def currentdict end clipRenderOff begin begin @@ -1089,7 +1089,7 @@ end end end begin - + /clipForward? false ddef } if } ifelse diff --git a/library/listbox.tcl b/library/listbox.tcl index 44abfb9..f0009bf 100644 --- a/library/listbox.tcl +++ b/library/listbox.tcl @@ -3,9 +3,9 @@ # This file defines the default bindings for Tk listbox widgets # and provides procedures that help in implementing those bindings. # -# Copyright (c) 1994 The Regents of the University of California. -# Copyright (c) 1994-1995 Sun Microsystems, Inc. -# Copyright (c) 1998 by Scriptics Corporation. +# Copyright © 1994 The Regents of the University of California. +# Copyright © 1994-1995 Sun Microsystems, Inc. +# Copyright © 1998 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -31,7 +31,7 @@ # can put "break"s in their bindings to avoid the error, but this check # makes that unnecessary. -bind Listbox <1> { +bind Listbox <Button-1> { if {[winfo exists %W]} { tk::ListboxBeginSelect %W [%W index @%x,%y] 1 } @@ -41,7 +41,7 @@ bind Listbox <1> { # Among other things, this prevents errors if the user deletes the # listbox on a double click. -bind Listbox <Double-1> { +bind Listbox <Double-Button-1> { # Empty script } @@ -54,10 +54,10 @@ bind Listbox <ButtonRelease-1> { tk::CancelRepeat %W activate @%x,%y } -bind Listbox <Shift-1> { +bind Listbox <Shift-Button-1> { tk::ListboxBeginExtend %W [%W index @%x,%y] } -bind Listbox <Control-1> { +bind Listbox <Control-Button-1> { tk::ListboxBeginToggle %W [%W index @%x,%y] } bind Listbox <B1-Leave> { @@ -169,72 +169,24 @@ bind Listbox <<SelectNone>> { # Additional Tk bindings that aren't part of the Motif look and feel: -bind Listbox <2> { +bind Listbox <Button-2> { %W scan mark %x %y } bind Listbox <B2-Motion> { %W scan dragto %x %y } -# The MouseWheel will typically only fire on Windows and Mac OS X. -# However, someone could use the "event generate" command to produce -# one on other platforms. - -if {[tk windowingsystem] eq "aqua"} { - bind Listbox <MouseWheel> { - %W yview scroll [expr {-(%D)}] units - } - bind Listbox <Option-MouseWheel> { - %W yview scroll [expr {-10 * (%D)}] units - } - bind Listbox <Shift-MouseWheel> { - %W xview scroll [expr {-(%D)}] units - } - bind Listbox <Shift-Option-MouseWheel> { - %W xview scroll [expr {-10 * (%D)}] units - } -} else { - bind Listbox <MouseWheel> { - if {%D >= 0} { - %W yview scroll [expr {-%D/30}] units - } else { - %W yview scroll [expr {(29-%D)/30}] units - } - } - bind Listbox <Shift-MouseWheel> { - if {%D >= 0} { - %W xview scroll [expr {-%D/30}] units - } else { - %W xview scroll [expr {(29-%D)/30}] units - } - } +bind Listbox <MouseWheel> { + tk::MouseWheel %W y %D -40.0 } - -if {[tk windowingsystem] eq "x11"} { - # Support for mousewheels on Linux/Unix commonly comes through mapping - # the wheel to the extended buttons. If you have a mousewheel, find - # Linux configuration info at: - # https://linuxreviews.org/HOWTO_change_the_mouse_speed_in_X - bind Listbox <4> { - if {!$tk_strictMotif} { - %W yview scroll -5 units - } - } - bind Listbox <Shift-4> { - if {!$tk_strictMotif} { - %W xview scroll -5 units - } - } - bind Listbox <5> { - if {!$tk_strictMotif} { - %W yview scroll 5 units - } - } - bind Listbox <Shift-5> { - if {!$tk_strictMotif} { - %W xview scroll 5 units - } - } +bind Listbox <Option-MouseWheel> { + tk::MouseWheel %W y %D -12.0 +} +bind Listbox <Shift-MouseWheel> { + tk::MouseWheel %W x %D -40.0 +} +bind Listbox <Shift-Option-MouseWheel> { + tk::MouseWheel %W x %D -12.0 } # ::tk::ListboxBeginSelect -- @@ -506,7 +458,7 @@ proc ::tk::ListboxCancel w { } set first [$w index anchor] set last $Priv(listboxPrev) - if {$last eq ""} { + if {$last < 0} { # Not actually doing any selection right now return } diff --git a/library/megawidget.tcl b/library/megawidget.tcl index ec9f469..5114f63 100644 --- a/library/megawidget.tcl +++ b/library/megawidget.tcl @@ -4,13 +4,13 @@ # the ::tk::IconList megawdget, which is itself only designed for use in # the Unix file dialogs. # -# Copyright (c) 2009-2010 Donal K. Fellows +# Copyright © 2009-2010 Donal K. Fellows # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # -package require Tk +package require tk ::oo::class create ::tk::Megawidget { superclass ::oo::class @@ -284,7 +284,7 @@ package require Tk method CreateHull {} { ttk::frame $w set hull [ttk::entry $w.cHull -takefocus 0 -cursor $options(-cursor)] - pack $hull -expand yes -fill both -ipadx 2 -ipady 2 + pack $hull -expand yes -fill both -ipadx 1.5p -ipady 1.5p my TraceOption -cursor UpdateCursorOption } } diff --git a/library/menu.tcl b/library/menu.tcl index deca485..ba7acf1 100644 --- a/library/menu.tcl +++ b/library/menu.tcl @@ -4,10 +4,10 @@ # It also implements keyboard traversal of menus and implements a few # other utility procedures related to menus. # -# Copyright (c) 1992-1994 The Regents of the University of California. -# Copyright (c) 1994-1997 Sun Microsystems, Inc. -# Copyright (c) 1998-1999 Scriptics Corporation. -# Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net> +# Copyright © 1992-1994 The Regents of the University of California. +# Copyright © 1994-1997 Sun Microsystems, Inc. +# Copyright © 1998-1999 Scriptics Corporation. +# Copyright © 2007 Daniel A. Steffen <das@users.sourceforge.net> # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -88,7 +88,7 @@ bind Menubutton <Enter> { bind Menubutton <Leave> { tk::MbLeave %W } -bind Menubutton <1> { +bind Menubutton <Button-1> { if {$tk::Priv(inMenubutton) ne ""} { tk::MbPost $tk::Priv(inMenubutton) %X %Y } @@ -281,7 +281,7 @@ proc ::tk::MbPost {w {x {}} {y {}}} { set Priv(postedMb) $w set Priv(focus) [focus] - $menu activate none + $menu activate {} GenerateMenuSelect $menu update idletasks @@ -364,8 +364,8 @@ proc ::tk::MenuUnpost menu { if {[winfo class $parent] ne "Menu" || ![winfo ismapped $parent]} { break } - $parent activate none - $parent postcascade none + $parent activate {} + $parent postcascade {} GenerateMenuSelect $parent set type [$parent cget -type] if {$type eq "menubar" || $type eq "tearoff"} { @@ -475,7 +475,7 @@ proc ::tk::MbButtonUp w { proc ::tk::MenuMotion {menu x y state} { variable ::tk::Priv if {$menu eq $Priv(window)} { - set active [$menu index active] + set activeindex [$menu index active] if {[$menu cget -type] eq "menubar"} { if {[info exists Priv(focus)] && $menu ne $Priv(focus)} { $menu activate @$x,$y @@ -487,8 +487,8 @@ proc ::tk::MenuMotion {menu x y state} { } set index [$menu index @$x,$y] if {[info exists Priv(menuActivated)] \ - && $index ne "none" \ - && $index ne $active} { + && $index >= 0 \ + && $index ne $activeindex} { set mode [option get $menu clickToFocus ClickToFocus] if {[string is false $mode]} { set delay [expr {[$menu cget -type] eq "menubar" ? 0 : 50}] @@ -496,10 +496,12 @@ proc ::tk::MenuMotion {menu x y state} { # Catch these postcascade commands since the menu could be # destroyed before they run. set Priv(menuActivatedTimer) \ - [after $delay "catch {$menu postcascade active}"] + [after $delay [list catch [list \ + $menu postcascade active]]] } else { set Priv(menuDeactivatedTimer) \ - [after $delay "catch {$menu postcascade none}"] + [after $delay [list catch [list + $menu postcascade {}]]] } } } @@ -527,7 +529,7 @@ proc ::tk::MenuButtonDown menu { if {![winfo viewable $menu]} { return } - if {[$menu index active] eq "none"} { + if {[$menu index active] < 0} { if {[$menu cget -type] ne "menubar" } { set Priv(window) {} } @@ -585,7 +587,7 @@ proc ::tk::MenuButtonDown menu { proc ::tk::MenuLeave {menu rootx rooty state} { variable ::tk::Priv set Priv(window) {} - if {[$menu index active] eq "none"} { + if {[$menu index active] < 0} { return } if {[$menu type active] eq "cascade" \ @@ -593,7 +595,7 @@ proc ::tk::MenuLeave {menu rootx rooty state} { [$menu entrycget active -menu]} { return } - $menu activate none + $menu activate {} GenerateMenuSelect $menu } @@ -615,8 +617,8 @@ proc ::tk::MenuInvoke {w buttonRelease} { # dragged off the menu (possibly with a cascade posted) and # released. Unpost everything and quit. - $w postcascade none - $w activate none + $w postcascade {} + $w activate {} event generate $w <<MenuSelect>> MenuUnpost $w return @@ -629,7 +631,7 @@ proc ::tk::MenuInvoke {w buttonRelease} { ::tk::TearOffMenu $w MenuUnpost $w } elseif {[$w cget -type] eq "menubar"} { - $w postcascade none + $w postcascade {} set active [$w index active] set isCascade [string equal [$w type $active] "cascade"] @@ -638,7 +640,7 @@ proc ::tk::MenuInvoke {w buttonRelease} { # checkbuttons/commands/etc. on menubars if { $isCascade } { - $w activate none + $w activate {} event generate $w <<MenuSelect>> } @@ -653,7 +655,7 @@ proc ::tk::MenuInvoke {w buttonRelease} { } } else { set active [$w index active] - if {$Priv(popup) eq "" || $active ne "none"} { + if {$Priv(popup) eq "" || $active >= 0} { MenuUnpost $w } uplevel #0 [list $w invoke active] @@ -757,11 +759,11 @@ proc ::tk::MenuNextMenu {menu direction} { set count -1 set m2 [winfo parent $menu] if {[winfo class $m2] eq "Menu"} { - $menu activate none + $menu activate {} GenerateMenuSelect $menu tk_menuSetFocus $m2 - $m2 postcascade none + $m2 postcascade {} if {[$m2 cget -type] ne "menubar"} { return @@ -797,7 +799,7 @@ proc ::tk::MenuNextMenu {menu direction} { if {[winfo class $mb] eq "Menubutton" \ && [$mb cget -state] ne "disabled" \ && [$mb cget -menu] ne "" \ - && [[$mb cget -menu] index last] ne "none"} { + && [[$mb cget -menu] index last] >= 0} { break } if {$mb eq $w} { @@ -819,13 +821,14 @@ proc ::tk::MenuNextMenu {menu direction} { # -1 means go to the next higher entry. proc ::tk::MenuNextEntry {menu count} { - if {[$menu index last] eq "none"} { + set last [$menu index last] + if {$last < 0} { return } set length [expr {[$menu index last]+1}] set quitAfter $length set active [$menu index active] - if {$active eq "none"} { + if {$active < 0} { set i 0 } else { set i [expr {$active + $count}] @@ -941,7 +944,7 @@ proc ::tk::MenuFind {w char} { } } } - return "" + return {} } # ::tk::TraverseToMenu -- @@ -1026,9 +1029,6 @@ proc ::tk::TraverseWithinMenu {w char} { } set char [string tolower $char] set last [$w index last] - if {$last eq "none"} { - return - } for {set i 0} {$i <= $last} {incr i} { if {[catch {set char2 [string index \ [$w entrycget $i -label] [$w entrycget $i -underline]]}]} { @@ -1068,13 +1068,10 @@ proc ::tk::MenuFirstEntry menu { return } tk_menuSetFocus $menu - if {[$menu index active] ne "none"} { + if {[$menu index active] >= 0} { return } set last [$menu index last] - if {$last eq "none"} { - return - } for {set i 0} {$i <= $last} {incr i} { if {([catch {set state [$menu entrycget $i -state]}] == 0) \ && $state ne "disabled" && [$menu type $i] ne "tearoff"} { @@ -1114,9 +1111,6 @@ proc ::tk::MenuFindName {menu s} { return $i } 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]} { if {$label eq $s} { @@ -1343,12 +1337,14 @@ proc ::tk_menuSetFocus {menu} { proc ::tk::GenerateMenuSelect {menu} { variable ::tk::Priv - if {$Priv(activeMenu) ne $menu \ - || $Priv(activeItem) ne [$menu index active]} { - set Priv(activeMenu) $menu - set Priv(activeItem) [$menu index active] - event generate $menu <<MenuSelect>> + if {$Priv(activeMenu) eq $menu \ + && $Priv(activeItem) eq [$menu index active]} { + return } + + set Priv(activeMenu) $menu + set Priv(activeItem) [$menu index active] + event generate $menu <<MenuSelect>> } # ::tk_popup -- diff --git a/library/msgbox.tcl b/library/msgbox.tcl index 646c143..b401ad1 100644 --- a/library/msgbox.tcl +++ b/library/msgbox.tcl @@ -3,7 +3,7 @@ # Implements messageboxes for platforms that do not have native # messagebox support. # -# Copyright (c) 1994-1997 Sun Microsystems, Inc. +# Copyright © 1994-1997 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. diff --git a/library/msgs/cs.msg b/library/msgs/cs.msg index d6be730..b3bcab4 100644 --- a/library/msgs/cs.msg +++ b/library/msgs/cs.msg @@ -1,77 +1,95 @@ namespace eval ::tk { - ::msgcat::mcset cs "&Abort" "&P\u0159eru\u0161it" + ::msgcat::mcset cs "&Abort" "&Přerušit" ::msgcat::mcset cs "&About..." "&O programu..." - ::msgcat::mcset cs "All Files" "V\u0161echny soubory" + ::msgcat::mcset cs "All Files" "Všechny soubory" ::msgcat::mcset cs "Application Error" "Chyba programu" ::msgcat::mcset cs "Bold Italic" - ::msgcat::mcset cs "&Blue" "&Modr\341" - ::msgcat::mcset cs "Cancel" "Zru\u0161it" - ::msgcat::mcset cs "&Cancel" "&Zru\u0161it" - ::msgcat::mcset cs "Cannot change to the directory \"%1\$s\".\nPermission denied." "Nemohu zm\u011bnit atku\341ln\355 adres\341\u0159 na \"%1\$s\".\nP\u0159\355stup odm\355tnut." - ::msgcat::mcset cs "Choose Directory" "V\375b\u011br adres\341\u0159e" + ::msgcat::mcset cs "&Blue" "&Modá" + ::msgcat::mcset cs "Cancel" "Zrušit" + ::msgcat::mcset cs "&Cancel" "&Zrušit" + ::msgcat::mcset cs "Cannot change to the directory \"%1\$s\".\nPermission denied." "Nemohu změnit atkálí adreář na \"%1\$s\".\nPístup odítnut." + ::msgcat::mcset cs "Choose Directory" "ýběr adreáře" ::msgcat::mcset cs "Cl&ear" "Sma&zat" ::msgcat::mcset cs "&Clear Console" "&Smazat konzolu" ::msgcat::mcset cs "Color" "Barva" ::msgcat::mcset cs "Console" "Konzole" - ::msgcat::mcset cs "&Copy" "&Kop\355rovat" - ::msgcat::mcset cs "Cu&t" "V&y\u0159\355znout" + ::msgcat::mcset cs "&Copy" "&Koírovat" + ::msgcat::mcset cs "Cu&t" "V&yíznout" ::msgcat::mcset cs "&Delete" "&Smazat" ::msgcat::mcset cs "Details >>" "Detaily >>" - ::msgcat::mcset cs "Directory \"%1\$s\" does not exist." "Adres\341\u0159 \"%1\$s\" neexistuje." - ::msgcat::mcset cs "&Directory:" "&Adres\341\u0159:" - ::msgcat::mcset cs "&Edit" "&\332pravy" + ::msgcat::mcset cs "Directory \"%1\$s\" does not exist." "Adreář \"%1\$s\" neexistuje." + ::msgcat::mcset cs "&Directory:" "&Adreář:" + ::msgcat::mcset cs "&Edit" "Úpravy" ::msgcat::mcset cs "Error: %1\$s" "Chyba: %1\$s" ::msgcat::mcset cs "E&xit" "&Konec" ::msgcat::mcset cs "&File" "&Soubor" - ::msgcat::mcset cs "File \"%1\$s\" already exists.\nDo you want to overwrite it?" "Soubor \"%1\$s\" ji\u017e existuje.\nChcete jej p\u0159epsat?" - ::msgcat::mcset cs "File \"%1\$s\" already exists.\n\n" "Soubor \"%1\$s\" ji\u017e existuje.\n\n" + ::msgcat::mcset cs "File \"%1\$s\" already exists.\nDo you want to overwrite it?" "Soubor \"%1\$s\" již existuje.\nChcete jej přepsat?" + ::msgcat::mcset cs "File \"%1\$s\" already exists.\n\n" "Soubor \"%1\$s\" již existuje.\n\n" ::msgcat::mcset cs "File \"%1\$s\" does not exist." "Soubor \"%1\$s\" neexistuje." - ::msgcat::mcset cs "File &name:" "&Jm\351no souboru:" - ::msgcat::mcset cs "File &names:" "&Jm\351na soubor\u016f:" - ::msgcat::mcset cs "Files of &type:" "&Typy soubor\u016f:" + ::msgcat::mcset cs "File &name:" "&Jéno souboru:" + ::msgcat::mcset cs "File &names:" "&Jéna souborů:" + ::msgcat::mcset cs "Files of &type:" "&Typy souborů:" ::msgcat::mcset cs "Fi&les:" "Sou&bory:" ::msgcat::mcset cs "&Filter" "&Filtr" ::msgcat::mcset cs "Fil&ter:" "Fil&tr:" ::msgcat::mcset cs "Font st&yle:" - ::msgcat::mcset cs "&Green" "Ze&len\341" - ::msgcat::mcset cs "&Help" "&N\341pov\u011bda" + ::msgcat::mcset cs "&Green" "Ze&leá" + ::msgcat::mcset cs "&Help" "&ápověda" ::msgcat::mcset cs "Hi" "Ahoj" ::msgcat::mcset cs "&Hide Console" "&Schovat Konzolu" ::msgcat::mcset cs "&Ignore" "&Ignorovat" - ::msgcat::mcset cs "Invalid file name \"%1\$s\"." "\u0160patn\351 jm\351no souboru \"%1\$s\"." + ::msgcat::mcset cs "Invalid file name \"%1\$s\"." "Špaté jéno souboru \"%1\$s\"." ::msgcat::mcset cs "Log Files" "Log soubory" ::msgcat::mcset cs "&No" "&Ne" ::msgcat::mcset cs "&OK" ::msgcat::mcset cs "OK" ::msgcat::mcset cs "Ok" - ::msgcat::mcset cs "Open" "Otev\u0159\355t" - ::msgcat::mcset cs "&Open" "&Otev\u0159\355t" - ::msgcat::mcset cs "Open Multiple Files" "Otev\u0159\355t v\355ce soubor\u016f" - ::msgcat::mcset cs "P&aste" "&Vlo\u017eit" - ::msgcat::mcset cs "&Quit" "&Ukon\u010dit" - ::msgcat::mcset cs "&Red" "\u010ce&rven\341" - ::msgcat::mcset cs "Replace existing file?" "Nahradit st\341vaj\355c\355 soubor?" + ::msgcat::mcset cs "Open" "Otevít" + ::msgcat::mcset cs "&Open" "&Otevít" + ::msgcat::mcset cs "Open Multiple Files" "Otevít íce souborů" + ::msgcat::mcset cs "P&aste" "&Vložit" + ::msgcat::mcset cs "&Quit" "&Ukončit" + ::msgcat::mcset cs "&Red" "Če&rveá" + ::msgcat::mcset cs "Replace existing file?" "Nahradit sávaíí soubor?" ::msgcat::mcset cs "&Retry" "Z&novu" - ::msgcat::mcset cs "&Save" "&Ulo\u017eit" - ::msgcat::mcset cs "Save As" "Ulo\u017eit jako" - ::msgcat::mcset cs "Save To Log" "Ulo\u017eit do logu" + ::msgcat::mcset cs "&Save" "&Uložit" + ::msgcat::mcset cs "Save As" "Uložit jako" + ::msgcat::mcset cs "Save To Log" "Uložit do logu" ::msgcat::mcset cs "Select Log File" "Vybrat log soubor" - ::msgcat::mcset cs "Select a file to source" "Vybrat soubor k nahr\341n\355" - ::msgcat::mcset cs "&Selection:" "&V\375b\u011br:" - ::msgcat::mcset cs "Skip Messages" "P\u0159esko\u010dit zpr\341vy" + ::msgcat::mcset cs "Select a file to source" "Vybrat soubor k naháí" + ::msgcat::mcset cs "&Selection:" "&ýběr:" + ::msgcat::mcset cs "Skip Messages" "Přeskočit zpávy" ::msgcat::mcset cs "&Source..." "&Zdroj..." ::msgcat::mcset cs "Tcl Scripts" "Tcl skripty" ::msgcat::mcset cs "Tcl for Windows" "Tcl pro Windows" - ::msgcat::mcset cs "Text Files" "Textov\351 soubory" - ::msgcat::mcset cs "abort" "p\u0159eru\u0161it" - ::msgcat::mcset cs "blue" "modr\341" - ::msgcat::mcset cs "cancel" "zru\u0161it" - ::msgcat::mcset cs "extension" "p\u0159\355pona" - ::msgcat::mcset cs "extensions" "p\u0159\355pony" - ::msgcat::mcset cs "green" "zelen\341" + ::msgcat::mcset cs "Text Files" "Textoé soubory" + ::msgcat::mcset cs "abort" "přerušit" + ::msgcat::mcset cs "blue" "modá" + ::msgcat::mcset cs "cancel" "zrušit" + ::msgcat::mcset cs "extension" "pípona" + ::msgcat::mcset cs "extensions" "pípony" + ::msgcat::mcset cs "green" "zeleá" ::msgcat::mcset cs "ignore" "ignorovat" ::msgcat::mcset cs "ok" - ::msgcat::mcset cs "red" "\u010derven\341" + ::msgcat::mcset cs "red" "červeá" ::msgcat::mcset cs "retry" "znovu" ::msgcat::mcset cs "yes" "ano" } +#localization of print terms by Kevin Walzer via Microsoft Translator +namespace eval ::tk { + ::msgcat::mcset cs "Print" "Tisknout" + ::msgcat::mcset cs "Printer" "Tiskárna" + ::msgcat::mcset cs "Letter " "Dopis " + ::msgcat::mcset cs "Legal " "Legální " + ::msgcat::mcset cs "A4" "A4" + ::msgcat::mcset cs "Grayscale" "Stupně Šedi" + ::msgcat::mcset cs "RGB" "RGB" + ::msgcat::mcset cs "Options" "Možnosti" + ::msgcat::mcset cs "Copies" "Kopie" + ::msgcat::mcset cs "Paper" "Papír" + ::msgcat::mcset cs "Scale" "Škála" + ::msgcat::mcset cs "Orientation" "Orientace" + ::msgcat::mcset cs "Portrait" "Portrét" + ::msgcat::mcset cs "Landscape" "Krajina" + ::msgcat::mcset cs "Output" "Výstup" +}
\ No newline at end of file diff --git a/library/msgs/da.msg b/library/msgs/da.msg index c302c79..8311479 100644 --- a/library/msgs/da.msg +++ b/library/msgs/da.msg @@ -3,11 +3,11 @@ namespace eval ::tk { ::msgcat::mcset da "&About..." "&Om..." ::msgcat::mcset da "All Files" "Alle filer" ::msgcat::mcset da "Application Error" "Programfejl" - ::msgcat::mcset da "&Blue" "&Bl\u00E5" + ::msgcat::mcset da "&Blue" "&Blå" ::msgcat::mcset da "Cancel" "Annuller" ::msgcat::mcset da "&Cancel" "&Annuller" ::msgcat::mcset da "Cannot change to the directory \"%1\$s\".\nPermission denied." "Kan ikke skifte til katalog \"%1\$s\".\nIngen rettigheder." - ::msgcat::mcset da "Choose Directory" "V\u00E6lg katalog" + ::msgcat::mcset da "Choose Directory" "Vælg katalog" ::msgcat::mcset da "Cl&ear" "&Ryd" ::msgcat::mcset da "&Clear Console" "&Ryd konsolen" ::msgcat::mcset da "Color" "Farve" @@ -31,8 +31,8 @@ namespace eval ::tk { ::msgcat::mcset da "Fi&les:" "Fi&ler:" ::msgcat::mcset da "&Filter" ::msgcat::mcset da "Fil&ter:" - ::msgcat::mcset da "&Green" "&Gr\u00F8n" - ::msgcat::mcset da "&Help" "&Hj\u00E6lp" + ::msgcat::mcset da "&Green" "&Grøn" + ::msgcat::mcset da "&Help" "&Hjælp" ::msgcat::mcset da "Hi" "Hej" ::msgcat::mcset da "&Hide Console" "Skjul &konsol" ::msgcat::mcset da "&Ignore" "&Ignorer" @@ -42,37 +42,55 @@ namespace eval ::tk { ::msgcat::mcset da "&OK" "&O.K." ::msgcat::mcset da "OK" "O.K." ::msgcat::mcset da "Ok" - ::msgcat::mcset da "Open" "\u00C5bn" - ::msgcat::mcset da "&Open" "&\u00C5bn" - ::msgcat::mcset da "Open Multiple Files" "\u00C5bn flere filer" - ::msgcat::mcset da "P&aste" "&Inds\u00E6t" + ::msgcat::mcset da "Open" "Åbn" + ::msgcat::mcset da "&Open" "&Åbn" + ::msgcat::mcset da "Open Multiple Files" "Åbn flere filer" + ::msgcat::mcset da "P&aste" "&Indsæt" ::msgcat::mcset da "&Quit" "&Afslut" - ::msgcat::mcset da "&Red" "&R\u00F8d" + ::msgcat::mcset da "&Red" "&Rød" ::msgcat::mcset da "Replace existing file?" "Erstat eksisterende fil?" ::msgcat::mcset da "&Retry" "&Gentag" ::msgcat::mcset da "&Save" "&Gem" ::msgcat::mcset da "Save As" "Gem som" ::msgcat::mcset da "Save To Log" "Gem i log" - ::msgcat::mcset da "Select Log File" "V\u00E6lg logfil" - ::msgcat::mcset da "Select a file to source" "V\u00E6lg k\u00F8rbar fil" + ::msgcat::mcset da "Select Log File" "Vælg logfil" + ::msgcat::mcset da "Select a file to source" "Vælg kørbar fil" ::msgcat::mcset da "&Selection:" "&Udvalg:" ::msgcat::mcset da "Show &Hidden Directories" "Vis &skjulte kataloger" ::msgcat::mcset da "Show &Hidden Files and Directories" "Vis &skjulte filer og kataloger" ::msgcat::mcset da "Skip Messages" "Overspring beskeder" - ::msgcat::mcset da "&Source..." "&K\u00F8r..." + ::msgcat::mcset da "&Source..." "&Kør..." ::msgcat::mcset da "Tcl Scripts" "Tcl-Skripter" ::msgcat::mcset da "Tcl for Windows" "Tcl for Windows" ::msgcat::mcset da "Text Files" "Tekstfiler" ::msgcat::mcset da "&Yes" "&Ja" ::msgcat::mcset da "abort" "afbryd" - ::msgcat::mcset da "blue" "bl\u00E5" + ::msgcat::mcset da "blue" "blå" ::msgcat::mcset da "cancel" "afbryd" ::msgcat::mcset da "extension" ::msgcat::mcset da "extensions" - ::msgcat::mcset da "green" "gr\u00F8n" + ::msgcat::mcset da "green" "grøn" ::msgcat::mcset da "ignore" "ignorer" ::msgcat::mcset da "ok" - ::msgcat::mcset da "red" "r\u00F8d" + ::msgcat::mcset da "red" "rød" ::msgcat::mcset da "retry" "gentag" ::msgcat::mcset da "yes" "ja" } +#localization of print terms by Kevin Walzer via Microsoft Translator +namespace eval ::tk { + ::msgcat::mcset da "Print" "Trykke" + ::msgcat::mcset da "Printer" "Printer" + ::msgcat::mcset da "Letter " "Brev" + ::msgcat::mcset da "Legal " "Juridisk" + ::msgcat::mcset da "A4" "A4" + ::msgcat::mcset da "Grayscale" "Gråtoneskala" + ::msgcat::mcset da "RGB" "Rgb" + ::msgcat::mcset da "Options" "Indstillinger" + ::msgcat::mcset da "Copies" "Kopier" + ::msgcat::mcset da "Paper" "Papir" + ::msgcat::mcset da "Scale" "Skalere" + ::msgcat::mcset da "Orientation" "Orientering" + ::msgcat::mcset da "Portrait" "Portræt" + ::msgcat::mcset da "Landscape" "Landskab" + ::msgcat::mcset da "Output" "Udskriv Publikation" +}
\ No newline at end of file diff --git a/library/msgs/de.msg b/library/msgs/de.msg index e420f8a..555c848 100644 --- a/library/msgs/de.msg +++ b/library/msgs/de.msg @@ -1,6 +1,6 @@ namespace eval ::tk { ::msgcat::mcset de "&Abort" "&Abbruch" - ::msgcat::mcset de "&About..." "&\u00dcber..." + ::msgcat::mcset de "&About..." "&Über..." ::msgcat::mcset de "All Files" "Alle Dateien" ::msgcat::mcset de "Application Error" "Applikationsfehler" ::msgcat::mcset de "&Apply" "&Anwenden" @@ -10,14 +10,14 @@ namespace eval ::tk { ::msgcat::mcset de "Cancel" "Abbruch" ::msgcat::mcset de "&Cancel" "&Abbruch" ::msgcat::mcset de "Cannot change to the directory \"%1\$s\".\nPermission denied." "Kann nicht in das Verzeichnis \"%1\$s\" wechseln.\nKeine Rechte vorhanden." - ::msgcat::mcset de "Choose Directory" "W\u00e4hle Verzeichnis" - ::msgcat::mcset de "Cl&ear" "&R\u00fccksetzen" - ::msgcat::mcset de "&Clear Console" "&Konsole l\u00f6schen" + ::msgcat::mcset de "Choose Directory" "Wähle Verzeichnis" + ::msgcat::mcset de "Cl&ear" "&Rücksetzen" + ::msgcat::mcset de "&Clear Console" "&Konsole löschen" ::msgcat::mcset de "Color" "Farbe" ::msgcat::mcset de "Console" "Konsole" ::msgcat::mcset de "&Copy" "&Kopieren" ::msgcat::mcset de "Cu&t" "Aus&schneiden" - ::msgcat::mcset de "&Delete" "&L\u00f6schen" + ::msgcat::mcset de "&Delete" "&Löschen" ::msgcat::mcset de "Details >>" ::msgcat::mcset de "Directory \"%1\$s\" does not exist." "Das Verzeichnis \"%1\$s\" existiert nicht." ::msgcat::mcset de "&Directory:" "&Verzeichnis:" @@ -26,7 +26,7 @@ namespace eval ::tk { ::msgcat::mcset de "Error: %1\$s" "Fehler: %1\$s" ::msgcat::mcset de "E&xit" "&Ende" ::msgcat::mcset de "&File" "&Datei" - ::msgcat::mcset de "File \"%1\$s\" already exists.\nDo you want to overwrite it?" "Die Datei \"%1\$s\" ist bereits vorhanden.\nWollen sie diese Datei \u00fcberschreiben ?" + ::msgcat::mcset de "File \"%1\$s\" already exists.\nDo you want to overwrite it?" "Die Datei \"%1\$s\" ist bereits vorhanden.\nWollen sie diese Datei überschreiben ?" ::msgcat::mcset de "File \"%1\$s\" already exists.\n\n" "Die Datei \"%1\$s\" ist bereits vorhanden.\n\n" ::msgcat::mcset de "File \"%1\$s\" does not exist." "Die Datei \"%1\$s\" existiert nicht." ::msgcat::mcset de "File &name:" "Datei&name:" @@ -38,22 +38,22 @@ namespace eval ::tk { ::msgcat::mcset de "Font" "Schriftart" ::msgcat::mcset de "&Font:" "Schriftart:" ::msgcat::mcset de "Font st&yle:" "Schriftschnitt:" - ::msgcat::mcset de "&Green" "&Gr\u00fcn" + ::msgcat::mcset de "&Green" "&Grün" ::msgcat::mcset de "&Help" "&Hilfe" ::msgcat::mcset de "Hi" "Hallo" ::msgcat::mcset de "&Hide Console" "&Konsole unsichtbar machen" ::msgcat::mcset de "&Ignore" "&Ignorieren" - ::msgcat::mcset de "Invalid file name \"%1\$s\"." "Ung\u00fcltiger Dateiname \"%1\$s\"." + ::msgcat::mcset de "Invalid file name \"%1\$s\"." "Ungültiger Dateiname \"%1\$s\"." ::msgcat::mcset de "Italic" "Kursiv" ::msgcat::mcset de "Log Files" "Protokolldatei" ::msgcat::mcset de "&No" "&Nein" ::msgcat::mcset de "&OK" ::msgcat::mcset de "OK" ::msgcat::mcset de "Ok" - ::msgcat::mcset de "Open" "\u00d6ffnen" - ::msgcat::mcset de "&Open" "\u00d6&ffnen" - ::msgcat::mcset de "Open Multiple Files" "Mehrere Dateien \u00F6ffnen" - ::msgcat::mcset de "P&aste" "E&inf\u00fcgen" + ::msgcat::mcset de "Open" "Öffnen" + ::msgcat::mcset de "&Open" "Ö&ffnen" + ::msgcat::mcset de "Open Multiple Files" "Mehrere Dateien Öffnen" + ::msgcat::mcset de "P&aste" "E&infügen" ::msgcat::mcset de "&Quit" "&Beenden" ::msgcat::mcset de "&Red" "&Rot" ::msgcat::mcset de "Regular" "Standard" @@ -63,17 +63,17 @@ namespace eval ::tk { ::msgcat::mcset de "&Save" "&Speichern" ::msgcat::mcset de "Save As" "Speichern unter" ::msgcat::mcset de "Save To Log" "In Protokoll speichern" - ::msgcat::mcset de "Select Log File" "Protokolldatei ausw\u00e4hlen" - ::msgcat::mcset de "Select a file to source" "Auszuf\u00fchrende Datei ausw\u00e4hlen" + ::msgcat::mcset de "Select Log File" "Protokolldatei auswählen" + ::msgcat::mcset de "Select a file to source" "Auszuführende Datei auswählen" ::msgcat::mcset de "&Selection:" "Auswah&l:" ::msgcat::mcset de "&Size:" "Schriftgrad:" ::msgcat::mcset de "Show &Hidden Directories" "Zeige versteckte Dateien" ::msgcat::mcset de "Show &Hidden Files and Directories" "Zeige versteckte Dateien und Verzeichnisse" - ::msgcat::mcset de "Skip Messages" "Weitere Nachrichten \u00fcberspringen" - ::msgcat::mcset de "&Source..." "&Ausf\u00fchren..." + ::msgcat::mcset de "Skip Messages" "Weitere Nachrichten überspringen" + ::msgcat::mcset de "&Source..." "&Ausführen..." ::msgcat::mcset de "Stri&keout" "&Durchgestrichen" ::msgcat::mcset de "Tcl Scripts" "Tcl-Skripte" - ::msgcat::mcset de "Tcl for Windows" "Tcl f\u00fcr Windows" + ::msgcat::mcset de "Tcl for Windows" "Tcl für Windows" ::msgcat::mcset de "Text Files" "Textdateien" ::msgcat::mcset de "&Underline" "&Unterstrichen" ::msgcat::mcset de "&Yes" "&Ja" @@ -82,10 +82,28 @@ namespace eval ::tk { ::msgcat::mcset de "cancel" "abbrechen" ::msgcat::mcset de "extension" "Erweiterung" ::msgcat::mcset de "extensions" "Erweiterungen" - ::msgcat::mcset de "green" "gr\u00fcn" + ::msgcat::mcset de "green" "grün" ::msgcat::mcset de "ignore" "ignorieren" ::msgcat::mcset de "ok" ::msgcat::mcset de "red" "rot" ::msgcat::mcset de "retry" "wiederholen" ::msgcat::mcset de "yes" "ja" } +#localization of print terms by Kevin Walzer via Microsoft Translator +namespace eval ::tk { + ::msgcat::mcset de "Print" "Drucken" + ::msgcat::mcset de "Printer" "Drucker" + ::msgcat::mcset de "Letter " "Letter" + ::msgcat::mcset de "Legal " "Legal" + ::msgcat::mcset de "A4" "A4" + ::msgcat::mcset de "Grayscale" "Graustufen" + ::msgcat::mcset de "RGB" "RGB" + ::msgcat::mcset de "Options" "Optionen" + ::msgcat::mcset de "Copies" "Kopien" + ::msgcat::mcset de "Paper" "Papier" + ::msgcat::mcset de "Scale" "Skalierung" + ::msgcat::mcset de "Orientation" "Ausrichtung" + ::msgcat::mcset de "Portrait" "Hochformat" + ::msgcat::mcset de "Landscape" "Querformat" + ::msgcat::mcset de "Output" "Ausgabe" +} diff --git a/library/msgs/el.msg b/library/msgs/el.msg index 2e3f236..0336326 100644 --- a/library/msgs/el.msg +++ b/library/msgs/el.msg @@ -3,84 +3,102 @@ ## petasis@iit.demokritos.gr namespace eval ::tk { - ::msgcat::mcset el "&Abort" "\u03a4\u03b5\u03c1\u03bc\u03b1\u03c4\u03b9\u03c3\u03bc\u03cc\u03c2" - ::msgcat::mcset el "About..." "\u03a3\u03c7\u03b5\u03c4\u03b9\u03ba\u03ac..." - ::msgcat::mcset el "All Files" "\u038c\u03bb\u03b1 \u03c4\u03b1 \u0391\u03c1\u03c7\u03b5\u03af\u03b1" - ::msgcat::mcset el "Application Error" "\u039b\u03ac\u03b8\u03bf\u03c2 \u0395\u03c6\u03b1\u03c1\u03bc\u03bf\u03b3\u03ae\u03c2" - ::msgcat::mcset el "&Blue" "\u039c\u03c0\u03bb\u03b5" - ::msgcat::mcset el "&Cancel" "\u0391\u03ba\u03cd\u03c1\u03c9\u03c3\u03b7" + ::msgcat::mcset el "&Abort" "Τερματισμός" + ::msgcat::mcset el "About..." "Σχετικά..." + ::msgcat::mcset el "All Files" "Όλα τα Αρχεία" + ::msgcat::mcset el "Application Error" "Λάθος Εφαρμογής" + ::msgcat::mcset el "&Blue" "Μπλε" + ::msgcat::mcset el "&Cancel" "Ακύρωση" ::msgcat::mcset el \ "Cannot change to the directory \"%1\$s\".\nPermission denied." \ -"\u0394\u03b5\u03bd \u03b5\u03af\u03bd\u03b1\u03b9 \u03b4\u03c5\u03bd\u03b1\u03c4\u03ae \u03b7 \u03b1\u03bb\u03bb\u03b1\u03b3\u03ae \u03ba\u03b1\u03c4\u03b1\u03bb\u03cc\u03b3\u03bf\u03c5 \u03c3\u03b5 \"%1\$s\".\n\u0397 \u03c0\u03c1\u03cc\u03c3\u03b2\u03b1\u03c3\u03b7 \u03b4\u03b5\u03bd \u03b5\u03c0\u03b9\u03c4\u03c1\u03ad\u03c0\u03b5\u03c4\u03b1\u03b9." - ::msgcat::mcset el "Choose Directory" "\u0395\u03c0\u03b9\u03bb\u03bf\u03b3\u03ae \u039a\u03b1\u03c4\u03b1\u03bb\u03cc\u03b3\u03bf\u03c5" - ::msgcat::mcset el "Clear" "\u039a\u03b1\u03b8\u03b1\u03c1\u03b9\u03c3\u03bc\u03cc\u03c2" - ::msgcat::mcset el "Color" "\u03a7\u03c1\u03ce\u03bc\u03b1" - ::msgcat::mcset el "Console" "\u039a\u03bf\u03bd\u03c3\u03cc\u03bb\u03b1" - ::msgcat::mcset el "Copy" "\u0391\u03bd\u03c4\u03b9\u03b3\u03c1\u03b1\u03c6\u03ae" - ::msgcat::mcset el "Cut" "\u0391\u03c0\u03bf\u03ba\u03bf\u03c0\u03ae" - ::msgcat::mcset el "Delete" "\u0394\u03b9\u03b1\u03b3\u03c1\u03b1\u03c6\u03ae" - ::msgcat::mcset el "Details >>" "\u039b\u03b5\u03c0\u03c4\u03bf\u03bc\u03ad\u03c1\u03b5\u03b9\u03b5\u03c2 >>" +"Δεν είναι δυνατή η αλλαγή καταλόγου σε \"%1\$s\".\nΗ πρόσβαση δεν επιτρέπεται." + ::msgcat::mcset el "Choose Directory" "Επιλογή Καταλόγου" + ::msgcat::mcset el "Clear" "Καθαρισμός" + ::msgcat::mcset el "Color" "Χρώμα" + ::msgcat::mcset el "Console" "Κονσόλα" + ::msgcat::mcset el "Copy" "Αντιγραφή" + ::msgcat::mcset el "Cut" "Αποκοπή" + ::msgcat::mcset el "Delete" "Διαγραφή" + ::msgcat::mcset el "Details >>" "Λεπτομέρειες >>" ::msgcat::mcset el "Directory \"%1\$s\" does not exist." \ - "\u039f \u03ba\u03b1\u03c4\u03ac\u03bb\u03bf\u03b3\u03bf\u03c2 \"%1\$s\" \u03b4\u03b5\u03bd \u03c5\u03c0\u03ac\u03c1\u03c7\u03b5\u03b9." - ::msgcat::mcset el "&Directory:" "&\u039a\u03b1\u03c4\u03ac\u03bb\u03bf\u03b3\u03bf\u03c2:" - ::msgcat::mcset el "Error: %1\$s" "\u039b\u03ac\u03b8\u03bf\u03c2: %1\$s" - ::msgcat::mcset el "Exit" "\u0388\u03be\u03bf\u03b4\u03bf\u03c2" + "Ο κατάλογος \"%1\$s\" δεν υπάρχει." + ::msgcat::mcset el "&Directory:" "&Κατάλογος:" + ::msgcat::mcset el "Error: %1\$s" "Λάθος: %1\$s" + ::msgcat::mcset el "Exit" "Έξοδος" ::msgcat::mcset el \ "File \"%1\$s\" already exists.\nDo you want to overwrite it?" \ - "\u03a4\u03bf \u03b1\u03c1\u03c7\u03b5\u03af\u03bf \"%1\$s\" \u03ae\u03b4\u03b7 \u03c5\u03c0\u03ac\u03c1\u03c7\u03b5\u03b9.\n\u0398\u03ad\u03bb\u03b5\u03c4\u03b5 \u03bd\u03b1 \u03b5\u03c0\u03b9\u03ba\u03b1\u03bb\u03c5\u03c6\u03b8\u03b5\u03af;" + "Το αρχείο \"%1\$s\" ήδη υπάρχει.\nΘέλετε να επικαλυφθεί;" ::msgcat::mcset el "File \"%1\$s\" already exists.\n\n" \ - "\u03a4\u03bf \u03b1\u03c1\u03c7\u03b5\u03af\u03bf \"%1\$s\" \u03ae\u03b4\u03b7 \u03c5\u03c0\u03ac\u03c1\u03c7\u03b5\u03b9.\n\n" + "Το αρχείο \"%1\$s\" ήδη υπάρχει.\n\n" ::msgcat::mcset el "File \"%1\$s\" does not exist." \ - "\u03a4\u03bf \u03b1\u03c1\u03c7\u03b5\u03af\u03bf \"%1\$s\" \u03b4\u03b5\u03bd \u03c5\u03c0\u03ac\u03c1\u03c7\u03b5\u03b9." - ::msgcat::mcset el "File &name:" "\u038c&\u03bd\u03bf\u03bc\u03b1 \u03b1\u03c1\u03c7\u03b5\u03af\u03bf\u03c5:" - ::msgcat::mcset el "File &names:" "\u038c&\u03bd\u03bf\u03bc\u03b1 \u03b1\u03c1\u03c7\u03b5\u03af\u03c9\u03bd:" - ::msgcat::mcset el "Files of &type:" "\u0391\u03c1\u03c7\u03b5\u03af\u03b1 \u03c4\u03bf\u03c5 &\u03c4\u03cd\u03c0\u03bf\u03c5:" - ::msgcat::mcset el "Fi&les:" "\u0391\u03c1\u03c7\u03b5\u03af\u03b1:" - ::msgcat::mcset el "&Filter" "\u03a6\u03af\u03bb\u03c4\u03c1\u03bf" - ::msgcat::mcset el "Fil&ter:" "\u03a6\u03af\u03bb\u03c4\u03c1\u03bf:" - ::msgcat::mcset el "&Green" "\u03a0\u03c1\u03ac\u03c3\u03b9\u03bd\u03bf" - ::msgcat::mcset el "Hi" "\u0393\u03b5\u03b9\u03b1" - ::msgcat::mcset el "Hide Console" "\u0391\u03c0\u03cc\u03ba\u03c1\u03c5\u03c8\u03b7 \u03ba\u03bf\u03bd\u03c3\u03cc\u03bb\u03b1\u03c2" - ::msgcat::mcset el "&Ignore" "\u0391\u03b3\u03bd\u03cc\u03b7\u03c3\u03b7" + "Το αρχείο \"%1\$s\" δεν υπάρχει." + ::msgcat::mcset el "File &name:" "Ό&νομα αρχείου:" + ::msgcat::mcset el "File &names:" "Ό&νομα αρχείων:" + ::msgcat::mcset el "Files of &type:" "Αρχεία του &τύπου:" + ::msgcat::mcset el "Fi&les:" "Αρχεία:" + ::msgcat::mcset el "&Filter" "Φίλτρο" + ::msgcat::mcset el "Fil&ter:" "Φίλτρο:" + ::msgcat::mcset el "&Green" "Πράσινο" + ::msgcat::mcset el "Hi" "Γεια" + ::msgcat::mcset el "Hide Console" "Απόκρυψη κονσόλας" + ::msgcat::mcset el "&Ignore" "Αγνόηση" ::msgcat::mcset el "Invalid file name \"%1\$s\"." \ - "\u0386\u03ba\u03c5\u03c1\u03bf \u03cc\u03bd\u03bf\u03bc\u03b1 \u03b1\u03c1\u03c7\u03b5\u03af\u03bf\u03c5 \"%1\$s\"." - ::msgcat::mcset el "Log Files" "\u0391\u03c1\u03c7\u03b5\u03af\u03b1 \u039a\u03b1\u03c4\u03b1\u03b3\u03c1\u03b1\u03c6\u03ae\u03c2" - ::msgcat::mcset el "&No" "\u038c\u03c7\u03b9" - ::msgcat::mcset el "&OK" "\u0395\u03bd\u03c4\u03ac\u03be\u03b5\u03b9" - ::msgcat::mcset el "OK" "\u0395\u03bd\u03c4\u03ac\u03be\u03b5\u03b9" - ::msgcat::mcset el "Ok" "\u0395\u03bd\u03c4\u03ac\u03be\u03b5\u03b9" - ::msgcat::mcset el "Open" "\u0386\u03bd\u03bf\u03b9\u03b3\u03bc\u03b1" - ::msgcat::mcset el "&Open" "\u0386\u03bd\u03bf\u03b9\u03b3\u03bc\u03b1" + "Άκυρο όνομα αρχείου \"%1\$s\"." + ::msgcat::mcset el "Log Files" "Αρχεία Καταγραφής" + ::msgcat::mcset el "&No" "Όχι" + ::msgcat::mcset el "&OK" "Εντάξει" + ::msgcat::mcset el "OK" "Εντάξει" + ::msgcat::mcset el "Ok" "Εντάξει" + ::msgcat::mcset el "Open" "Άνοιγμα" + ::msgcat::mcset el "&Open" "Άνοιγμα" ::msgcat::mcset el "Open Multiple Files" \ - "\u0386\u03bd\u03bf\u03b9\u03b3\u03bc\u03b1 \u03c0\u03bf\u03bb\u03bb\u03b1\u03c0\u03bb\u03ce\u03bd \u03b1\u03c1\u03c7\u03b5\u03af\u03c9\u03bd" - ::msgcat::mcset el "P&aste" "\u0395\u03c0\u03b9\u03ba\u03cc\u03bb\u03bb\u03b7\u03c3\u03b7" - ::msgcat::mcset el "Quit" "\u0388\u03be\u03bf\u03b4\u03bf\u03c2" - ::msgcat::mcset el "&Red" "\u039a\u03cc\u03ba\u03ba\u03b9\u03bd\u03bf" + "Άνοιγμα πολλαπλών αρχείων" + ::msgcat::mcset el "P&aste" "Επικόλληση" + ::msgcat::mcset el "Quit" "Έξοδος" + ::msgcat::mcset el "&Red" "Κόκκινο" ::msgcat::mcset el "Replace existing file?" \ - "\u0395\u03c0\u03b9\u03ba\u03ac\u03bb\u03c5\u03c8\u03b7 \u03c5\u03c0\u03ac\u03c1\u03c7\u03bf\u03bd\u03c4\u03bf\u03c2 \u03b1\u03c1\u03c7\u03b5\u03af\u03bf\u03c5;" - ::msgcat::mcset el "&Retry" "\u03a0\u03c1\u03bf\u03c3\u03c0\u03ac\u03b8\u03b7\u03c3\u03b5 \u03be\u03b1\u03bd\u03ac" - ::msgcat::mcset el "&Save" "\u0391\u03c0\u03bf\u03b8\u03ae\u03ba\u03b5\u03c5\u03c3\u03b7" - ::msgcat::mcset el "Save As" "\u0391\u03c0\u03bf\u03b8\u03ae\u03ba\u03b5\u03c5\u03c3\u03b7 \u03c3\u03b1\u03bd" - ::msgcat::mcset el "Save To Log" "\u0391\u03c0\u03bf\u03b8\u03ae\u03ba\u03b5\u03c5\u03c3\u03b7 \u03c3\u03c4\u03bf \u03b1\u03c1\u03c7\u03b5\u03af\u03bf \u03ba\u03b1\u03c4\u03b1\u03b3\u03c1\u03b1\u03c6\u03ae\u03c2" - ::msgcat::mcset el "Select Log File" "\u0395\u03c0\u03b9\u03bb\u03bf\u03b3\u03ae \u03b1\u03c1\u03c7\u03b5\u03af\u03bf\u03c5 \u03ba\u03b1\u03c4\u03b1\u03b3\u03c1\u03b1\u03c6\u03ae\u03c2" + "Επικάλυψη υπάρχοντος αρχείου;" + ::msgcat::mcset el "&Retry" "Προσπάθησε ξανά" + ::msgcat::mcset el "&Save" "Αποθήκευση" + ::msgcat::mcset el "Save As" "Αποθήκευση σαν" + ::msgcat::mcset el "Save To Log" "Αποθήκευση στο αρχείο καταγραφής" + ::msgcat::mcset el "Select Log File" "Επιλογή αρχείου καταγραφής" ::msgcat::mcset el "Select a file to source" \ - "\u0395\u03c0\u03b9\u03bb\u03ad\u03be\u03c4\u03b5 \u03b1\u03c1\u03c7\u03b5\u03af\u03bf \u03b3\u03b9\u03b1 \u03b5\u03ba\u03c4\u03ad\u03bb\u03b5\u03c3\u03b7" - ::msgcat::mcset el "&Selection:" "\u0395\u03c0\u03b9\u03bb\u03bf\u03b3\u03ae:" - ::msgcat::mcset el "Skip Messages" "\u0391\u03c0\u03bf\u03c6\u03c5\u03b3\u03ae\u03bc\u03b7\u03bd\u03c5\u03bc\u03ac\u03c4\u03c9\u03bd" - ::msgcat::mcset el "&Source..." "\u0395\u03ba\u03c4\u03ad\u03bb\u03b5\u03c3\u03b7..." + "Επιλέξτε αρχείο για εκτέλεση" + ::msgcat::mcset el "&Selection:" "Επιλογή:" + ::msgcat::mcset el "Skip Messages" "Αποφυγήμηνυμάτων" + ::msgcat::mcset el "&Source..." "Εκτέλεση..." ::msgcat::mcset el "Tcl Scripts" "Tcl Scripts" - ::msgcat::mcset el "Tcl for Windows" "Tcl \u03b3\u03b9\u03b1 Windows" - ::msgcat::mcset el "Text Files" "\u0391\u03c1\u03c7\u03b5\u03af\u03b1 \u039a\u03b5\u03b9\u03bc\u03ad\u03bd\u03bf\u03c5" - ::msgcat::mcset el "&Yes" "\u039d\u03b1\u03b9" - ::msgcat::mcset el "abort" "\u03c4\u03b5\u03c1\u03bc\u03b1\u03c4\u03b9\u03c3\u03bc\u03cc\u03c2" - ::msgcat::mcset el "blue" "\u03bc\u03c0\u03bb\u03b5" - ::msgcat::mcset el "cancel" "\u03b1\u03ba\u03cd\u03c1\u03c9\u03c3\u03b7" - ::msgcat::mcset el "extension" "\u03b5\u03c0\u03ad\u03ba\u03c4\u03b1\u03c3\u03b7" - ::msgcat::mcset el "extensions" "\u03b5\u03c0\u03b5\u03ba\u03c4\u03ac\u03c3\u03b5\u03b9\u03c2" - ::msgcat::mcset el "green" "\u03c0\u03c1\u03ac\u03c3\u03b9\u03bd\u03bf" - ::msgcat::mcset el "ignore" "\u03b1\u03b3\u03bd\u03cc\u03b7\u03c3\u03b7" - ::msgcat::mcset el "ok" "\u03b5\u03bd\u03c4\u03ac\u03be\u03b5\u03b9" - ::msgcat::mcset el "red" "\u03ba\u03cc\u03ba\u03ba\u03b9\u03bd\u03bf" - ::msgcat::mcset el "retry" "\u03c0\u03c1\u03bf\u03c3\u03c0\u03ac\u03b8\u03b7\u03c3\u03b5 \u03be\u03b1\u03bd\u03ac" - ::msgcat::mcset el "yes" "\u03bd\u03b1\u03b9" + ::msgcat::mcset el "Tcl for Windows" "Tcl για Windows" + ::msgcat::mcset el "Text Files" "Αρχεία Κειμένου" + ::msgcat::mcset el "&Yes" "Ναι" + ::msgcat::mcset el "abort" "τερματισμός" + ::msgcat::mcset el "blue" "μπλε" + ::msgcat::mcset el "cancel" "ακύρωση" + ::msgcat::mcset el "extension" "επέκταση" + ::msgcat::mcset el "extensions" "επεκτάσεις" + ::msgcat::mcset el "green" "πράσινο" + ::msgcat::mcset el "ignore" "αγνόηση" + ::msgcat::mcset el "ok" "εντάξει" + ::msgcat::mcset el "red" "κόκκινο" + ::msgcat::mcset el "retry" "προσπάθησε ξανά" + ::msgcat::mcset el "yes" "ναι" } +#localization of print terms by Kevin Walzer via Microsoft Translator +namespace eval ::tk { + ::msgcat::mcset el "Print" "Τυπώνω" + ::msgcat::mcset el "Printer" "Εκτυπωτής" + ::msgcat::mcset el "Letter " "Γράμμα" + ::msgcat::mcset el "Legal " "Νομικός" + ::msgcat::mcset el "A4" "Α4" + ::msgcat::mcset el "Grayscale" "Κλίμακα Του Γκρι" + ::msgcat::mcset el "RGB" "Rgb" + ::msgcat::mcset el "Options" "Επιλογές" + ::msgcat::mcset el "Copies" "Αντίγραφα" + ::msgcat::mcset el "Paper" "Χαρτί" + ::msgcat::mcset el "Scale" "Κλίμακα" + ::msgcat::mcset el "Orientation" "Προσανατολισμός" + ::msgcat::mcset el "Portrait" "Προσωπογραφία" + ::msgcat::mcset el "Landscape" "Τοπίο" + ::msgcat::mcset el "Output" "Έξοδος" +}
\ No newline at end of file diff --git a/library/msgs/en.msg b/library/msgs/en.msg index 5ad1094..92fa138 100644 --- a/library/msgs/en.msg +++ b/library/msgs/en.msg @@ -89,3 +89,22 @@ namespace eval ::tk { ::msgcat::mcset en "retry" ::msgcat::mcset en "yes" } + +#localization of print terms by Kevin Walzer via Microsoft Translator +namespace eval ::tk { + ::msgcat::mcset en "Print" + ::msgcat::mcset en "Printer" + ::msgcat::mcset en "Letter " + ::msgcat::mcset en "Legal " + ::msgcat::mcset en "A4" + ::msgcat::mcset en "Grayscale" + ::msgcat::mcset en "RGB" + ::msgcat::mcset en "Options" + ::msgcat::mcset en "Copies" + ::msgcat::mcset en "Paper" + ::msgcat::mcset en "Scale" + ::msgcat::mcset en "Orientation" + ::msgcat::mcset en "Portrait" + ::msgcat::mcset en "Landscape" + ::msgcat::mcset en "Output" +} diff --git a/library/msgs/eo.msg b/library/msgs/eo.msg index a096b62..97c2c67 100644 --- a/library/msgs/eo.msg +++ b/library/msgs/eo.msg @@ -1,12 +1,12 @@ namespace eval ::tk { - ::msgcat::mcset eo "&Abort" "&\u0108esigu" + ::msgcat::mcset eo "&Abort" "&Ĉesigu" ::msgcat::mcset eo "&About..." "Pri..." - ::msgcat::mcset eo "All Files" "\u0108iuj dosieroj" + ::msgcat::mcset eo "All Files" "Ĉiuj dosieroj" ::msgcat::mcset eo "Application Error" "Aplikoeraro" ::msgcat::mcset eo "&Blue" "&Blua" ::msgcat::mcset eo "Cancel" "Rezignu" ::msgcat::mcset eo "&Cancel" "&Rezignu" - ::msgcat::mcset eo "Cannot change to the directory \"%1\$s\".\nPermission denied." "Neeble \u015dan\u011di al dosierujo \"%1\$s\".\nVi ne rajtas tion." + ::msgcat::mcset eo "Cannot change to the directory \"%1\$s\".\nPermission denied." "Neeble ŝanĝi al dosierujo \"%1\$s\".\nVi ne rajtas tion." ::msgcat::mcset eo "Choose Directory" "Elektu Dosierujon" ::msgcat::mcset eo "Cl&ear" "&Vakigu" ::msgcat::mcset eo "&Clear Console" "&Vakigu konzolon" @@ -22,7 +22,7 @@ namespace eval ::tk { ::msgcat::mcset eo "Error: %1\$s" "Eraro: %1\$s" ::msgcat::mcset eo "E&xit" "&Eliru" ::msgcat::mcset eo "&File" "&Dosiero" - ::msgcat::mcset eo "File \"%1\$s\" already exists.\nDo you want to overwrite it?" "La dosiero \"%1\$s\" jam ekzistas.\n\u0108u vi volas anstata\u016digi la dosieron?" + ::msgcat::mcset eo "File \"%1\$s\" already exists.\nDo you want to overwrite it?" "La dosiero \"%1\$s\" jam ekzistas.\nĈu vi volas anstataŭigi la dosieron?" ::msgcat::mcset eo "File \"%1\$s\" already exists.\n\n" "La dosiero \"%1\$s\" jam ekzistas. \n\n" ::msgcat::mcset eo "File \"%1\$s\" does not exist." "La dosiero \"%1\$s\" ne ekzistas." ::msgcat::mcset eo "File &name:" "Dosiero&nomo:" @@ -34,7 +34,7 @@ namespace eval ::tk { ::msgcat::mcset eo "&Green" "&Verda" ::msgcat::mcset eo "&Help" "&Helpu" ::msgcat::mcset eo "Hi" "Saluton" - ::msgcat::mcset eo "&Hide Console" "&Ka\u015du konzolon" + ::msgcat::mcset eo "&Hide Console" "&Kaŝu konzolon" ::msgcat::mcset eo "&Ignore" "&Ignoru" ::msgcat::mcset eo "Invalid file name \"%1\$s\"." "Malvalida dosieronomo \"%1\$s\"." ::msgcat::mcset eo "Log Files" "Protokolaj dosieroj" @@ -47,8 +47,8 @@ namespace eval ::tk { ::msgcat::mcset eo "Open Multiple Files" "Malfermu plurajn dosierojn" ::msgcat::mcset eo "P&aste" "&Algluu" ::msgcat::mcset eo "&Quit" "&Forlasu" - ::msgcat::mcset eo "&Red" "&Ru\u011da" - ::msgcat::mcset eo "Replace existing file?" "\u0108u anstata\u016digi ekzistantan dosieron?" + ::msgcat::mcset eo "&Red" "&Ruĝa" + ::msgcat::mcset eo "Replace existing file?" "Ĉu anstataŭigi ekzistantan dosieron?" ::msgcat::mcset eo "&Retry" "&Reprovu" ::msgcat::mcset eo "&Save" "&Konservu" ::msgcat::mcset eo "Save As" "Konservu kiel" @@ -56,20 +56,38 @@ namespace eval ::tk { ::msgcat::mcset eo "Select Log File" "Elektu prokolodosieron" ::msgcat::mcset eo "Select a file to source" "Elektu dosieron por interpreti" ::msgcat::mcset eo "&Selection:" "&Elekto:" - ::msgcat::mcset eo "Skip Messages" "transsaltu mesa\u011dojn" + ::msgcat::mcset eo "Skip Messages" "transsaltu mesaĝojn" ::msgcat::mcset eo "&Source..." "&Fontoprogramo..." ::msgcat::mcset eo "Tcl Scripts" "Tcl-skriptoj" ::msgcat::mcset eo "Tcl for Windows" "Tcl por Vindozo" ::msgcat::mcset eo "Text Files" "Tekstodosieroj" ::msgcat::mcset eo "&Yes" "&Jes" - ::msgcat::mcset eo "abort" "\u0109esigu" + ::msgcat::mcset eo "abort" "ĉesigu" ::msgcat::mcset eo "blue" "blua" ::msgcat::mcset eo "cancel" "rezignu" ::msgcat::mcset eo "extension" "kromprogramo" ::msgcat::mcset eo "extensions" "kromprogramoj" ::msgcat::mcset eo "green" "verda" ::msgcat::mcset eo "ignore" "ignoru" - ::msgcat::mcset eo "red" "ru\u011da" + ::msgcat::mcset eo "red" "ruĝa" ::msgcat::mcset eo "retry" "reprovu" ::msgcat::mcset eo "yes" "jes" } +#localization of print terms by Kevin Walzer via Microsoft Translator +namespace eval ::tk { + ::msgcat::mcset eo "Print" "Presi" + ::msgcat::mcset eo "Printer" "Presilo" + ::msgcat::mcset eo "Letter " "Letero" + ::msgcat::mcset eo "Legal " "Laŭleĝa" + ::msgcat::mcset eo "A4" "A4" + ::msgcat::mcset eo "Grayscale" "Grizskalo" + ::msgcat::mcset eo "RGB" "RGB" + ::msgcat::mcset eo "Options" "Opcioj" + ::msgcat::mcset eo "Copies" "Kopioj" + ::msgcat::mcset eo "Paper" "Papero" + ::msgcat::mcset eo "Scale" "Skalo" + ::msgcat::mcset eo "Orientation" "Orientiĝo" + ::msgcat::mcset eo "Portrait" "Portreto" + ::msgcat::mcset eo "Landscape" "Pejzaĝo" + ::msgcat::mcset eo "Output" "Eligo" +} diff --git a/library/msgs/es.msg b/library/msgs/es.msg index 578c52c..71ad5ad 100644 --- a/library/msgs/es.msg +++ b/library/msgs/es.msg @@ -2,7 +2,7 @@ namespace eval ::tk { ::msgcat::mcset es "&Abort" "&Abortar" ::msgcat::mcset es "&About..." "&Acerca de ..." ::msgcat::mcset es "All Files" "Todos los archivos" - ::msgcat::mcset es "Application Error" "Error de la aplicaci\u00f3n" + ::msgcat::mcset es "Application Error" "Error de la aplicación" ::msgcat::mcset es "&Blue" "&Azul" ::msgcat::mcset es "Cancel" "Cancelar" ::msgcat::mcset es "&Cancel" "&Cancelar" @@ -22,7 +22,7 @@ namespace eval ::tk { ::msgcat::mcset es "Error: %1\$s" ::msgcat::mcset es "E&xit" "Salir" ::msgcat::mcset es "&File" "&Archivo" - ::msgcat::mcset es "File \"%1\$s\" already exists.\nDo you want to overwrite it?" "El archivo \"%1\$s\" ya existe.\n\u00bfDesea sobreescribirlo?" + ::msgcat::mcset es "File \"%1\$s\" already exists.\nDo you want to overwrite it?" "El archivo \"%1\$s\" ya existe.\n¿Desea sobreescribirlo?" ::msgcat::mcset es "File \"%1\$s\" already exists.\n\n" "El archivo \"%1\$s\" ya existe.\n\n" ::msgcat::mcset es "File \"%1\$s\" does not exist." "El archivo \"%1\$s\" no existe." ::msgcat::mcset es "File &name:" "&Nombre de archivo:" @@ -36,7 +36,7 @@ namespace eval ::tk { ::msgcat::mcset es "Hi" "Hola" ::msgcat::mcset es "&Hide Console" "&Esconder la consola" ::msgcat::mcset es "&Ignore" "&Ignorar" - ::msgcat::mcset es "Invalid file name \"%1\$s\"." "Nombre de archivo inv\u00e1lido \"%1\$s\"." + ::msgcat::mcset es "Invalid file name \"%1\$s\"." "Nombre de archivo inválido \"%1\$s\"." ::msgcat::mcset es "Log Files" "Ficheros de traza" ::msgcat::mcset es "&No" ::msgcat::mcset es "&OK" @@ -44,33 +44,51 @@ namespace eval ::tk { ::msgcat::mcset es "Ok" ::msgcat::mcset es "Open" "Abrir" ::msgcat::mcset es "&Open" "&Abrir" - ::msgcat::mcset es "Open Multiple Files" "Abrir m\u00faltiples archivos" + ::msgcat::mcset es "Open Multiple Files" "Abrir múltiples archivos" ::msgcat::mcset es "P&aste" "Peg&ar" ::msgcat::mcset es "&Quit" "&Abandonar" ::msgcat::mcset es "&Red" "&Rojo" - ::msgcat::mcset es "Replace existing file?" "\u00bfReemplazar el archivo existente?" + ::msgcat::mcset es "Replace existing file?" "¿Reemplazar el archivo existente?" ::msgcat::mcset es "&Retry" "&Reintentar" ::msgcat::mcset es "&Save" "&Guardar" ::msgcat::mcset es "Save As" "Guardar como" ::msgcat::mcset es "Save To Log" "Guardar al archivo de traza" ::msgcat::mcset es "Select Log File" "Elegir un archivo de traza" ::msgcat::mcset es "Select a file to source" "Seleccionar un archivo a evaluar" - ::msgcat::mcset es "&Selection:" "&Selecci\u00f3n:" + ::msgcat::mcset es "&Selection:" "&Selección:" ::msgcat::mcset es "Skip Messages" "Omitir los mensajes" ::msgcat::mcset es "&Source..." "E&valuar..." ::msgcat::mcset es "Tcl Scripts" "Scripts Tcl" ::msgcat::mcset es "Tcl for Windows" "Tcl para Windows" ::msgcat::mcset es "Text Files" "Archivos de texto" - ::msgcat::mcset es "&Yes" "&S\u00ed" + ::msgcat::mcset es "&Yes" "&Sí" ::msgcat::mcset es "abort" "abortar" ::msgcat::mcset es "blue" "azul" ::msgcat::mcset es "cancel" "cancelar" - ::msgcat::mcset es "extension" "extensi\u00f3n" + ::msgcat::mcset es "extension" "extensión" ::msgcat::mcset es "extensions" "extensiones" ::msgcat::mcset es "green" "verde" ::msgcat::mcset es "ignore" "ignorar" ::msgcat::mcset es "ok" ::msgcat::mcset es "red" "rojo" ::msgcat::mcset es "retry" "reintentar" - ::msgcat::mcset es "yes" "s\u00ed" + ::msgcat::mcset es "yes" "sí" } +#localization of print terms by Kevin Walzer via Microsoft Translator +namespace eval ::tk { + ::msgcat::mcset es "Print" "Imprimir" + ::msgcat::mcset es "Printer" "Impresora" + ::msgcat::mcset es "Letter" "Carta" + ::msgcat::mcset es "Legal" "Legal" + ::msgcat::mcset es "A4" "A4" + ::msgcat::mcset es "Grayscale" "Escala De Grises" + ::msgcat::mcset es "RGB" "Color" + ::msgcat::mcset es "Options" "Opciones" + ::msgcat::mcset es "Copies" "Copias" + ::msgcat::mcset es "Paper" "Papel" + ::msgcat::mcset es "Scale" "Escala" + ::msgcat::mcset es "Orientation" "Orientación" + ::msgcat::mcset es "Portrait" "Retrato" + ::msgcat::mcset es "Landscape" "Paisaje" + ::msgcat::mcset es "Output" "Salida" +}
\ No newline at end of file diff --git a/library/msgs/fi.msg b/library/msgs/fi.msg index e014cce..c00b373 100644 --- a/library/msgs/fi.msg +++ b/library/msgs/fi.msg @@ -1,24 +1,26 @@ namespace eval ::tk { - ::msgcat::mcset fi "&Abort" "&Keskeyt\u00e4" + ::msgcat::mcset fi "AaBbYyZz01" "AaBbÄäÖö01" + ::msgcat::mcset fi "&Abort" "&Keskeytä" ::msgcat::mcset fi "&About..." "&Tietoja..." ::msgcat::mcset fi "All Files" "Kaikki tiedostot" + ::msgcat::mcset fi "&Apply" "Kä&ytä" ::msgcat::mcset fi "Application Error" "Ohjelmavirhe" - ::msgcat::mcset fi "&Apply" "K\u00e4&yt\u00e4" + ::msgcat::mcset fi "&Blue" "&Sininen" ::msgcat::mcset fi "Bold" "Lihavoitu" ::msgcat::mcset fi "Bold Italic" "Lihavoitu, kursivoitu" - ::msgcat::mcset fi "&Blue" "&Sininen" ::msgcat::mcset fi "Cancel" "Peruuta" ::msgcat::mcset fi "&Cancel" "&Peruuta" - ::msgcat::mcset fi "Cannot change to the directory \"%1\$s\".\nPermission denied." "Ei voitu vaihtaa hakemistoon \"%1\$s\".\nLupa ev\u00e4tty." + ::msgcat::mcset fi "Cannot change to the directory \"%1\$s\".\nPermission denied." "Ei voitu vaihtaa hakemistoon \"%1\$s\".\nLupa evätty." ::msgcat::mcset fi "Choose Directory" "Valitse hakemisto" - ::msgcat::mcset fi "Cl&ear" "&Tyhjenn\u00e4" - ::msgcat::mcset fi "&Clear Console" "&Tyhjenn\u00e4 konsoli" - ::msgcat::mcset fi "Color" "V\u00e4ri" + ::msgcat::mcset fi "Cl&ear" "&Tyhjennä" + ::msgcat::mcset fi "&Clear Console" "&Tyhjennä konsoli" + ::msgcat::mcset fi "Color" "Väri" ::msgcat::mcset fi "Console" "Konsoli" ::msgcat::mcset fi "&Copy" "K&opioi" ::msgcat::mcset fi "Cu&t" "&Leikkaa" + ::msgcat::mcset fi "&Decrease Font Size" "&Pienennä kirjasinkokoa" ::msgcat::mcset fi "&Delete" "&Poista" - ::msgcat::mcset fi "Details >>" "Lis\u00e4tiedot >>" + ::msgcat::mcset fi "Details >>" "Lisätiedot >>" ::msgcat::mcset fi "Directory \"%1\$s\" does not exist." "Hakemistoa \"%1\$s\" ei ole olemassa." ::msgcat::mcset fi "&Directory:" "&Hakemisto:" ::msgcat::mcset fi "&Edit" "&Muokkaa" @@ -35,14 +37,19 @@ namespace eval ::tk { ::msgcat::mcset fi "Fi&les:" "Ti&edostot:" ::msgcat::mcset fi "&Filter" "&Suodata" ::msgcat::mcset fi "Fil&ter:" "Suo&data:" + ::msgcat::mcset fi "Fit To Screen Width" "Sovita ruudun kokoon" ::msgcat::mcset fi "Font" "Kirjasin" + ::msgcat::mcset fi "&Font..." "Kir&jasin..." ::msgcat::mcset fi "&Font:" "&Kirjasin:" ::msgcat::mcset fi "Font st&yle:" "Kirjasint&yyli:" - ::msgcat::mcset fi "&Green" "&Vihre\u00e4" + ::msgcat::mcset fi "&Green" "&Vihreä" + ::msgcat::mcset fi "Help" "Ohje" ::msgcat::mcset fi "&Help" "&Ohje" ::msgcat::mcset fi "Hi" "Hei" ::msgcat::mcset fi "&Hide Console" "P&iilota konsoli" + ::msgcat::mcset fi "Hide Fonts" "Piilota kirjasimet" ::msgcat::mcset fi "&Ignore" "&Ohita" + ::msgcat::mcset fi "&Increase Font Size" "&Suurenna kirjasinkokoa" ::msgcat::mcset fi "Invalid file name \"%1\$s\"." "Virheellinen tiedostonimi \"%1\$s\"." ::msgcat::mcset fi "Italic" "Kursivoitu" ::msgcat::mcset fi "Log Files" "Lokitiedostot" @@ -53,37 +60,55 @@ namespace eval ::tk { ::msgcat::mcset fi "Open" "Avaa" ::msgcat::mcset fi "&Open" "&Avaa" ::msgcat::mcset fi "Open Multiple Files" "Avaa monta tiedostoa" - ::msgcat::mcset fi "P&aste" "L&iit\u00e4" + ::msgcat::mcset fi "P&aste" "L&iitä" ::msgcat::mcset fi "&Quit" "&Lopeta" ::msgcat::mcset fi "&Red" "&Punainen" ::msgcat::mcset fi "Regular" "Tavallinen" ::msgcat::mcset fi "Replace existing file?" "Korvataanko olemassaoleva tiedosto?" - ::msgcat::mcset fi "&Retry" "&Yrit\u00e4 uudelleen" + ::msgcat::mcset fi "&Retry" "&Yritä uudelleen" ::msgcat::mcset fi "Sample" "Malli" ::msgcat::mcset fi "&Save" "&Tallenna" - ::msgcat::mcset fi "Save As" "Tallenna nimell\u00e4" + ::msgcat::mcset fi "Save As" "Tallenna nimellä" ::msgcat::mcset fi "Save To Log" "Tallenna lokiin" ::msgcat::mcset fi "Select Log File" "Valitse lokitiedosto" - ::msgcat::mcset fi "Select a file to source" "Valitse l\u00e4hdetiedosto" + ::msgcat::mcset fi "Select a file to source" "Valitse lähdetiedosto" ::msgcat::mcset fi "&Selection:" "&Valinta:" + ::msgcat::mcset fi "Show Fonts" "Näytä kirjasimet" + ::msgcat::mcset fi "Skip Messages" "Jätä viestit huomiotta" ::msgcat::mcset fi "&Size:" "K&oko:" - ::msgcat::mcset fi "Skip Messages" "J\u00e4t\u00e4 viestit huomiotta" - ::msgcat::mcset fi "&Source..." "L&\u00e4hde..." + ::msgcat::mcset fi "&Source..." "L&ähde..." ::msgcat::mcset fi "Stri&keout" "&Yliviivaa" ::msgcat::mcset fi "Tcl Scripts" "Tcl-skriptit" ::msgcat::mcset fi "Tcl for Windows" "Tcl Windowsille" ::msgcat::mcset fi "Text Files" "Tekstitiedostot" ::msgcat::mcset fi "&Underline" "&Alleviivaa" - ::msgcat::mcset fi "&Yes" "&Kyll\u00e4" - ::msgcat::mcset fi "abort" "keskeyt\u00e4" + ::msgcat::mcset fi "Window" "Ikkuna" + ::msgcat::mcset fi "&Yes" "&Kyllä" + ::msgcat::mcset fi "abort" "keskeytä" ::msgcat::mcset fi "blue" "sininen" ::msgcat::mcset fi "cancel" "peruuta" - ::msgcat::mcset fi "extension" "lis\u00e4osa" - ::msgcat::mcset fi "extensions" "lis\u00e4osat" - ::msgcat::mcset fi "green" "vihre\u00e4" + ::msgcat::mcset fi "extension" "lisäosa" + ::msgcat::mcset fi "extensions" "lisäosat" + ::msgcat::mcset fi "green" "vihreä" ::msgcat::mcset fi "ignore" "ohita" ::msgcat::mcset fi "ok" ::msgcat::mcset fi "red" "punainen" - ::msgcat::mcset fi "retry" "yrit\u00e4 uudelleen" - ::msgcat::mcset fi "yes" "kyll\u00e4" + ::msgcat::mcset fi "retry" "yritä uudelleen" + ::msgcat::mcset fi "yes" "kyllä" + + ::msgcat::mcset fi "Print" "Tulosta" + ::msgcat::mcset fi "Printer" "Tulostin" + ::msgcat::mcset fi "Letter " "Letter" + ::msgcat::mcset fi "Legal " "Legal" + ::msgcat::mcset fi "A4" "A4" + ::msgcat::mcset fi "Grayscale" "Harmaasävy" + ::msgcat::mcset fi "RGB" "RGB" + ::msgcat::mcset fi "Options" "Asetukset" + ::msgcat::mcset fi "Copies" "Tulosteita" + ::msgcat::mcset fi "Paper" "Paperikoko" + ::msgcat::mcset fi "Scale" "Skaalaus" + ::msgcat::mcset fi "Orientation" "Suunta" + ::msgcat::mcset fi "Portrait" "Pysty" + ::msgcat::mcset fi "Landscape" "Vaaka" + ::msgcat::mcset fi "Output" "Tulos" } diff --git a/library/msgs/fr.msg b/library/msgs/fr.msg index 7f42aca..cb4fdf2 100644 --- a/library/msgs/fr.msg +++ b/library/msgs/fr.msg @@ -1,26 +1,26 @@ namespace eval ::tk { ::msgcat::mcset fr "&Abort" "&Annuler" - ::msgcat::mcset fr "About..." "\u00c0 propos..." + ::msgcat::mcset fr "About..." "À propos..." ::msgcat::mcset fr "All Files" "Tous les fichiers" ::msgcat::mcset fr "Application Error" "Erreur d'application" ::msgcat::mcset fr "&Blue" "&Bleu" ::msgcat::mcset fr "Cancel" "Annuler" ::msgcat::mcset fr "&Cancel" "&Annuler" - ::msgcat::mcset fr "Cannot change to the directory \"%1\$s\".\nPermission denied." "Impossible d'acc\u00e9der au r\u00e9pertoire \"%1\$s\".\nPermission refus\u00e9e." - ::msgcat::mcset fr "Choose Directory" "Choisir r\u00e9pertoire" + ::msgcat::mcset fr "Cannot change to the directory \"%1\$s\".\nPermission denied." "Impossible d'accéder au répertoire \"%1\$s\".\nPermission refusée." + ::msgcat::mcset fr "Choose Directory" "Choisir répertoire" ::msgcat::mcset fr "Cl&ear" "Effacer" ::msgcat::mcset fr "Color" "Couleur" ::msgcat::mcset fr "Console" ::msgcat::mcset fr "Copy" "Copier" ::msgcat::mcset fr "Cu&t" "Couper" ::msgcat::mcset fr "Delete" "Effacer" - ::msgcat::mcset fr "Details >>" "D\u00e9tails >>" - ::msgcat::mcset fr "Directory \"%1\$s\" does not exist." "Le r\u00e9pertoire \"%1\$s\" n'existe pas." - ::msgcat::mcset fr "&Directory:" "&R\u00e9pertoire:" + ::msgcat::mcset fr "Details >>" "Détails >>" + ::msgcat::mcset fr "Directory \"%1\$s\" does not exist." "Le répertoire \"%1\$s\" n'existe pas." + ::msgcat::mcset fr "&Directory:" "&Répertoire:" ::msgcat::mcset fr "Error: %1\$s" "Erreur: %1\$s" ::msgcat::mcset fr "E&xit" "Quitter" - ::msgcat::mcset fr "File \"%1\$s\" already exists.\nDo you want to overwrite it?" "Le fichier \"%1\$s\" existe d\u00e9j\u00e0.\nVoulez-vous l'\u00e9craser?" - ::msgcat::mcset fr "File \"%1\$s\" already exists.\n\n" "Le fichier \"%1\$s\" existe d\u00e9j\u00e0.\n\n" + ::msgcat::mcset fr "File \"%1\$s\" already exists.\nDo you want to overwrite it?" "Le fichier \"%1\$s\" existe déjà.\nVoulez-vous l'écraser?" + ::msgcat::mcset fr "File \"%1\$s\" already exists.\n\n" "Le fichier \"%1\$s\" existe déjà.\n\n" ::msgcat::mcset fr "File \"%1\$s\" does not exist." "Le fichier \"%1\$s\" n'existe pas." ::msgcat::mcset fr "File &name:" "&Nom de fichier:" ::msgcat::mcset fr "File &names:" "&Noms de fichiers:" @@ -45,15 +45,15 @@ namespace eval ::tk { ::msgcat::mcset fr "&Quit" "&Quitter" ::msgcat::mcset fr "&Red" "&Rouge" ::msgcat::mcset fr "Replace existing file?" "Remplacer le fichier existant?" - ::msgcat::mcset fr "&Retry" "&R\u00e9-essayer" + ::msgcat::mcset fr "&Retry" "&Ré-essayer" ::msgcat::mcset fr "&Save" "&Sauvegarder" ::msgcat::mcset fr "Save As" "Sauvegarder sous" ::msgcat::mcset fr "Save To Log" "Sauvegarde au fichier de trace" ::msgcat::mcset fr "Select Log File" "Choisir un fichier de trace" - ::msgcat::mcset fr "Select a file to source" "Choisir un fichier \u00e0 \u00e9valuer" - ::msgcat::mcset fr "&Selection:" "&S\u00e9lection:" + ::msgcat::mcset fr "Select a file to source" "Choisir un fichier à évaluer" + ::msgcat::mcset fr "&Selection:" "&Sélection:" ::msgcat::mcset fr "Skip Messages" "Omettre les messages" - ::msgcat::mcset fr "&Source..." "\u00c9valuer..." + ::msgcat::mcset fr "&Source..." "Évaluer..." ::msgcat::mcset fr "Tcl Scripts" "Scripts Tcl" ::msgcat::mcset fr "Tcl for Windows" "Tcl pour Windows" ::msgcat::mcset fr "Text Files" "Fichiers texte" @@ -67,6 +67,24 @@ namespace eval ::tk { ::msgcat::mcset fr "ignore" "ignorer" ::msgcat::mcset fr "ok" ::msgcat::mcset fr "red" "rouge" - ::msgcat::mcset fr "retry" "r\u00e9essayer" + ::msgcat::mcset fr "retry" "réessayer" ::msgcat::mcset fr "yes" "oui" } +#localization of print terms by Kevin Walzer via Microsoft Translator +namespace eval ::tk { + ::msgcat::mcset fr "Print" "Imprimer" + ::msgcat::mcset fr "Printer" "Imprimante" + ::msgcat::mcset fr "Letter " "Lettre" + ::msgcat::mcset fr "Legal " "Légal" + ::msgcat::mcset fr "A4" "A4" + ::msgcat::mcset fr "Grayscale" "Niveaux de Gris" + ::msgcat::mcset fr "RGB" "RVB" + ::msgcat::mcset fr "Options" "Options" + ::msgcat::mcset fr "Copies" "Nombre d'exemplaires" + ::msgcat::mcset fr "Paper" "Papier" + ::msgcat::mcset fr "Scale" "Échelle" + ::msgcat::mcset fr "Orientation" "Orientation" + ::msgcat::mcset fr "Portrait" "Portrait" + ::msgcat::mcset fr "Landscape" "Paysage" + ::msgcat::mcset fr "Output" "Sortie" +}
\ No newline at end of file diff --git a/library/msgs/hu.msg b/library/msgs/hu.msg index 38ef0b8..543d8bf 100644 --- a/library/msgs/hu.msg +++ b/library/msgs/hu.msg @@ -1,78 +1,96 @@ namespace eval ::tk { - ::msgcat::mcset hu "&Abort" "&Megszak\u00edt\u00e1s" - ::msgcat::mcset hu "&About..." "N\u00e9vjegy..." - ::msgcat::mcset hu "All Files" "Minden f\u00e1jl" - ::msgcat::mcset hu "Application Error" "Alkalmaz\u00e1s hiba" - ::msgcat::mcset hu "&Blue" "&K\u00e9k" - ::msgcat::mcset hu "Cancel" "M\u00e9gsem" - ::msgcat::mcset hu "&Cancel" "M\u00e9g&sem" - ::msgcat::mcset hu "Cannot change to the directory \"%1\$s\".\nPermission denied." "A k\u00f6nyvt\u00e1rv\u00e1lt\u00e1s nem siker\u00fclt: \"%1\$s\".\nHozz\u00e1f\u00e9r\u00e9s megtagadva." - ::msgcat::mcset hu "Choose Directory" "K\u00f6nyvt\u00e1r kiv\u00e1laszt\u00e1sa" - ::msgcat::mcset hu "Cl&ear" "T\u00f6rl\u00e9s" - ::msgcat::mcset hu "&Clear Console" "&T\u00f6rl\u00e9s Konzol" - ::msgcat::mcset hu "Color" "Sz\u00edn" + ::msgcat::mcset hu "&Abort" "&Megszakítás" + ::msgcat::mcset hu "&About..." "Névjegy..." + ::msgcat::mcset hu "All Files" "Minden fájl" + ::msgcat::mcset hu "Application Error" "Alkalmazás hiba" + ::msgcat::mcset hu "&Blue" "&Kék" + ::msgcat::mcset hu "Cancel" "Mégsem" + ::msgcat::mcset hu "&Cancel" "Még&sem" + ::msgcat::mcset hu "Cannot change to the directory \"%1\$s\".\nPermission denied." "A könyvtárváltás nem sikerült: \"%1\$s\".\nHozzáférés megtagadva." + ::msgcat::mcset hu "Choose Directory" "Könyvtár kiválasztása" + ::msgcat::mcset hu "Cl&ear" "Törlés" + ::msgcat::mcset hu "&Clear Console" "&Törlés Konzol" + ::msgcat::mcset hu "Color" "Szín" ::msgcat::mcset hu "Console" "Konzol" - ::msgcat::mcset hu "&Copy" "&M\u00e1sol\u00e1s" - ::msgcat::mcset hu "Cu&t" "&Kiv\u00e1g\u00e1s" - ::msgcat::mcset hu "&Delete" "&T\u00f6rl\u00e9s" - ::msgcat::mcset hu "Details >>" "R\u00e9szletek >>" - ::msgcat::mcset hu "Directory \"%1\$s\" does not exist." "\"%1\$s\" k\u00f6nyvt\u00e1r nem l\u00e9tezik." - ::msgcat::mcset hu "&Directory:" "&K\u00f6nyvt\u00e1r:" + ::msgcat::mcset hu "&Copy" "&Másolás" + ::msgcat::mcset hu "Cu&t" "&Kivágás" + ::msgcat::mcset hu "&Delete" "&Törlés" + ::msgcat::mcset hu "Details >>" "Részletek >>" + ::msgcat::mcset hu "Directory \"%1\$s\" does not exist." "\"%1\$s\" könyvtár nem létezik." + ::msgcat::mcset hu "&Directory:" "&Könyvtár:" #::msgcat::mcset hu "&Edit" ::msgcat::mcset hu "Error: %1\$s" "Hiba: %1\$s" - ::msgcat::mcset hu "E&xit" "Kil\u00e9p\u00e9s" - ::msgcat::mcset hu "&File" "&F\u00e1jl" - ::msgcat::mcset hu "File \"%1\$s\" already exists.\nDo you want to overwrite it?" "\"%1\$s\" f\u00e1jl m\u00e1r l\u00e9tezik.\nFel\u00fcl\u00edrjam?" - ::msgcat::mcset hu "File \"%1\$s\" already exists.\n\n" "\"%1\$s\" f\u00e1jl m\u00e1r l\u00e9tezik.\n\n" - ::msgcat::mcset hu "File \"%1\$s\" does not exist." "\"%1\$s\" f\u00e1jl nem l\u00e9tezik." - ::msgcat::mcset hu "File &name:" "F\u00e1jl &neve:" - ::msgcat::mcset hu "File &names:" "F\u00e1jlok &nevei:" - ::msgcat::mcset hu "Files of &type:" "F\u00e1jlok &t\u00edpusa:" - ::msgcat::mcset hu "Fi&les:" "F\u00e1j&lok:" - ::msgcat::mcset hu "&Filter" "&Sz\u0171r\u0151" - ::msgcat::mcset hu "Fil&ter:" "S&z\u0171r\u0151:" - ::msgcat::mcset hu "&Green" "&Z\u00f6ld" + ::msgcat::mcset hu "E&xit" "Kilépés" + ::msgcat::mcset hu "&File" "&Fájl" + ::msgcat::mcset hu "File \"%1\$s\" already exists.\nDo you want to overwrite it?" "\"%1\$s\" fájl már létezik.\nFelülírjam?" + ::msgcat::mcset hu "File \"%1\$s\" already exists.\n\n" "\"%1\$s\" fájl már létezik.\n\n" + ::msgcat::mcset hu "File \"%1\$s\" does not exist." "\"%1\$s\" fájl nem létezik." + ::msgcat::mcset hu "File &name:" "Fájl &neve:" + ::msgcat::mcset hu "File &names:" "Fájlok &nevei:" + ::msgcat::mcset hu "Files of &type:" "Fájlok &típusa:" + ::msgcat::mcset hu "Fi&les:" "Fáj&lok:" + ::msgcat::mcset hu "&Filter" "&Szűrő" + ::msgcat::mcset hu "Fil&ter:" "S&zűrő:" + ::msgcat::mcset hu "&Green" "&Zöld" #::msgcat::mcset hu "&Help" - ::msgcat::mcset hu "Hi" "\u00dcdv" - ::msgcat::mcset hu "&Hide Console" "Konzol &elrejt\u00e9se" - ::msgcat::mcset hu "&Ignore" "K&ihagy\u00e1s" - ::msgcat::mcset hu "Invalid file name \"%1\$s\"." "\u00c9rv\u00e9nytelen f\u00e1jln\u00e9v: \"%1\$s\"." - ::msgcat::mcset hu "Log Files" "Log f\u00e1jlok" + ::msgcat::mcset hu "Hi" "Üdv" + ::msgcat::mcset hu "&Hide Console" "Konzol &elrejtése" + ::msgcat::mcset hu "&Ignore" "K&ihagyás" + ::msgcat::mcset hu "Invalid file name \"%1\$s\"." "Érvénytelen fájlnév: \"%1\$s\"." + ::msgcat::mcset hu "Log Files" "Log fájlok" ::msgcat::mcset hu "&No" "&Nem" ::msgcat::mcset hu "&OK" ::msgcat::mcset hu "OK" ::msgcat::mcset hu "Ok" - ::msgcat::mcset hu "Open" "Megnyit\u00e1s" - ::msgcat::mcset hu "&Open" "&Megnyit\u00e1s" - ::msgcat::mcset hu "Open Multiple Files" "T\u00f6bb f\u00e1jl megnyit\u00e1sa" - ::msgcat::mcset hu "P&aste" "&Beilleszt\u00e9s" - ::msgcat::mcset hu "&Quit" "&Kil\u00e9p\u00e9s" - ::msgcat::mcset hu "&Red" "&V\u00f6r\u00f6s" - ::msgcat::mcset hu "Replace existing file?" "Megl\u00e9v\u0151 f\u00e1jl cser\u00e9je?" - ::msgcat::mcset hu "&Retry" "\u00daj&ra" - ::msgcat::mcset hu "&Save" "&Ment\u00e9s" - ::msgcat::mcset hu "Save As" "Ment\u00e9s m\u00e1sk\u00e9nt" - ::msgcat::mcset hu "Save To Log" "Ment\u00e9s log f\u00e1jlba" - ::msgcat::mcset hu "Select Log File" "Log f\u00e1jl kiv\u00e1laszt\u00e1sa" - ::msgcat::mcset hu "Select a file to source" "Forr\u00e1sf\u00e1jl kiv\u00e1laszt\u00e1sa" - ::msgcat::mcset hu "&Selection:" "&Kijel\u00f6l\u00e9s:" - ::msgcat::mcset hu "Show &Hidden Directories" "&Rejtett k\u00f6nyvt\u00e1rak megjelen\u00edt\u00e9se" - ::msgcat::mcset hu "Show &Hidden Files and Directories" "&Rejtett f\u00e1jlok \u00e9s k\u00f6nyvt\u00e1rak megjelen\u00edt\u00e9se" - ::msgcat::mcset hu "Skip Messages" "\u00dczenetek kihagy\u00e1sa" - ::msgcat::mcset hu "&Source..." "&Forr\u00e1s..." + ::msgcat::mcset hu "Open" "Megnyitás" + ::msgcat::mcset hu "&Open" "&Megnyitás" + ::msgcat::mcset hu "Open Multiple Files" "Több fájl megnyitása" + ::msgcat::mcset hu "P&aste" "&Beillesztés" + ::msgcat::mcset hu "&Quit" "&Kilépés" + ::msgcat::mcset hu "&Red" "&Vörös" + ::msgcat::mcset hu "Replace existing file?" "Meglévő fájl cseréje?" + ::msgcat::mcset hu "&Retry" "Új&ra" + ::msgcat::mcset hu "&Save" "&Mentés" + ::msgcat::mcset hu "Save As" "Mentés másként" + ::msgcat::mcset hu "Save To Log" "Mentés log fájlba" + ::msgcat::mcset hu "Select Log File" "Log fájl kiválasztása" + ::msgcat::mcset hu "Select a file to source" "Forrásfájl kiválasztása" + ::msgcat::mcset hu "&Selection:" "&Kijelölés:" + ::msgcat::mcset hu "Show &Hidden Directories" "&Rejtett könyvtárak megjelenítése" + ::msgcat::mcset hu "Show &Hidden Files and Directories" "&Rejtett fájlok és könyvtárak megjelenítése" + ::msgcat::mcset hu "Skip Messages" "Üzenetek kihagyása" + ::msgcat::mcset hu "&Source..." "&Forrás..." ::msgcat::mcset hu "Tcl Scripts" "Tcl scriptek" ::msgcat::mcset hu "Tcl for Windows" "Tcl Windows-hoz" - ::msgcat::mcset hu "Text Files" "Sz\u00f6vegf\u00e1jlok" + ::msgcat::mcset hu "Text Files" "Szövegfájlok" ::msgcat::mcset hu "&Yes" "&Igen" - ::msgcat::mcset hu "abort" "megszak\u00edt\u00e1s" - ::msgcat::mcset hu "blue" "k\u00e9k" - ::msgcat::mcset hu "cancel" "m\u00e9gsem" - ::msgcat::mcset hu "extension" "kiterjeszt\u00e9s" - ::msgcat::mcset hu "extensions" "kiterjeszt\u00e9sek" - ::msgcat::mcset hu "green" "z\u00f6ld" + ::msgcat::mcset hu "abort" "megszakítás" + ::msgcat::mcset hu "blue" "kék" + ::msgcat::mcset hu "cancel" "mégsem" + ::msgcat::mcset hu "extension" "kiterjesztés" + ::msgcat::mcset hu "extensions" "kiterjesztések" + ::msgcat::mcset hu "green" "zöld" ::msgcat::mcset hu "ignore" "ignorer" ::msgcat::mcset hu "ok" - ::msgcat::mcset hu "red" "v\u00f6r\u00f6s" - ::msgcat::mcset hu "retry" "\u00fajra" + ::msgcat::mcset hu "red" "vörös" + ::msgcat::mcset hu "retry" "újra" ::msgcat::mcset hu "yes" "igen" } +#localization of print terms by Kevin Walzer via Microsoft Translator +namespace eval ::tk { + ::msgcat::mcset hu "Print" "Nyomtat" + ::msgcat::mcset hu "Printer" "Nyomtató" + ::msgcat::mcset hu "Letter " "Levél" + ::msgcat::mcset hu "Legal " "Törvényes" + ::msgcat::mcset hu "A4" "A4" + ::msgcat::mcset hu "Grayscale" "Szürkeárnyalatos" + ::msgcat::mcset hu "RGB" "Rgb" + ::msgcat::mcset hu "Options" "Beállítások" + ::msgcat::mcset hu "Copies" "Másolatok" + ::msgcat::mcset hu "Paper" "Papír" + ::msgcat::mcset hu "Scale" "Hangsor" + ::msgcat::mcset hu "Orientation" "Tájékozódás" + ::msgcat::mcset hu "Portrait" "Portré" + ::msgcat::mcset hu "Landscape" "Táj" + ::msgcat::mcset hu "Output" "Hozam" +}
\ No newline at end of file diff --git a/library/msgs/it.msg b/library/msgs/it.msg index 2e1b4bd..58bf5b0 100644 --- a/library/msgs/it.msg +++ b/library/msgs/it.msg @@ -20,8 +20,8 @@ namespace eval ::tk { ::msgcat::mcset it "&Directory:" ::msgcat::mcset it "Error: %1\$s" "Errore: %1\$s" ::msgcat::mcset it "E&xit" "Esci" - ::msgcat::mcset it "File \"%1\$s\" already exists.\nDo you want to overwrite it?" "Il file \"%1\$s\" esiste gi\u00e0.\nVuoi sovrascriverlo?" - ::msgcat::mcset it "File \"%1\$s\" already exists.\n\n" "Il file \"%1\$s\" esiste gi\u00e0.\n\n" + ::msgcat::mcset it "File \"%1\$s\" already exists.\nDo you want to overwrite it?" "Il file \"%1\$s\" esiste già.\nVuoi sovrascriverlo?" + ::msgcat::mcset it "File \"%1\$s\" already exists.\n\n" "Il file \"%1\$s\" esiste già.\n\n" ::msgcat::mcset it "File \"%1\$s\" does not exist." "Il file \"%1\$s\" non esiste." ::msgcat::mcset it "File &name:" "&Nome del file:" ::msgcat::mcset it "File &names:" "&Nomi dei file:" @@ -58,7 +58,7 @@ namespace eval ::tk { ::msgcat::mcset it "Tcl Scripts" "Script Tcl" ::msgcat::mcset it "Tcl for Windows" "Tcl per Windows" ::msgcat::mcset it "Text Files" "File di testo" - ::msgcat::mcset it "&Yes" "&S\u00ec" + ::msgcat::mcset it "&Yes" "&Sì" ::msgcat::mcset it "abort" "interrompi" ::msgcat::mcset it "blue" "blu" ::msgcat::mcset it "cancel" "annulla" @@ -69,5 +69,23 @@ namespace eval ::tk { ::msgcat::mcset it "ok" ::msgcat::mcset it "red" "rosso" ::msgcat::mcset it "retry" "riprova" - ::msgcat::mcset it "yes" "s\u00ec" + ::msgcat::mcset it "yes" "sì" } +#localization of print terms by Kevin Walzer via Microsoft Translator +namespace eval ::tk { + ::msgcat::mcset it "Print" "Stampare" + ::msgcat::mcset it "Printer" "Stampante" + ::msgcat::mcset it "Letter " "Lettera" + ::msgcat::mcset it "Legal " "Legale" + ::msgcat::mcset it "A4" "A4" + ::msgcat::mcset it "Grayscale" "Scala Di Grigi" + ::msgcat::mcset it "RGB" "Rgb" + ::msgcat::mcset it "Options" "Opzioni" + ::msgcat::mcset it "Copies" "Copie" + ::msgcat::mcset it "Paper" "Carta" + ::msgcat::mcset it "Scale" "Scala" + ::msgcat::mcset it "Orientation" "Orientamento" + ::msgcat::mcset it "Portrait" "Ritratto" + ::msgcat::mcset it "Landscape" "Paesaggio" + ::msgcat::mcset it "Output" "Prodotto" +}
\ No newline at end of file diff --git a/library/msgs/nl.msg b/library/msgs/nl.msg index 148a9e6..576d780 100644 --- a/library/msgs/nl.msg +++ b/library/msgs/nl.msg @@ -15,7 +15,7 @@ namespace eval ::tk { ::msgcat::mcset nl "&Clear Console" "&Wis Console" ::msgcat::mcset nl "Color" "Kleur" ::msgcat::mcset nl "Console" - ::msgcat::mcset nl "&Copy" "Kopi\u00ebren" + ::msgcat::mcset nl "&Copy" "Kopiëren" ::msgcat::mcset nl "Cu&t" "Knippen" ::msgcat::mcset nl "&Delete" "Wissen" ::msgcat::mcset nl "Details >>" @@ -24,7 +24,7 @@ namespace eval ::tk { ::msgcat::mcset nl "&Edit" "Bewerken" ::msgcat::mcset nl "Effects" "Effecten" ::msgcat::mcset nl "Error: %1\$s" "Fout: %1\$s" - ::msgcat::mcset nl "E&xit" "Be\u00ebindigen" + ::msgcat::mcset nl "E&xit" "Beëindigen" ::msgcat::mcset nl "&File" "Bestand" ::msgcat::mcset nl "File \"%1\$s\" already exists.\nDo you want to overwrite it?" "Bestand \"%1\$s\" bestaat al.\nWilt u het overschrijven?" ::msgcat::mcset nl "File \"%1\$s\" already exists.\n\n" "Bestand \"%1\$s\" bestaat al.\n\n" @@ -40,7 +40,7 @@ namespace eval ::tk { ::msgcat::mcset nl "Font st&yle:" "Font stijl:" ::msgcat::mcset nl "&Green" "&Groen" ::msgcat::mcset nl "&Help" - ::msgcat::mcset nl "Hi" "H\u00e9" + ::msgcat::mcset nl "Hi" "Hé" ::msgcat::mcset nl "&Hide Console" "Verberg Console" ::msgcat::mcset nl "&Ignore" "&Negeren" ::msgcat::mcset nl "Invalid file name \"%1\$s\"." "Ongeldige bestandsnaam \"%1\$s\"." @@ -89,3 +89,21 @@ namespace eval ::tk { ::msgcat::mcset nl "retry" "opnieuw" ::msgcat::mcset nl "yes" "ja" } +#localization of print terms by Kevin Walzer via Microsoft Translator +namespace eval ::tk { + ::msgcat::mcset nl "Print" "Afdrukken" + ::msgcat::mcset nl "Printer" "Printer" + ::msgcat::mcset nl "Letter " "Brief" + ::msgcat::mcset nl "Legal " "Legaal" + ::msgcat::mcset nl "A4" "A4" + ::msgcat::mcset nl "Grayscale" "Grijswaarden" + ::msgcat::mcset nl "RGB" "Rgb" + ::msgcat::mcset nl "Options" "Opties" + ::msgcat::mcset nl "Copies" "Kopieën" + ::msgcat::mcset nl "Paper" "Papier" + ::msgcat::mcset nl "Scale" "Schub" + ::msgcat::mcset nl "Orientation" "Oriëntatie" + ::msgcat::mcset nl "Portrait" "Portret" + ::msgcat::mcset nl "Landscape" "Landschap" + ::msgcat::mcset nl "Output" "Uitvoer" +}
\ No newline at end of file diff --git a/library/msgs/pl.msg b/library/msgs/pl.msg index c20f41e..b367c01 100644 --- a/library/msgs/pl.msg +++ b/library/msgs/pl.msg @@ -2,35 +2,35 @@ namespace eval ::tk { ::msgcat::mcset pl "&Abort" "&Przerwij" ::msgcat::mcset pl "&About..." "O programie..." ::msgcat::mcset pl "All Files" "Wszystkie pliki" - ::msgcat::mcset pl "Application Error" "B\u0142\u0105d w programie" + ::msgcat::mcset pl "Application Error" "Błąd w programie" ::msgcat::mcset pl "&Apply" "Zastosuj" ::msgcat::mcset pl "Bold" "Pogrubienie" ::msgcat::mcset pl "Bold Italic" "Pogrubiona kursywa" ::msgcat::mcset pl "&Blue" "&Niebieski" ::msgcat::mcset pl "Cancel" "Anuluj" ::msgcat::mcset pl "&Cancel" "&Anuluj" - ::msgcat::mcset pl "Cannot change to the directory \"%1\$s\".\nPermission denied." "Nie mo\u017cna otworzy\u0107 katalogu \"%1\$s\".\nOdmowa dost\u0119pu." + ::msgcat::mcset pl "Cannot change to the directory \"%1\$s\".\nPermission denied." "Nie można otworzyć katalogu \"%1\$s\".\nOdmowa dostępu." ::msgcat::mcset pl "Choose Directory" "Wybierz katalog" - ::msgcat::mcset pl "Cl&ear" "&Wyczy\u015b\u0107" - ::msgcat::mcset pl "&Clear Console" "&Wyczy\u015b\u0107 konsol\u0119" + ::msgcat::mcset pl "Cl&ear" "&Wyczyść" + ::msgcat::mcset pl "&Clear Console" "&Wyczyść konsolę" ::msgcat::mcset pl "Color" "Kolor" ::msgcat::mcset pl "Console" "Konsola" ::msgcat::mcset pl "&Copy" "&Kopiuj" ::msgcat::mcset pl "Cu&t" "&Wytnij" - ::msgcat::mcset pl "&Delete" "&Usu\u0144" - ::msgcat::mcset pl "Details >>" "Szczeg\u00f3\u0142y >>" + ::msgcat::mcset pl "&Delete" "&Usuń" + ::msgcat::mcset pl "Details >>" "Szczegóły >>" ::msgcat::mcset pl "Directory \"%1\$s\" does not exist." "Katalog \"%1\$s\" nie istnieje." ::msgcat::mcset pl "&Directory:" "&Katalog:" ::msgcat::mcset pl "&Edit" "&Edytuj" ::msgcat::mcset pl "Effects" "Efekty" - ::msgcat::mcset pl "Error: %1\$s" "B\u0142\u0105d: %1\$s" - ::msgcat::mcset pl "E&xit" "&Wyjd\u017a" + ::msgcat::mcset pl "Error: %1\$s" "Błąd: %1\$s" + ::msgcat::mcset pl "E&xit" "&Wyjdź" ::msgcat::mcset pl "&File" "&Plik" - ::msgcat::mcset pl "File \"%1\$s\" already exists.\nDo you want to overwrite it?" "Plik \"%1\$s\" ju\u017c istnieje.\nCzy chcesz go nadpisa\u0107?" - ::msgcat::mcset pl "File \"%1\$s\" already exists.\n\n" "Plik \"%1\$s\" ju\u017c istnieje.\n\n" + ::msgcat::mcset pl "File \"%1\$s\" already exists.\nDo you want to overwrite it?" "Plik \"%1\$s\" już istnieje.\nCzy chcesz go nadpisać?" + ::msgcat::mcset pl "File \"%1\$s\" already exists.\n\n" "Plik \"%1\$s\" już istnieje.\n\n" ::msgcat::mcset pl "File \"%1\$s\" does not exist." "Plik \"%1\$s\" nie istnieje." ::msgcat::mcset pl "File &name:" "Nazwa &pliku:" - ::msgcat::mcset pl "File &names:" "Nazwy &plik\u00f3w:" + ::msgcat::mcset pl "File &names:" "Nazwy &plików:" ::msgcat::mcset pl "Files of &type:" "Pliki &typu:" ::msgcat::mcset pl "Fi&les:" "Pli&ki:" ::msgcat::mcset pl "&Filter" "&Filtr" @@ -41,41 +41,41 @@ namespace eval ::tk { ::msgcat::mcset pl "&Green" "&Zielony" ::msgcat::mcset pl "&Help" "&Pomoc" ::msgcat::mcset pl "Hi" "Witaj" - ::msgcat::mcset pl "&Hide Console" "&Ukryj konsol\u0119" + ::msgcat::mcset pl "&Hide Console" "&Ukryj konsolę" ::msgcat::mcset pl "&Ignore" "&Ignoruj" - ::msgcat::mcset pl "Invalid file name \"%1\$s\"." "Niew\u0142a\u015bciwa nazwa pliku \"%1\$s\"." + ::msgcat::mcset pl "Invalid file name \"%1\$s\"." "Niewłaściwa nazwa pliku \"%1\$s\"." ::msgcat::mcset pl "Italic" "Kursywa" ::msgcat::mcset pl "Log Files" "Pliki dziennika" ::msgcat::mcset pl "&No" "&Nie" ::msgcat::mcset pl "&OK" ::msgcat::mcset pl "OK" ::msgcat::mcset pl "Ok" - ::msgcat::mcset pl "Open" "Otw\u00f3rz" - ::msgcat::mcset pl "&Open" "&Otw\u00f3rz" - ::msgcat::mcset pl "Open Multiple Files" "Otw\u00f3rz wiele plik\u00f3w" + ::msgcat::mcset pl "Open" "Otwórz" + ::msgcat::mcset pl "&Open" "&Otwórz" + ::msgcat::mcset pl "Open Multiple Files" "Otwórz wiele plików" ::msgcat::mcset pl "P&aste" "&Wklej" - ::msgcat::mcset pl "&Quit" "&Zako\u0144cz" + ::msgcat::mcset pl "&Quit" "&Zakończ" ::msgcat::mcset pl "&Red" "&Czerwony" ::msgcat::mcset pl "Regular" "Regularne" - ::msgcat::mcset pl "Replace existing file?" "Czy zast\u0105pi\u0107 istniej\u0105cy plik?" - ::msgcat::mcset pl "&Retry" "&Pon\u00f3w" - ::msgcat::mcset pl "Sample" "Przyk\u0142ad" + ::msgcat::mcset pl "Replace existing file?" "Czy zastąpić istniejący plik?" + ::msgcat::mcset pl "&Retry" "&Ponów" + ::msgcat::mcset pl "Sample" "Przykład" ::msgcat::mcset pl "&Save" "&Zapisz" ::msgcat::mcset pl "Save As" "Zapisz jako" ::msgcat::mcset pl "Save To Log" "Wpisz do dziennika" ::msgcat::mcset pl "Select Log File" "Wybierz plik dziennika" ::msgcat::mcset pl "Select a file to source" "Wybierz plik do wykonania" - ::msgcat::mcset pl "&Selection:" "&Wyb\u00f3r:" + ::msgcat::mcset pl "&Selection:" "&Wybór:" ::msgcat::mcset pl "&Size:" "&Rozmiar:" - ::msgcat::mcset pl "Show &Hidden Directories" "Poka\u017c &ukryte katalogi" - ::msgcat::mcset pl "Show &Hidden Files and Directories" "Poka\u017c &ukryte pliki i katalogi" - ::msgcat::mcset pl "Skip Messages" "Pomi\u0144 pozosta\u0142e komunikaty" - ::msgcat::mcset pl "&Source..." "&Kod \u017ar\u00f3d\u0142owy..." - ::msgcat::mcset pl "Stri&keout" "&Przekre\u015blenie" + ::msgcat::mcset pl "Show &Hidden Directories" "Pokaż &ukryte katalogi" + ::msgcat::mcset pl "Show &Hidden Files and Directories" "Pokaż &ukryte pliki i katalogi" + ::msgcat::mcset pl "Skip Messages" "Pomiń pozostałe komunikaty" + ::msgcat::mcset pl "&Source..." "&Kod źródłowy..." + ::msgcat::mcset pl "Stri&keout" "&Przekreślenie" ::msgcat::mcset pl "Tcl Scripts" "Skrypty Tcl" ::msgcat::mcset pl "Tcl for Windows" "Tcl dla Windows" ::msgcat::mcset pl "Text Files" "Pliki tekstowe" - ::msgcat::mcset pl "&Underline" "Po&dkre\u015blenie" + ::msgcat::mcset pl "&Underline" "Po&dkreślenie" ::msgcat::mcset pl "&Yes" "&Tak" ::msgcat::mcset pl "abort" "przerwij" ::msgcat::mcset pl "blue" "niebieski" @@ -86,6 +86,24 @@ namespace eval ::tk { ::msgcat::mcset pl "ignore" "ignoruj" ::msgcat::mcset pl "ok" ::msgcat::mcset pl "red" "czerwony" - ::msgcat::mcset pl "retry" "pon\u00f3w" + ::msgcat::mcset pl "retry" "ponów" ::msgcat::mcset pl "yes" "tak" } +#localization of print terms by Kevin Walzer via Microsoft Translator +namespace eval ::tk { + ::msgcat::mcset pl "Print" "Drukować" + ::msgcat::mcset pl "Printer" "Drukarka" + ::msgcat::mcset pl "Letter " "Litera" + ::msgcat::mcset pl "Legal " "Legalny" + ::msgcat::mcset pl "A4" "A4" + ::msgcat::mcset pl "Grayscale" "Skala Szarości" + ::msgcat::mcset pl "RGB" "Rgb" + ::msgcat::mcset pl "Options" "Opcje" + ::msgcat::mcset pl "Copies" "Kopie" + ::msgcat::mcset pl "Paper" "Papier" + ::msgcat::mcset pl "Scale" "Skala" + ::msgcat::mcset pl "Orientation" "Orientacja" + ::msgcat::mcset pl "Portrait" "Portret" + ::msgcat::mcset pl "Landscape" "Krajobraz" + ::msgcat::mcset pl "Output" "Produkt Wyjściowy" +}
\ No newline at end of file diff --git a/library/msgs/pt.msg b/library/msgs/pt.msg index c29e293..cbfc634 100644 --- a/library/msgs/pt.msg +++ b/library/msgs/pt.msg @@ -2,12 +2,12 @@ namespace eval ::tk { ::msgcat::mcset pt "&Abort" "&Abortar" ::msgcat::mcset pt "About..." "Sobre ..." ::msgcat::mcset pt "All Files" "Todos os arquivos" - ::msgcat::mcset pt "Application Error" "Erro de aplica\u00e7\u00e3o" + ::msgcat::mcset pt "Application Error" "Erro de aplicação" ::msgcat::mcset pt "&Blue" "&Azul" ::msgcat::mcset pt "Cancel" "Cancelar" ::msgcat::mcset pt "&Cancel" "&Cancelar" - ::msgcat::mcset pt "Cannot change to the directory \"%1\$s\".\nPermission denied." "N\u00e3o foi poss\u00edvel mudar para o diret\u00f3rio \"%1\$s\".\nPermiss\u00e3o negada." - ::msgcat::mcset pt "Choose Directory" "Escolha um diret\u00f3rio" + ::msgcat::mcset pt "Cannot change to the directory \"%1\$s\".\nPermission denied." "Não foi possível mudar para o diretório \"%1\$s\".\nPermissão negada." + ::msgcat::mcset pt "Choose Directory" "Escolha um diretório" ::msgcat::mcset pt "Cl&ear" "Apagar" ::msgcat::mcset pt "&Clear Console" "Apagar Console" ::msgcat::mcset pt "Color" "Cor" @@ -16,14 +16,14 @@ namespace eval ::tk { ::msgcat::mcset pt "Cu&t" "Recortar" ::msgcat::mcset pt "&Delete" "Excluir" ::msgcat::mcset pt "Details >>" "Detalhes >>" - ::msgcat::mcset pt "Directory \"%1\$s\" does not exist." "O diret\u00f3rio \"%1\$s\" n\u00e3o existe." - ::msgcat::mcset pt "&Directory:" "&Diret\u00f3rio:" + ::msgcat::mcset pt "Directory \"%1\$s\" does not exist." "O diretório \"%1\$s\" não existe." + ::msgcat::mcset pt "&Directory:" "&Diretório:" ::msgcat::mcset pt "Error: %1\$s" "Erro: %1\$s" ::msgcat::mcset pt "E&xit" "Sair" ::msgcat::mcset pt "&File" "Arquivo" - ::msgcat::mcset pt "File \"%1\$s\" already exists.\nDo you want to overwrite it?" "O arquivo \"%1\$s\" j\u00e1 existe.\nDeseja sobrescreve-lo?" - ::msgcat::mcset pt "File \"%1\$s\" already exists.\n\n" "O arquivo \"%1\$s\" j\u00e1 existe.\n\n" - ::msgcat::mcset pt "File \"%1\$s\" does not exist." "Arquivo \"%1\$s\" n\u00e3o existe." + ::msgcat::mcset pt "File \"%1\$s\" already exists.\nDo you want to overwrite it?" "O arquivo \"%1\$s\" já existe.\nDeseja sobrescreve-lo?" + ::msgcat::mcset pt "File \"%1\$s\" already exists.\n\n" "O arquivo \"%1\$s\" já existe.\n\n" + ::msgcat::mcset pt "File \"%1\$s\" does not exist." "Arquivo \"%1\$s\" não existe." ::msgcat::mcset pt "File &name:" "&Nome do arquivo:" ::msgcat::mcset pt "File &names:" "&Nomes dos arquivos:" ::msgcat::mcset pt "Files of &type:" "Arquivos do &tipo:" @@ -34,15 +34,15 @@ namespace eval ::tk { ::msgcat::mcset pt "Hi" "Oi" ::msgcat::mcset pt "&Hide Console" "Ocultar console" ::msgcat::mcset pt "&Ignore" "&Ignorar" - ::msgcat::mcset pt "Invalid file name \"%1\$s\"." "O nome do arquivo \u00e9 inv\u00e1lido \"%1\$s\"." + ::msgcat::mcset pt "Invalid file name \"%1\$s\"." "O nome do arquivo é inválido \"%1\$s\"." ::msgcat::mcset pt "Log Files" "Arquivos de log" - ::msgcat::mcset pt "&No" "&N\u00e3o" + ::msgcat::mcset pt "&No" "&Não" ::msgcat::mcset pt "&OK" ::msgcat::mcset pt "OK" ::msgcat::mcset pt "Ok" ::msgcat::mcset pt "Open" "Abrir" ::msgcat::mcset pt "&Open" "&Abrir" - ::msgcat::mcset pt "Open Multiple Files" "Abrir m\u00faltiplos arquivos" + ::msgcat::mcset pt "Open Multiple Files" "Abrir múltiplos arquivos" ::msgcat::mcset pt "P&aste" "Col&ar" ::msgcat::mcset pt "Quit" "Encerrar" ::msgcat::mcset pt "&Red" "&Vermelho" @@ -53,7 +53,7 @@ namespace eval ::tk { ::msgcat::mcset pt "Save To Log" "Salvar arquivo de log" ::msgcat::mcset pt "Select Log File" "Selecionar arquivo de log" ::msgcat::mcset pt "Select a file to source" "Selecione um arquivo como fonte" - ::msgcat::mcset pt "&Selection:" "&Sele\u00e7\u00e3o:" + ::msgcat::mcset pt "&Selection:" "&Seleção:" ::msgcat::mcset pt "Skip Messages" "Omitir as mensagens" ::msgcat::mcset pt "&Source..." "&Fonte..." ::msgcat::mcset pt "Tcl Scripts" "Scripts Tcl" @@ -63,8 +63,8 @@ namespace eval ::tk { ::msgcat::mcset pt "abort" "abortar" ::msgcat::mcset pt "blue" "azul" ::msgcat::mcset pt "cancel" "cancelar" - ::msgcat::mcset pt "extension" "extens\u00e3o" - ::msgcat::mcset pt "extensions" "extens\u00f5es" + ::msgcat::mcset pt "extension" "extensão" + ::msgcat::mcset pt "extensions" "extensões" ::msgcat::mcset pt "green" "verde" ::msgcat::mcset pt "ignore" "ignorar" ::msgcat::mcset pt "ok" @@ -72,3 +72,21 @@ namespace eval ::tk { ::msgcat::mcset pt "retry" "tentar novamente" ::msgcat::mcset pt "yes" "sim" } +#localization of print terms by Kevin Walzer via Microsoft Translator +namespace eval ::tk { + ::msgcat::mcset pt "Print" "Imprimir" + ::msgcat::mcset pt "Printer" "Impressora" + ::msgcat::mcset pt "Letter " "Letra" + ::msgcat::mcset pt "Legal " "Legal" + ::msgcat::mcset pt "A4" "A4" + ::msgcat::mcset pt "Grayscale" "Escala De Cinza" + ::msgcat::mcset pt "RGB" "Rgb" + ::msgcat::mcset pt "Options" "Opções" + ::msgcat::mcset pt "Copies" "Exemplares" + ::msgcat::mcset pt "Paper" "Papel" + ::msgcat::mcset pt "Scale" "Escala" + ::msgcat::mcset pt "Orientation" "Orientação" + ::msgcat::mcset pt "Portrait" "Retrato" + ::msgcat::mcset pt "Landscape" "Paisagem" + ::msgcat::mcset pt "Output" "Saída" +}
\ No newline at end of file diff --git a/library/msgs/ru.msg b/library/msgs/ru.msg index d7ad8b1..91a9d00 100644 --- a/library/msgs/ru.msg +++ b/library/msgs/ru.msg @@ -1,93 +1,112 @@ namespace eval ::tk { - ::msgcat::mcset ru "&Abort" "&\u041e\u0442\u043c\u0435\u043d\u0438\u0442\u044c" - ::msgcat::mcset ru "&About..." "\u041f\u0440\u043e..." - ::msgcat::mcset ru "All Files" "\u0412\u0441\u0435 \u0444\u0430\u0439\u043b\u044b" - ::msgcat::mcset ru "Application Error" "\u041e\u0448\u0438\u0431\u043a\u0430 \u0432 \u043f\u0440\u043e\u0433\u0440\u0430\u043c\u043c\u0435" - ::msgcat::mcset ru "&Apply" "&\u041f\u0440\u0438\u043c\u0435\u043d\u0438\u0442\u044c" + ::msgcat::mcset ru "&Abort" "&Отменить" + ::msgcat::mcset ru "&About..." "Про..." + ::msgcat::mcset ru "All Files" "Все файлы" + ::msgcat::mcset ru "Application Error" "Ошибка в программе" + ::msgcat::mcset ru "&Apply" "&Применить" ::msgcat::mcset ru "Bold" "Bold" ::msgcat::mcset ru "Bold Italic" "Bold Italic" - ::msgcat::mcset ru "&Blue" " &\u0413\u043e\u043b\u0443\u0431\u043e\u0439" - ::msgcat::mcset ru "Cancel" "\u041e\u0442\u043c\u0435\u043d\u0430" - ::msgcat::mcset ru "&Cancel" "\u041e\u0442&\u043c\u0435\u043d\u0430" + ::msgcat::mcset ru "&Blue" " &Голубой" + ::msgcat::mcset ru "Cancel" "Отмена" + ::msgcat::mcset ru "&Cancel" "От&мена" ::msgcat::mcset ru "Cannot change to the directory \"%1\$s\".\nPermission denied." \ - "\u041d\u0435 \u043c\u043e\u0433\u0443 \u043f\u0435\u0440\u0435\u0439\u0442\u0438 \u0432 \u043a\u0430\u0442\u0430\u043b\u043e\u0433 \"%1\$s\".\n\u041d\u0435\u0434\u043e\u0441\u0442\u0430\u0442\u043e\u0447\u043d\u043e \u043f\u0440\u0430\u0432 \u0434\u043e\u0441\u0442\u0443\u043f\u0430" - ::msgcat::mcset ru "Choose Directory" "\u0412\u044b\u0431\u0435\u0440\u0438\u0442\u0435 \u043a\u0430\u0442\u0430\u043b\u043e\u0433" - ::msgcat::mcset ru "Cl&ear" "\u041e\u0447\u0438\u0441\u0442\u0438\u0442\u044c" + "Не могу перейти в каталог \"%1\$s\".\nНедостаточно прав доступа" + ::msgcat::mcset ru "Choose Directory" "Выберите каталог" + ::msgcat::mcset ru "Cl&ear" "Очистить" ::msgcat::mcset ru "&Clear Console" "&Clear Console" - ::msgcat::mcset ru "Color" "\u0426\u0432\u0435\u0442" - ::msgcat::mcset ru "Console" "\u041a\u043e\u043d\u0441\u043e\u043b\u044c" - ::msgcat::mcset ru "&Copy" "\u041a\u043e\u043f\u0438\u0440\u043e\u0432\u0430\u0442\u044c" - ::msgcat::mcset ru "Cu&t" "\u0412\u044b\u0440\u0435\u0437\u0430\u0442\u044c" - ::msgcat::mcset ru "&Delete" "\u0423\u0434\u0430\u043b\u0438\u0442\u044c" - ::msgcat::mcset ru "Details >>" "\u041f\u043e\u0434\u0440\u043e\u0431\u043d\u0435\u0435 >>" - ::msgcat::mcset ru "Directory \"%1\$s\" does not exist." "\u041a\u0430\u0442\u0430\u043b\u043e\u0433\u0430 \"%1\$s\" \u043d\u0435 \u0441\u0443\u0449\u0435\u0441\u0442\u0432\u0443\u0435\u0442." - ::msgcat::mcset ru "&Directory:" "&\u041a\u0430\u0442\u0430\u043b\u043e\u0433:" + ::msgcat::mcset ru "Color" "Цвет" + ::msgcat::mcset ru "Console" "Консоль" + ::msgcat::mcset ru "&Copy" "Копировать" + ::msgcat::mcset ru "Cu&t" "Вырезать" + ::msgcat::mcset ru "&Delete" "Удалить" + ::msgcat::mcset ru "Details >>" "Подробнее >>" + ::msgcat::mcset ru "Directory \"%1\$s\" does not exist." "Каталога \"%1\$s\" не существует." + ::msgcat::mcset ru "&Directory:" "&Каталог:" ::msgcat::mcset ru "&Edit" "&Edit" - ::msgcat::mcset ru "Effects" "\u042d\u0444\u0444\u0435\u043a\u0442\u044b" - ::msgcat::mcset ru "Error: %1\$s" "\u041e\u0448\u0438\u0431\u043a\u0430: %1\$s" - ::msgcat::mcset ru "E&xit" "\u0412\u044b\u0445\u043e\u0434" + ::msgcat::mcset ru "Effects" "Эффекты" + ::msgcat::mcset ru "Error: %1\$s" "Ошибка: %1\$s" + ::msgcat::mcset ru "E&xit" "Выход" ::msgcat::mcset ru "&File" "&File" ::msgcat::mcset ru "File \"%1\$s\" already exists.\nDo you want to overwrite it?" \ - "\u0424\u0430\u0439\u043b \"%1\$s\" \u0443\u0436\u0435 \u0441\u0443\u0449\u0435\u0441\u0442\u0432\u0443\u0435\u0442.\n\u0417\u0430\u043c\u0435\u043d\u0438\u0442\u044c \u0435\u0433\u043e?" - ::msgcat::mcset ru "File \"%1\$s\" already exists.\n\n" "\u0424\u0430\u0439\u043b \"%1\$s\" \u0443\u0436\u0435 \u0441\u0443\u0449\u0435\u0441\u0442\u0432\u0443\u0435\u0442.\n\n" - ::msgcat::mcset ru "File \"%1\$s\" does not exist." "\u0424\u0430\u0439\u043b \"%1\$s\" \u043d\u0435 \u043d\u0430\u0439\u0434\u0435\u043d." - ::msgcat::mcset ru "File &name:" "&\u0418\u043c\u044f \u0444\u0430\u0439\u043b\u0430:" - ::msgcat::mcset ru "File &names:" "&\u0418\u043c\u0435\u043d\u0430 \u0444\u0430\u0439\u043b\u043e\u0432:" - ::msgcat::mcset ru "Files of &type:" "&\u0422\u0438\u043f \u0444\u0430\u0439\u043b\u043e\u0432:" - ::msgcat::mcset ru "Fi&les:" "\u0424\u0430\u0439&\u043b\u044b:" - ::msgcat::mcset ru "&Filter" "&\u0424\u0438\u043b\u044c\u0442\u0440" - ::msgcat::mcset ru "Fil&ter:" "\u0424\u0438\u043b\u044c&\u0442\u0440:" - ::msgcat::mcset ru "Font" "\u0428\u0440\u0438\u0444\u0442" - ::msgcat::mcset ru "&Font:" "&\u0428\u0440\u0438\u0444\u0442" - ::msgcat::mcset ru "Font st&yle:" "&\u0421\u0442\u0438\u043b\u044c \u0448\u0440\u0438\u0444\u0442\u0430:" - ::msgcat::mcset ru "&Green" " &\u0417\u0435\u043b\u0435\u043d\u044b\u0439" + "Файл \"%1\$s\" уже существует.\nЗаменить его?" + ::msgcat::mcset ru "File \"%1\$s\" already exists.\n\n" "Файл \"%1\$s\" уже существует.\n\n" + ::msgcat::mcset ru "File \"%1\$s\" does not exist." "Файл \"%1\$s\" не найден." + ::msgcat::mcset ru "File &name:" "&Имя файла:" + ::msgcat::mcset ru "File &names:" "&Имена файлов:" + ::msgcat::mcset ru "Files of &type:" "&Тип файлов:" + ::msgcat::mcset ru "Fi&les:" "Фай&лы:" + ::msgcat::mcset ru "&Filter" "&Фильтр" + ::msgcat::mcset ru "Fil&ter:" "Филь&тр:" + ::msgcat::mcset ru "Font" "Шрифт" + ::msgcat::mcset ru "&Font:" "&Шрифт" + ::msgcat::mcset ru "Font st&yle:" "&Стиль шрифта:" + ::msgcat::mcset ru "&Green" " &Зеленый" ::msgcat::mcset ru "&Help" "&Help" - ::msgcat::mcset ru "Hi" "\u041f\u0440\u0438\u0432\u0435\u0442" - ::msgcat::mcset ru "&Hide Console" "\u0421\u043f\u0440\u044f\u0442\u0430\u0442\u044c \u043a\u043e\u043d\u0441\u043e\u043b\u044c" - ::msgcat::mcset ru "&Ignore" "&\u0418\u0433\u043d\u043e\u0440\u0438\u0440\u043e\u0432\u0430\u0442\u044c" - ::msgcat::mcset ru "Invalid file name \"%1\$s\"." "\u041d\u0435\u0432\u0435\u0440\u043d\u043e\u0435 \u0438\u043c\u044f \u0444\u0430\u0439\u043b\u0430 \"%1\$s\"." + ::msgcat::mcset ru "Hi" "Привет" + ::msgcat::mcset ru "&Hide Console" "Спрятать консоль" + ::msgcat::mcset ru "&Ignore" "&Игнорировать" + ::msgcat::mcset ru "Invalid file name \"%1\$s\"." "Неверное имя файла \"%1\$s\"." ::msgcat::mcset ru "Italic" "Italic" - ::msgcat::mcset ru "Log Files" "\u0424\u0430\u0439\u043b\u044b \u0436\u0443\u0440\u043d\u0430\u043b\u0430" - ::msgcat::mcset ru "&No" "&\u041d\u0435\u0442" - ::msgcat::mcset ru "&OK" "&\u041e\u041a" - ::msgcat::mcset ru "OK" "\u041e\u041a" - ::msgcat::mcset ru "Ok" "\u0414\u0430" - ::msgcat::mcset ru "Open" "\u041e\u0442\u043a\u0440\u044b\u0442\u044c" - ::msgcat::mcset ru "&Open" "&\u041e\u0442\u043a\u0440\u044b\u0442\u044c" - ::msgcat::mcset ru "Open Multiple Files" "\u041e\u0442\u043a\u0440\u044b\u0442\u044c \u043d\u0435\u0441\u043a\u043e\u043b\u044c\u043a\u043e \u0444\u0430\u0439\u043b\u043e\u0432" - ::msgcat::mcset ru "P&aste" "\u0412\u0441\u0442\u0430\u0432\u0438\u0442\u044c" - ::msgcat::mcset ru "&Quit" "\u0412\u044b\u0445\u043e\u0434" - ::msgcat::mcset ru "&Red" " &\u041a\u0440\u0430\u0441\u043d\u044b\u0439" + ::msgcat::mcset ru "Log Files" "Файлы журнала" + ::msgcat::mcset ru "&No" "&Нет" + ::msgcat::mcset ru "&OK" "&ОК" + ::msgcat::mcset ru "OK" "ОК" + ::msgcat::mcset ru "Ok" "Да" + ::msgcat::mcset ru "Open" "Открыть" + ::msgcat::mcset ru "&Open" "&Открыть" + ::msgcat::mcset ru "Open Multiple Files" "Открыть несколько файлов" + ::msgcat::mcset ru "P&aste" "Вставить" + ::msgcat::mcset ru "&Quit" "Выход" + ::msgcat::mcset ru "&Red" " &Красный" + ::msgcat::mcset ru "Replace existing file?" "Заменить существующий файл?" ::msgcat::mcset ru "Regular" "Regular" - ::msgcat::mcset ru "Replace existing file?" "\u0417\u0430\u043c\u0435\u043d\u0438\u0442\u044c \u0441\u0443\u0449\u0435\u0441\u0442\u0432\u0443\u044e\u0449\u0438\u0439 \u0444\u0430\u0439\u043b?" - ::msgcat::mcset ru "&Retry" "&\u041f\u043e\u0432\u0442\u043e\u0440\u0438\u0442\u044c" - ::msgcat::mcset ru "Sample" "\u041f\u0440\u0438\u043c\u0435\u0440" - ::msgcat::mcset ru "&Save" "&\u0421\u043e\u0445\u0440\u0430\u043d\u0438\u0442\u044c" - ::msgcat::mcset ru "Save As" "\u0421\u043e\u0445\u0440\u0430\u043d\u0438\u0442\u044c \u043a\u0430\u043a" - ::msgcat::mcset ru "Save To Log" "\u0421\u043e\u0445\u0440\u0430\u043d\u0438\u0442\u044c \u0432 \u0436\u0443\u0440\u043d\u0430\u043b" - ::msgcat::mcset ru "Select Log File" "\u0412\u044b\u0431\u0440\u0430\u0442\u044c \u0436\u0443\u0440\u043d\u0430\u043b" - ::msgcat::mcset ru "Select a file to source" "\u0412\u044b\u0431\u0435\u0440\u0438\u0442\u0435 \u0444\u0430\u0439\u043b \u0434\u043b\u044f \u0438\u043d\u0442\u0435\u0440\u043f\u0440\u0435\u0442\u0430\u0446\u0438\u0438" - ::msgcat::mcset ru "&Selection:" "&Selection:" - ::msgcat::mcset ru "&Size:" "&\u0420\u0430\u0437\u043c\u0435\u0440:" + ::msgcat::mcset ru "&Retry" "&Повторить" + ::msgcat::mcset ru "Sample" "Пример" + ::msgcat::mcset ru "&Save" "&Сохранить" + ::msgcat::mcset ru "Save As" "Сохранить как" + ::msgcat::mcset ru "Save To Log" "Сохранить в журнал" + ::msgcat::mcset ru "Select Log File" "Выбрать журнал" + ::msgcat::mcset ru "Select a file to source" "Выберите файл для интерпретации" + ::msgcat::mcset ru "&Selection:" + ::msgcat::mcset ru "&Size:" "&Размер:" ::msgcat::mcset ru "Show &Hidden Directories" "Show &Hidden Directories" ::msgcat::mcset ru "Show &Hidden Files and Directories" "Show &Hidden Files and Directories" - ::msgcat::mcset ru "Skip Messages" "\u041f\u0440\u043e\u043f\u0443\u0441\u0442\u0438\u0442\u044c \u0441\u043e\u043e\u0431\u0449\u0435\u043d\u0438\u044f" - ::msgcat::mcset ru "&Source..." "\u0418\u043d\u0442\u0435\u0440\u043f\u0440\u0435\u0442\u0438\u0440\u043e\u0432\u0430\u0442\u044c \u0444\u0430\u0439\u043b..." - ::msgcat::mcset ru "Stri&keout" "\u041f&\u0435\u0440\u0435\u0447\u0451\u0440\u043a\u043d\u0443\u0442\u044b\u0439" - ::msgcat::mcset ru "Tcl Scripts" "\u041f\u0440\u043e\u0433\u0440\u0430\u043c\u043c\u0430 \u043d\u0430 \u044f\u0437\u044b\u043a\u0435 TCL" - ::msgcat::mcset ru "Tcl for Windows" "TCL \u0434\u043b\u044f Windows" - ::msgcat::mcset ru "Text Files" "\u0422\u0435\u043a\u0441\u0442\u043e\u0432\u044b\u0435 \u0444\u0430\u0439\u043b\u044b" - ::msgcat::mcset ru "&Underline" "\u041f\u043e&\u0434\u0447\u0435\u0440\u043a\u043d\u0443\u0442\u044b\u0439" - ::msgcat::mcset ru "&Yes" "&\u0414\u0430" - ::msgcat::mcset ru "abort" "\u043e\u0442\u043c\u0435\u043d\u0430" - ::msgcat::mcset ru "blue" " \u0433\u043e\u043b\u0443\u0431\u043e\u0439" - ::msgcat::mcset ru "cancel" "\u043e\u0442\u043c\u0435\u043d\u0430" - ::msgcat::mcset ru "extension" "\u0440\u0430\u0441\u0448\u0438\u0440\u0435\u043d\u0438\u0435" - ::msgcat::mcset ru "extensions" "\u0440\u0430\u0441\u0448\u0438\u0440\u0435\u043d\u0438\u044f" - ::msgcat::mcset ru "green" " \u0437\u0435\u043b\u0435\u043d\u044b\u0439" - ::msgcat::mcset ru "ignore" "\u043f\u0440\u043e\u043f\u0443\u0441\u0442\u0438\u0442\u044c" - ::msgcat::mcset ru "ok" "\u043e\u043a" - ::msgcat::mcset ru "red" " \u043a\u0440\u0430\u0441\u043d\u044b\u0439" - ::msgcat::mcset ru "retry" "\u043f\u043e\u0432\u0442\u043e\u0440\u0438\u0442\u044c" - ::msgcat::mcset ru "yes" "\u0434\u0430" + ::msgcat::mcset ru "Skip Messages" "Пропустить сообщения" + ::msgcat::mcset ru "&Source..." "Интерпретировать файл..." + ::msgcat::mcset ru "Stri&keout" "П&еречёркнутый" + ::msgcat::mcset ru "Tcl Scripts" "Программа на языке TCL" + ::msgcat::mcset ru "Tcl for Windows" "TCL для Windows" + ::msgcat::mcset ru "Text Files" "Текстовые файлы" + ::msgcat::mcset ru "&Underline" "По&дчеркнутый" + ::msgcat::mcset ru "&Yes" "&Да" + ::msgcat::mcset ru "abort" "отмена" + ::msgcat::mcset ru "blue" " голубой" + ::msgcat::mcset ru "cancel" "отмена" + ::msgcat::mcset ru "extension" "расширение" + ::msgcat::mcset ru "extensions" "расширения" + ::msgcat::mcset ru "green" " зеленый" + ::msgcat::mcset ru "ignore" "пропустить" + ::msgcat::mcset ru "ok" "ок" + ::msgcat::mcset ru "red" " красный" + ::msgcat::mcset ru "retry" "повторить" + ::msgcat::mcset ru "yes" "да" } + +#localization of print terms by Kevin Walzer via Microsoft Translator +namespace eval ::tk { + ::msgcat::mcset ru "Print" "Печатать" + ::msgcat::mcset ru "Printer" "Принтер" + ::msgcat::mcset ru "Letter " "Письмо" + ::msgcat::mcset ru "Legal " "Законный" + ::msgcat::mcset ru "A4" "A4" + ::msgcat::mcset ru "Grayscale" "Серый Масштаб" + ::msgcat::mcset ru "RGB" "Ргб" + ::msgcat::mcset ru "Options" "Параметры" + ::msgcat::mcset ru "Copies" "Копии" + ::msgcat::mcset ru "Paper" "Бумага" + ::msgcat::mcset ru "Scale" "Шкала" + ::msgcat::mcset ru "Orientation" "Ориентация" + ::msgcat::mcset ru "Portrait" "Портрет" + ::msgcat::mcset ru "Landscape" "Ландшафт" + ::msgcat::mcset ru "Output" "Выпуск" +}
\ No newline at end of file diff --git a/library/msgs/sv.msg b/library/msgs/sv.msg index 62bfcbd..c49e01f 100644 --- a/library/msgs/sv.msg +++ b/library/msgs/sv.msg @@ -3,14 +3,14 @@ namespace eval ::tk { ::msgcat::mcset sv "&About..." "&Om..." ::msgcat::mcset sv "All Files" "Samtliga filer" ::msgcat::mcset sv "Application Error" "Programfel" - ::msgcat::mcset sv "&Blue" "&Bl\u00e5" + ::msgcat::mcset sv "&Blue" "&Blå" ::msgcat::mcset sv "Cancel" "Avbryt" ::msgcat::mcset sv "&Cancel" "&Avbryt" - ::msgcat::mcset sv "Cannot change to the directory \"%1\$s\".\nPermission denied." "Kan ej n\u00e5 mappen \"%1\$s\".\nSaknar r\u00e4ttigheter." - ::msgcat::mcset sv "Choose Directory" "V\u00e4lj mapp" + ::msgcat::mcset sv "Cannot change to the directory \"%1\$s\".\nPermission denied." "Kan ej nå mappen \"%1\$s\".\nSaknar rättigheter." + ::msgcat::mcset sv "Choose Directory" "Välj mapp" ::msgcat::mcset sv "Cl&ear" "&Radera" ::msgcat::mcset sv "&Clear Console" "&Radera konsollen" - ::msgcat::mcset sv "Color" "F\u00e4rg" + ::msgcat::mcset sv "Color" "Färg" ::msgcat::mcset sv "Console" "Konsoll" ::msgcat::mcset sv "&Copy" "&Kopiera" ::msgcat::mcset sv "Cu&t" "Klipp u&t" @@ -22,7 +22,7 @@ namespace eval ::tk { ::msgcat::mcset sv "Error: %1\$s" "Fel: %1\$s" ::msgcat::mcset sv "E&xit" "&Avsluta" ::msgcat::mcset sv "&File" "&Fil" - ::msgcat::mcset sv "File \"%1\$s\" already exists.\nDo you want to overwrite it?" "Filen \"%1\$s\" finns redan.\nVill du skriva \u00f6ver den?" + ::msgcat::mcset sv "File \"%1\$s\" already exists.\nDo you want to overwrite it?" "Filen \"%1\$s\" finns redan.\nVill du skriva över den?" ::msgcat::mcset sv "File \"%1\$s\" already exists.\n\n" "Filen \"%1\$s\" finns redan.\n\n" ::msgcat::mcset sv "File \"%1\$s\" does not exist." "Filen \"%1\$s\" finns ej." ::msgcat::mcset sv "File &name:" "Fil&namn:" @@ -31,10 +31,10 @@ namespace eval ::tk { ::msgcat::mcset sv "Fi&les:" "Fi&ler:" ::msgcat::mcset sv "&Filter" ::msgcat::mcset sv "Fil&ter:" - ::msgcat::mcset sv "&Green" "&Gr\u00f6n" - ::msgcat::mcset sv "&Help" "&Hj\u00e4lp" + ::msgcat::mcset sv "&Green" "&Grön" + ::msgcat::mcset sv "&Help" "&Hjälp" ::msgcat::mcset sv "Hi" "Hej" - ::msgcat::mcset sv "&Hide Console" "&G\u00f6m konsollen" + ::msgcat::mcset sv "&Hide Console" "&Göm konsollen" ::msgcat::mcset sv "&Ignore" "&Ignorera" ::msgcat::mcset sv "Invalid file name \"%1\$s\"." "Ogiltigt filnamn \"%1\$s\"." ::msgcat::mcset sv "Log Files" "Loggfiler" @@ -42,35 +42,53 @@ namespace eval ::tk { ::msgcat::mcset sv "&OK" ::msgcat::mcset sv "OK" ::msgcat::mcset sv "Ok" - ::msgcat::mcset sv "Open" "\u00d6ppna" - ::msgcat::mcset sv "&Open" "&\u00d6ppna" - ::msgcat::mcset sv "Open Multiple Files" "\u00d6ppna flera filer" + ::msgcat::mcset sv "Open" "Öppna" + ::msgcat::mcset sv "&Open" "&Öppna" + ::msgcat::mcset sv "Open Multiple Files" "Öppna flera filer" ::msgcat::mcset sv "P&aste" "&Klistra in" ::msgcat::mcset sv "&Quit" "&Avsluta" - ::msgcat::mcset sv "&Red" "&R\u00f6d" - ::msgcat::mcset sv "Replace existing file?" "Ers\u00e4tt existerande fil?" - ::msgcat::mcset sv "&Retry" "&F\u00f6rs\u00f6k igen" + ::msgcat::mcset sv "&Red" "&Röd" + ::msgcat::mcset sv "Replace existing file?" "Ersätt existerande fil?" + ::msgcat::mcset sv "&Retry" "&Försök igen" ::msgcat::mcset sv "&Save" "&Spara" ::msgcat::mcset sv "Save As" "Spara som" ::msgcat::mcset sv "Save To Log" "Spara till logg" - ::msgcat::mcset sv "Select Log File" "V\u00e4lj loggfil" - ::msgcat::mcset sv "Select a file to source" "V\u00e4lj k\u00e4llfil" + ::msgcat::mcset sv "Select Log File" "Välj loggfil" + ::msgcat::mcset sv "Select a file to source" "Välj källfil" ::msgcat::mcset sv "&Selection:" "&Val:" - ::msgcat::mcset sv "Skip Messages" "Hoppa \u00f6ver meddelanden" - ::msgcat::mcset sv "&Source..." "&K\u00e4lla..." + ::msgcat::mcset sv "Skip Messages" "Hoppa över meddelanden" + ::msgcat::mcset sv "&Source..." "&Källa..." ::msgcat::mcset sv "Tcl Scripts" "Tcl skript" - ::msgcat::mcset sv "Tcl for Windows" "Tcl f\u00f6r Windows" + ::msgcat::mcset sv "Tcl for Windows" "Tcl för Windows" ::msgcat::mcset sv "Text Files" "Textfiler" ::msgcat::mcset sv "&Yes" "&Ja" ::msgcat::mcset sv "abort" "avbryt" - ::msgcat::mcset sv "blue" "bl\u00e5" + ::msgcat::mcset sv "blue" "blå" ::msgcat::mcset sv "cancel" "avbryt" ::msgcat::mcset sv "extension" "utvidgning" ::msgcat::mcset sv "extensions" "utvidgningar" - ::msgcat::mcset sv "green" "gr\u00f6n" + ::msgcat::mcset sv "green" "grön" ::msgcat::mcset sv "ignore" "ignorera" ::msgcat::mcset sv "ok" - ::msgcat::mcset sv "red" "r\u00f6d" - ::msgcat::mcset sv "retry" "f\u00f6rs\u00f6k igen" + ::msgcat::mcset sv "red" "röd" + ::msgcat::mcset sv "retry" "försök igen" ::msgcat::mcset sv "yes" "ja" } +#localization of print terms by Kevin Walzer via Microsoft Translator +namespace eval ::tk { + ::msgcat::mcset sv "Print" "Trycka" + ::msgcat::mcset sv "Printer" "Skrivare" + ::msgcat::mcset sv "Letter " "Brev" + ::msgcat::mcset sv "Legal " "Laglig" + ::msgcat::mcset sv "A4" "A4 (På 199" + ::msgcat::mcset sv "Grayscale" "Gråskala" + ::msgcat::mcset sv "RGB" "Rgb" + ::msgcat::mcset sv "Options" "Alternativ" + ::msgcat::mcset sv "Copies" "Kopior" + ::msgcat::mcset sv "Paper" "Papper" + ::msgcat::mcset sv "Scale" "Skala" + ::msgcat::mcset sv "Orientation" "Orientering" + ::msgcat::mcset sv "Portrait" "Porträtt" + ::msgcat::mcset sv "Landscape" "Landskap" + ::msgcat::mcset sv "Output" "Utdata" +}
\ No newline at end of file diff --git a/library/msgs/zh_cn.msg b/library/msgs/zh_cn.msg index 9a728b7..b699b67 100644 --- a/library/msgs/zh_cn.msg +++ b/library/msgs/zh_cn.msg @@ -90,3 +90,21 @@ namespace eval ::tk { ::msgcat::mcset zh_cn "yes" "确认" } +#Kevin Walzer通过微软翻译对打印内容进行本地化 localization of print terms by Kevin Walzer via Microsoft Translator +namespace eval ::tk { + ::msgcat::mcset zh_cn "Print" "输出" + ::msgcat::mcset zh_cn "Printer" "输出器" + ::msgcat::mcset zh_cn "Letter " "信 " + ::msgcat::mcset zh_cn "Legal " "合法的 " + ::msgcat::mcset zh_cn "A4" "A4" + ::msgcat::mcset zh_cn "Grayscale" "灰度" + ::msgcat::mcset zh_cn "RGB" "RGB" + ::msgcat::mcset zh_cn "Options" "设置" + ::msgcat::mcset zh_cn "Copies" "复制" + ::msgcat::mcset zh_cn "Paper" "纸" + ::msgcat::mcset zh_cn "Scale" "规模" + ::msgcat::mcset zh_cn "Orientation" "方向" + ::msgcat::mcset zh_cn "Portrait" "竖向" + ::msgcat::mcset zh_cn "Landscape" "横向" + ::msgcat::mcset zh_cn "Output" "输出" +}
\ No newline at end of file diff --git a/library/obsolete.tcl b/library/obsolete.tcl index 3ee7f28..a31884d 100644 --- a/library/obsolete.tcl +++ b/library/obsolete.tcl @@ -3,8 +3,8 @@ # This file contains obsolete procedures that people really shouldn't # be using anymore, but which are kept around for backward compatibility. # -# Copyright (c) 1994 The Regents of the University of California. -# Copyright (c) 1994 Sun Microsystems, Inc. +# Copyright © 1994 The Regents of the University of California. +# Copyright © 1994 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -103,7 +103,7 @@ proc ::tk::classic::restore_listbox {args} { option add *Listbox.selectBorderWidth 1 $prio; # 0 } # Remove focus into Listbox added for 8.5 - bind Listbox <1> { + bind Listbox <Button-1> { if {[winfo exists %W]} { tk::ListboxBeginSelect %W [%W index @%x,%y] } diff --git a/library/optMenu.tcl b/library/optMenu.tcl index 7cfdaa0..aeddc01 100644 --- a/library/optMenu.tcl +++ b/library/optMenu.tcl @@ -3,8 +3,8 @@ # This file defines the procedure tk_optionMenu, which creates # an option button and its associated menu. # -# Copyright (c) 1994 The Regents of the University of California. -# Copyright (c) 1994 Sun Microsystems, Inc. +# Copyright © 1994 The Regents of the University of California. +# Copyright © 1994 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -37,7 +37,7 @@ proc ::tk_optionMenu {w varName firstValue args} { menu $w.menu -tearoff 0 $w.menu add radiobutton -label $firstValue -variable $varName foreach i $args { - $w.menu add radiobutton -label $i -variable $varName + $w.menu add radiobutton -label $i -variable $varName } return $w.menu } diff --git a/library/palette.tcl b/library/palette.tcl index 42c6a90..8cea657 100644 --- a/library/palette.tcl +++ b/library/palette.tcl @@ -3,7 +3,7 @@ # This file contains procedures that change the color palette used # by Tk. # -# Copyright (c) 1995-1997 Sun Microsystems, Inc. +# Copyright © 1995-1997 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -71,6 +71,20 @@ proc ::tk_setPalette {args} { if {![info exists new(highlightBackground)]} { set new(highlightBackground) $new(background) } + # 'buttonBackground' is the background color of the buttons in + # the spinbox widget. + if {![info exists new(buttonBackground)]} { + set new(buttonBackground) $new(background) + } + # 'selectColor' is the background of check & radio buttons. + if {![info exists new(selectColor)]} { + foreach {r g b} $bg {break} + if {$r+1.5*$g+0.5*$b > 100000} { + set new(selectColor) white + } else { + set new(selectColor) black + } + } if {![info exists new(activeBackground)]} { # Pick a default active background that islighter than the # normal background. To do this, round each color component @@ -139,6 +153,22 @@ proc ::tk_setPalette {args} { # next time we change the options. array set ::tk::Palette [array get new] + + # Update the 'default' ttk theme with the new palette, + # and then set 'default' as the current ttk theme, + # in order to apply the new palette to the ttk widgets. + + foreach option [array names new] { + if {[info exists ttk::theme::default::colorOptionLookup($option)]} { + foreach colorName $ttk::theme::default::colorOptionLookup($option) { + set ttk::theme::default::colors($colorName) $new($option) + } + } + } + ttk::theme::default::reconfigureDefaultTheme + ttk::setTheme default + + return } # ::tk::RecolorTree -- diff --git a/library/print.tcl b/library/print.tcl new file mode 100644 index 0000000..85383c5 --- /dev/null +++ b/library/print.tcl @@ -0,0 +1,1005 @@ +# print.tcl -- + +# This file defines the 'tk print' command for printing of the canvas +# widget and text on X11, Windows, and macOS. It implements an abstraction +# layer that presents a consistent API across the three platforms. + +# Copyright © 2009 Michael I. Schwartz. +# Copyright © 2021 Kevin Walzer/WordTech Communications LLC. +# Copyright © 2021 Harald Oehlmann, Elmicron GmbH +# Copyright © 2022 Emiliano Gavilan +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. + +namespace eval ::tk::print { + namespace import -force ::tk::msgcat::* + + # makeTempFile: + # Create a temporary file and populate its contents + # Arguments: + # filename - base of the name of the file to create + # contents - what to put in the file; defaults to empty + # Returns: + # Full filename for created file + # + proc makeTempFile {filename {contents ""}} { + set f [file tempfile filename $filename] + try { + puts -nonewline $f $contents + return $filename + } finally { + close $f + } + } + + if {[tk windowingsystem] eq "win32"} { + variable printer_name + variable copies + variable dpi_x + variable dpi_y + variable paper_width + variable paper_height + variable margin_left + variable margin_top + variable printargs + array set printargs {} + + # Multiple utility procedures for printing text based on the + # C printer primitives. + + # _set_dc: + # Select printer and set device context and other parameters + # for print job. + # + proc _set_dc {} { + variable printargs + variable printer_name + variable paper_width + variable paper_height + variable dpi_x + variable dpi_y + variable copies + + #First, we select the printer. + _selectprinter + + #Next, set values. Some are taken from the printer, + #some are sane defaults. + + if {[info exists printer_name] && $printer_name ne ""} { + set printargs(hDC) $printer_name + set printargs(pw) $paper_width + set printargs(pl) $paper_height + set printargs(lm) 1000 + set printargs(tm) 1000 + set printargs(rm) 1000 + set printargs(bm) 1000 + set printargs(resx) $dpi_x + set printargs(resy) $dpi_y + set printargs(copies) $copies + set printargs(resolution) [list $dpi_x $dpi_y] + } + } + + # _print_data + # This function prints multiple-page files, using a line-oriented + # function, taking advantage of knowing the character widths. + # Arguments: + # data - Text data for printing + # breaklines - If non-zero, keep newlines in the string as + # newlines in the output. + # font - Font for printing + proc _print_data {data {breaklines 1} {font ""}} { + variable printargs + variable printer_name + + _set_dc + + if {![info exists printer_name]} { + return + } + + if {$font eq ""} { + _gdi characters $printargs(hDC) -array printcharwid + } else { + _gdi characters $printargs(hDC) -font $font -array printcharwid + } + set pagewid [expr {($printargs(pw) - $printargs(rm) ) / 1000 * $printargs(resx)}] + set pagehgt [expr {($printargs(pl) - $printargs(bm) ) / 1000 * $printargs(resy)}] + set totallen [string length $data] + set curlen 0 + set curhgt [expr {$printargs(tm) * $printargs(resy) / 1000}] + + _opendoc + _openpage + + while {$curlen < $totallen} { + set linestring [string range $data $curlen end] + if {$breaklines} { + set endind [string first "\n" $linestring] + if {$endind >= 0} { + set linestring [string range $linestring 0 $endind] + # handle blank lines.... + if {$linestring eq ""} { + set linestring " " + } + } + } + + set result [_print_page_nextline $linestring \ + printcharwid printargs $curhgt $font] + incr curlen [lindex $result 0] + incr curhgt [lindex $result 1] + if {$curhgt + [lindex $result 1] > $pagehgt} { + _closepage + _openpage + set curhgt [expr {$printargs(tm) * $printargs(resy) / 1000}] + } + } + + _closepage + _closedoc + } + + # _print_file + # This function prints multiple-page files + # It will either break lines or just let them run over the + # margins (and thus truncate). + # The font argument is JUST the font name, not any additional + # arguments. + # Arguments: + # filename - File to open for printing + # breaklines - 1 to break lines as done on input, 0 to ignore newlines + # font - Optional arguments to supply to the text command + proc _print_file {filename {breaklines 1} {font ""}} { + set fn [open $filename r] + set data [read $fn] + close $fn + _print_data $data $breaklines $font + } + + # _print_page_nextline + # Returns the pair "chars y" + # where chars is the number of characters printed on the line + # and y is the height of the line printed + # Arguments: + # string - Data to print + # pdata - Array of values for printer characteristics + # cdata - Array of values for character widths + # y - Y value to begin printing at + # font - if non-empty specifies a font to draw the line in + proc _print_page_nextline {string carray parray y font} { + upvar #0 $carray charwidths + upvar #0 $parray printargs + + variable printargs + + set endindex 0 + set totwidth 0 + set maxwidth [expr { + (($printargs(pw) - $printargs(rm)) / 1000) * $printargs(resx) + }] + set maxstring [string length $string] + set lm [expr {$printargs(lm) * $printargs(resx) / 1000}] + + for {set i 0} {($i < $maxstring) && ($totwidth < $maxwidth)} {incr i} { + incr totwidth $charwidths([string index $string $i]) + # set width($i) $totwidth + } + + set endindex $i + set startindex $endindex + + if {$i < $maxstring} { + # In this case, the whole data string is not used up, and we + # wish to break on a word. Since we have all the partial + # widths calculated, this should be easy. + + set endindex [expr {[string wordstart $string $endindex] - 1}] + set startindex [expr {$endindex + 1}] + + # If the line is just too long (no word breaks), print as much + # as you can.... + if {$endindex <= 1} { + set endindex $i + set startindex $i + } + } + + set txt [string trim [string range $string 0 $endindex] "\r\n"] + if {$font ne ""} { + set result [_gdi text $printargs(hDC) $lm $y \ + -anchor nw -justify left \ + -text $txt -font $font] + } else { + set result [_gdi text $printargs(hDC) $lm $y \ + -anchor nw -justify left -text $txt] + } + return "$startindex $result" + } + + # These procedures read in the canvas widget, and write all of + # its contents out to the Windows printer. + + variable option + variable vtgPrint + + proc _init_print_canvas {} { + variable option + variable vtgPrint + variable printargs + + set vtgPrint(printer.bg) white + } + + proc _is_win {} { + variable printargs + + return [info exist tk_patchLevel] + } + + # _print_widget + # Main procedure for printing a widget. Currently supports + # canvas widgets. Handles opening and closing of printer. + # Arguments: + # wid - The widget to be printed. + # printer - Flag whether to use the default printer. + # name - App name to pass to printer. + + proc _print_widget {wid {printer default} {name "Tk Print Output"}} { + variable printargs + variable printer_name + + _set_dc + + if {![info exists printer_name]} { + return + } + + _opendoc + _openpage + + # Here is where any scaling/gdi mapping should take place + # For now, scale so the dimensions of the window are sized to the + # width of the page. Scale evenly. + + # For normal windows, this may be fine--but for a canvas, one + # wants the canvas dimensions, and not the WINDOW dimensions. + if {[winfo class $wid] eq "Canvas"} { + set sc [$wid cget -scrollregion] + # if there is no scrollregion, use width and height. + if {$sc eq ""} { + set window_x [$wid cget -width] + set window_y [$wid cget -height] + } else { + set window_x [lindex $sc 2] + set window_y [lindex $sc 3] + } + } else { + set window_x [winfo width $wid] + set window_y [winfo height $wid] + } + + set printer_x [expr { + ( $printargs(pw) - $printargs(lm) - $printargs(rm) ) * + $printargs(resx) / 1000.0 + }] + set printer_y [expr { + ( $printargs(pl) - $printargs(tm) - $printargs(bm) ) * + $printargs(resy) / 1000.0 + }] + set factor_x [expr {$window_x / $printer_x}] + set factor_y [expr {$window_y / $printer_y}] + + if {$factor_x < $factor_y} { + set lo $window_y + set ph $printer_y + } else { + set lo $window_x + set ph $printer_x + } + + _gdi map $printargs(hDC) -logical $lo -physical $ph \ + -offset $printargs(resolution) + + # Handling of canvas widgets. + switch [winfo class $wid] { + Canvas { + _print_canvas $printargs(hDC) $wid + } + default { + puts "Can't print items of type [winfo class $wid]. No handler registered" + } + } + + # End printing process. + _closepage + _closedoc + } + + # _print_canvas + # Main procedure for writing canvas widget items to printer. + # Arguments: + # hdc - The printer handle. + # cw - The canvas widget. + proc _print_canvas {hdc cw} { + variable vtgPrint + variable printargs + + # Get information about page being printed to + # print_canvas.CalcSizing $cw + set vtgPrint(canvas.bg) [string tolower [$cw cget -background]] + + # Re-write each widget from cw to printer + foreach id [$cw find all] { + set type [$cw type $id] + if {[info commands _print_canvas.$type] eq "_print_canvas.$type"} { + _print_canvas.[$cw type $id] $printargs(hDC) $cw $id + } else { + puts "Omitting canvas item of type $type since there is no handler registered for it" + } + } + } + + # These procedures support the various canvas item types, reading the + # information about the item on the real canvas and then writing a + # similar item to the printer. + + # _print_canvas.line + # Description: + # Prints a line item. + # Arguments: + # hdc - The printer handle. + # cw - The canvas widget. + # id - The id of the canvas item. + proc _print_canvas.line {hdc cw id} { + variable vtgPrint + variable printargs + + set color [_print_canvas.TransColor [$cw itemcget $id -fill]] + if {[string match $vtgPrint(printer.bg) $color]} { + return + } + + set coords [$cw coords $id] + set wdth [$cw itemcget $id -width] + set arrow [$cw itemcget $id -arrow] + set arwshp [$cw itemcget $id -arrowshape] + set dash [$cw itemcget $id -dash] + set smooth [$cw itemcget $id -smooth] + set splinesteps [$cw itemcget $id -splinesteps] + + set cmdargs {} + + if {$wdth > 1} { + lappend cmdargs -width $wdth + } + if {$dash ne ""} { + lappend cmdargs -dash $dash + } + if {$smooth ne ""} { + lappend cmdargs -smooth $smooth + } + if {$splinesteps ne ""} { + lappend cmdargs -splinesteps $splinesteps + } + + set result [_gdi line $hdc {*}$coords \ + -fill $color -arrow $arrow -arrowshape $arwshp \ + {*}$cmdargs] + if {$result ne ""} { + puts $result + } + } + + # _print_canvas.arc + # Prints a arc item. + # Args: + # hdc - The printer handle. + # cw - The canvas widget. + # id - The id of the canvas item. + proc _print_canvas.arc {hdc cw id} { + variable vtgPrint + variable printargs + + set color [_print_canvas.TransColor [$cw itemcget $id -outline]] + if {[string match $vtgPrint(printer.bg) $color]} { + return + } + set coords [$cw coords $id] + set wdth [$cw itemcget $id -width] + set style [$cw itemcget $id -style] + set start [$cw itemcget $id -start] + set extent [$cw itemcget $id -extent] + set fill [$cw itemcget $id -fill] + + set cmdargs {} + if {$wdth > 1} { + lappend cmdargs -width $wdth + } + if {$fill ne ""} { + lappend cmdargs -fill $fill + } + + _gdi arc $hdc {*}$coords \ + -outline $color -style $style -start $start -extent $extent \ + {*}$cmdargs + } + + # _print_canvas.polygon + # Prints a polygon item. + # Arguments: + # hdc - The printer handle. + # cw - The canvas widget. + # id - The id of the canvas item. + proc _print_canvas.polygon {hdc cw id} { + variable vtgPrint + variable printargs + + set fcolor [_print_canvas.TransColor [$cw itemcget $id -fill]] + if {$fcolor eq ""} { + set fcolor $vtgPrint(printer.bg) + } + set ocolor [_print_canvas.TransColor [$cw itemcget $id -outline]] + if {$ocolor eq ""} { + set ocolor $vtgPrint(printer.bg) + } + set coords [$cw coords $id] + set wdth [$cw itemcget $id -width] + set smooth [$cw itemcget $id -smooth] + set splinesteps [$cw itemcget $id -splinesteps] + + set cmdargs {} + if {$smooth ne ""} { + lappend cmdargs -smooth $smooth + } + if {$splinesteps ne ""} { + lappend cmdargs -splinesteps $splinesteps + } + + _gdi polygon $hdc {*}$coords \ + -width $wdth -fill $fcolor -outline $ocolor {*}$cmdargs + } + + # _print_canvas.oval + # Prints an oval item. + # Arguments: + # hdc - The printer handle. + # cw - The canvas widget. + # id - The id of the canvas item. + proc _print_canvas.oval {hdc cw id} { + variable vtgPrint + + set fcolor [_print_canvas.TransColor [$cw itemcget $id -fill]] + if {$fcolor eq ""} { + set fcolor $vtgPrint(printer.bg) + } + set ocolor [_print_canvas.TransColor [$cw itemcget $id -outline]] + if {$ocolor eq ""} { + set ocolor $vtgPrint(printer.bg) + } + set coords [$cw coords $id] + set wdth [$cw itemcget $id -width] + + _gdi oval $hdc {*}$coords \ + -width $wdth -fill $fcolor -outline $ocolor + } + + # _print_canvas.rectangle + # Prints a rectangle item. + # Arguments: + # hdc - The printer handle. + # cw - The canvas widget. + # id - The id of the canvas item. + proc _print_canvas.rectangle {hdc cw id} { + variable vtgPrint + + set fcolor [_print_canvas.TransColor [$cw itemcget $id -fill]] + if {$fcolor eq ""} { + set fcolor $vtgPrint(printer.bg) + } + set ocolor [_print_canvas.TransColor [$cw itemcget $id -outline]] + if {$ocolor eq ""} { + set ocolor $vtgPrint(printer.bg) + } + set coords [$cw coords $id] + set wdth [$cw itemcget $id -width] + + _gdi rectangle $hdc {*}$coords \ + -width $wdth -fill $fcolor -outline $ocolor + } + + # _print_canvas.text + # Prints a text item. + # Arguments: + # hdc - The printer handle. + # cw - The canvas widget. + # id - The id of the canvas item. + proc _print_canvas.text {hdc cw id} { + variable vtgPrint + variable printargs + + set color [_print_canvas.TransColor [$cw itemcget $id -fill]] + # if {"white" eq [string tolower $color]} {return} + # set color black + set txt [$cw itemcget $id -text] + if {$txt eq ""} { + return + } + set coords [$cw coords $id] + set anchr [$cw itemcget $id -anchor] + + set bbox [$cw bbox $id] + set wdth [expr {[lindex $bbox 2] - [lindex $bbox 0]}] + + set just [$cw itemcget $id -justify] + + # Get the real canvas font info and create a compatible font, + # suitable for printer name extraction. + set font [font create {*}[font actual [$cw itemcget $id -font]]] + + # Just get the name and family, or some of the _gdi commands will + # fail. + set font [list [font configure $font -family] \ + -[font configure $font -size]] + + _gdi text $hdc {*}$coords \ + -fill $color -text $txt -font $font \ + -anchor $anchr -width $wdth -justify $just + } + + # _print_canvas.image + # Prints an image item. + # Arguments: + # hdc - The printer handle. + # cw - The canvas widget. + # id - The id of the canvas item. + proc _print_canvas.image {hdc cw id} { + # First, we have to get the image name. + set imagename [$cw itemcget $id -image] + + # Now we get the size. + set wid [image width $imagename] + set hgt [image height $imagename] + + # Next, we get the location and anchor + set anchor [$cw itemcget $id -anchor] + set coords [$cw coords $id] + + _gdi photo $hdc -destination $coords -photo $imagename + } + + # _print_canvas.bitmap + # Prints a bitmap item. + # Arguments: + # hdc - The printer handle. + # cw - The canvas widget. + # id - The id of the canvas item. + proc _print_canvas.bitmap {hdc cw id} { + variable option + variable vtgPrint + + # First, we have to get the bitmap name. + set imagename [$cw itemcget $id -image] + + # Now we get the size. + set wid [image width $imagename] + set hgt [image height $imagename] + + #Next, we get the location and anchor. + set anchor [$cw itemcget $id -anchor] + set coords [$cw coords $id] + + # Since the GDI commands don't yet support images and bitmaps, + # and since this represents a rendered bitmap, we CAN use + # copybits IF we create a new temporary toplevel to hold the beast. + # If this is too ugly, change the option! + + if {[info exist option(use_copybits)]} { + set firstcase $option(use_copybits) + } else { + set firstcase 0 + } + if {$firstcase > 0} { + set tl [toplevel .tmptop[expr {int( rand() * 65535 )}] \ + -height $hgt -width $wid \ + -background $vtgPrint(canvas.bg)] + canvas $tl.canvas -width $wid -height $hgt + $tl.canvas create image 0 0 -image $imagename -anchor nw + pack $tl.canvas -side left -expand false -fill none + tkwait visibility $tl.canvas + update + set srccoords [list 0 0 [expr {$wid - 1}] [expr {$hgt - 1}]] + set dstcoords [list [lindex $coords 0] [lindex $coords 1] [expr {$wid - 1}] [expr {$hgt - 1}]] + _gdi copybits $hdc -window $tl -client \ + -source $srccoords -destination $dstcoords + destroy $tl + } else { + _gdi bitmap $hdc {*}$coords \ + -anchor $anchor -bitmap $imagename + } + } + + # These procedures transform attribute setting from the real + # canvas to the appropriate setting for printing to paper. + + # _print_canvas.TransColor + # Does the actual transformation of colors from the + # canvas widget to paper. + # Arguments: + # color - The color value to be transformed. + proc _print_canvas.TransColor {color} { + variable vtgPrint + variable printargs + + switch [string toupper $color] { + $vtgPrint(canvas.bg) {return $vtgPrint(printer.bg)} + } + return $color + } + + # Initialize all the variables once. + _init_print_canvas + } + #end win32 procedures + + #begin X11 procedures + + # X11 procedures wrap standard Unix shell commands such as lp/lpr and + # lpstat for printing. Some output configuration that on other platforms + # is managed through the printer driver/dialog is configured through the + # canvas postscript command. + + if {[tk windowingsystem] eq "x11"} { + variable printcmd {} + + # print options + variable optlist + set optlist(printer) {} + set optlist(paper) [list [mc "Letter"] [mc "Legal"] [mc "A4"]] + set optlist(orient) [list [mc "Portrait"] [mc "Landscape"]] + set optlist(color) [list [mc "Grayscale"] [mc "RGB"]] + set optlist(zoom) {100 90 80 70 60 50 40 30 20 10} + + # selected options + variable sel + array set sel { + printer {} + copies {} + paper {} + orient {} + color {} + zoom {} + } + + # default values for dialog widgets + option add *Printdialog*TLabel.anchor e + option add *Printdialog*TMenubutton.Menu.tearOff 0 + option add *Printdialog*TMenubutton.width 12 + option add *Printdialog*TSpinbox.width 12 + # this is tempting to add, but it's better to leave it to user's taste + # option add *Printdialog*Menu.background snow + + # returns the full qualified var name + proc myvar {varname} { + set fqvar [uplevel 1 [list namespace which -variable $varname]] + # assert var existence + if {$fqvar eq ""} { + return -code error "Wrong varname \"$varname\"" + } + return $fqvar + } + + # ttk version of [tk_optionMenu] + # var should be a full qualified varname + proc ttk_optionMenu {w var args} { + ttk::menubutton $w \ + -textvariable $var \ + -menu $w.menu + menu $w.menu + foreach option $args { + $w.menu add command \ + -label $option \ + -command [list set $var $option] + } + # return the same value as tk_optionMenu + return $w.menu + } + + # _setprintenv + # Set the print environtment - print command, and list of printers. + # Arguments: + # none. + + proc _setprintenv {} { + variable printcmd + variable optlist + + #Test for existence of lpstat command to obtain list of printers. Return error + #if not found. + + catch {exec lpstat -a} msg + set notfound "command not found" + if {[string first $notfound $msg] >= 0} { + error "Unable to obtain list of printers. Please install the CUPS package \ + for your system." + return + } + set notfound "No destinations added" + if {[string first $notfound $msg] != -1} { + error "Please check or update your CUPS installation." + return + } + + # Select print command. We prefer lpr, but will fall back to lp if + # necessary. + if {[auto_execok lpr] ne ""} { + set printcmd lpr + } else { + set printcmd lp + } + + #Build list of printers + set printers {} + set printdata [exec lpstat -a] + foreach item [split $printdata \n] { + lappend printers [lindex [split $item] 0] + } + # filter out duplicates + set optlist(printer) [lsort -unique $printers] + } + + # _print + # Main printer dialog. Select printer, set options, and + # fire print command. + # Arguments: + # w - widget with contents to print. + # + + proc _print {w} { + # TODO: revise padding + variable optlist + variable sel + + # should this be called with every invocaton? + _setprintenv + if {$sel(printer) eq "" && [llength $optlist(printer)] > 0} { + set sel(printer) [lindex $optlist(printer) 0] + } + + set p ._print + catch {destroy $p} + + # copy the current values to a dialog's temorary variable + # this allow us to cancel the dialog discarding any changes + # made to the options + namespace eval dlg {variable sel} + array set dlg::sel [array get sel] + + # The toplevel of our dialog + toplevel $p -class Printdialog + place [ttk::frame $p.background] -x 0 -y 0 -relwidth 1.0 -relheight 1.0 + wm title $p [mc "Print"] + wm resizable $p 0 0 + wm attributes $p -type dialog + + # The printer to use + set pf [ttk::frame $p.printerf] + pack $pf -side top -fill x -expand no -padx 9p -pady 9p + + ttk::label $pf.printerl -text "[mc "Printer"] :" + ttk::combobox $pf.printer \ + -textvariable [myvar dlg::sel](printer) \ + -state readonly \ + -values $optlist(printer) + pack $pf.printerl -side left -padx {0 4.5p} + pack $pf.printer -side left + + # Start of printing options + set of [ttk::labelframe $p.optionsframe -text [mc "Options"]] + pack $of -fill x -padx 9p -pady {0 9p} -ipadx 2p -ipady 2p + + # COPIES + ttk::label $of.copiesl -text "[mc "Copies"] :" + ttk::spinbox $of.copies -from 1 -to 1000 \ + -textvariable [myvar dlg::sel](copies) + grid $of.copiesl $of.copies -sticky ew -padx 2p -pady 2p + + # PAPER SIZE + ttk::label $of.paperl -text "[mc "Paper"] :" + ttk_optionMenu $of.paper [myvar dlg::sel](paper) {*}$optlist(paper) + grid $of.paperl $of.paper -sticky ew -padx 2p -pady 2p + + # additional options for canvas output + if {[winfo class $w] eq "Canvas"} { + # SCALE + ttk::label $of.percentl -text "[mc "Scale"] :" + ttk_optionMenu $of.percent [myvar dlg::sel](zoom) {*}$optlist(zoom) + grid $of.percentl $of.percent -sticky ew -padx 2p -pady 2p + + # ORIENT + ttk::label $of.orientl -text "[mc "Orientation"] :" + ttk_optionMenu $of.orient [myvar dlg::sel](orient) {*}$optlist(orient) + grid $of.orientl $of.orient -sticky ew -padx 2p -pady 2p + + # COLOR + ttk::label $of.colorl -text "[mc "Output"] :" + ttk_optionMenu $of.color [myvar dlg::sel](color) {*}$optlist(color) + grid $of.colorl $of.color -sticky ew -padx 2p -pady 2p + } + + # The buttons frame. + set bf [ttk::frame $p.buttonf] + pack $bf -fill x -expand no -side bottom -padx 9p -pady {0 9p} + + ttk::button $bf.print -text [mc "Print"] \ + -command [namespace code [list _runprint $w $p]] + ttk::button $bf.cancel -text [mc "Cancel"] \ + -command [namespace code [list _cancel $p]] + pack $bf.print -side right + pack $bf.cancel -side right -padx {0 4.5p} + #Center the window as a dialog. + ::tk::PlaceWindow $p + } + + proc _cancel {p} { + namespace delete dlg + destroy $p + } + + # _runprint - + # Execute the print command--print the file. + # Arguments: + # w - widget with contents to print. + # + proc _runprint {w p} { + variable printcmd + variable sel + + # copy the values back from the dialog + array set sel [array get dlg::sel] + namespace delete dlg + + #First, generate print file. + if {[winfo class $w] eq "Text"} { + set file [makeTempFile tk_text.txt [$w get 1.0 end]] + } + + if {[winfo class $w] eq "Canvas"} { + if {$sel(color) eq [mc "RGB"]} { + set colormode color + } else { + set colormode gray + } + + if {$sel(orient) eq [mc "Landscape"]} { + set willrotate "1" + } else { + set willrotate "0" + } + + #Scale based on size of widget, not size of paper. + set printwidth [expr {$sel(zoom) / 100.00 * [winfo width $w]}] + set file [makeTempFile tk_canvas.ps] + $w postscript -file $file -colormode $colormode \ + -rotate $willrotate -pagewidth $printwidth + } + + #Build list of args to pass to print command. + set printargs {} + if {$printcmd eq "lpr"} { + lappend printargs -P $sel(printer) -# $sel(copies) + } else { + lappend printargs -d $sel(printer) -n $sel(copies) + } + + # launch the job in the background + after 0 [list exec $printcmd {*}$printargs -o PageSize=$sel(paper) $file] + destroy $p + } + + # Initialize with sane defaults. + set sel(copies) 1 + set sel(paper) [mc "A4"] + set sel(orient) [mc "Portrait"] + set sel(color) [mc "RGB"] + set sel(zoom) 100 + } + #end X11 procedures + + #begin macOS Aqua procedures + if {[tk windowingsystem] eq "aqua"} { + # makePDF - + # Convert a file to PDF + # Arguments: + # inFilename - file containing the data to convert; format is + # autodetected. + # outFilename - base for filename to write to; conventionally should + # have .pdf as suffix + # Returns: + # The full pathname of the generated PDF. + # + proc makePDF {inFilename outFilename} { + set out [::tk::print::makeTempFile $outFilename] + try { + exec /usr/sbin/cupsfilter $inFilename > $out + } trap NONE {msg} { + # cupsfilter produces a lot of debugging output, which we + # don't want. + regsub -all -line {^(?:DEBUG|INFO):.*$} $msg "" msg + set msg [string trimleft [regsub -all {\n+} $msg "\n"] "\n"] + if {$msg ne ""} { + # Lines should be prefixed with WARN or ERROR now + puts $msg + } + } + return $out + } + } + #end macOS Aqua procedures + + namespace export canvas text + namespace ensemble create +} + +# tk print -- +# This procedure prints the canvas and text widgets using platform- +# native API's. +# Arguments: +# w: Widget to print. +proc ::tk::print {w} { + switch [winfo class $w],[tk windowingsystem] { + "Canvas,win32" { + tailcall ::tk::print::_print_widget $w 0 "Tk Print Output" + } + "Canvas,x11" { + tailcall ::tk::print::_print $w + } + "Canvas,aqua" { + set psfile [::tk::print::makeTempFile tk_canvas.ps] + try { + $w postscript -file $psfile + set printfile [::tk::print::makePDF $psfile tk_canvas.pdf] + ::tk::print::_print $printfile + } finally { + file delete $psfile + } + } + + "Text,win32" { + tailcall ::tk::print::_print_data [$w get 1.0 end] 1 {Arial 12} + } + "Text,x11" { + tailcall ::tk::print::_print $w + } + "Text,aqua" { + set txtfile [::tk::print::makeTempFile tk_text.txt [$w get 1.0 end]] + try { + set printfile [::tk::print::makePDF $txtfile tk_text.pdf] + ::tk::print::_print $printfile + } finally { + file delete $txtfile + } + } + + default { + return -code error -errorcode {TK PRINT CLASS_UNSUPPORTED} \ + "widgets of class [winfo class $w] are not supported on\ + this platform" + } + } +} + +#Add this command to the tk command ensemble: tk print +#Thanks to Christian Gollwitzer for the guidance here +namespace ensemble configure tk -map \ + [dict merge [namespace ensemble configure tk -map] \ + {print ::tk::print}] + +return + +# Local Variables: +# mode: tcl +# fill-column: 78 +# End: diff --git a/library/safetk.tcl b/library/safetk.tcl index 9e71cc6..f3dacd7 100644 --- a/library/safetk.tcl +++ b/library/safetk.tcl @@ -2,7 +2,7 @@ # # Support procs to use Tk in safe interpreters. # -# Copyright (c) 1997 Sun Microsystems, Inc. +# Copyright © 1997 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -250,7 +250,7 @@ proc ::safe::tkTopLevel {child display} { -command [list ::safe::tkDelete $w $w $child] pack $wc.fb.b -side right -fill both pack $wc.fb -side right -fill both -expand 1 - pack $wc.l -side left -fill both -expand 1 -ipady 2 + pack $wc.l -side left -fill both -expand 1 -ipady 1.5p pack $wc -side bottom -fill x # Container frame diff --git a/library/scale.tcl b/library/scale.tcl index 466a3ce..74d6449 100644 --- a/library/scale.tcl +++ b/library/scale.tcl @@ -3,8 +3,8 @@ # This file defines the default bindings for Tk scale widgets and provides # procedures that help in implementing the bindings. # -# Copyright (c) 1994 The Regents of the University of California. -# Copyright (c) 1994-1995 Sun Microsystems, Inc. +# Copyright © 1994 The Regents of the University of California. +# Copyright © 1994-1995 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -34,7 +34,7 @@ bind Scale <Leave> { %W configure -state normal } } -bind Scale <1> { +bind Scale <Button-1> { tk::ScaleButtonDown %W %x %y } bind Scale <B1-Motion> { @@ -47,7 +47,7 @@ bind Scale <ButtonRelease-1> { tk::ScaleEndDrag %W tk::ScaleActivate %W %x %y } -bind Scale <2> { +bind Scale <Button-2> { tk::ScaleButton2Down %W %x %y } bind Scale <B2-Motion> { @@ -60,15 +60,7 @@ bind Scale <ButtonRelease-2> { tk::ScaleEndDrag %W tk::ScaleActivate %W %x %y } -if {[tk windowingsystem] eq "win32"} { - # On Windows do the same with button 3, as that is the right mouse button - bind Scale <3> [bind Scale <2>] - bind Scale <B3-Motion> [bind Scale <B2-Motion>] - bind Scale <B3-Leave> [bind Scale <B2-Leave>] - bind Scale <B3-Enter> [bind Scale <B2-Enter>] - bind Scale <ButtonRelease-3> [bind Scale <ButtonRelease-2>] -} -bind Scale <Control-1> { +bind Scale <Control-Button-1> { tk::ScaleControlPress %W %x %y } bind Scale <<PrevLine>> { diff --git a/library/scaling.tcl b/library/scaling.tcl new file mode 100644 index 0000000..092fa14 --- /dev/null +++ b/library/scaling.tcl @@ -0,0 +1,232 @@ +# scaling.tcl -- +# +# Contains scaling-related utility procedures. +# +# Copyright © 2022 Csaba Nemethi <csaba.nemethi@t-online.de> + +# ::tk::ScalingPct -- +# +# Returns the display's current scaling percentage (100, 125, 150, 175, 200, or +# a greater integer value). + +namespace eval ::tk { + namespace export ScalingPct ScaleNum +} + +proc ::tk::ScalingPct {} { + variable scalingPct + if {[info exists scalingPct]} { + return $scalingPct + } + + set pct [expr {[tk scaling] * 75}] + set origPct $pct + + set onX11 [expr {[tk windowingsystem] eq "x11"}] + set usingSDL [expr {[info exists ::tk::sdltk] && $::tk::sdltk}] + + if {$onX11 && !$usingSDL} { + # + # Try to get the window scaling factor (1 or 2), partly + # based on https://wiki.archlinux.org/title/HiDPI + # + set winScalingFactor 1 + variable fontScalingFactor 1 ;# needed in the file ttk/fonts + if {[catch {exec ps -e | grep xfce4-session}] == 0} { ;# Xfce + if {[catch {exec xfconf-query -c xsettings \ + -p /Gdk/WindowScalingFactor} result] == 0} { + set winScalingFactor $result + if {$winScalingFactor >= 2} { + set fontScalingFactor 2 + } + } + + # + # The DPI value can be set in the "Fonts" tab of the "Appearance" + # dialog or (on Linux Lite 5+) via the "HiDPI Settings" dialog. + # + } elseif {[catch {exec ps -e | grep mate-session}] == 0} { ;# MATE + if {[catch {exec gsettings get org.mate.interface \ + window-scaling-factor} result] == 0} { + if {$result == 0} { ;# means: "Auto-detect" + # + # Try to get winScalingFactor from the cursor size + # + if {[catch {exec xrdb -query | grep Xcursor.size} result] + == 0 && + [catch {exec gsettings get org.mate.peripherals-mouse \ + cursor-size} defCursorSize] == 0} { + set cursorSize [lindex $result 1] + set winScalingFactor \ + [expr {($cursorSize + $defCursorSize - 1) / + $defCursorSize}] + } + } else { + set winScalingFactor $result + } + } + + # + # The DPI value can be set via the "Font Rendering Details" + # dialog, which can be opened using the "Details..." button + # in the "Fonts" tab of the "Appearance Preferences" dialog. + # + } elseif {[catch {exec ps -e | grep gnome-session}] == 0 && + [catch {exec gsettings get \ + org.gnome.settings-daemon.plugins.xsettings overrides} \ + result] == 0 && + [set idx \ + [string first "'Gdk/WindowScalingFactor'" $result]] >= 0} { + scan [string range $result $idx end] "%*s <%d>" winScalingFactor + } + + # + # Get the scaling percentage + # + if {$winScalingFactor >= 2} { + set pct 200 + } elseif {[catch {exec xrdb -query | grep Xft.dpi} result] == 0} { + # + # Derive the value of pct from that of the font DPI + # + set dpi [lindex $result 1] + set pct [expr {100 * $dpi / 96}] + } elseif {[catch {exec ps -e | grep gnome-session}] == 0 && + ![info exists ::env(WAYLAND_DISPLAY)] && + [catch {exec xrandr | grep " connected"} result] == 0 && + [catch {open $::env(HOME)/.config/monitors.xml} chan] == 0} { + # + # Update pct by scanning the file ~/.config/monitors.xml + # + ScanMonitorsFile $result $chan pct + } + } + + if {$pct < 100 + 12.5} { + set pct 100 + } elseif {$pct < 125 + 12.5} { + set pct 125 + } elseif {$pct < 150 + 12.5} { + set pct 150 + } elseif {$pct < 175 + 12.5} { + set pct 175 + } elseif {$pct < 200 + 12.5} { + set pct 200 + } elseif {$pct < 225 + 12.5} { + set pct 225 + } elseif {$pct < 250 + 12.5} { + set pct 250 + } elseif {$pct < 275 + 12.5} { + set pct 275 + } elseif {$pct < 300 + 25} { + set pct 300 + } elseif {$pct < 350 + 25} { + set pct 350 + } elseif {$pct < 400 + 25} { + set pct 400 + } elseif {$pct < 450 + 25} { + set pct 450 + } elseif {$pct < 500 + 25} { + set pct 500 + } else { + set pct [expr {int($pct + 0.5)}] + } + + if {$onX11 && $pct != 100 && $pct != $origPct} { + # + # Set Tk's scaling factor according to $pct + # + tk scaling [expr {$pct / 75.0}] + } + + set scalingPct $pct + return $pct +} + +# ::tk::ScaleNum -- +# +# Scales a nonnegative integer according to the display's current scaling +# percentage. +# +# Arguments: +# num - A nonnegative integer. + +proc ::tk::ScaleNum num { + set pct [::tk::ScalingPct] + set factor [expr {$num * $pct}] + set result [expr {$factor / 100}] + if {$factor % 100 >= 50} { + incr result + } + + return $result +} + +# ::tk::ScanMonitorsFile -- +# +# Updates the scaling percentage by scanning the file ~/.config/monitors.xml. +# +# Arguments: +# xrandrResult - The output of 'xrandr | grep " connected"'. +# chan - Returned from 'open ~/.config/monitors.xml'. +# pctName - The name of a variable containing the scaling percentage. + +proc ::tk::ScanMonitorsFile {xrandrResult chan pctName} { + upvar $pctName pct + + # + # Get the list of connected outputs reported by xrandr + # + set outputList {} + foreach line [split $xrandrResult "\n"] { + set idx [string first " " $line] + set output [string range $line 0 [incr idx -1]] + lappend outputList $output + } + set outputList [lsort $outputList] + + # + # Get the content of the file ~/.config/monitors.xml + # + set str [read $chan] + close $chan + + # + # Run over the file's "configuration" sections + # + set idx 0 + while {[set idx2 [string first "<configuration>" $str $idx]] >= 0} { + set idx2 [string first ">" $str $idx2] + set idx [string first "</configuration>" $str $idx2] + set config [string range $str [incr idx2] [incr idx -1]] + + # + # Get the list of connectors within this configuration + # + set connectorList {} + foreach {dummy connector} [regexp -all -inline \ + {<connector>([^<]+)</connector>} $config] { + lappend connectorList $connector + } + set connectorList [lsort $connectorList] + + # + # If $outputList and $connectorList are identical then set the + # variable pct to 100 or 200, depending on the max. scaling + # within this configuration, and exit the loop. (Due to the + # way fractional scaling is implemented in GNOME, we have to + # set the variable pct to 200 rather than 125, 150, or 175.) + # + if {[string compare $outputList $connectorList] == 0} { + set maxScaling 0.0 + foreach {dummy scaling} [regexp -all -inline \ + {<scale>([^<]+)</scale>} $config] { + if {$scaling > $maxScaling} { + set maxScaling $scaling + } + } + set pct [expr {$maxScaling > 1.0 ? 200 : 100}] + break + } + } +} diff --git a/library/scrlbar.tcl b/library/scrlbar.tcl index a1c4398..c18d4a8 100644 --- a/library/scrlbar.tcl +++ b/library/scrlbar.tcl @@ -3,8 +3,8 @@ # This file defines the default bindings for Tk scrollbar widgets. # It also provides procedures that help in implementing the bindings. # -# Copyright (c) 1994 The Regents of the University of California. -# Copyright (c) 1994-1996 Sun Microsystems, Inc. +# Copyright © 1994 The Regents of the University of California. +# Copyright © 1994-1996 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -39,7 +39,7 @@ bind Scrollbar <Leave> { } %W activate {} } -bind Scrollbar <1> { +bind Scrollbar <Button-1> { tk::ScrollButtonDown %W %x %y } bind Scrollbar <B1-Motion> { @@ -57,13 +57,13 @@ bind Scrollbar <B1-Leave> { bind Scrollbar <B1-Enter> { # Prevents <Enter> binding from being invoked. } -bind Scrollbar <2> { +bind Scrollbar <Button-2> { tk::ScrollButton2Down %W %x %y } -bind Scrollbar <B1-2> { +bind Scrollbar <B1-Button-2> { # Do nothing, since button 1 is already down. } -bind Scrollbar <B2-1> { +bind Scrollbar <B2-Button-1> { # Do nothing, since button 2 is already down. } bind Scrollbar <B2-Motion> { @@ -84,10 +84,10 @@ bind Scrollbar <B2-Leave> { bind Scrollbar <B2-Enter> { # Prevents <Enter> binding from being invoked. } -bind Scrollbar <Control-1> { +bind Scrollbar <Control-Button-1> { tk::ScrollTopBottom %W %x %y } -bind Scrollbar <Control-2> { +bind Scrollbar <Control-Button-2> { tk::ScrollTopBottom %W %x %y } @@ -129,41 +129,11 @@ bind Scrollbar <<LineEnd>> { } } -if {[tk windowingsystem] eq "aqua"} { - bind Scrollbar <MouseWheel> { - tk::ScrollByUnits %W v [expr {-(%D)}] - } - bind Scrollbar <Option-MouseWheel> { - tk::ScrollByUnits %W v [expr {-10 * (%D)}] - } - bind Scrollbar <Shift-MouseWheel> { - tk::ScrollByUnits %W h [expr {-(%D)}] - } - bind Scrollbar <Shift-Option-MouseWheel> { - tk::ScrollByUnits %W h [expr {-10 * (%D)}] - } -} else { - bind Scrollbar <MouseWheel> { - if {%D >= 0} { - tk::ScrollByUnits %W v [expr {-%D/30}] - } else { - tk::ScrollByUnits %W v [expr {(29-%D)/30}] - } - } - bind Scrollbar <Shift-MouseWheel> { - if {%D >= 0} { - tk::ScrollByUnits %W h [expr {-%D/30}] - } else { - tk::ScrollByUnits %W h [expr {(29-%D)/30}] - } - } +bind Scrollbar <MouseWheel> { + tk::ScrollByUnits %W hv %D -40.0 } - -if {[tk windowingsystem] eq "x11"} { - bind Scrollbar <4> {tk::ScrollByUnits %W v -5} - bind Scrollbar <5> {tk::ScrollByUnits %W v 5} - bind Scrollbar <Shift-4> {tk::ScrollByUnits %W h -5} - bind Scrollbar <Shift-5> {tk::ScrollByUnits %W h 5} +bind Scrollbar <Option-MouseWheel> { + tk::ScrollByUnits %W hv %D -12.0 } # tk::ScrollButtonDown -- @@ -336,7 +306,7 @@ proc ::tk::ScrollEndDrag {w x y} { # horizontal, "v" for vertical, "hv" for both. # amount - How many units to scroll: typically 1 or -1. -proc ::tk::ScrollByUnits {w orient amount} { +proc ::tk::ScrollByUnits {w orient amount {factor 1.0}} { set cmd [$w cget -command] if {$cmd eq "" || ([string first \ [string index [$w cget -orient] 0] $orient] < 0)} { @@ -344,9 +314,9 @@ proc ::tk::ScrollByUnits {w orient amount} { } set info [$w get] if {[llength $info] == 2} { - uplevel #0 $cmd scroll $amount units + uplevel #0 $cmd scroll [expr {$amount/$factor}] units } else { - uplevel #0 $cmd [expr {[lindex $info 2] + $amount}] + uplevel #0 $cmd [expr {[lindex $info 2] + [expr {$amount/$factor}]}] } } diff --git a/library/spinbox.tcl b/library/spinbox.tcl index 0e26644..1430800 100644 --- a/library/spinbox.tcl +++ b/library/spinbox.tcl @@ -4,10 +4,10 @@ # procedures that help in implementing those bindings. The spinbox builds # off the entry widget, so it can reuse Entry bindings and procedures. # -# Copyright (c) 1992-1994 The Regents of the University of California. -# Copyright (c) 1994-1997 Sun Microsystems, Inc. -# Copyright (c) 1999-2000 Jeffrey Hobbs -# Copyright (c) 2000 Ajuba Solutions +# Copyright © 1992-1994 The Regents of the University of California. +# Copyright © 1994-1997 Sun Microsystems, Inc. +# Copyright © 1999-2000 Jeffrey Hobbs +# Copyright © 2000 Ajuba Solutions # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -79,31 +79,31 @@ bind Spinbox <<TraverseIn>> { # Standard Motif bindings: -bind Spinbox <1> { +bind Spinbox <Button-1> { ::tk::spinbox::ButtonDown %W %x %y } bind Spinbox <B1-Motion> { ::tk::spinbox::Motion %W %x %y } -bind Spinbox <Double-1> { +bind Spinbox <Double-Button-1> { ::tk::spinbox::ArrowPress %W %x %y set tk::Priv(selectMode) word ::tk::spinbox::MouseSelect %W %x sel.first } -bind Spinbox <Triple-1> { +bind Spinbox <Triple-Button-1> { ::tk::spinbox::ArrowPress %W %x %y set tk::Priv(selectMode) line ::tk::spinbox::MouseSelect %W %x 0 } -bind Spinbox <Shift-1> { +bind Spinbox <Shift-Button-1> { set tk::Priv(selectMode) char %W selection adjust @%x } -bind Spinbox <Double-Shift-1> { +bind Spinbox <Double-Shift-Button-1> { set tk::Priv(selectMode) word ::tk::spinbox::MouseSelect %W %x } -bind Spinbox <Triple-Shift-1> { +bind Spinbox <Triple-Shift-Button-1> { set tk::Priv(selectMode) line ::tk::spinbox::MouseSelect %W %x } @@ -117,7 +117,7 @@ bind Spinbox <B1-Enter> { bind Spinbox <ButtonRelease-1> { ::tk::spinbox::ButtonUp %W %x %y } -bind Spinbox <Control-1> { +bind Spinbox <Control-Button-1> { %W icursor @%x } @@ -129,17 +129,17 @@ bind Spinbox <<NextLine>> { } bind Spinbox <<PrevChar>> { - ::tk::EntrySetCursor %W [expr {[%W index insert] - 1}] + ::tk::EntrySetCursor %W [tk::EntryPreviousChar %W insert] } bind Spinbox <<NextChar>> { - ::tk::EntrySetCursor %W [expr {[%W index insert] + 1}] + ::tk::EntrySetCursor %W [tk::EntryNextChar %W insert] } bind Spinbox <<SelectPrevChar>> { - ::tk::EntryKeySelect %W [expr {[%W index insert] - 1}] + ::tk::EntryKeySelect %W [tk::EntryPreviousChar %W insert] ::tk::EntrySeeInsert %W } bind Spinbox <<SelectNextChar>> { - ::tk::EntryKeySelect %W [expr {[%W index insert] + 1}] + ::tk::EntryKeySelect %W [tk::EntryNextChar %W insert] ::tk::EntrySeeInsert %W } bind Spinbox <<PrevWord>> { @@ -175,7 +175,8 @@ bind Spinbox <Delete> { if {[%W selection present]} { %W delete sel.first sel.last } else { - %W delete insert + %W delete [tk::startOfCluster [%W get] [%W index insert]] \ + [tk::endOfGlyphCluster [%W get] [%W index insert]] } } bind Spinbox <BackSpace> { @@ -204,7 +205,7 @@ bind Spinbox <Key> { ::tk::EntryInsert %W %A } -# Ignore all Alt, Meta, Control, and Mod4 keypresses unless explicitly bound. +# Ignore all Alt, Meta, Control, Command, and Fn keypresses unless explicitly bound. # Otherwise, if a widget binding for one of these is defined, the # <Key> class binding will also fire and insert the character, # which is wrong. Ditto for Escape, Return, and Tab. @@ -218,10 +219,8 @@ bind Spinbox <KP_Enter> {# nothing} bind Spinbox <Tab> {# nothing} bind Spinbox <Prior> {# nothing} bind Spinbox <Next> {# nothing} -if {[tk windowingsystem] eq "aqua"} { - bind Spinbox <Command-Key> {# nothing} - bind Spinbox <Mod4-Key> {# nothing} -} +bind Spinbox <Command-Key> {# nothing} +bind Spinbox <Fn-Key> {# nothing} # On Windows, paste is done using Shift-Insert. Shift-Insert already # generates the <<Paste>> event, so we don't need to do anything here. @@ -281,27 +280,14 @@ bind Spinbox <Meta-Delete> { # A few additional bindings of my own. -if {[tk windowingsystem] ne "aqua"} { - bind Spinbox <2> { - if {!$tk_strictMotif} { - ::tk::EntryScanMark %W %x - } - } - bind Spinbox <B2-Motion> { - if {!$tk_strictMotif} { - ::tk::EntryScanDrag %W %x - } - } -} else { - bind Spinbox <3> { - if {!$tk_strictMotif} { - ::tk::EntryScanMark %W %x - } +bind Spinbox <Button-2> { + if {!$tk_strictMotif} { + ::tk::EntryScanMark %W %x } - bind Spinbox <B3-Motion> { - if {!$tk_strictMotif} { - ::tk::EntryScanDrag %W %x - } +} +bind Spinbox <B2-Motion> { + if {!$tk_strictMotif} { + ::tk::EntryScanDrag %W %x } } @@ -483,11 +469,11 @@ proc ::tk::spinbox::MouseSelect {w x {cursor {}}} { } word { if {$cur < [$w index anchor]} { - set before [tcl_wordBreakBefore [$w get] $cur] - set after [tcl_wordBreakAfter [$w get] $anchor-1] + set before [tk::wordBreakBefore [$w get] $cur] + set after [tk::wordBreakAfter [$w get] $anchor-1] } else { - set before [tcl_wordBreakBefore [$w get] $anchor] - set after [tcl_wordBreakAfter [$w get] $cur-1] + set before [tk::wordBreakBefore [$w get] $anchor] + set after [tk::wordBreakAfter [$w get] $cur-1] } if {$before < 0} { set before 0 @@ -590,5 +576,5 @@ proc ::tk::spinbox::AutoScan {w} { proc ::tk::spinbox::GetSelection {w} { return [string range [$w get] [$w index sel.first] \ - [expr {[$w index sel.last] - 1}]] + [$w index sel.last]-1] } diff --git a/library/systray.tcl b/library/systray.tcl new file mode 100644 index 0000000..5b03f3a --- /dev/null +++ b/library/systray.tcl @@ -0,0 +1,380 @@ +# systray.tcl -- + +# This file defines the 'tk systray' command for icon display and manipulation +# in the system tray on X11, Windows, and macOS, and the 'tk sysnotify' command +# for system alerts on each platform. It implements an abstraction layer that +# presents a consistent API across the three platforms. + +# Copyright © 2020 Kevin Walzer/WordTech Communications LLC. +# Copyright © 2020 Eric Boudaillier. +# Copyright © 2020 Francois Vogel. +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. + +# Pure-Tcl system tooltip window for use with system tray icon if native +# implementation not available. + +namespace eval ::tk::systray { + variable _created 0 + variable _options {-image "" -text "" -button1 "" -button3 ""} + variable _current {} + variable _ico + + proc _balloon {w help} { + bind $w <Any-Enter> "after 100 [list [namespace current]::_balloon_show %W [list $help] cursor]" + bind $w <Any-Leave> "destroy %W._balloon" + } + + proc _balloon_show {w msg i} { + if {![winfo exists $w]} { return } + + # Use string match to allow that the help will be shown when + # the pointer is in any child of the desired widget + if {([winfo class $w] ne "Menu") && ![string match $w* [eval [list winfo containing] \ + [winfo pointerxy $w]]]} { + return + } + + set top $w._balloon + catch {destroy $top} + toplevel $top -bg black -bd 1 + wm overrideredirect $top 1 + if {[tk windowingsystem] eq "aqua"} { + ::tk::unsupported::MacWindowStyle style $top help none + } + pack [message $top._txt -aspect 10000 -text $msg] + + update idletasks + set screenw [winfo screenwidth $w] + set screenh [winfo screenheight $w] + set reqw [winfo reqwidth $top] + set reqh [winfo reqheight $top] + # When adjusting for being on the screen boundary, check that we are + # near the "edge" already, as Tk handles multiple monitors oddly + if {$i eq "cursor"} { + set y [expr {[winfo pointery $w]+20}] + if {($y < $screenh) && ($y+$reqh) > $screenh} { + set y [expr {[winfo pointery $w]-$reqh-5}] + } + } elseif {$i ne ""} { + set y [expr {[winfo rooty $w]+[winfo vrooty $w]+[$w yposition $i]+25}] + if {($y < $screenh) && ($y+$reqh) > $screenh} { + # show above if we would be offscreen + set y [expr {[winfo rooty $w]+[$w yposition $i]-$reqh-5}] + } + } else { + set y [expr {[winfo rooty $w]+[winfo vrooty $w]+[winfo height $w]+5}] + if {($y < $screenh) && ($y+$reqh) > $screenh} { + # show above if we would be offscreen + set y [expr {[winfo rooty $w]-$reqh-5}] + } + } + if {$i eq "cursor"} { + set x [winfo pointerx $w] + } else { + set x [expr {[winfo rootx $w]+[winfo vrootx $w]+ ([winfo width $w]-$reqw)/2}] + } + # only readjust when we would appear right on the screen edge + if {$x<0 && ($x+$reqw)>0} { + set x 0 + } elseif {($x < $screenw) && ($x+$reqw) > $screenw} { + set x [expr {$screenw-$reqw}] + } + if {[tk windowingsystem] eq "aqua"} { + set focus [focus] + } + + wm geometry $top +$x+$y + wm deiconify $top + raise $top + + if {[tk windowingsystem] eq "aqua" && $focus ne ""} { + # Aqua's help window steals focus on display + after idle [list focus -force $focus] + } + } + + proc _win_callback {msg} { + variable _current + # The API at the Tk level does not feature bindings to double clicks. Whatever + # the speed the user clicks with, he expects the single click binding to fire. + # Therefore we need to bind to both WM_*BUTTONDOWN and to WM_*BUTTONDBLCLK. + switch -exact -- $msg { + WM_LBUTTONDOWN - WM_LBUTTONDBLCLK { + uplevel #0 [dict get $_current -button1] + } + WM_RBUTTONDOWN - WM_RBUTTONDBLCLK { + uplevel #0 [dict get $_current -button3] + } + } + } + + namespace export create configure destroy + namespace ensemble create +} + + +# Pure-Tcl system notification window for use if native implementation not available. +namespace eval ::tk::sysnotify:: { + + proc _notifywindow {title msg} { + catch {destroy ._notify} + set w [toplevel ._notify] + if {[tk windowingsystem] eq "aqua"} { + ::tk::unsupported::MacWindowStyle style $w utility {hud closeBox resizable} + wm title $w "Alert" + } + if {[tk windowingsystem] eq "win32"} { + wm attributes $w -toolwindow true + wm title $w "Alert" + } + label $w.l -bg gray30 -fg white -image ::tk::icons::information + pack $w.l -fill both -expand yes -side left + message $w.message -aspect 150 -bg gray30 -fg white -text $title\n\n$msg -width 210p + pack $w.message -side right -fill both -expand yes + if {[tk windowingsystem] eq "x11"} { + wm overrideredirect $w true + } + wm attributes $w -alpha 0.0 + set xpos [expr {[winfo screenwidth $w] - [::tk::ScaleNum 325]}] + wm geometry $w +$xpos+[::tk::ScaleNum 30] + ::tk::sysnotify::_fade_in $w + after 3000 ::tk::sysnotify::_fade_out $w + } + + #Fade and destroy window. + proc _fade_out {w} { + catch { + set prev_degree [wm attributes $w -alpha] + set new_degree [expr {$prev_degree - 0.05}] + set current_degree [wm attributes $w -alpha $new_degree] + if {$new_degree > 0.0 && $new_degree != $prev_degree} { + after 10 [list ::tk::sysnotify::_fade_out $w] + } else { + destroy $w + } + } + } + + #Fade the window into view. + proc _fade_in {w} { + catch { + raise $w + wm attributes $w -topmost 1 + set prev_degree [wm attributes $w -alpha] + set new_degree [expr {$prev_degree + 0.05}] + set current_degree [wm attributes $w -alpha $new_degree] + focus -force $w + if {$new_degree < 0.9 && $new_degree != $prev_degree} { + after 10 [list ::tk::sysnotify::_fade_in $w] + } + } + } + namespace export * +} + + +# tk systray -- +# This procedure creates an icon display in the platform-specific system tray. +# +# Subcommands: +# +# create - create systray icon. +# Arguments: +# -image - Tk image to display. +# -text - string to display in tooltip over image. +# -button1 - Tcl proc to invoke on <Button-1> event. +# -button3 - Tcl proc to invoke on <Button-3> event. +# +# configure - change one of the systray properties. +# Arguments (Any or all can be called): +# -image - Tk image to update. +# -text - string to update. +# -button1 - Tcl proc to change for <Button-1> event. +# -button3 - Tcl proc to change for <Button-3> event. +# +# destroy - destroy systray icon. +# Arguments: +# none. +proc ::tk::systray::create {args} { + variable _created + variable _options + variable _current + variable _ico + + if {$_created} { + return -code error -errorcode {TK SYSTRAY CREATE} "only one system tray icon supported per interpeter" + } + _check_options $args 0 + if {![dict exists $args -image]} { + return -code error -errorcode {TK SYSTRAY CREATE} "missing required option \"-image\"" + } + set values [dict merge $_options $args] + try { + switch -- [tk windowingsystem] { + "win32" { + set _ico [_systray add -image [dict get $values -image] \ + -text [dict get $values -text] \ + -callback [list ::tk::systray::_win_callback %m]] + } + "x11" { + _systray ._tray -image [dict get $values -image] -visible true + _balloon ._tray [dict get $values -text] + bind ._tray <Button-1> [dict get $values -button1] + bind ._tray <Button-3> [dict get $values -button3] + } + "aqua" { + _systray create [dict get $values -image] [dict get $values -text] \ + [dict get $values -button1] [dict get $values -button3] + } + } + } on ok {} { + set _current $values + set _created 1 + return + } on error {msg opts} { + return -code error -errorcode [dict get $opts -errorcode] $msg + } +} + +# Modify the systray icon. +proc ::tk::systray::configure {args} { + variable _created + variable _options + variable _current + variable _ico + + if {!$_created} { + return -code error -errorcode {TK SYSTRAY CREATE} "systray not created" + } + _check_options $args 1 + if {[llength $args] == 0} { + return $_current + } elseif {[llength $args] == 1} { + return [dict get $_current [lindex $args 0]] + } + set values [dict merge $_current $args] + try { + switch -- [tk windowingsystem] { + "win32" { + if {[dict exists $args -image]} { + _systray modify $_ico -image [dict get $args -image] + } + if {[dict exists $args -text]} { + _systray modify $_ico -text [dict get $args -text] + } + } + "x11" { + if {[dict exists $args -image]} { + ._tray configure -image [dict get $args -image] + } + if {[dict exists $args -text]} { + _balloon ._tray [dict get $args -text] + } + if {[dict exists $args -button1]} { + bind ._tray <Button-1> [dict get $args -button1] + } + if {[dict exists $args -button3]} { + bind ._tray <Button-3> [dict get $args -button3] + } + } + "aqua" { + foreach {key opt} {image -image text \ + -text b1_callback -button1 b3_callback -button3} { + if {[dict exists $args $opt]} { + _systray modify $key [dict get $args $opt] + } + } + } + } + } on ok {} { + set _current $values + return + } on error {msg opts} { + return -code error -errorcode [dict get $opts -errorcode] $msg + } +} + + +# Remove the systray icon. +proc ::tk::systray::destroy {} { + variable _created + variable _current + variable _ico + + if {!$_created} { + return -code error -errorcode {TK SYSTRAY DESTROY} "systray not created" + } + switch -- [tk windowingsystem] { + "win32" { + _systray delete $_ico + set _ico "" + } + "x11" { + ::destroy ._tray + } + "aqua" { + _systray destroy + } + } + set _created 0 + set _current {} + return +} + +# Check systray options +proc ::tk::systray::_check_options {argsList singleOk} { + variable _options + + set len [llength $argsList] + while {[llength $argsList] > 0} { + set opt [lindex $argsList 0] + if {![dict exists $_options $opt]} { + tailcall return -code error -errorcode {TK SYSTRAY OPTION} \ + "unknown option \"$opt\": must be -image, -text, -button1 or -button3" + } + if {[llength $argsList] == 1 && !($len == 1 && $singleOk)} { + tailcall return -code error -errorcode {TK SYSTRAY OPTION} \ + "missing value for option \"$opt\"" + } + set argsList [lrange $argsList 2 end] + } +} + +# tk sysnotify -- +# This procedure implements a platform-specific system notification alert. +# +# Arguments: +# title - main text of alert. +# message - body text of alert. + +proc ::tk::sysnotify::sysnotify {title message} { + + switch -- [tk windowingsystem] { + "win32" { + if {!$::tk::systray::_created} { + error "must create a system tray icon with the \"tk systray\" command first" + } + _sysnotify notify $::tk::systray::_ico $title $message + } + "x11" { + if {[info commands ::tk::sysnotify::_sysnotify] eq ""} { + _notifywindow $title $message + } else { + _sysnotify $title $message + } + } + "aqua" { + _sysnotify $title $message + } + } + return +} + +#Add these commands to the tk command ensemble: tk systray, tk sysnotify +#Thanks to Christian Gollwitzer for the guidance here +namespace ensemble configure tk -map \ + [dict merge [namespace ensemble configure tk -map] \ + {systray ::tk::systray sysnotify ::tk::sysnotify::sysnotify}] + diff --git a/library/tclIndex b/library/tclIndex index b3f37fa..f064cea 100644 --- a/library/tclIndex +++ b/library/tclIndex @@ -144,6 +144,9 @@ set auto_index(::tk::ScaleEndDrag) [list source [file join $dir scale.tcl]] set auto_index(::tk::ScaleIncrement) [list source [file join $dir scale.tcl]] set auto_index(::tk::ScaleControlPress) [list source [file join $dir scale.tcl]] set auto_index(::tk::ScaleButton2Down) [list source [file join $dir scale.tcl]] +set auto_index(::tk::ScalingPct) [list source [file join $dir scaling.tcl]] +set auto_index(::tk::ScaleNum) [list source [file join $dir scaling.tcl]] +set auto_index(::tk::ScanMonitorsFile) [list source [file join $dir scaling.tcl]] set auto_index(::tk::ScrollButtonDown) [list source [file join $dir scrlbar.tcl]] set auto_index(::tk::ScrollButtonUp) [list source [file join $dir scrlbar.tcl]] set auto_index(::tk::ScrollSelect) [list source [file join $dir scrlbar.tcl]] @@ -199,6 +202,7 @@ set auto_index(::tk::RestoreFocusGrab) [list source [file join $dir tk.tcl]] set auto_index(::tk::ScreenChanged) [list source [file join $dir tk.tcl]] set auto_index(::tk::EventMotifBindings) [list source [file join $dir tk.tcl]] set auto_index(::tk::CancelRepeat) [list source [file join $dir tk.tcl]] +set auto_index(::tk::MouseWheel) [list source [file join $dir tk.tcl]] set auto_index(::tk::TabToWindow) [list source [file join $dir tk.tcl]] set auto_index(::tk::dialog::file::) [list source [file join $dir tkfbox.tcl]] set auto_index(::tk::dialog::file::Config) [list source [file join $dir tkfbox.tcl]] @@ -247,7 +251,6 @@ set auto_index(::tk::ListBoxKeyAccel_Unset) [list source [file join $dir xmfbox. set auto_index(::tk::ListBoxKeyAccel_Key) [list source [file join $dir xmfbox.tcl]] set auto_index(::tk::ListBoxKeyAccel_Goto) [list source [file join $dir xmfbox.tcl]] set auto_index(::tk::ListBoxKeyAccel_Reset) [list source [file join $dir xmfbox.tcl]] -set auto_index(tk_getFileType) [list source [file join $dir xmfbox.tcl]] set auto_index(::tk::unsupported::ExposePrivateCommand) [list source [file join $dir unsupported.tcl]] set auto_index(::tk::unsupported::ExposePrivateVariable) [list source [file join $dir unsupported.tcl]] set auto_index(::tk::fontchooser) [list source [file join $dir fontchooser.tcl]] diff --git a/library/tearoff.tcl b/library/tearoff.tcl index 1dbe858..856f8a2 100644 --- a/library/tearoff.tcl +++ b/library/tearoff.tcl @@ -2,8 +2,8 @@ # # This file contains procedures that implement tear-off menus. # -# Copyright (c) 1994 The Regents of the University of California. -# Copyright (c) 1994-1997 Sun Microsystems, Inc. +# Copyright © 1994 The Regents of the University of California. +# Copyright © 1994-1997 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -31,10 +31,10 @@ proc ::tk::TearOffMenu {w {x 0} {y 0}} { # away when the toplevel goes away. if {$x == 0} { - set x [winfo rootx $w] + set x [winfo rootx $w] } if {$y == 0} { - set y [winfo rooty $w] + set y [winfo rooty $w] if {[tk windowingsystem] eq "aqua"} { # Shift by height of tearoff entry minus height of window titlebar catch {incr y [expr {[$w yposition 1] - 16}]} @@ -66,24 +66,24 @@ proc ::tk::TearOffMenu {w {x 0} {y 0}} { set parent [winfo parent $w] if {[$menu cget -title] ne ""} { - wm title $menu [$menu cget -title] + wm title $menu [$menu cget -title] } else { - switch -- [winfo class $parent] { + switch -- [winfo class $parent] { Menubutton { - wm title $menu [$parent cget -text] + wm title $menu [$parent cget -text] } Menu { - wm title $menu [$parent entrycget active -label] + wm title $menu [$parent entrycget active -label] } } } if {[tk windowingsystem] eq "win32"} { - # [Bug 3181181]: Find the toplevel window for the menu - set parent [winfo toplevel $parent] - while {[winfo class $parent] eq "Menu"} { - set parent [winfo toplevel [winfo parent $parent]] - } + # [Bug 3181181]: Find the toplevel window for the menu + set parent [winfo toplevel $parent] + while {[winfo class $parent] eq "Menu"} { + set parent [winfo toplevel [winfo parent $parent]] + } wm transient $menu [winfo toplevel $parent] wm attributes $menu -toolwindow 1 } @@ -138,7 +138,7 @@ proc ::tk::MenuDup {src dst type} { # Copy the meny entries, if any set last [$src index last] - if {$last ne "none" && $last >= 0} { + if {$last >= 0} { for {set i [$src cget -tearoff]} {$i <= $last} {incr i} { set cmd [list $dst add [$src type $i]] foreach option [$src entryconfigure $i] { diff --git a/library/text.tcl b/library/text.tcl index 60eab41..eb73db0 100644 --- a/library/text.tcl +++ b/library/text.tcl @@ -3,9 +3,9 @@ # This file defines the default bindings for Tk text widgets and provides # procedures that help in implementing the bindings. # -# Copyright (c) 1992-1994 The Regents of the University of California. -# Copyright (c) 1994-1997 Sun Microsystems, Inc. -# Copyright (c) 1998 by Scriptics Corporation. +# Copyright © 1992-1994 The Regents of the University of California. +# Copyright © 1994-1997 Sun Microsystems, Inc. +# Copyright © 1998 Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -42,7 +42,7 @@ # Standard Motif bindings: -bind Text <1> { +bind Text <Button-1> { tk::TextButton1 %W %x %y %W tag remove sel 0.0 end } @@ -51,26 +51,26 @@ bind Text <B1-Motion> { set tk::Priv(y) %y tk::TextSelectTo %W %x %y } -bind Text <Double-1> { +bind Text <Double-Button-1> { set tk::Priv(selectMode) word tk::TextSelectTo %W %x %y catch {%W mark set insert sel.first} } -bind Text <Triple-1> { +bind Text <Triple-Button-1> { set tk::Priv(selectMode) line tk::TextSelectTo %W %x %y catch {%W mark set insert sel.first} } -bind Text <Shift-1> { +bind Text <Shift-Button-1> { tk::TextResetAnchor %W @%x,%y set tk::Priv(selectMode) char tk::TextSelectTo %W %x %y } -bind Text <Double-Shift-1> { +bind Text <Double-Shift-Button-1> { set tk::Priv(selectMode) word tk::TextSelectTo %W %x %y 1 } -bind Text <Triple-Shift-1> { +bind Text <Triple-Shift-Button-1> { set tk::Priv(selectMode) line tk::TextSelectTo %W %x %y } @@ -86,7 +86,7 @@ bind Text <ButtonRelease-1> { tk::CancelRepeat } -bind Text <Control-1> { +bind Text <Control-Button-1> { %W mark set insert @%x,%y # An operation that moves the insert mark without making it # one end of the selection must insert an autoseparator @@ -95,14 +95,14 @@ bind Text <Control-1> { } } # stop an accidental double click triggering <Double-Button-1> -bind Text <Double-Control-1> { # nothing } +bind Text <Double-Control-Button-1> { # nothing } # stop an accidental movement triggering <B1-Motion> bind Text <Control-B1-Motion> { # nothing } bind Text <<PrevChar>> { - tk::TextSetCursor %W insert-1displayindices + tk::TextSetCursor %W [tk::TextPrevPos %W insert tk::startOfCluster] } bind Text <<NextChar>> { - tk::TextSetCursor %W insert+1displayindices + tk::TextSetCursor %W [tk::TextNextPos %W insert tk::endOfCluster] } bind Text <<PrevLine>> { tk::TextSetCursor %W [tk::TextUpDownLine %W -1] @@ -111,10 +111,10 @@ bind Text <<NextLine>> { tk::TextSetCursor %W [tk::TextUpDownLine %W 1] } bind Text <<SelectPrevChar>> { - tk::TextKeySelect %W [%W index {insert - 1displayindices}] + tk::TextKeySelect %W [tk::TextPrevPos %W insert tk::startOfCluster] } bind Text <<SelectNextChar>> { - tk::TextKeySelect %W [%W index {insert + 1displayindices}] + tk::TextKeySelect %W [tk::TextNextPos %W insert tk::endOfCluster] } bind Text <<SelectPrevLine>> { tk::TextKeySelect %W [tk::TextUpDownLine %W -1] @@ -123,7 +123,7 @@ bind Text <<SelectNextLine>> { tk::TextKeySelect %W [tk::TextUpDownLine %W 1] } bind Text <<PrevWord>> { - tk::TextSetCursor %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord] + tk::TextSetCursor %W [tk::TextPrevPos %W insert tk::startOfPreviousWord] } bind Text <<NextWord>> { tk::TextSetCursor %W [tk::TextNextWord %W insert] @@ -135,7 +135,7 @@ bind Text <<NextPara>> { tk::TextSetCursor %W [tk::TextNextPara %W insert] } bind Text <<SelectPrevWord>> { - tk::TextKeySelect %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord] + tk::TextKeySelect %W [tk::TextPrevPos %W insert tk::startOfPreviousWord] } bind Text <<SelectNextWord>> { tk::TextKeySelect %W [tk::TextNextWord %W insert] @@ -222,7 +222,8 @@ bind Text <Delete> { %W delete sel.first sel.last } else { if {[%W compare end != insert+1c]} { - %W delete insert + %W delete [tk::TextPrevPos %W insert+1c tk::startOfCluster] \ + [tk::TextNextPos %W insert tk::endOfCluster] } %W see insert } @@ -232,7 +233,8 @@ bind Text <BackSpace> { %W delete sel.first sel.last } else { if {[%W compare insert != 1.0]} { - %W delete insert-1c + %W delete [tk::TextPrevPos %W insert tk::startOfCluster] \ + [tk::TextNextPos %W insert-1c tk::endOfCluster] } %W see insert } @@ -296,7 +298,7 @@ bind Text <Key> { tk::TextInsert %W %A } -# Ignore all Alt, Meta, and Control keypresses unless explicitly bound. +# Ignore all Alt, Meta, Control, Command, and Fn keypresses unless explicitly bound. # Otherwise, if a widget binding for one of these is defined, the # <Key> class binding will also fire and insert the character, # which is wrong. Ditto for <Escape>. @@ -306,10 +308,8 @@ bind Text <Meta-Key> {# nothing} bind Text <Control-Key> {# nothing} bind Text <Escape> {# nothing} bind Text <KP_Enter> {# nothing} -if {[tk windowingsystem] eq "aqua"} { - bind Text <Command-Key> {# nothing} - bind Text <Mod4-Key> {# nothing} -} +bind Text <Command-Key> {# nothing} +bind Text <Fn-Key> {# nothing} # Additional emacs-like bindings: @@ -358,7 +358,7 @@ bind Text <<Redo>> { bind Text <Meta-b> { if {!$tk_strictMotif} { - tk::TextSetCursor %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord] + tk::TextSetCursor %W [tk::TextPrevPos %W insert tk::startOfPreviousWord] } } bind Text <Meta-d> { @@ -383,12 +383,12 @@ bind Text <Meta-greater> { } bind Text <Meta-BackSpace> { if {!$tk_strictMotif} { - %W delete [tk::TextPrevPos %W insert tcl_startOfPreviousWord] insert + %W delete [tk::TextPrevPos %W insert tk::startOfPreviousWord] insert } } bind Text <Meta-Delete> { if {!$tk_strictMotif} { - %W delete [tk::TextPrevPos %W insert tcl_startOfPreviousWord] insert + %W delete [tk::TextPrevPos %W insert tk::startOfPreviousWord] insert } } @@ -398,12 +398,7 @@ bind Text <<TkStartIMEMarkedText>> { dict set ::tk::Priv(IMETextMark) "%W" [%W index insert] } bind Text <<TkEndIMEMarkedText>> { - if { [catch {dict get $::tk::Priv(IMETextMark) "%W"} mark] } { - bell - } else { - %W tag add IMEmarkedtext $mark insert - %W tag configure IMEmarkedtext -underline on - } + ::tk::TextEndIMEMarkedText %W } bind Text <<TkClearIMEMarkedText>> { %W delete IMEmarkedtext.first IMEmarkedtext.last @@ -412,6 +407,25 @@ bind Text <<TkAccentBackspace>> { %W delete insert-1c } +# ::tk::TextEndIMEMarkedText -- +# +# Handles input method text marking in a text widget. +# +# Arguments: +# w - The text widget + +proc ::tk::TextEndIMEMarkedText {w} { + variable Priv + if {[catch { + set mark [dict get $Priv(IMETextMark) $w] + }]} { + bell + return + } + $w tag add IMEmarkedtext $mark insert + $w tag configure IMEmarkedtext -underline on +} + # Macintosh only bindings: if {[tk windowingsystem] eq "aqua"} { @@ -430,97 +444,29 @@ bind Text <Control-h> { %W see insert } } -if {[tk windowingsystem] ne "aqua"} { - bind Text <2> { - if {!$tk_strictMotif} { - tk::TextScanMark %W %x %y - } - } - bind Text <B2-Motion> { - if {!$tk_strictMotif} { - tk::TextScanDrag %W %x %y - } - } -} else { - bind Text <3> { - if {!$tk_strictMotif} { - tk::TextScanMark %W %x %y - } +bind Text <Button-2> { + if {!$tk_strictMotif} { + tk::TextScanMark %W %x %y } - bind Text <B3-Motion> { - if {!$tk_strictMotif} { - tk::TextScanDrag %W %x %y - } +} +bind Text <B2-Motion> { + if {!$tk_strictMotif} { + tk::TextScanDrag %W %x %y } } set ::tk::Priv(prevPos) {} -# The MouseWheel will typically only fire on Windows and MacOS X. -# However, someone could use the "event generate" command to produce one -# on other platforms. We must be careful not to round -ve values of %D -# down to zero. - -if {[tk windowingsystem] eq "aqua"} { - bind Text <MouseWheel> { - %W yview scroll [expr {-15 * (%D)}] pixels - } - bind Text <Option-MouseWheel> { - %W yview scroll [expr {-150 * (%D)}] pixels - } - bind Text <Shift-MouseWheel> { - %W xview scroll [expr {-15 * (%D)}] pixels - } - bind Text <Shift-Option-MouseWheel> { - %W xview scroll [expr {-150 * (%D)}] pixels - } -} else { - # We must make sure that positive and negative movements are rounded - # equally to integers, avoiding the problem that - # (int)1/3 = 0, - # but - # (int)-1/3 = -1 - # The following code ensure equal +/- behaviour. - bind Text <MouseWheel> { - if {%D >= 0} { - %W yview scroll [expr {-%D/3}] pixels - } else { - %W yview scroll [expr {(2-%D)/3}] pixels - } - } - bind Text <Shift-MouseWheel> { - if {%D >= 0} { - %W xview scroll [expr {-%D/3}] pixels - } else { - %W xview scroll [expr {(2-%D)/3}] pixels - } - } +bind Text <MouseWheel> { + tk::MouseWheel %W y %D -4.0 pixels } - -if {[tk windowingsystem] eq "x11"} { - # Support for mousewheels on Linux/Unix commonly comes through mapping - # the wheel to the extended buttons. If you have a mousewheel, find - # Linux configuration info at: - # https://linuxreviews.org/HOWTO_change_the_mouse_speed_in_X - bind Text <4> { - if {!$tk_strictMotif} { - %W yview scroll -50 pixels - } - } - bind Text <5> { - if {!$tk_strictMotif} { - %W yview scroll 50 pixels - } - } - bind Text <Shift-4> { - if {!$tk_strictMotif} { - %W xview scroll -50 pixels - } - } - bind Text <Shift-5> { - if {!$tk_strictMotif} { - %W xview scroll 50 pixels - } - } +bind Text <Option-MouseWheel> { + tk::MouseWheel %W y %D -1.2 pixels +} +bind Text <Shift-MouseWheel> { + tk::MouseWheel %W x %D -4.0 pixels +} +bind Text <Shift-Option-MouseWheel> { + tk::MouseWheel %W x %D -1.2 pixels } # ::tk::TextClosestGap -- @@ -648,8 +594,8 @@ proc ::tk::TextSelectTo {w x y {extend 0}} { } # Now find word boundaries - set first [TextPrevPos $w "$first + 1c" tcl_wordBreakBefore] - set last [TextNextPos $w "$last - 1c" tcl_wordBreakAfter] + set first [TextPrevPos $w "$first + 1c" tk::wordBreakBefore] + set last [TextNextPos $w "$last - 1c" tk::wordBreakAfter] } line { # Set initial range based only on the anchor @@ -1142,12 +1088,12 @@ proc ::tk_textPaste w { if {[tk windowingsystem] eq "win32"} { proc ::tk::TextNextWord {w start} { - TextNextPos $w [TextNextPos $w $start tcl_endOfWord] \ - tcl_startOfNextWord + TextNextPos $w [TextNextPos $w $start tk::endOfWord] \ + tk::startOfNextWord } } else { proc ::tk::TextNextWord {w start} { - TextNextPos $w $start tcl_endOfWord + TextNextPos $w $start tk::endOfWord } } @@ -1240,3 +1186,96 @@ proc ::tk::TextScanDrag {w x y} { $w scan dragto $x $y } } +# ::tk::TextUndoRedoProcessMarks -- +# +# This proc is executed after an undo or redo action. +# It processes the list of undo/redo marks temporarily set in the +# text widget to positions delimiting where changes happened, and +# returns a flat list of ranges. The temporary marks are removed +# from the text widget. +# +# Arguments: +# w - The text widget + +proc ::tk::TextUndoRedoProcessMarks {w} { + set indices {} + set undoMarks {} + + # only consider the temporary marks set by an undo/redo action + foreach mark [$w mark names] { + if {[string range $mark 0 11] eq "tk::undoMark"} { + lappend undoMarks $mark + } + } + + # transform marks into indices + # the number of undo/redo marks is always even, each right mark + # completes a left mark to give a range + # this is true because: + # - undo/redo only deals with insertions and deletions of text + # - insertions may move marks but not delete them + # - when deleting text, marks located inside the deleted range + # are not erased but moved to the start of the deletion range + # . this is done in TkBTreeDeleteIndexRange ("This segment + # refuses to die...") + # . because MarkDeleteProc does nothing else than returning + # a value indicating that marks are not deleted by this + # deleteProc + # . mark deletion rather happen through [.text mark unset xxx] + # which was not used _up to this point of the code_ (it + # is a bit later just before exiting the present proc) + set nUndoMarks [llength $undoMarks] + set n [expr {$nUndoMarks / 2}] + set undoMarks [lsort -dictionary $undoMarks] + if {$n > 0} { + set Lmarks [lrange $undoMarks 0 [expr {$n - 1}]] + } else { + set Lmarks {} + } + set Rmarks [lrange $undoMarks $n [llength $undoMarks]] + foreach Lmark $Lmarks Rmark $Rmarks { + lappend indices [$w index $Lmark] [$w index $Rmark] + $w mark unset $Lmark $Rmark + } + + # process ranges to: + # - remove those already fully included in another range + # - merge overlapping ranges + set ind [lsort -dictionary -stride 2 $indices] + set indices {} + + for {set i 0} {$i < $nUndoMarks} {incr i 2} { + set il1 [lindex $ind $i] + set ir1 [lindex $ind [expr {$i + 1}]] + lappend indices $il1 $ir1 + + for {set j [expr {$i + 2}]} {$j < $nUndoMarks} {incr j 2} { + set il2 [lindex $ind $j] + set ir2 [lindex $ind [expr {$j + 1}]] + + if {[$w compare $il2 > $ir1]} { + # second range starts after the end of first range + # -> further second ranges do not need to be considered + # because ranges were sorted by increasing first index + set j $nUndoMarks + } else { + if {[$w compare $ir2 > $ir1]} { + # second range overlaps first range + # -> merge them into a single range + set indices [lreplace $indices end-1 end] + lappend indices $il1 $ir2 + } else { + # second range is fully included in first range + # -> ignore it + } + # in both cases above, the second range shall be + # trimmed out from the list of ranges + set ind [lreplace $ind $j [expr {$j + 1}]] + incr j -2 + incr nUndoMarks -2 + } + } + } + + return $indices +} diff --git a/library/tk.tcl b/library/tk.tcl index e00f073..7f3ede3 100644 --- a/library/tk.tcl +++ b/library/tk.tcl @@ -3,15 +3,15 @@ # Initialization script normally executed in the interpreter for each Tk-based # application. Arranges class bindings for widgets. # -# Copyright (c) 1992-1994 The Regents of the University of California. -# Copyright (c) 1994-1996 Sun Microsystems, Inc. -# Copyright (c) 1998-2000 Ajuba Solutions. +# Copyright © 1992-1994 The Regents of the University of California. +# Copyright © 1994-1996 Sun Microsystems, Inc. +# Copyright © 1998-2000 Ajuba Solutions. # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # Verify that we have Tk binary and script components from the same release -package require -exact Tk 8.6.13 +package require -exact tk 8.7a6 # Create a ::tk namespace namespace eval ::tk { @@ -308,21 +308,21 @@ proc ::tk::EventMotifBindings {n1 dummy dummy} { set op add } - event $op <<Cut>> <Control-Key-w> <Control-Lock-Key-W> <Shift-Key-Delete> - event $op <<Copy>> <Meta-Key-w> <Meta-Lock-Key-W> <Control-Key-Insert> - event $op <<Paste>> <Control-Key-y> <Control-Lock-Key-Y> <Shift-Key-Insert> - event $op <<PrevChar>> <Control-Key-b> <Control-Lock-Key-B> - event $op <<NextChar>> <Control-Key-f> <Control-Lock-Key-F> - event $op <<PrevLine>> <Control-Key-p> <Control-Lock-Key-P> - event $op <<NextLine>> <Control-Key-n> <Control-Lock-Key-N> - event $op <<LineStart>> <Control-Key-a> <Control-Lock-Key-A> - event $op <<LineEnd>> <Control-Key-e> <Control-Lock-Key-E> - event $op <<SelectPrevChar>> <Control-Key-B> <Control-Lock-Key-b> - event $op <<SelectNextChar>> <Control-Key-F> <Control-Lock-Key-f> - event $op <<SelectPrevLine>> <Control-Key-P> <Control-Lock-Key-p> - event $op <<SelectNextLine>> <Control-Key-N> <Control-Lock-Key-n> - event $op <<SelectLineStart>> <Control-Key-A> <Control-Lock-Key-a> - event $op <<SelectLineEnd>> <Control-Key-E> <Control-Lock-Key-e> + event $op <<Cut>> <Control-w> <Control-Lock-W> <Shift-Delete> + event $op <<Copy>> <Meta-w> <Meta-Lock-W> <Control-Insert> + event $op <<Paste>> <Control-y> <Control-Lock-Y> <Shift-Insert> + event $op <<PrevChar>> <Control-b> <Control-Lock-B> + event $op <<NextChar>> <Control-f> <Control-Lock-F> + event $op <<PrevLine>> <Control-p> <Control-Lock-P> + event $op <<NextLine>> <Control-n> <Control-Lock-N> + event $op <<LineStart>> <Control-a> <Control-Lock-A> + event $op <<LineEnd>> <Control-e> <Control-Lock-E> + event $op <<SelectPrevChar>> <Control-B> <Control-Lock-b> + event $op <<SelectNextChar>> <Control-F> <Control-Lock-f> + event $op <<SelectPrevLine>> <Control-P> <Control-Lock-p> + event $op <<SelectNextLine>> <Control-N> <Control-Lock-n> + event $op <<SelectLineStart>> <Control-A> <Control-Lock-a> + event $op <<SelectLineEnd>> <Control-E> <Control-Lock-e> } #---------------------------------------------------------------------- @@ -368,20 +368,21 @@ if {![llength [info command tk_chooseDirectory]]} { # Define the set of common virtual events. #---------------------------------------------------------------------- +event add <<ContextMenu>> <Button-3> +event add <<PasteSelection>> <ButtonRelease-2> + switch -exact -- [tk windowingsystem] { "x11" { - event add <<Cut>> <Control-Key-x> <Key-F20> <Control-Lock-Key-X> - event add <<Copy>> <Control-Key-c> <Key-F16> <Control-Lock-Key-C> - event add <<Paste>> <Control-Key-v> <Key-F18> <Control-Lock-Key-V> - event add <<PasteSelection>> <ButtonRelease-2> - event add <<Undo>> <Control-Key-z> <Control-Lock-Key-Z> - event add <<Redo>> <Control-Key-Z> <Control-Lock-Key-z> - event add <<ContextMenu>> <Button-3> + event add <<Cut>> <Control-x> <F20> <Control-Lock-X> + event add <<Copy>> <Control-c> <F16> <Control-Lock-C> + event add <<Paste>> <Control-v> <F18> <Control-Lock-V> + event add <<Undo>> <Control-z> <Control-Lock-Z> + event add <<Redo>> <Control-Z> <Control-Lock-z> # On Darwin/Aqua, buttons from left to right are 1,3,2. On Darwin/X11 with recent # XQuartz as the X server, they are 1,2,3; other X servers may differ. - event add <<SelectAll>> <Control-Key-slash> - event add <<SelectNone>> <Control-Key-backslash> + event add <<SelectAll>> <Control-/> + event add <<SelectNone>> <Control-backslash> event add <<NextChar>> <Right> event add <<SelectNextChar>> <Shift-Right> event add <<PrevChar>> <Left> @@ -421,16 +422,14 @@ switch -exact -- [tk windowingsystem] { set ::tk::AlwaysShowSelection 1 } "win32" { - event add <<Cut>> <Control-Key-x> <Shift-Key-Delete> <Control-Lock-Key-X> - event add <<Copy>> <Control-Key-c> <Control-Key-Insert> <Control-Lock-Key-C> - event add <<Paste>> <Control-Key-v> <Shift-Key-Insert> <Control-Lock-Key-V> - event add <<PasteSelection>> <ButtonRelease-2> - event add <<Undo>> <Control-Key-z> <Control-Lock-Key-Z> - event add <<Redo>> <Control-Key-y> <Control-Lock-Key-Y> - event add <<ContextMenu>> <Button-3> - - event add <<SelectAll>> <Control-Key-slash> <Control-Key-a> <Control-Lock-Key-A> - event add <<SelectNone>> <Control-Key-backslash> + event add <<Cut>> <Control-x> <Shift-Delete> <Control-Lock-X> + event add <<Copy>> <Control-c> <Control-Insert> <Control-Lock-C> + event add <<Paste>> <Control-v> <Shift-Insert> <Control-Lock-V> + event add <<Undo>> <Control-z> <Control-Lock-Z> + event add <<Redo>> <Control-y> <Control-Lock-Y> + + event add <<SelectAll>> <Control-/> <Control-a> <Control-Lock-A> + event add <<SelectNone>> <Control-backslash> event add <<NextChar>> <Right> event add <<SelectNextChar>> <Shift-Right> event add <<PrevChar>> <Left> @@ -454,16 +453,14 @@ switch -exact -- [tk windowingsystem] { event add <<ToggleSelection>> <Control-Button-1> } "aqua" { - event add <<Cut>> <Command-Key-x> <Key-F2> <Command-Lock-Key-X> - event add <<Copy>> <Command-Key-c> <Key-F3> <Command-Lock-Key-C> - event add <<Paste>> <Command-Key-v> <Key-F4> <Command-Lock-Key-V> - event add <<PasteSelection>> <ButtonRelease-3> + event add <<Cut>> <Command-x> <F2> <Command-Lock-X> + event add <<Copy>> <Command-c> <F3> <Command-Lock-C> + event add <<Paste>> <Command-v> <F4> <Command-Lock-V> event add <<Clear>> <Clear> - event add <<ContextMenu>> <Button-2> # Official bindings # See https://support.apple.com/en-us/HT201236 - event add <<SelectAll>> <Command-Key-a> + event add <<SelectAll>> <Command-a> event add <<Undo>> <Command-Key-z> <Command-Lock-Key-Z> event add <<Redo>> <Shift-Command-Key-z> <Shift-Command-Lock-Key-z> event add <<NextChar>> <Right> <Control-Key-f> <Control-Lock-Key-F> @@ -474,14 +471,14 @@ switch -exact -- [tk windowingsystem] { event add <<SelectNextWord>> <Shift-Option-Right> event add <<PrevWord>> <Option-Left> event add <<SelectPrevWord>> <Shift-Option-Left> - event add <<LineStart>> <Home> <Command-Left> <Control-Key-a> <Control-Lock-Key-A> - event add <<SelectLineStart>> <Shift-Home> <Shift-Command-Left> <Shift-Control-Key-A> <Shift-Control-Lock-Key-A> - event add <<LineEnd>> <End> <Command-Right> <Control-Key-e> <Control-Lock-Key-E> - event add <<SelectLineEnd>> <Shift-End> <Shift-Command-Right> <Shift-Control-Key-E> <Shift-Control-Lock-Key-E> - event add <<PrevLine>> <Up> <Control-Key-p> <Control-Lock-Key-P> - event add <<SelectPrevLine>> <Shift-Up> <Shift-Control-Key-P> <Shift-Control-Lock-Key-P> - event add <<NextLine>> <Down> <Control-Key-n> <Control-Lock-Key-N> - event add <<SelectNextLine>> <Shift-Down> <Shift-Control-Key-N> <Shift-Control-Lock-Key-N> + event add <<LineStart>> <Home> <Command-Left> <Control-a> <Control-Lock-A> + event add <<SelectLineStart>> <Shift-Home> <Shift-Command-Left> <Shift-Control-A> <Shift-Control-Lock-A> + event add <<LineEnd>> <End> <Command-Right> <Control-e> <Control-Lock-E> + event add <<SelectLineEnd>> <Shift-End> <Shift-Command-Right> <Shift-Control-E> <Shift-Control-Lock-E> + event add <<PrevLine>> <Up> <Control-p> <Control-Lock-P> + event add <<SelectPrevLine>> <Shift-Up> <Shift-Control-P> <Shift-Control-Lock-P> + event add <<NextLine>> <Down> <Control-n> <Control-Lock-N> + event add <<SelectNextLine>> <Shift-Down> <Shift-Control-N> <Shift-Control-Lock-N> # Not official, but logical extensions of above. Also derived from # bindings present in MS Word on OSX. event add <<PrevPara>> <Option-Up> @@ -502,14 +499,19 @@ if {$::tk_library ne ""} { } namespace eval ::tk { SourceLibFile icons + SourceLibFile iconbadges SourceLibFile button SourceLibFile entry SourceLibFile listbox SourceLibFile menu SourceLibFile panedwindow + SourceLibFile print SourceLibFile scale SourceLibFile scrlbar SourceLibFile spinbox + if {![interp issafe]} { + SourceLibFile systray + } SourceLibFile text } } @@ -538,6 +540,13 @@ proc ::tk::CancelRepeat {} { set Priv(afterId) {} } +## ::tk::MouseWheel $w $dir $amount $factor $units + +proc ::tk::MouseWheel {w dir amount {factor -120.0} {units units}} { + $w ${dir}view scroll [expr {$amount/$factor}] $units +} + + # ::tk::TabToWindow -- # This procedure moves the focus to the given widget. # It sends a <<TraverseOut>> virtual event to the previous focus window, @@ -629,8 +638,8 @@ proc ::tk::FindAltKeyTarget {path char} { [string index [$path cget -text] [$path cget -underline]]]} { return $path } - set subwins [concat [grid slaves $path] [pack slaves $path] \ - [place slaves $path]] + set subwins [concat [grid content $path] [pack content $path] \ + [place content $path]] if {$class eq "Canvas"} { foreach item [$path find all] { if {[$path type $item] eq "window"} { @@ -681,11 +690,123 @@ if {[tk windowingsystem] eq "aqua"} { #stub procedures to respond to "do script" Apple Events proc ::tk::mac::DoScriptFile {file} { uplevel #0 $file - source -encoding utf-8 $file + source -encoding utf-8 $file } proc ::tk::mac::DoScriptText {script} { uplevel #0 $script - eval $script + eval $script + } + #This procedure is required to silence warnings generated + #by inline AppleScript execution. + proc ::tk::mac::GetDynamicSdef {} { + puts "" + } +} + +if {[info commands ::tk::endOfWord] eq ""} { + proc ::tk::endOfWord {str start {locale {}}} { + if {$start < 0} { + set start -1 + } + set start [tcl_endOfWord $str $start] + if {$start < 0} { + set start "" + } + return $start + } +} +if {[info commands ::tk::startOfNextWord] eq ""} { + proc ::tk::startOfNextWord {str start {locale {}}} { + if {$start < 0} { + set start -1 + } elseif {[string match end-* $start]} { + set start [expr {[string length $str]-1-[string range $start 4 end]}] + } + set start [tcl_startOfNextWord $str $start] + if {$start < 0} { + set start "" + } + return $start + } +} +if {[info commands ::tk::startOfPreviousWord] eq ""} { + proc ::tk::startOfPreviousWord {str start {locale {}}} { + if {$start < 0} { + set start -1 + } elseif {[string match end-* $start]} { + set start [expr {[string length $str]-1-[string range $start 4 end]}] + } + set start [tcl_startOfPreviousWord $str $start] + if {$start < 0} { + set start "" + } + return $start + } +} +if {[info commands ::tk::wordBreakBefore] eq ""} { + proc ::tk::wordBreakBefore {str start {locale {}}} { + if {$start < 0} { + set start -1 + } elseif {[string match end-* $start]} { + set start [expr {[string length $str]-1-[string range $start 4 end]}] + } + set start [tcl_wordBreakBefore $str $start] + if {$start < 0} { + set start "" + } + return $start + } +} +if {[info commands ::tk::wordBreakAfter] eq ""} { + proc ::tk::wordBreakAfter {str start {locale {}}} { + if {$start < 0} { + set start -1 + } elseif {[string match end-* $start]} { + set start [expr {[string length $str]-1-[string range $start 4 end]}] + } + set start [tcl_wordBreakAfter $str $start] + if {$start < 0} { + set start "" + } + return $start + } +} +if {[info commands ::tk::endOfCluster] eq ""} { + proc ::tk::endOfCluster {str start {locale {}}} { + if {$start < 0} { + set start -1 + } elseif {$start eq "end"} { + set start [expr {[string length $str]-1}] + } elseif {[string match end-* $start]} { + set start [expr {[string length $str]-1-[string range $start 4 end]}] + } elseif {$start >= [string length $str]} { + return "" + } + if {[string length [string index $str $start]] > 1} { + incr start + } + incr start + return $start + } +} +if {[info commands ::tk::startOfCluster] eq ""} { + proc ::tk::startOfCluster {str start {locale {}}} { + if {$start < 0} { + set start -1 + } elseif {$start eq "end"} { + set start [expr {[string length $str]-1}] + } elseif {[string match end-* $start]} { + set start [expr {[string length $str]-1-[string range $start 4 end]}] + } elseif {$start >= [string length $str]} { + return [string length $str] + } + if {[string length [string index $str $start]] < 1} { + incr start -1 + } + if {$start < 0} { + return "" + } + return $start } } @@ -694,6 +815,21 @@ if {[tk windowingsystem] eq "aqua"} { set ::tk::Priv(IMETextMark) [dict create] +# Scale the default parameters of the panedwindow sash +option add *Panedwindow.handlePad 6p widgetDefault +option add *Panedwindow.handleSize 6p widgetDefault +option add *Panedwindow.sashWidth 2.25p widgetDefault + +# Scale the default size of the scale widget and its slider +option add *Scale.length 75p widgetDefault +option add *Scale.sliderLength 22.5p widgetDefault +option add *Scale.width 11.25p widgetDefault + +# Scale the default scrollbar width on X11 +if {[tk windowingsystem] eq "x11"} { + option add *Scrollbar.width 8.25p widgetDefault +} + # Run the Ttk themed widget set initialization if {$::ttk::library ne ""} { uplevel \#0 [list source -encoding utf-8 $::ttk::library/ttk.tcl] diff --git a/library/tkfbox.tcl b/library/tkfbox.tcl index f034778..9c43cf6 100644 --- a/library/tkfbox.tcl +++ b/library/tkfbox.tcl @@ -10,7 +10,7 @@ # "Directory" option menu. The user can select files by clicking on the # file icons or by entering a filename in the "Filename:" entry. # -# Copyright (c) 1994-1998 Sun Microsystems, Inc. +# Copyright © 1994-1998 Sun Microsystems, Inc. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -24,61 +24,36 @@ namespace eval ::tk::dialog::file { # Create the images if they did not already exist. if {![info exists ::tk::Priv(updirImage)]} { - set ::tk::Priv(updirImage) [image create photo -data { - iVBORw0KGgoAAAANSUhEUgAAABYAAAAWCAYAAADEtGw7AAAABmJLR0QA/gD+AP7rGN - SCAAAACXBIWXMAAA3WAAAN1gGQb3mcAAAACXZwQWcAAAAWAAAAFgDcxelYAAAENUlE - QVQ4y7WUbWiVZRjHf/f9POcc9+Kc5bC2aIq5sGG0XnTzNU13zAIlFMNc9CEhTCKwCC - JIgt7AglaR0RcrolAKg14+GBbiGL6xZiYyy63cmzvu7MVznnOe537rw7bDyvlBoT/c - n+6L3/3nf13XLZLJJP+HfICysjKvqqpq+rWKysvLR1tbW+11g+fPn/+bEGIe4KYqCs - Owu66u7oG2trah6wJrrRc0NTVhjME5h7Vj5pxzCCE4duxYZUdHx/aGhoZmgJ+yb+wF - uCO19RmAffv25f8LFslkktraWtvU1CS6u7vRWmOtxVpbAPu+T0tLS04pFU/J34Wd3S - cdFtlfZWeZBU4IcaS5uXn1ZLAEMMY4ay1aa4wx/zpKKYIgoL6+vmjxqoXe5ZLTcsPq - bTyycjODpe1y3WMrvDAMV14jCuW0VhhjiJQpOJ5w7Zwjk8/y9R+vsHHNNq6oFMrkeX - BxI+8d2sktap3YvOPD0lRQrH+Z81fE7t3WB4gihVKazsuaA20aKSUgAG/seQdy2l6W - 37+EyopqTv39I6HJUT2zlnlza2jLdgiTaxwmDov6alLHcZUTzXPGGAauWJbfO4dHl9 - bgJs3HyfNf0N4ZsOa+jbT3/ownY/hO09p1kBULtjBw+Tvq7xzwauds4dWPDleAcP5E - xlprgtBRUZRgYCRPTzoHwEi2g6OnX+eFrW/RM9qBE4p43CeTz5ATaU6nDrFm2cPs/+ - E1SopqkZ7MFJqntXZaa7IKppckwIEvJbg8LWd28OT6nVihCPQQ8UScWCLGqO4hXuQx - qDtJ204eWrqWb1ufRspwtABWaqx5gRKUFSdwDnxPcuLcyyxbuIyaqntIBV34MY9YzC - Owg+S9YeJFkniRpGPkCLMrZzG3+jbktA/KClMxFoUhiKC0OAbAhd79CO8i6xe/STyW - 4O7KVRgUJ/sP0heeJV4kEVKw/vZd40sFKxat4mLvp6VLdvnb/XHHGGPIKwBBpC1/9n - 3DpfRZnn9/AwCxRII9O79kVPdjvByxuET6Ai8mePeTt4lyheXzhOSpCcdWa00uckTG - kckbGu76nEhbIm2xznH4VB3OWYaiXqQn8GKSWGIMHuXyPL76LBcupmhp69pz4uMnXi - w4VloTGcdQRtGdzmHs1f+RdYZslMZJhzUOHVnceN1ooEiP5JUzdqCQMWCD0JCIeQzn - NNpO+clhrCYf5rC+A2cxWmDUWG2oHEOZMEKIwclgMnnLrTeXUV7sUzpNXgU9DmijWV - v9LEKCkAIhKIBnlvpks6F21qUZ31u/sbExPa9h0/RzwzMov2nGlG5TmW1YOzzlnSfL - mVnyGf19Q7lwZHBp+1fPtflAIgiC7389n9qkihP+lWyeqfUO15ZwQTqlw9H+o2cOvN - QJCAHEgEqgYnI0NyALjAJdyWQy7wMa6AEujUdzo3LjcAXwD/XCTKIRjWytAAAAJXRF - WHRjcmVhdGUtZGF0ZQAyMDA5LTA0LTA2VDIxOjI1OjQxLTAzOjAw8s+uCAAAACV0RV - h0bW9kaWZ5LWRhdGUAMjAwOC0wMS0wM1QxNTowODoyMS0wMjowMJEc/44AAAAZdEVY - dFNvZnR3YXJlAHd3dy5pbmtzY2FwZS5vcmeb7jwaAAAAAElFTkSuQmCC + # Based on Vimix/16/actions/go-up.svg + # See https://github.com/vinceliuice/vimix-icon-theme + set ::tk::Priv(updirImage) [image create photo -format $::tk::svgFmt -data { + <?xml version="1.0" encoding="UTF-8"?> + <svg width="16" height="16" version="1.1" xmlns="http://www.w3.org/2000/svg"> + <path d="m7 14v-9l-4 4-1-1 6-6 6 6-1 1-4-4v9z"/> + </svg> }] } if {![info exists ::tk::Priv(folderImage)]} { - set ::tk::Priv(folderImage) [image create photo -data { - iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABHNCSVQICAgIfAhkiA - AAAAlwSFlzAAAN1wAADdcBQiibeAAAABl0RVh0U29mdHdhcmUAd3d3Lmlua3NjYXBl - Lm9yZ5vuPBoAAAHCSURBVDiNpZAxa5NRFIafc+9XLCni4BC6FBycMnbrLpkcgtDVX6 - C70D/g4lZX/4coxLlgxFkpiiSSUGm/JiXfveee45AmNlhawXc53HvPee55X+l2u/yP - qt3d3Tfu/viatwt3fzIYDI5uBJhZr9fr3TMzzAx3B+D09PR+v98/7HQ6z5fNOWdCCG - U4HH6s67oAVDlnV1UmkwmllBUkhMD29nYHeLuEAkyn06qU8qqu64MrgIyqYmZrkHa7 - 3drc3KTVahFjJITAaDRiPB4/XFlQVVMtHH5IzJo/P4EA4MyB+erWPQB7++zs7ccYvl - U5Z08pMW2cl88eIXLZeDUpXzsBkNQ5eP1+p0opmaoCTgzw6fjs6gLLsp58FB60t0Dc - K1Ul54yIEIMQ43Uj68pquDmCeJVztpwzuBNE2LgBoMVpslHMCUEAFgDVxQbzVAiA+a - K5uGPmmDtZF3VpoUm2ArhqQaRiUjcMf81p1G60UEVhcjZfAFTVUkrgkS+jc06mDX9n - vq4YhJ9nlxZExMwMEaHJRutOdWuIIsJFUoBSuTvHJ4YIfP46unV4qdlsjsBRZRtb/X - fHd5+C8+P7+J8BIoxFwovfRxYhnhxjpzEAAAAASUVORK5CYII= + # Based on https://icons8.com/icon/JXYalxb9XWWd/folder + set ::tk::Priv(folderImage) [image create photo -format $::tk::svgFmt -data { + <?xml version="1.0" encoding="UTF-8"?> + <svg width="16" height="16" version="1.1" xmlns="http://www.w3.org/2000/svg"> + <path d="m0.5 13.5v-12h4.293l2 2h8.707v10z" fill="#59afff"/> + <path d="m4.586 2 2 2h8.414v9h-14v-11h3.586m0.414-1h-5v13h16v-11h-9l-2-2z" fill="#2d8cff"/> + <path d="m0.5 14.5v-10h4.618l2-1h8.382v11z" fill="#8cc5ff"/> + <path d="m15 4v10h-14v-9h4.236l0.211-0.106 1.789-0.894h7.764m1-1h-9l-2 1h-5v11h16z" fill="#2d8cff"/> + </svg> }] } if {![info exists ::tk::Priv(fileImage)]} { - set ::tk::Priv(fileImage) [image create photo -data { - iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABmJLR0QA/wD/AP+gva - eTAAAACXBIWXMAAAsTAAALEwEAmpwYAAAAB3RJTUUH1QQWFA84umAmQgAAANpJREFU - OMutkj1uhDAQhb8HSLtbISGfgZ+zbJkix0HmFhwhUdocBnMBGvqtTIqIFSReWKK8ai - x73nwzHrVt+zEMwwvH9FrX9TsA1trpqKy10+yUzME4jnjvAZB0LzXHkojjmDRNVyh3 - A+89zrlVwlKSqKrqVy/J8lAUxSZBSMny4ZLgp54iyPM8UPHGNJ2IomibAKDv+9VlWZ - bABbgB5/0WQgSSkC4PF2JF4JzbHN430c4vhAm0TyCJruuClefph4yCBCGT3T3Isoy/ - KDHGfDZNcz2SZIx547/0BVRRX7n8uT/sAAAAAElFTkSuQmCC + # Based on https://icons8.com/icon/mEF_vyjYlnE3/file + set ::tk::Priv(fileImage) [image create photo -format $::tk::svgFmt -data { + <?xml version="1.0" encoding="UTF-8"?> + <svg width="16" height="16" version="1.1" xmlns="http://www.w3.org/2000/svg"> + <path d="m2 1h8l4 4v11h-12z" fill="#808080"/> + <path d="m3 2h6.5l3.5 3.5v9.5h-10z" fill="#e8e8e8"/> + <path d="m9 1v5h5v-1h-4v-4h-1z" fill="#808080"/> + </svg> }] } } @@ -363,9 +338,9 @@ proc ::tk::dialog::file::Create {w class} { $f1.menu configure -takefocus 1;# -highlightthickness 2 - pack $data(upBtn) -side right -padx 4 -fill both - pack $f1.lab -side left -padx 4 -fill both - pack $f1.menu -expand yes -fill both -padx 4 + pack $data(upBtn) -side right -padx 3p -fill both + pack $f1.lab -side left -padx 3p -fill both + pack $f1.menu -expand yes -fill both -padx 3p # data(icons): the IconList that list the files and directories. # @@ -425,7 +400,7 @@ proc ::tk::dialog::file::Create {w class} { -text $text -state disabled \ -variable ::tk::dialog::file::showHiddenVar \ -command [list ::tk::dialog::file::UpdateWhenIdle $w]] -# -anchor w -padx 3 +# -anchor w -padx 2p # the okBtn is created after the typeMenu so that the keyboard traversal # is in the right order, and add binding so that we find out when the @@ -434,30 +409,30 @@ proc ::tk::dialog::file::Create {w class} { # once will do). [Bug 987169] set data(okBtn) [::tk::AmpWidget ttk::button $f2.ok \ - -text [mc "&OK"] -default active];# -pady 3] + -text [mc "&OK"] -default active];# -pady 2p] bind $data(okBtn) <Destroy> [list ::tk::dialog::file::Destroyed $w] set data(cancelBtn) [::tk::AmpWidget ttk::button $f2.cancel \ - -text [mc "&Cancel"] -default normal];# -pady 3] + -text [mc "&Cancel"] -default normal];# -pady 2p] # grid the widgets in f2 # - grid $f2.lab $f2.ent $data(okBtn) -padx 4 -pady 3 -sticky ew - grid configure $f2.ent -padx 2 + grid $f2.lab $f2.ent $data(okBtn) -padx 3p -pady 2p -sticky ew + grid configure $f2.ent -padx 1.5p if {$class eq "TkFDialog"} { grid $data(typeMenuLab) $data(typeMenuBtn) $data(cancelBtn) \ - -padx 4 -sticky ew + -padx 3p -sticky ew grid configure $data(typeMenuBtn) -padx 0 - grid $data(hiddenBtn) -columnspan 2 -padx 4 -sticky ew + grid $data(hiddenBtn) -columnspan 2 -padx 3p -sticky ew } else { - grid $data(hiddenBtn) - $data(cancelBtn) -padx 4 -sticky ew + grid $data(hiddenBtn) - $data(cancelBtn) -padx 3p -sticky ew } grid columnconfigure $f2 1 -weight 1 # Pack all the frames together. We are done with widget construction. # - pack $f1 -side top -fill x -pady 4 - pack $f2 -side bottom -pady 4 -fill x - pack $data(icons) -expand yes -fill both -padx 4 -pady 1 + pack $f1 -side top -fill x -pady 3p + pack $f2 -side bottom -pady 3p -fill x + pack $data(icons) -expand yes -fill both -padx 3p -pady 1p # Set up the event handlers that are common to Directory and File Dialogs # diff --git a/library/ttk/altTheme.tcl b/library/ttk/altTheme.tcl index 80ef415..26708b7 100644 --- a/library/ttk/altTheme.tcl +++ b/library/ttk/altTheme.tcl @@ -8,6 +8,7 @@ namespace eval ttk::theme::alt { array set colors { -frame "#d9d9d9" -window "#ffffff" + -alternate "#f0f0f0" -darker "#c3c3c3" -border "#414141" -activebg "#ececec" @@ -26,26 +27,26 @@ namespace eval ttk::theme::alt { -bordercolor $colors(-border) \ -selectbackground $colors(-selectbg) \ -selectforeground $colors(-selectfg) \ - -font TkDefaultFont \ - ; + -font TkDefaultFont ttk::style map "." -background \ - [list disabled $colors(-frame) active $colors(-activebg)] ; - ttk::style map "." -foreground [list disabled $colors(-disabledfg)] ; - ttk::style map "." -embossed [list disabled 1] ; + [list disabled $colors(-frame) active $colors(-activebg)] + ttk::style map "." -foreground [list disabled $colors(-disabledfg)] + ttk::style map "." -embossed [list disabled 1] ttk::style configure TButton \ - -anchor center -width -11 -padding "1 1" \ + -anchor center -width -11 -padding 0.75p \ -relief raised -shiftrelief 1 \ -highlightthickness 1 -highlightcolor $colors(-frame) - ttk::style map TButton -relief { - {pressed !disabled} sunken - {active !disabled} raised + {pressed !disabled} sunken + {active !disabled} raised } -highlightcolor {alternate black} - ttk::style configure TCheckbutton -indicatorcolor "#ffffff" -padding 2 - ttk::style configure TRadiobutton -indicatorcolor "#ffffff" -padding 2 + ttk::style configure TCheckbutton -indicatorcolor "#ffffff" \ + -indicatormargin {0 1.5p 3p 1.5p} -padding 1.5p + ttk::style configure TRadiobutton -indicatorcolor "#ffffff" \ + -indicatormargin {0 1.5p 3p 1.5p} -padding 1.5p ttk::style map TCheckbutton -indicatorcolor \ [list pressed $colors(-frame) \ alternate $colors(-altindicator) \ @@ -56,44 +57,51 @@ namespace eval ttk::theme::alt { disabled $colors(-frame)] ttk::style configure TMenubutton \ - -width -11 -padding "3 3" -relief raised + -width -11 -padding 2.25p -arrowsize 3.75p -relief raised ttk::style configure TEntry -padding 1 ttk::style map TEntry -fieldbackground \ [list readonly $colors(-frame) disabled $colors(-frame)] - ttk::style configure TCombobox -padding 1 + + ttk::style configure TCombobox -padding 1 -arrowsize 10.5p ttk::style map TCombobox -fieldbackground \ [list readonly $colors(-frame) disabled $colors(-frame)] \ -arrowcolor [list disabled $colors(-disabledfg)] ttk::style configure ComboboxPopdownFrame \ -relief solid -borderwidth 1 - ttk::style configure TSpinbox -arrowsize 10 -padding {2 0 10 0} + ttk::style configure TSpinbox -arrowsize 7.5p -padding {1.5p 0 7.5p 0} ttk::style map TSpinbox -fieldbackground \ [list readonly $colors(-frame) disabled $colors(-frame)] \ -arrowcolor [list disabled $colors(-disabledfg)] - ttk::style configure Toolbutton -relief flat -padding 2 + ttk::style configure Toolbutton -relief flat -padding 1.5p ttk::style map Toolbutton -relief \ {disabled flat selected sunken pressed sunken active raised} ttk::style map Toolbutton -background \ [list pressed $colors(-darker) active $colors(-activebg)] - ttk::style configure TScrollbar -relief raised + ttk::style configure TScrollbar -relief raised \ + -arrowsize 10.5p -width 10.5p ttk::style configure TLabelframe -relief groove -borderwidth 2 - ttk::style configure TNotebook -tabmargins {2 2 1 0} - ttk::style configure TNotebook.Tab \ - -padding {4 2} -background $colors(-darker) + ttk::style configure TNotebook -tabmargins {1.5p 1.5p 0.75p 0} + ttk::style configure TNotebook.Tab -background $colors(-darker) \ + -padding {3p 1.5p} ttk::style map TNotebook.Tab \ -background [list selected $colors(-frame)] \ - -expand [list selected {2 2 1 0}] \ - ; + -expand {selected {1.5p 1.5p 0.75p 0}} # Treeview: ttk::style configure Heading -font TkHeadingFont -relief raised - ttk::style configure Treeview -background $colors(-window) + ttk::style configure Item -diameter 6.75p \ + -indicatormargins {1.5p 1.5p 3p 1.5p} + ttk::style configure Treeview -background $colors(-window) \ + -stripedbackground $colors(-alternate) -indent 15p + ttk::setTreeviewRowHeight + ttk::style configure Treeview.Separator \ + -background $colors(-alternate) ttk::style map Treeview \ -background [list disabled $colors(-frame)\ selected $colors(-selectbg)] \ @@ -101,9 +109,11 @@ namespace eval ttk::theme::alt { selected $colors(-selectfg)] ttk::style configure TScale \ - -groovewidth 4 -troughrelief sunken \ - -sliderwidth raised -borderwidth 2 + -groovewidth 3p -troughrelief sunken \ + -sliderthickness 11.25p -borderwidth 2 + ttk::style configure TProgressbar \ - -background $colors(-selectbg) -borderwidth 0 + -background $colors(-selectbg) -borderwidth 0 \ + -barsize 22.5p -thickness 11.25p } } diff --git a/library/ttk/aquaTheme.tcl b/library/ttk/aquaTheme.tcl index 876423f..7b6dd9c 100644 --- a/library/ttk/aquaTheme.tcl +++ b/library/ttk/aquaTheme.tcl @@ -26,15 +26,69 @@ namespace eval ttk::theme::aqua { !focus systemSelectedTextColor} # Button - ttk::style configure TButton -anchor center -width -6 \ + ttk::style configure TButton -anchor center \ -foreground systemControlTextColor ttk::style map TButton \ -foreground { pressed white - {alternate !pressed !background} white} + {alternate !pressed !background} white + disabled systemDisabledControlTextColor} + + # Menubutton ttk::style configure TMenubutton -anchor center -padding {2 0 0 2} + + # Toolbutton ttk::style configure Toolbutton -anchor center + # Inline Button + ttk::style configure InlineButton -anchor center -font TkHeadingFont \ + -foreground systemTextBackgroundColor + ttk::style map InlineButton \ + -foreground { + disabled systemWindowBackgroundColor + } + + # Image Button + ttk::style configure ImageButton -anchor center -width 1 \ + -compound top + ttk::style map ImageButton \ + -foreground { + pressed systemLabelColor + !pressed systemSecondaryLabelColor + } + + # Recessed (radio) button + font create RecessedFont -family EmphasizedSystem -size 11 -weight bold + ttk::style configure RecessedButton \ + -foreground systemControlTextColor + ttk::style map RecessedButton \ + -foreground { + {disabled selected} systemWindowBackgroundColor3 + {disabled !selected} systemDisabledControlTextColor + selected systemTextBackgroundColor + active white + pressed white + } \ + -font { + selected RecessedFont + active RecessedFont + pressed RecessedFont + } + + # Sidebar (radio) button + font create SidebarFont -family .AppleSystemUIFont -size 11 -weight normal + ttk::style configure SidebarButton \ + -foreground systemControlTextColor \ + -font SidebarFont + ttk::style map SidebarButton \ + -foreground { + {disabled selected} systemWindowBackgroundColor3 + {disabled !selected} systemDisabledControlTextColor + selected systemTextColor + active systemTextColor + pressed systemTextColor + } + # For Entry, Combobox and Spinbox widgets the selected text background # is the "Highlight color" selected in preferences when the widget # has focus. It is a gray color when the widget does not have focus or @@ -86,9 +140,10 @@ namespace eval ttk::theme::aqua { ttk::style configure TNotebook.Tab -foreground systemControlTextColor ttk::style map TNotebook.Tab \ -foreground { - background systemControlTextColor - disabled systemDisabledControlTextColor - selected systemSelectedTabTextColor} + {background !selected} systemControlTextColor + {background selected} black + {!background selected} systemSelectedTabTextColor + disabled systemDisabledControlTextColor} # Treeview: ttk::style configure Heading \ @@ -97,7 +152,8 @@ namespace eval ttk::theme::aqua { -background systemWindowBackgroundColor ttk::style configure Treeview -rowheight 18 \ -background systemTextBackgroundColor \ - -foreground systemTextColor \ + -stripedbackground systemDisabledControlTextColor \ + -foreground systemTextColor \ -fieldbackground systemTextBackgroundColor ttk::style map Treeview \ -background { @@ -112,7 +168,11 @@ namespace eval ttk::theme::aqua { # (ref: Apple Human Interface Guidelines / Controls / Grouping Controls) # ttk::style configure TLabelframe \ - -labeloutside true -labelmargins {14 0 14 4} + -labeloutside true \ + -labelmargins {14 0 14 2} + + ttk::style configure TLabelframe.Label \ + -font TkSmallCaptionFont # TODO: panedwindow sashes should be 9 pixels (HIG:Controls:Split Views) } diff --git a/library/ttk/button.tcl b/library/ttk/button.tcl index e8c24a1..a14a53b 100644 --- a/library/ttk/button.tcl +++ b/library/ttk/button.tcl @@ -42,7 +42,7 @@ ttk::copyBindings TButton TRadiobutton bind TRadiobutton <Up> { ttk::button::RadioTraverse %W -1 } bind TRadiobutton <Down> { ttk::button::RadioTraverse %W +1 } -# bind TCheckbutton <plus> { %W select } +# bind TCheckbutton <+> { %W select } # bind TCheckbutton <minus> { %W deselect } # activate -- @@ -66,7 +66,7 @@ proc ttk::button::activate {w} { proc ttk::button::RadioTraverse {w dir} { set group [list] foreach sibling [winfo children [winfo parent $w]] { - if { [winfo class $sibling] eq "TRadiobutton" + if { [winfo class $sibling] eq "TRadiobutton" && [$sibling cget -variable] eq [$w cget -variable] && ![$sibling instate disabled] } { @@ -75,7 +75,7 @@ proc ttk::button::RadioTraverse {w dir} { } if {![llength $group]} { # Shouldn't happen, but can. - return + return } set pos [expr {([lsearch -exact $group $w] + $dir) % [llength $group]}] diff --git a/library/ttk/clamTheme.tcl b/library/ttk/clamTheme.tcl index bfcb194..6379e81 100644 --- a/library/ttk/clamTheme.tcl +++ b/library/ttk/clamTheme.tcl @@ -5,6 +5,7 @@ # namespace eval ttk::theme::clam { + variable colors array set colors { -disabledfg "#999999" @@ -33,20 +34,19 @@ namespace eval ttk::theme::clam { -selectbackground $colors(-selectbg) \ -selectforeground $colors(-selectfg) \ -selectborderwidth 0 \ - -font TkDefaultFont \ - ; + -font TkDefaultFont ttk::style map "." \ -background [list disabled $colors(-frame) \ active $colors(-lighter)] \ -foreground [list disabled $colors(-disabledfg)] \ -selectbackground [list !focus $colors(-darkest)] \ - -selectforeground [list !focus white] \ - ; + -selectforeground [list !focus white] + # -selectbackground [list !focus "#847d73"] ttk::style configure TButton \ - -anchor center -width -11 -padding 5 -relief raised + -anchor center -width -11 -padding 3.75p -relief raised ttk::style map TButton \ -background [list \ disabled $colors(-frame) \ @@ -54,11 +54,10 @@ namespace eval ttk::theme::clam { active $colors(-lighter)] \ -lightcolor [list pressed $colors(-darker)] \ -darkcolor [list pressed $colors(-darker)] \ - -bordercolor [list alternate "#000000"] \ - ; + -bordercolor {alternate #000000} ttk::style configure Toolbutton \ - -anchor center -padding 2 -relief flat + -anchor center -padding 1.5p -relief flat ttk::style map Toolbutton \ -relief [list \ disabled flat \ @@ -70,17 +69,16 @@ namespace eval ttk::theme::clam { pressed $colors(-darker) \ active $colors(-lighter)] \ -lightcolor [list pressed $colors(-darker)] \ - -darkcolor [list pressed $colors(-darker)] \ - ; + -darkcolor [list pressed $colors(-darker)] ttk::style configure TCheckbutton \ -indicatorbackground "#ffffff" \ - -indicatormargin {1 1 4 1} \ - -padding 2 ; + -indicatormargin {0.75p 0.75p 3p 0.75p} \ + -padding 1.5p ttk::style configure TRadiobutton \ -indicatorbackground "#ffffff" \ - -indicatormargin {1 1 4 1} \ - -padding 2 ; + -indicatormargin {0.75p 0.75p 3p 0.75p} \ + -padding 1.5p ttk::style map TCheckbutton -indicatorbackground \ [list pressed $colors(-frame) \ {!disabled alternate} $colors(-altindicator) \ @@ -93,17 +91,17 @@ namespace eval ttk::theme::clam { disabled $colors(-frame)] ttk::style configure TMenubutton \ - -width -11 -padding 5 -relief raised + -width -11 -arrowsize 3.75p -padding 3.75p -relief raised ttk::style configure TEntry -padding 1 -insertwidth 1 ttk::style map TEntry \ -background [list readonly $colors(-frame)] \ -bordercolor [list focus $colors(-selectbg)] \ - -lightcolor [list focus "#6f9dc6"] \ - -darkcolor [list focus "#6f9dc6"] \ - ; + -lightcolor {focus #6f9dc6} \ + -darkcolor {focus #6f9dc6} - ttk::style configure TCombobox -padding 1 -insertwidth 1 + ttk::style configure TCombobox -padding 1 -insertwidth 1 \ + -arrowsize 10.5p ttk::style map TCombobox \ -background [list active $colors(-lighter) \ pressed $colors(-lighter)] \ @@ -114,34 +112,46 @@ namespace eval ttk::theme::clam { ttk::style configure ComboboxPopdownFrame \ -relief solid -borderwidth 1 - ttk::style configure TSpinbox -arrowsize 10 -padding {2 0 10 0} + ttk::style configure TSpinbox -arrowsize 7.5p -padding {1.5p 0 7.5p 0} ttk::style map TSpinbox \ -background [list readonly $colors(-frame)] \ -arrowcolor [list disabled $colors(-disabledfg)] - ttk::style configure TNotebook.Tab -padding {6 2 6 2} + ttk::style configure TNotebook.Tab -padding {4.5p 1.5p 4.5p 1.5p} ttk::style map TNotebook.Tab \ - -padding [list selected {6 4 6 2}] \ + -padding {selected {4.5p 3p 4.5p 1.5p}} \ -background [list selected $colors(-frame) {} $colors(-darker)] \ - -lightcolor [list selected $colors(-lighter) {} $colors(-dark)] \ - ; + -lightcolor [list selected $colors(-lighter) {} $colors(-dark)] # Treeview: ttk::style configure Heading \ - -font TkHeadingFont -relief raised -padding {3} - ttk::style configure Treeview -background $colors(-window) + -font TkHeadingFont -relief raised -padding 2.25p + ttk::style configure Item -indicatorsize 9p \ + -indicatormargins {1.5p 1.5p 3p 1.5p} + ttk::style configure Treeview -background $colors(-window) \ + -stripedbackground $colors(-lighter) -indent 15p + ttk::setTreeviewRowHeight + ttk::style configure Treeview.Separator \ + -background $colors(-lighter) ttk::style map Treeview \ -background [list disabled $colors(-frame)\ selected $colors(-selectbg)] \ -foreground [list disabled $colors(-disabledfg) \ selected $colors(-selectfg)] - ttk::style configure TLabelframe \ - -labeloutside true -labelmargins {0 0 0 4} \ + ttk::style configure TLabelframe \ + -labeloutside true -labelmargins {0 0 0 3p} \ -borderwidth 2 -relief raised - ttk::style configure TProgressbar -background $colors(-frame) + ttk::style configure TScrollbar -gripcount 3.75p \ + -arrowsize 10.5p -width 10.5p + + ttk::style configure TScale -gripcount 3.75p \ + -arrowsize 10.5p -sliderlength 22.5p + + ttk::style configure TProgressbar -background $colors(-frame) \ + -arrowsize 10.5p -sliderlength 22.5p - ttk::style configure Sash -sashthickness 6 -gripcount 10 + ttk::style configure Sash -sashthickness 4.5p -gripcount 7.5p } } diff --git a/library/ttk/classicTheme.tcl b/library/ttk/classicTheme.tcl index f237fba..7235b2b 100644 --- a/library/ttk/classicTheme.tcl +++ b/library/ttk/classicTheme.tcl @@ -6,9 +6,11 @@ namespace eval ttk::theme::classic { - variable colors; array set colors { + variable colors + array set colors { -frame "#d9d9d9" -window "#ffffff" + -alternate "#f0f0f0" -activebg "#ececec" -troughbg "#c3c3c3" -selectbg "#c3c3c3" @@ -30,8 +32,7 @@ namespace eval ttk::theme::classic { -highlightcolor $colors(-frame) \ -highlightthickness 1 \ -selectborderwidth 1 \ - -insertwidth 2 \ - ; + -insertwidth 2 # To match pre-Xft X11 appearance, use: # ttk::style configure . -font {Helvetica 12 bold} @@ -41,54 +42,60 @@ namespace eval ttk::theme::classic { ttk::style map "." -foreground \ [list disabled $colors(-disabledfg)] - ttk::style map "." -highlightcolor [list focus black] + ttk::style map "." -highlightcolor {focus black} ttk::style configure TButton \ -anchor center -padding "3m 1m" -relief raised -shiftrelief 1 - ttk::style map TButton -relief [list {!disabled pressed} sunken] + ttk::style map TButton -relief {{!disabled pressed} sunken} - ttk::style configure TCheckbutton -indicatorrelief raised + ttk::style configure TCheckbutton -indicatorrelief raised \ + -indicatordiameter 9p -indicatormargin {0 1.5p 3p 1.5p} ttk::style map TCheckbutton \ -indicatorcolor [list \ pressed $colors(-frame) \ alternate $colors(-altindicator) \ selected $colors(-indicator)] \ - -indicatorrelief {alternate raised selected sunken pressed sunken} \ - ; + -indicatorrelief {alternate raised selected sunken pressed sunken} - ttk::style configure TRadiobutton -indicatorrelief raised + ttk::style configure TRadiobutton -indicatorrelief raised \ + -indicatordiameter 9p -indicatormargin {0 1.5p 3p 1.5p} ttk::style map TRadiobutton \ -indicatorcolor [list \ pressed $colors(-frame) \ alternate $colors(-altindicator) \ selected $colors(-indicator)] \ - -indicatorrelief {alternate raised selected sunken pressed sunken} \ - ; + -indicatorrelief {alternate raised selected sunken pressed sunken} - ttk::style configure TMenubutton -relief raised -padding "3m 1m" + ttk::style configure TMenubutton -relief raised \ + -indicatormargin {3.75p 0} -padding {3m 1m} ttk::style configure TEntry -relief sunken -padding 1 -font TkTextFont ttk::style map TEntry -fieldbackground \ [list readonly $colors(-frame) disabled $colors(-frame)] - ttk::style configure TCombobox -padding 1 + + ttk::style configure TCombobox -padding 1 -arrowsize 11.75p ttk::style map TCombobox -fieldbackground \ [list readonly $colors(-frame) disabled $colors(-frame)] ttk::style configure ComboboxPopdownFrame \ -relief solid -borderwidth 1 - ttk::style configure TSpinbox -arrowsize 10 -padding {2 0 10 0} + ttk::style configure TSpinbox -arrowsize 7.5p -padding {1.5p 0 7.5p 0} ttk::style map TSpinbox -fieldbackground \ [list readonly $colors(-frame) disabled $colors(-frame)] ttk::style configure TLabelframe -borderwidth 2 -relief groove - ttk::style configure TScrollbar -relief raised + ttk::style configure TScrollbar -relief raised \ + -arrowsize 11.25p -width 11.25p ttk::style map TScrollbar -relief {{pressed !disabled} sunken} - ttk::style configure TScale -sliderrelief raised + ttk::style configure TScale -sliderrelief raised \ + -sliderlength 22.5p -sliderthickness 11.25p ttk::style map TScale -sliderrelief {{pressed !disabled} sunken} - ttk::style configure TProgressbar -background SteelBlue + ttk::style configure TProgressbar -background SteelBlue \ + -barsize 22.5p -thickness 11.25p + ttk::style configure TNotebook.Tab \ -padding {3m 1m} \ -background $colors(-troughbg) @@ -96,7 +103,13 @@ namespace eval ttk::theme::classic { # Treeview: ttk::style configure Heading -font TkHeadingFont -relief raised - ttk::style configure Treeview -background $colors(-window) + ttk::style configure Item -indicatorsize 9p \ + -indicatormargins {1.5p 1.5p 3p 1.5p} + ttk::style configure Treeview -background $colors(-window) \ + -stripedbackground $colors(-alternate) -indent 15p + ttk::setTreeviewRowHeight + ttk::style configure Treeview.Separator \ + -background $colors(-alternate) ttk::style map Treeview \ -background [list disabled $colors(-frame)\ selected $colors(-selectbg)] \ @@ -106,10 +119,13 @@ namespace eval ttk::theme::classic { # # Toolbar buttons: # - ttk::style configure Toolbutton -padding 2 -relief flat -shiftrelief 2 + ttk::style configure Toolbutton -padding 1.5p -relief flat -shiftrelief 2 ttk::style map Toolbutton -relief \ {disabled flat selected sunken pressed sunken active raised} ttk::style map Toolbutton -background \ [list pressed $colors(-troughbg) active $colors(-activebg)] + + ttk::style configure Sash \ + -sashthickness 4.5p -sashpad 1.5 -handlesize 6p -handlepad 6p } } diff --git a/library/ttk/combobox.tcl b/library/ttk/combobox.tcl index e339f97..653102e 100644 --- a/library/ttk/combobox.tcl +++ b/library/ttk/combobox.tcl @@ -16,20 +16,17 @@ # window managers (even though the older ICCCM spec says # it's meaningless). # -# On OSX: [wm transient] does utterly the wrong thing. -# Instead, we use [MacWindowStyle "help" "noActivates hideOnSuspend"]. -# The "noActivates" attribute prevents the parent toplevel -# from deactivating when the popdown is posted, and is also -# necessary for "help" windows to receive mouse events. -# "hideOnSuspend" makes the popdown disappear (resp. reappear) -# when the parent toplevel is deactivated (resp. reactivated). -# (see [#1814778]). Also set [wm resizable 0 0], to prevent -# TkAqua from shrinking the scrollbar to make room for a grow box -# that isn't there. -# -# In order to work around other platform quirks in TkAqua, -# [grab] and [focus] are set in <Map> bindings instead of -# immediately after deiconifying the window. +# On OSX: The native combobox uses a popup menu to display the +# combobox choices. So this implementation does that as well, +# rather than construc a Tk listbox. Since the window manager +# takes care of scrolling and making sure that the menu can be +# displayed even when the button is close to the bottom of the +# screen, this actually simplifies the implementation. The Post +# and PopupWindow procs have separate implementations for Aqua +# and other systems. The configuration of the menu is handled +# by a different proc than the one which configures the listbox +# on other platforms -- ConfigureAquaMenu instead of +# ConfigureListbox. # namespace eval ttk::combobox { @@ -76,6 +73,9 @@ switch -- [tk windowingsystem] { # NB: *only* do this on Windows (see #1814778) bind ComboboxListbox <FocusOut> { ttk::combobox::LBCancel %W } } + aqua { + bind TCombobox <Destroy> { ttk::combobox::AquaCleanup %W } + } } ### Combobox popdown window bindings. @@ -98,9 +98,6 @@ switch -- [tk windowingsystem] { x11 { option add *TCombobox*Listbox.background white widgetDefault } - aqua { - option add *TCombobox*Listbox.borderWidth 0 widgetDefault - } } ### Binding procedures. @@ -182,13 +179,20 @@ proc ttk::combobox::SelectEntry {cb index} { ## Scroll -- Mousewheel binding # -proc ttk::combobox::Scroll {cb dir} { +proc ttk::combobox::Scroll {cb dir {factor 1.0}} { $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 + if {$current < 0} { + set index 0 + } else { + set d [expr {$dir/$factor}] + set index [expr {$current + int($d > 0 ? ceil($d) : floor($d))}] + if {$index >= $max} {set index [expr {$max - 1}]} + if {$index < 0} {set index 0} + } + if {$max != 0 && $index != $current} { + SelectEntry $cb $index } } @@ -197,7 +201,7 @@ proc ttk::combobox::Scroll {cb dir} { # and unpost the listbox. # proc ttk::combobox::LBSelected {lb} { - set cb [LBMaster $lb] + set cb [LBMain $lb] LBSelect $lb Unpost $cb focus $cb @@ -207,14 +211,14 @@ proc ttk::combobox::LBSelected {lb} { # Unpost the listbox. # proc ttk::combobox::LBCancel {lb} { - Unpost [LBMaster $lb] + Unpost [LBMain $lb] } ## LBTab -- Tab key binding for combobox listbox. # Set the selection, and navigate to next/prev widget. # proc ttk::combobox::LBTab {lb dir} { - set cb [LBMaster $lb] + set cb [LBMain $lb] switch -- $dir { next { set newFocus [tk_focusNext $cb] } prev { set newFocus [tk_focusPrev $cb] } @@ -257,34 +261,52 @@ proc ttk::combobox::UnmapPopdown {w} { # Returns the popdown widget associated with a combobox, # creating it if necessary. # -proc ttk::combobox::PopdownWindow {cb} { - if {![winfo exists $cb.popdown]} { - set poplevel [PopdownToplevel $cb.popdown] - set popdown [ttk::frame $poplevel.f -style ComboboxPopdownFrame] - - ttk::scrollbar $popdown.sb \ - -orient vertical -command [list $popdown.l yview] - listbox $popdown.l \ - -listvariable ttk::combobox::Values($cb) \ - -yscrollcommand [list $popdown.sb set] \ - -exportselection false \ - -selectmode browse \ - -activestyle none \ - ; - - bindtags $popdown.l \ - [list $popdown.l ComboboxListbox Listbox $popdown all] - - grid $popdown.l -row 0 -column 0 -padx {1 0} -pady 1 -sticky nsew - grid $popdown.sb -row 0 -column 1 -padx {0 1} -pady 1 -sticky ns - grid columnconfigure $popdown 0 -weight 1 - grid rowconfigure $popdown 0 -weight 1 - - grid $popdown -sticky news -padx 0 -pady 0 - grid rowconfigure $poplevel 0 -weight 1 - grid columnconfigure $poplevel 0 -weight 1 + +if {[tk windowingsystem] ne "aqua"} { + proc ttk::combobox::PopdownWindow {cb} { + if {![winfo exists $cb.popdown]} { + set poplevel [PopdownToplevel $cb.popdown] + set popdown [ttk::frame $poplevel.f -style ComboboxPopdownFrame] + + ttk::scrollbar $popdown.sb \ + -orient vertical -command [list $popdown.l yview] + listbox $popdown.l \ + -listvariable ttk::combobox::Values($cb) \ + -yscrollcommand [list $popdown.sb set] \ + -exportselection false \ + -selectmode browse \ + -activestyle none \ + ; + + bindtags $popdown.l \ + [list $popdown.l ComboboxListbox Listbox $popdown all] + + grid $popdown.l -row 0 -column 0 -padx {1 0} -pady 1 -sticky nsew + grid $popdown.sb -row 0 -column 1 -padx {0 1} -pady 1 -sticky ns + grid columnconfigure $popdown 0 -weight 1 + grid rowconfigure $popdown 0 -weight 1 + + grid $popdown -sticky news -padx 0 -pady 0 + grid rowconfigure $poplevel 0 -weight 1 + grid columnconfigure $poplevel 0 -weight 1 + } + return $cb.popdown + } +} else { + proc ttk::combobox::PopdownWindow {cb} { + if {![winfo exists $cb.popdown]} { + set poplevel [PopdownToplevel $cb.popdown] + # The menu should be (at least) the same length as the button. + # Since there is no direct way to control the width of a menu + # in Tk, we fake it by using an invisible image in a disabled + # menu item, adjusting the image size to make the menu be the + # correct width. + image create nsimage $cb.spacer -source NSStatusNone -as name \ + -alpha 0 + set menu [menu $cb.popdown.menu -tearoff 0] + } + return $cb.popdown } - return $cb.popdown } ## PopdownToplevel -- Create toplevel window for the combobox popdown @@ -307,10 +329,8 @@ proc ttk::combobox::PopdownToplevel {w} { wm attributes $w -topmost 1 } aqua { - $w configure -relief solid -borderwidth 0 - tk::unsupported::MacWindowStyle style $w \ - help {noActivates hideOnSuspend} - wm resizable $w 0 0 + wm overrideredirect $w true + wm attributes $w -alpha 0 } } return $w @@ -337,7 +357,7 @@ proc ttk::combobox::ConfigureListbox {cb} { set height [llength $values] if {$height > [$cb cget -height]} { set height [$cb cget -height] - grid $popdown.sb + grid $popdown.sb grid configure $popdown.l -padx {1 0} } else { grid remove $popdown.sb @@ -346,6 +366,39 @@ proc ttk::combobox::ConfigureListbox {cb} { $popdown.l configure -height $height } +proc ttk::combobox::ConfigureAquaMenu {cb width} { + set popdown [PopdownWindow $cb] + set values [$cb cget -values] + set current [$cb current] + if {$current < 0} { + set current 0 ;# no current entry, highlight first one + } + $cb.popdown.menu delete 0 end + $cb.spacer configure -width [expr {$width - 40}] -height 1 + set i 0 + foreach item $values { + if {$i == 0} { + # Add spaces to the first item to make the menu as long as cb + set menufont [$cb cget -font] + set stretch $item + while {[font measure $menufont $stretch] < [expr {$width - 32}]} { + set stretch "$stretch " + } + $cb.popdown.menu add command -label "$stretch" \ + -command "ttk::combobox::SelectEntry $cb $i" + } else { + $cb.popdown.menu add command -label "$item" \ + -command "ttk::combobox::SelectEntry $cb $i" + } + incr i + } + if { $i == 0 } { + # There are no items. To make an empty menu appear add a dummy item + # containing a transparent image of the right width. + $cb.popdown.menu add command -label {} -image $cb.spacer -state disabled + } +} + ## PlacePopdown -- # Set popdown window geometry. # @@ -362,7 +415,7 @@ proc ttk::combobox::PlacePopdown {cb popdown} { } set postoffset [ttk::style lookup $style -postoffset {} {0 0 0 0}] foreach var {x y w h} delta $postoffset { - incr $var $delta + incr $var $delta } set H [winfo reqheight $popdown] @@ -374,34 +427,75 @@ proc ttk::combobox::PlacePopdown {cb popdown} { wm geometry $popdown ${w}x${H}+${x}+${Y} } +proc ttk::combobox::AquaPlacePopdown {cb popdown} { + set x [winfo rootx $cb] + set y [winfo rooty $cb] + set w [winfo width $cb] + set h [winfo height $cb] + set style [$cb cget -style] + set postoffset [ttk::style lookup $style -postoffset {} {0 0 0 0}] + foreach var {x y w h} delta $postoffset { + incr $var $delta + } + wm geometry $popdown ${w}x${h}+${x}+${y} + return [list $x $y $w $h] +} + ## Post $cb -- -# Pop down the associated listbox. -# -proc ttk::combobox::Post {cb} { - # Don't do anything if disabled: - # - $cb instate disabled { return } +# Pop down the associated listbox or menu. +# +if {[tk windowingsystem] ne "aqua"} { + proc ttk::combobox::Post {cb} { + # Don't do anything if disabled: + # + $cb instate disabled { return } + + # ASSERT: ![$cb instate pressed] + + # Run -postcommand callback: + # + uplevel #0 [$cb cget -postcommand] + + set popdown [PopdownWindow $cb] + ConfigureListbox $cb + update idletasks ;# needed for geometry propagation. + PlacePopdown $cb $popdown + # See <<NOTE-WM-TRANSIENT>> + switch -- [tk windowingsystem] { + x11 - win32 { wm transient $popdown [winfo toplevel $cb] } + } - # ASSERT: ![$cb instate pressed] + # Post the listbox: + # + wm attribute $popdown -topmost 1 + wm deiconify $popdown + raise $popdown + } +} else { + proc ttk::combobox::Post {cb} { + # Don't do anything if disabled: + # + $cb instate disabled { return } - # Run -postcommand callback: - # - uplevel #0 [$cb cget -postcommand] + # ASSERT: ![$cb instate pressed] - set popdown [PopdownWindow $cb] - ConfigureListbox $cb - update idletasks ;# needed for geometry propagation. - PlacePopdown $cb $popdown - # See <<NOTE-WM-TRANSIENT>> - switch -- [tk windowingsystem] { - x11 - win32 { wm transient $popdown [winfo toplevel $cb] } - } + # Run -postcommand callback: + # + uplevel #0 [$cb cget -postcommand] + + set popdown [PopdownWindow $cb] - # Post the listbox: - # - wm attribute $popdown -topmost 1 - wm deiconify $popdown - raise $popdown + # Configure the menu + + foreach {x y width height} [AquaPlacePopdown $cb $popdown] { break } + ConfigureAquaMenu $cb [winfo width $cb] + + # Post the menu. It will have a disclosure indicator if it is too + # close to the bottom of the screen, and it may be posted above the + # button if necessary to be visible. + + $popdown.menu post [expr {$x + 2}] [expr {$y + $height + 2}] + } } ## Unpost $cb -- @@ -414,10 +508,10 @@ proc ttk::combobox::Unpost {cb} { grab release $cb.popdown ;# in case of stuck or unexpected grab [#1239190] } -## LBMaster $lb -- +## LBMain $lb -- # Return the combobox main widget that owns the listbox. # -proc ttk::combobox::LBMaster {lb} { +proc ttk::combobox::LBMain {lb} { winfo parent [winfo parent [winfo parent $lb]] } @@ -425,7 +519,7 @@ proc ttk::combobox::LBMaster {lb} { # Transfer listbox selection to combobox value. # proc ttk::combobox::LBSelect {lb} { - set cb [LBMaster $lb] + set cb [LBMain $lb] set selection [$lb curselection] if {[llength $selection] == 1} { SelectEntry $cb [lindex $selection 0] @@ -442,7 +536,11 @@ proc ttk::combobox::LBSelect {lb} { # proc ttk::combobox::LBCleanup {lb} { variable Values - unset Values([LBMaster $lb]) + unset Values([LBMain $lb]) +} + +proc ttk::combobox::AquaCleanup {cb} { + catch {image delete $cb.spacer} } #*EOF* diff --git a/library/ttk/defaults.tcl b/library/ttk/defaults.tcl index 2db9a37..6f46dfd 100644 --- a/library/ttk/defaults.tcl +++ b/library/ttk/defaults.tcl @@ -3,11 +3,13 @@ # namespace eval ttk::theme::default { + variable colors array set colors { -frame "#d9d9d9" -foreground "#000000" -window "#ffffff" + -alternate "#e8e8e8" -text "#000000" -activebg "#ececec" -selectbg "#4a6984" @@ -16,9 +18,69 @@ namespace eval ttk::theme::default { -disabledfg "#a3a3a3" -indicator "#4a6984" -disabledindicator "#a3a3a3" - -altindicator "#9fbdd8" - -disabledaltindicator "#c0c0c0" + -pressedindicator "#5895bc" + } + + # On X11, if the user specifies their own choice of colour scheme via + # X resources, then set the colour palette based on the user's choice. + if {[tk windowingsystem] eq "x11"} { + foreach \ + xResourceName { + { background Background } + { foreground Foreground } + { background Background } + { background Background } + { foreground Foreground } + { activeBackground ActiveBackground } + { selectBackground SelectBackground } + { selectForeground SelectForeground } + { troughColor TroughColor } + { disabledForeground DisabledForeground } + { selectBackground SelectBackground } + { disabledForeground DisabledForeground } + { selectBackground SelectBackground } + { windowColor Background } } \ + colorName { + -frame -foreground -window -alternate -text + -activebg -selectbg -selectfg + -darker -disabledfg -indicator + -disabledindicator -pressedindicator -window } { + set color [eval option get . $xResourceName] + if {$color ne ""} { + set colors($colorName) $color + } + } + } + + # This array is used to match up the tk widget options with + # the corresponding values in the 'colors' array. + # This is used by tk_setPalette to apply the new palette + # to the ttk widgets. + variable colorOptionLookup + array set colorOptionLookup { + background {-frame -window -alternate} + foreground {-foreground -text} + activeBackground -activebg + selectBackground {-selectbg -indicator -pressedindicator} + selectForeground -selectfg + troughColor -darker + disabledForeground {-disabledfg -disabledindicator} } +} + +# ttk::theme::default::reconfigureDefaultTheme -- +# +# This procedure contains the definition of the 'default' theme itself. +# The theme definition is in a procedure, so it can be re-called when +# required, enabling tk_setPalette to set the colours of the ttk widgets. +# +# Arguments: +# None. + +proc ttk::theme::default::reconfigureDefaultTheme {} { + upvar ttk::theme::default::colors colors + + # The definition of the 'default' theme. ttk::style theme settings default { @@ -32,83 +94,93 @@ namespace eval ttk::theme::default { -selectbackground $colors(-selectbg) \ -selectforeground $colors(-selectfg) \ -insertwidth 1 \ - -indicatordiameter 10 \ ; ttk::style map "." -background \ [list disabled $colors(-frame) active $colors(-activebg)] ttk::style map "." -foreground \ - [list disabled $colors(-disabledfg)] + [list disabled $colors(-disabledfg) !disabled $colors(-text)] + ttk::style map "." -insertcolor \ + [list !disabled $colors(-foreground)] + ttk::style map "." -focuscolor \ + [list !disabled $colors(-text)] ttk::style configure TButton \ - -anchor center -padding "3 3" -width -9 \ + -anchor center -padding 2.25p -width -9 \ -relief raised -shiftrelief 1 ttk::style map TButton -relief [list {!disabled pressed} sunken] - ttk::style configure TCheckbutton \ - -indicatorcolor "#ffffff" -indicatorrelief sunken -padding 1 - ttk::style map TCheckbutton -indicatorcolor \ - [list pressed $colors(-activebg) \ - {!disabled alternate} $colors(-altindicator) \ - {disabled alternate} $colors(-disabledaltindicator) \ - {!disabled selected} $colors(-indicator) \ - {disabled selected} $colors(-disabledindicator)] - ttk::style map TCheckbutton -indicatorrelief \ - [list alternate raised] - - ttk::style configure TRadiobutton \ - -indicatorcolor "#ffffff" -indicatorrelief sunken -padding 1 - ttk::style map TRadiobutton -indicatorcolor \ - [list pressed $colors(-activebg) \ - {!disabled alternate} $colors(-altindicator) \ - {disabled alternate} $colors(-disabledaltindicator) \ - {!disabled selected} $colors(-indicator) \ - {disabled selected} $colors(-disabledindicator)] - ttk::style map TRadiobutton -indicatorrelief \ - [list alternate raised] + foreach style {TCheckbutton TRadiobutton} { + ttk::style configure $style \ + -indicatorbackground $colors(-window) \ + -indicatorforeground $colors(-selectfg) \ + -indicatormargin {0 1.5p 3p 1.5p} -padding 0.75p + ttk::style map $style -indicatorbackground \ + [list {alternate disabled} $colors(-disabledindicator) \ + {alternate pressed} $colors(-pressedindicator) \ + alternate $colors(-indicator) \ + {selected disabled} $colors(-disabledindicator) \ + {selected pressed} $colors(-pressedindicator) \ + selected $colors(-indicator) \ + disabled $colors(-frame) \ + pressed $colors(-darker)] + } ttk::style configure TMenubutton \ - -relief raised -padding "10 3" + -relief raised -indicatormargin {3.75p 0} -padding {7.5p 2.25p} ttk::style configure TEntry \ - -relief sunken -fieldbackground white -padding 1 + -relief sunken -fieldbackground $colors(-window) -padding 1 ttk::style map TEntry -fieldbackground \ [list readonly $colors(-frame) disabled $colors(-frame)] - ttk::style configure TCombobox -arrowsize 12 -padding 1 + ttk::style configure TCombobox -arrowsize 9p -padding 1 ttk::style map TCombobox -fieldbackground \ - [list readonly $colors(-frame) disabled $colors(-frame)] \ - -arrowcolor [list disabled $colors(-disabledfg)] + [list readonly $colors(-frame) disabled $colors(-frame) !disabled $colors(-window)] \ + -arrowcolor [list disabled $colors(-disabledfg) !disabled $colors(-text)] - ttk::style configure TSpinbox -arrowsize 10 -padding {2 0 10 0} + ttk::style configure TSpinbox -arrowsize 7.5p -padding {1.5p 0 7.5p 0} ttk::style map TSpinbox -fieldbackground \ - [list readonly $colors(-frame) disabled $colors(-frame)] \ - -arrowcolor [list disabled $colors(-disabledfg)] + [list readonly $colors(-frame) disabled $colors(-frame) !disabled $colors(-window)] \ + -arrowcolor [list disabled $colors(-disabledfg) !disabled $colors(-text)] ttk::style configure TLabelframe \ -relief groove -borderwidth 2 ttk::style configure TScrollbar \ - -width 12 -arrowsize 12 + -width 9p -arrowsize 9p ttk::style map TScrollbar \ - -arrowcolor [list disabled $colors(-disabledfg)] + -arrowcolor [list disabled $colors(-disabledfg) !disabled $colors(-text)] ttk::style configure TScale \ - -sliderrelief raised + -sliderrelief raised \ + -sliderlength 22.5p \ + -sliderthickness 11.25p + ttk::style configure TProgressbar \ - -background $colors(-selectbg) + -background $colors(-selectbg) \ + -barsize 22.5p \ + -thickness 11.25p ttk::style configure TNotebook.Tab \ - -padding {4 2} -background $colors(-darker) + -padding {3p 1.5p} -background $colors(-darker) ttk::style map TNotebook.Tab \ -background [list selected $colors(-frame)] # Treeview. # ttk::style configure Heading -font TkHeadingFont -relief raised + ttk::style configure Item -indicatorsize 9p \ + -indicatormargins {1.5p 1.5p 3p 1.5p} ttk::style configure Treeview \ -background $colors(-window) \ - -foreground $colors(-text) ; + -stripedbackground $colors(-alternate) \ + -fieldbackground $colors(-window) \ + -foreground $colors(-text) \ + -indent 15p + ttk::setTreeviewRowHeight + ttk::style configure Treeview.Separator \ + -background $colors(-alternate) ttk::style map Treeview \ -background [list disabled $colors(-frame)\ selected $colors(-selectbg)] \ @@ -134,10 +206,12 @@ namespace eval ttk::theme::default { } ttk::style configure Toolbutton \ - -padding 2 -relief flat + -padding 1.5p -relief flat ttk::style map Toolbutton -relief \ [list disabled flat selected sunken pressed sunken active raised] ttk::style map Toolbutton -background \ [list pressed $colors(-darker) active $colors(-activebg)] } } + +ttk::theme::default::reconfigureDefaultTheme diff --git a/library/ttk/entry.tcl b/library/ttk/entry.tcl index 12080a3..dc67269 100644 --- a/library/ttk/entry.tcl +++ b/library/ttk/entry.tcl @@ -1,9 +1,9 @@ # # 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 +# Copyright © 1992-1994 The Regents of the University of California. +# Copyright © 1994-1997 Sun Microsystems, Inc. +# Copyright © 2004, Joe English # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -82,20 +82,14 @@ bind TEntry <<ToggleSelection>> { %W instate {!readonly !disabled} { %W icursor @%x ; focus %W } } -## Button2 (Button3 on Aqua) bindings: +## Button2 bindings: # Used for scanning and primary transfer. -# Note: ButtonRelease-2 (ButtonRelease-3 on Aqua) +# Note: ButtonRelease-2 # is mapped to <<PasteSelection>> in tk.tcl. # -if {[tk windowingsystem] ne "aqua"} { - bind TEntry <Button-2> { ttk::entry::ScanMark %W %x } - bind TEntry <B2-Motion> { ttk::entry::ScanDrag %W %x } - bind TEntry <ButtonRelease-2> { ttk::entry::ScanRelease %W %x } -} else { - bind TEntry <Button-3> { ttk::entry::ScanMark %W %x } - bind TEntry <B3-Motion> { ttk::entry::ScanDrag %W %x } - bind TEntry <ButtonRelease-3> { ttk::entry::ScanRelease %W %x } -} +bind TEntry <Button-2> { ttk::entry::ScanMark %W %x } +bind TEntry <B2-Motion> { ttk::entry::ScanDrag %W %x } +bind TEntry <ButtonRelease-2> { ttk::entry::ScanRelease %W %x } bind TEntry <<PasteSelection>> { ttk::entry::ScanRelease %W %x } ## Keyboard navigation bindings: @@ -125,7 +119,7 @@ bind TEntry <Key> { ttk::entry::Insert %W %A } bind TEntry <Delete> { ttk::entry::Delete %W } bind TEntry <BackSpace> { ttk::entry::Backspace %W } -# Ignore all Alt, Meta, and Control keypresses unless explicitly bound. +# Ignore all Alt, Meta, Control, Command, and Fn keypresses unless explicitly bound. # Otherwise, the <Key> class binding will fire and insert the character. # Ditto for Escape, Return, and Tab. # @@ -136,13 +130,9 @@ bind TEntry <Escape> {# nothing} bind TEntry <Return> {# nothing} bind TEntry <KP_Enter> {# nothing} bind TEntry <Tab> {# nothing} +bind TEntry <Command-Key> {# nothing} +bind TEntry <Fn-Key> {# nothing} -# Argh. Apparently on Windows, the NumLock modifier is interpreted -# as a Command modifier. -if {[tk windowingsystem] eq "aqua"} { - bind TEntry <Command-Key> {# nothing} - bind TEntry <Mod4-Key> {# nothing} -} # Tk-on-Cocoa generates characters for these two keys. [Bug 2971663] bind TEntry <<PrevLine>> {# nothing} bind TEntry <<NextLine>> {# nothing} @@ -172,6 +162,19 @@ bind TEntry <<TkAccentBackspace>> { ttk::entry::Backspace %W } +## EndIMEMarkedText -- Handle the end of input method selection. +# +proc ::ttk::entry::EndIMEMarkedText {w} { + variable ::tk::Priv + if {[catch { + set mark [dict get $Priv(IMETextMark) $w] + }]} { + bell + return + } + $w selection range $mark insert +} + ### Clipboard procedures. # @@ -180,7 +183,7 @@ bind TEntry <<TkAccentBackspace>> { # proc ttk::entry::EntrySelection {w} { set entryString [string range [$w get] [$w index sel.first] \ - [expr {[$w index sel.last] - 1}]] + [$w index sel.last]-1] if {[$w cget -show] ne ""} { return [string repeat [string index [$w cget -show] 0] \ [string length $entryString]] @@ -255,9 +258,9 @@ set ::ttk::entry::State(startNext) \ proc ttk::entry::NextWord {w start} { variable State - set pos [tcl_endOfWord [$w get] [$w index $start]] + set pos [tk::endOfWord [$w get] [$w index $start]] if {$pos >= 0 && $State(startNext)} { - set pos [tcl_startOfNextWord [$w get] $pos] + set pos [tk::startOfNextWord [$w get] $pos] } if {$pos < 0} { return end @@ -268,7 +271,28 @@ proc ttk::entry::NextWord {w start} { ## PrevWord -- Find the previous word position. # proc ttk::entry::PrevWord {w start} { - set pos [tcl_startOfPreviousWord [$w get] [$w index $start]] + set pos [tk::startOfPreviousWord [$w get] [$w index $start]] + if {$pos < 0} { + return 0 + } + return $pos +} + +## NextChar -- Find the next char position. +# +proc ttk::entry::NextChar {w start} { + variable State + set pos [tk::endOfCluster [$w get] [$w index $start]] + if {$pos < 0} { + return end + } + return $pos +} + +## PrevChar -- Find the previous char position. +# +proc ttk::entry::PrevChar {w start} { + set pos [tk::startOfCluster [$w get] [expr {[$w index $start]-1}]] if {$pos < 0} { return 0 } @@ -279,8 +303,8 @@ proc ttk::entry::PrevWord {w start} { # proc ttk::entry::RelIndex {w where {index insert}} { switch -- $where { - prevchar { expr {[$w index $index] - 1} } - nextchar { expr {[$w index $index] + 1} } + prevchar { PrevChar $w $index } + nextchar { NextChar $w $index } prevword { PrevWord $w $index } nextword { NextWord $w $index } home { return 0 } @@ -321,9 +345,9 @@ proc ttk::entry::ExtendTo {w index} { # Figure out selection anchor: if {![$w selection present]} { - set anchor $insert + set anchor $insert } else { - set selfirst [$w index sel.first] + set selfirst [$w index sel.first] set sellast [$w index sel.last] if { ($index < $selfirst) @@ -339,7 +363,7 @@ proc ttk::entry::ExtendTo {w index} { if {$anchor < $index} { $w selection range $anchor $index } else { - $w selection range $index $anchor + $w selection range $index $anchor } $w icursor $index @@ -399,8 +423,8 @@ proc ttk::entry::Select {w x mode} { set cur [ClosestGap $w $x] switch -- $mode { - word { WordSelect $w $cur $cur } - line { LineSelect $w $cur $cur } + word { WordSelect $w $cur $cur } + line { LineSelect $w $cur $cur } char { # no-op } } @@ -506,11 +530,11 @@ proc ttk::entry::WordSelect {w from to} { ## WordBack, WordForward -- helper routines for WordSelect. # proc ttk::entry::WordBack {text index} { - if {[set pos [tcl_wordBreakBefore $text $index]] < 0} { return 0 } + if {[set pos [tk::wordBreakBefore $text $index]] < 0} { return 0 } return $pos } proc ttk::entry::WordForward {text index} { - if {[set pos [tcl_wordBreakAfter $text $index]] < 0} { return end } + if {[set pos [tk::wordBreakAfter $text $index]] < 0} { return end } return $pos } @@ -548,7 +572,7 @@ proc ttk::entry::ScanDrag {w x} { $w xview $left if {$left != [set newLeft [$w index @0]]} { - # We've scanned past one end of the entry; + # 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. # @@ -605,13 +629,13 @@ proc ttk::entry::Insert {w s} { # proc ttk::entry::Backspace {w} { if {[PendingDelete $w]} { - See $w + See $w return } set x [expr {[$w index insert] - 1}] if {$x < 0} { return } - $w delete $x + $w delete [tk::startOfCluster [$w get] $x] [tk::endOfCluster [$w get] $x] if {[$w index @0] >= [$w index insert]} { set range [$w xview] @@ -626,7 +650,8 @@ proc ttk::entry::Backspace {w} { # proc ttk::entry::Delete {w} { if {![PendingDelete $w]} { - $w delete insert + $w delete [tk::startOfCluster [$w get] [$w index insert]] \ + [tk::endOfCluster [$w get] [$w index insert]] } } diff --git a/library/ttk/fonts.tcl b/library/ttk/fonts.tcl index bf4ccd0..0897af0 100644 --- a/library/ttk/fonts.tcl +++ b/library/ttk/fonts.tcl @@ -53,10 +53,6 @@ # Most other toolkits use medium weight for all UI elements, # which is what we do now. # -# Font size specified in pixels on X11, not points. -# This is Theoretically Wrong, but in practice works better; using -# points leads to huge inconsistencies across different servers. -# namespace eval ttk { @@ -70,87 +66,89 @@ catch {font create TkIconFont} catch {font create TkMenuFont} catch {font create TkSmallCaptionFont} -if {!$tip145} { -variable F ;# miscellaneous platform-specific font parameters +if {!$tip145} {apply {{} { +global tcl_platform switch -- [tk windowingsystem] { win32 { # In safe interps there is no osVersion element. if {[info exists tcl_platform(osVersion)]} { if {$tcl_platform(osVersion) >= 5.0} { - set F(family) "Tahoma" + set family "Tahoma" } else { - set F(family) "MS Sans Serif" + set family "MS Sans Serif" } } else { if {[lsearch -exact [font families] Tahoma] >= 0} { - set F(family) "Tahoma" + set family "Tahoma" } else { - set F(family) "MS Sans Serif" + set family "MS Sans Serif" } } - set F(size) 8 + set size 8 - font configure TkDefaultFont -family $F(family) -size $F(size) - font configure TkTextFont -family $F(family) -size $F(size) - font configure TkHeadingFont -family $F(family) -size $F(size) - font configure TkCaptionFont -family $F(family) -size $F(size) \ - -weight bold - font configure TkTooltipFont -family $F(family) -size $F(size) + font configure 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 font configure TkFixedFont -family Courier -size 10 - font configure TkIconFont -family $F(family) -size $F(size) - font configure TkMenuFont -family $F(family) -size $F(size) - font configure TkSmallCaptionFont -family $F(family) -size $F(size) + font configure TkIconFont -family $family -size $size + font configure TkMenuFont -family $family -size $size + font configure TkSmallCaptionFont -family $family -size $size } aqua { - set F(family) "Lucida Grande" - set F(fixed) "Monaco" - set F(menusize) 14 - set F(size) 13 - set F(viewsize) 12 - set F(smallsize) 11 - set F(labelsize) 10 - set F(fixedsize) 11 + set family "Lucida Grande" + set fixed "Monaco" + set menusize 14 + set size 13 + set viewsize 12 + set smallsize 11 + set labelsize 10 + set fixedsize 11 - font configure TkDefaultFont -family $F(family) -size $F(size) - font configure TkTextFont -family $F(family) -size $F(size) - font configure TkHeadingFont -family $F(family) -size $F(smallsize) - font configure TkCaptionFont -family $F(family) -size $F(size) \ - -weight bold - font configure TkTooltipFont -family $F(family) -size $F(smallsize) - font configure TkFixedFont -family $F(fixed) -size $F(fixedsize) - font configure TkIconFont -family $F(family) -size $F(size) - font configure TkMenuFont -family $F(family) -size $F(menusize) - font configure TkSmallCaptionFont -family $F(family) -size $F(labelsize) + 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 $smallsize + font configure TkFixedFont -family $fixed -size $fixedsize + font configure TkIconFont -family $family -size $size + font configure TkMenuFont -family $family -size $menusize + font configure TkSmallCaptionFont -family $family -size $labelsize } default - x11 { - if {![catch {tk::pkgconfig get fontsystem} F(fs)] && $F(fs) eq "xft"} { - set F(family) "sans-serif" - set F(fixed) "monospace" + if {![catch {tk::pkgconfig get fontsystem} fs] && $fs eq "xft"} { + set family "sans-serif" + set fixed "monospace" + } else { + set family "Helvetica" + set fixed "courier" + } + if {$::tk::fontScalingFactor == 1} { + set size 10 + set ttsize 9 + set capsize 12 + set fixedsize 10 } else { - set F(family) "Helvetica" - set F(fixed) "courier" + set size 20 + set ttsize 18 + set capsize 24 + set fixedsize 20 } - set F(size) -12 - set F(ttsize) -10 - set F(capsize) -14 - set F(fixedsize) -12 - font configure TkDefaultFont -family $F(family) -size $F(size) - font configure TkTextFont -family $F(family) -size $F(size) - font configure TkHeadingFont -family $F(family) -size $F(size) \ - -weight bold - font configure TkCaptionFont -family $F(family) -size $F(capsize) \ - -weight bold - font configure TkTooltipFont -family $F(family) -size $F(ttsize) - font configure TkFixedFont -family $F(fixed) -size $F(fixedsize) - font configure TkIconFont -family $F(family) -size $F(size) - font configure TkMenuFont -family $F(family) -size $F(size) - font configure TkSmallCaptionFont -family $F(family) -size $F(ttsize) + 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 + font configure TkFixedFont -family $fixed -size $fixedsize + font configure TkIconFont -family $family -size $size + font configure TkMenuFont -family $family -size $size + font configure TkSmallCaptionFont -family $family -size $ttsize } } -unset -nocomplain F -} +} ::ttk}} } diff --git a/library/ttk/menubutton.tcl b/library/ttk/menubutton.tcl index f98a5da..8ef8937 100644 --- a/library/ttk/menubutton.tcl +++ b/library/ttk/menubutton.tcl @@ -57,7 +57,7 @@ if {[tk windowingsystem] eq "x11"} { bind TMenubutton <Button-1> \ { %W state pressed ; ttk::menubutton::Popdown %W } bind TMenubutton <ButtonRelease-1> \ - { if {[winfo exists %W]} { %W state !pressed } } + { if {[winfo exists %W]} { %W state {!pressed}} } } # PostPosition -- @@ -77,6 +77,7 @@ if {[tk windowingsystem] eq "aqua"} { set menuPad 5 set buttonPad 1 set bevelPad 4 + set flushPad 4 set mh [winfo reqheight $menu] set bh [expr {[winfo height $mb]} + $buttonPad] set bbh [expr {[winfo height $mb]} + $bevelPad] @@ -105,8 +106,11 @@ if {[tk windowingsystem] eq "aqua"} { incr y $menuPad incr x $bw } - default { # flush - incr y $bbh + flush { + incr y $flushPad + incr x -$flushPad + } + default { } } return [list $x $y $entry] @@ -134,7 +138,7 @@ if {[tk windowingsystem] eq "aqua"} { # if we go offscreen to the top, show as 'below' if {$y < [winfo vrooty $mb]} { set y [expr {[winfo vrooty $mb] + [winfo rooty $mb]\ - + [winfo reqheight $mb]}] + + [winfo reqheight $mb]}] } } below { @@ -207,7 +211,7 @@ proc ttk::menubutton::TransferGrab {mb} { set menu [$mb cget -menu] foreach {x y entry} [PostPosition $mb $menu] { break } - tk_popup $menu [winfo rootx $menu] [winfo rooty $menu] + tk_popup $menu [winfo rootx $menu] [winfo rooty $menu] } } @@ -218,7 +222,7 @@ proc ttk::menubutton::TransferGrab {mb} { # proc ttk::menubutton::FindMenuEntry {menu s} { set last [$menu index last] - if {$last eq "none" || $last < 0} { + if {$last < 0} { return "" } for {set i 0} {$i <= $last} {incr i} { diff --git a/library/ttk/notebook.tcl b/library/ttk/notebook.tcl index 518c6f5..7097c45 100644 --- a/library/ttk/notebook.tcl +++ b/library/ttk/notebook.tcl @@ -16,6 +16,8 @@ bind TNotebook <Control-ISO_Left_Tab> { ttk::notebook::CycleTab %W -1; break } } bind TNotebook <Destroy> { ttk::notebook::Cleanup %W } +ttk::bindMouseWheel TNotebook [list ttk::notebook::CycleTab %W] + # ActivateTab $nb $tab -- # Select the specified tab and set focus. # @@ -56,12 +58,14 @@ proc ttk::notebook::Press {w x y} { # CycleTab -- # Select the next/previous tab in the list. # -proc ttk::notebook::CycleTab {w dir} { +proc ttk::notebook::CycleTab {w dir {factor 1.0}} { set current [$w index current] if {$current >= 0} { set tabCount [$w index end] - set select [expr {($current + $dir) % $tabCount}] - set step [expr {$dir > 0 ? 1 : -1}] + set d [expr {$dir/$factor}] + set d [expr {int($d > 0 ? ceil($d) : floor($d))}] + set select [expr {($current + $d) % $tabCount}] + set step [expr {$d > 0 ? 1 : -1}] while {[$w tab $select -state] ne "normal" && ($select != $current)} { set select [expr {($select + $step) % $tabCount}] } @@ -114,13 +118,8 @@ proc ttk::notebook::enableTraversal {nb} { catch { bind $top <Control-ISO_Left_Tab> {+ttk::notebook::TLCycleTab %W -1} } - if {[tk windowingsystem] eq "aqua"} { - bind $top <Option-Key> \ - +[list ttk::notebook::MnemonicActivation $top %K] - } else { - bind $top <Alt-Key> \ - +[list ttk::notebook::MnemonicActivation $top %K] - } + bind $top <Option-Key> \ + +[list ttk::notebook::MnemonicActivation $top %K] bind $top <Destroy> {+ttk::notebook::TLCleanup %W} } diff --git a/library/ttk/panedwindow.tcl b/library/ttk/panedwindow.tcl index 1989b89..877f486 100644 --- a/library/ttk/panedwindow.tcl +++ b/library/ttk/panedwindow.tcl @@ -6,7 +6,7 @@ namespace eval ttk::panedwindow { variable State array set State { pressed 0 - pressX - + pressX - pressY - sash - sashPos - @@ -32,7 +32,7 @@ proc ttk::panedwindow::Press {w x y} { set sash [$w identify $x $y] if {$sash eq ""} { - set State(pressed) 0 + set State(pressed) 0 return } set State(pressed) 1 @@ -79,7 +79,7 @@ proc ttk::panedwindow::SetCursor {w x y} { set cursor $State(userConfCursor) if {[llength [$w identify $x $y]]} { - # Assume we're over a sash. + # Assume we're over a sash. switch -glob -- [$w cget -orient] { h* { set cursor hresize } v* { set cursor vresize } diff --git a/library/ttk/progress.tcl b/library/ttk/progress.tcl index 34dce72..929f0e6 100644 --- a/library/ttk/progress.tcl +++ b/library/ttk/progress.tcl @@ -13,13 +13,13 @@ proc ttk::progressbar::Autoincrement {pb steptime stepsize} { variable Timers if {![winfo exists $pb]} { - # widget has been destroyed -- cancel timer + # widget has been destroyed -- cancel timer unset -nocomplain Timers($pb) return } set Timers($pb) [after $steptime \ - [list ttk::progressbar::Autoincrement $pb $steptime $stepsize] ] + [list ttk::progressbar::Autoincrement $pb $steptime $stepsize] ] $pb step $stepsize } @@ -32,6 +32,9 @@ proc ttk::progressbar::start {pb {steptime 50} {stepsize 1}} { if {![info exists Timers($pb)]} { Autoincrement $pb $steptime $stepsize } + if {[tk windowingsystem] eq "aqua"} { + $pb state selected + } } # ttk::progressbar::stop -- @@ -44,6 +47,9 @@ proc ttk::progressbar::stop {pb} { unset Timers($pb) } $pb configure -value 0 + if {[tk windowingsystem] eq "aqua"} { + $pb state !selected + } } diff --git a/library/ttk/scale.tcl b/library/ttk/scale.tcl index 61c4136..a97440d 100644 --- a/library/ttk/scale.tcl +++ b/library/ttk/scale.tcl @@ -1,4 +1,4 @@ -# scale.tcl - Copyright (C) 2004 Pat Thoyts <patthoyts@users.sourceforge.net> +# scale.tcl - Copyright © 2004 Pat Thoyts <patthoyts@users.sourceforge.net> # # Bindings for the TScale widget diff --git a/library/ttk/scrollbar.tcl b/library/ttk/scrollbar.tcl index 8be9887..6ad6e15 100644 --- a/library/ttk/scrollbar.tcl +++ b/library/ttk/scrollbar.tcl @@ -19,22 +19,8 @@ bind TScrollbar <ButtonRelease-2> { ttk::scrollbar::Release %W %x %y } # Redirect scrollwheel bindings to the scrollbar widget # -# The shift-bindings scroll left/right (not up/down) -# if a widget has both possibilities -set eventList [list <MouseWheel> <Shift-MouseWheel>] -switch [tk windowingsystem] { - aqua { - lappend eventList <Option-MouseWheel> <Shift-Option-MouseWheel> - } - x11 { - lappend eventList <Button-4> <Button-5> \ - <Shift-Button-4> <Shift-Button-5> - } -} -foreach event $eventList { - bind TScrollbar $event [bind Scrollbar $event] -} -unset eventList event +bind TScrollbar <MouseWheel> [bind Scrollbar <MouseWheel>] +bind TScrollbar <Option-MouseWheel> [bind Scrollbar <Option-MouseWheel>] proc ttk::scrollbar::Scroll {w n units} { set cmd [$w cget -command] @@ -88,7 +74,7 @@ proc ttk::scrollbar::Press {w x y} { proc ttk::scrollbar::Drag {w x y} { variable State if {![info exists State(first)]} { - # Initial buttonpress was not on the thumb, + # Initial buttonpress was not on the thumb, # or something screwy has happened. In either case, ignore: return; } diff --git a/library/ttk/sizegrip.tcl b/library/ttk/sizegrip.tcl index 080ab2d..2a49451 100644 --- a/library/ttk/sizegrip.tcl +++ b/library/ttk/sizegrip.tcl @@ -12,7 +12,7 @@ switch -- [tk windowingsystem] { option add *TSizegrip.cursor [ttk::cursor seresize] widgetDefault } aqua { - # Aqua sizegrips use default Arrow cursor. + # Aqua sizegrips use default Arrow cursor. } } diff --git a/library/ttk/spinbox.tcl b/library/ttk/spinbox.tcl index 8aba5e1..9f002cd 100644 --- a/library/ttk/spinbox.tcl +++ b/library/ttk/spinbox.tcl @@ -23,7 +23,7 @@ bind TSpinbox <Down> { event generate %W <<Decrement>> } bind TSpinbox <<Increment>> { ttk::spinbox::Spin %W +1 } bind TSpinbox <<Decrement>> { ttk::spinbox::Spin %W -1 } -ttk::bindMouseWheel TSpinbox [list ttk::spinbox::MouseWheel %W] +ttk::bindMouseWheel TSpinbox [list ttk::spinbox::Spin %W] ## Motion -- # Sets cursor. @@ -80,13 +80,13 @@ proc ttk::spinbox::Release {w} { ## MouseWheel -- # Mousewheel callback. Turn these into <<Increment>> (-1, up) -# or <<Decrement> (+1, down) events. +# or <<Decrement> (+1, down) events. Not used any more. # -proc ttk::spinbox::MouseWheel {w dir} { +proc ttk::spinbox::MouseWheel {w dir {factor 1.0}} { if {[$w instate disabled]} { return } - if {$dir < 0} { + if {($dir < 0) ^ ($factor < 0)} { event generate $w <<Increment>> - } else { + } elseif {$dir != 0} { event generate $w <<Decrement>> } } @@ -134,7 +134,7 @@ proc ttk::spinbox::Adjust {w v min max} { # Otherwise cycle through numeric range based on # -from, -to, and -increment. # -proc ttk::spinbox::Spin {w dir} { +proc ttk::spinbox::Spin {w dir {factor -1.0}} { variable State if {[$w instate disabled]} { return } @@ -146,6 +146,8 @@ proc ttk::spinbox::Spin {w dir} { set State($w,values) [$w cget -values] set State($w,values.length) [llength $State($w,values)] + set d [expr {-($dir/$factor)}] + set d [expr {int($d > 0 ? ceil($d) : floor($d))}] if {$State($w,values.length) > 0} { set value [$w get] set current $State($w,values.index) @@ -153,13 +155,13 @@ proc ttk::spinbox::Spin {w dir} { set current [lsearch -exact $State($w,values) $value] if {$current < 0} {set current -1} } - set State($w,values.index) [Adjust $w [expr {$current + $dir}] 0 \ + set State($w,values.index) [Adjust $w [expr {$current + $d}] 0 \ [expr {$State($w,values.length) - 1}]] set State($w,values.last) [lindex $State($w,values) $State($w,values.index)] $w set $State($w,values.last) } else { if {[catch { - set v [expr {[scan [$w get] %f] + $dir * [$w cget -increment]}] + set v [expr {[scan [$w get] %f] + $d * [$w cget -increment]}] }]} { set v [$w cget -from] } diff --git a/library/ttk/treeview.tcl b/library/ttk/treeview.tcl index 62fc630..e9fc5ad 100644 --- a/library/ttk/treeview.tcl +++ b/library/ttk/treeview.tcl @@ -20,6 +20,9 @@ namespace eval ttk::treeview { # For pressmode == "heading" set State(heading) {} + + set State(cellAnchor) {} + set State(cellAnchorOp) "set" } ### Widget bindings. @@ -56,9 +59,20 @@ ttk::copyBindings TtkScrollable Treeview # @@@ TODO: verify/rewrite up and down code. # proc ttk::treeview::Keynav {w dir} { + variable State set focus [$w focus] if {$focus eq ""} { return } + set cells [expr {[$w cget -selecttype] eq "cell"}] + + if {$cells} { + lassign $State(cellAnchor) _ colAnchor + # Just in case, give it a valid value + if {$colAnchor eq ""} { + set colAnchor "#1" + } + } + switch -- $dir { up { if {[set up [$w prev $focus]] eq ""} { @@ -82,19 +96,46 @@ proc ttk::treeview::Keynav {w dir} { } } left { - if {[$w item $focus -open] && [llength [$w children $focus]]} { - CloseItem $w $focus + if {$cells} { + # This assumes that colAnchor is of the "#N" format. + set colNo [string range $colAnchor 1 end] + set firstCol [expr {"tree" ni [$w cget -show]}] + if {$colNo > $firstCol} { + incr colNo -1 + set colAnchor "#$colNo" + } + } elseif {[$w item $focus -open] && [llength [$w children $focus]]} { + CloseItem $w $focus } else { - set focus [$w parent $focus] + set focus [$w parent $focus] } } right { - OpenItem $w $focus + if {$cells} { + set colNo [string range $colAnchor 1 end] + set dispCol [$w cget -displaycolumns] + if {$dispCol eq "#all"} { + set lastCol [llength [$w cget -columns]] + } else { + set lastCol [llength $dispCol] + } + if {$colNo < ($lastCol - 1)} { + incr colNo + set colAnchor "#$colNo" + } + } else { + OpenItem $w $focus + } } } if {$focus != {}} { - SelectOp $w $focus choose + if {$cells} { + set cell [list $focus $colAnchor] + SelectOp $w $focus $cell choose + } else { + SelectOp $w $focus "" choose + } } } @@ -145,13 +186,27 @@ proc ttk::treeview::ActivateHeading {w heading} { } } +## IndentifyCell -- Locate the cell at coordinate +# Only active when -selecttype is "cell", and leaves cell empty otherwise. +# Down the call chain it is enough to check cell to know the selecttype. +proc ttk::treeview::IdentifyCell {w x y} { + set cell {} + if {[$w cget -selecttype] eq "cell"} { + # Later handling assumes that the column in the cell ID is of the + # format #N, which is always the case from "identify cell" + set cell [$w identify cell $x $y] + } + return $cell +} + ## 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 + set cell [IdentifyCell $w $x $y] + SelectOp $w $item $cell $op } } @@ -176,7 +231,9 @@ proc ttk::treeview::Press {w x y} { tree - cell { set item [$w identify item $x $y] - SelectOp $w $item choose + set cell [IdentifyCell $w $x $y] + + SelectOp $w $item $cell choose switch -glob -- [$w identify element $x $y] { *indicator - *disclosure { Toggle $w $item } @@ -238,9 +295,9 @@ proc ttk::treeview::heading.drag {w x y} { if { [$w identify region $x $y] eq "heading" && [$w identify column $x $y] eq $State(heading) } { - $w heading $State(heading) state pressed + $w heading $State(heading) state pressed } else { - $w heading $State(heading) state !pressed + $w heading $State(heading) state !pressed } } @@ -259,35 +316,51 @@ proc ttk::treeview::heading.release {w} { # 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 +proc ttk::treeview::SelectOp {w item cell op} { + select.$op.[$w cget -selectmode] $w $item $cell } ## -selectmode none: # -proc ttk::treeview::select.choose.none {w item} { $w focus $item; $w see $item } -proc ttk::treeview::select.toggle.none {w item} { $w focus $item; $w see $item } -proc ttk::treeview::select.extend.none {w item} { $w focus $item; $w see $item } +proc ttk::treeview::select.choose.none {w item cell} { $w focus $item; $w see $item } +proc ttk::treeview::select.toggle.none {w item cell} { $w focus $item; $w see $item } +proc ttk::treeview::select.extend.none {w item cell} { $w focus $item; $w see $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 } +proc ttk::treeview::select.choose.browse {w item cell} { BrowseTo $w $item $cell } +proc ttk::treeview::select.toggle.browse {w item cell} { BrowseTo $w $item $cell } +proc ttk::treeview::select.extend.browse {w item cell} { BrowseTo $w $item $cell } ## -selectmode multiple: # -proc ttk::treeview::select.choose.extended {w item} { - BrowseTo $w $item +proc ttk::treeview::select.choose.extended {w item cell} { + BrowseTo $w $item $cell } -proc ttk::treeview::select.toggle.extended {w item} { - $w selection toggle [list $item] +proc ttk::treeview::select.toggle.extended {w item cell} { + variable State + if {$cell ne ""} { + $w cellselection toggle [list $cell] + set State(cellAnchor) $cell + set State(cellAnchorOp) add + } else { + $w selection toggle [list $item] + } } -proc ttk::treeview::select.extend.extended {w item} { - if {[set anchor [$w focus]] ne ""} { - $w selection set [between $w $anchor $item] +proc ttk::treeview::select.extend.extended {w item cell} { + variable State + if {$cell ne ""} { + if {$State(cellAnchor) ne ""} { + $w cellselection $State(cellAnchorOp) $State(cellAnchor) $cell + } else { + BrowseTo $w $item $cell + } } else { - BrowseTo $w $item + if {[set anchor [$w focus]] ne ""} { + $w selection set [between $w $anchor $item] + } else { + BrowseTo $w $item $cell + } } } @@ -319,10 +392,10 @@ proc ttk::treeview::ScanBetween {tv item1 item2 item} { variable selectingBetween if {$item eq $item1 || $item eq $item2} { - lappend between $item + lappend between $item set selectingBetween [expr {!$selectingBetween}] } elseif {$selectingBetween} { - lappend between $item + lappend between $item } foreach child [$tv children $item] { ScanBetween $tv $item1 $item2 $child @@ -368,16 +441,24 @@ proc ttk::treeview::Toggle {w item} { proc ttk::treeview::ToggleFocus {w} { set item [$w focus] if {$item ne ""} { - Toggle $w $item + Toggle $w $item } } ## BrowseTo -- navigate to specified item; set focus and selection # -proc ttk::treeview::BrowseTo {w item} { +proc ttk::treeview::BrowseTo {w item cell} { + variable State + $w see $item $w focus $item - $w selection set [list $item] + set State(cellAnchor) $cell + set State(cellAnchorOp) set + if {$cell ne ""} { + $w cellselection set [list $cell] + } else { + $w selection set [list $item] + } } #*EOF* diff --git a/library/ttk/ttk.tcl b/library/ttk/ttk.tcl index 73ee3d9..cbf1303 100644 --- a/library/ttk/ttk.tcl +++ b/library/ttk/ttk.tcl @@ -95,6 +95,34 @@ proc ::ttk::setTheme {theme} { set currentTheme $theme } +## ttk::setTreeviewRowHeight -- +# Sets the default height of the ttk::treeview rows for the current theme. +# To be invoked from within the library files for the built-in themes. +# +proc ::ttk::setTreeviewRowHeight {} { + set font [::ttk::style lookup Treeview -font] + if {$font eq {}} { + set font TkDefaultFont + } + + ::ttk::style configure Treeview -rowheight \ + [expr {[font metrics $font -linespace] + 2}] +} + +# Applications should make sure that the ttk::setTreeviewRowHeight +# procedure will be invoked whenever the virtual event <<ThemeChanged>> +# is received (e.g., because the value of the Treeview style's -font +# option has changed), or the virtual event <<TkWorldChanged>> with +# the user_data field (%d) set to "FontChanged" is received. Example: +# +# bindtags . [linsert [bindtags .] 1 MyMainWin] +# bind MyMainWin <<ThemeChanged>> ttk::setTreeviewRowHeight +# bind MyMainWin <<TkWorldChanged>> { +# if {"%d" eq "FontChanged"} { +# ttk::setTreeviewRowHeight +# } +# } + ### Load widget bindings. # source -encoding utf-8 [file join $::ttk::library button.tcl] @@ -173,4 +201,8 @@ proc ttk::DefaultTheme {} { ttk::setTheme [ttk::DefaultTheme] ; rename ttk::DefaultTheme {} +# Scale the default ttk::scale and ttk::progressbar length +option add *TScale.length 75p widgetDefault +option add *TProgressbar.length 75p widgetDefault + #*EOF* diff --git a/library/ttk/utils.tcl b/library/ttk/utils.tcl index 3d90880..c2c7e8f 100644 --- a/library/ttk/utils.tcl +++ b/library/ttk/utils.tcl @@ -73,7 +73,7 @@ proc ttk::clickToFocus {w} { # proc ttk::takesFocus {w} { if {![winfo viewable $w]} { - return 0 + return 0 } elseif {[catch {$w cget -takefocus} takefocus]} { return [GuessTakeFocus $w] } else { @@ -144,7 +144,7 @@ proc ttk::SaveGrab {w} { set grabbed [grab current $w] if {[winfo exists $grabbed]} { - switch [grab status $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 } @@ -153,7 +153,7 @@ proc ttk::SaveGrab {w} { set focus [focus] if {$focus ne ""} { - set restoreFocus [list focus -force $focus] + set restoreFocus [list focus -force $focus] } set Grab($w) [list $restoreGrab $restoreFocus] @@ -273,18 +273,6 @@ proc ttk::copyBindings {from to} { # # Platform inconsistencies: # -# On X11, the server typically maps the mouse wheel to Button4 and Button5. -# -# On OSX, Tk generates sensible values for the %D field in <MouseWheel> events. -# -# On Windows, %D must be scaled by a factor of 120. -# -# OSX conventionally uses Shift+MouseWheel for horizontal scrolling, -# and Option+MouseWheel for accelerated scrolling. -# -# The Shift+MouseWheel behavior is not conventional on Windows or most -# X11 toolkits, but it's useful. -# # MouseWheel scrolling is accelerated on X11, which is conventional # for Tk and appears to be conventional for other toolkits (although # Gtk+ and Qt do not appear to use as large a factor). @@ -292,46 +280,25 @@ proc ttk::copyBindings {from to} { ## ttk::bindMouseWheel $bindtag $command... # Adds basic mousewheel support to $bindtag. -# $command will be passed one additional argument -# specifying the mousewheel direction (-1: up, +1: down). +# $command will be passed two additional arguments +# specifying the mousewheel change and a factor. # proc ttk::bindMouseWheel {bindtag callback} { - if {[tk windowingsystem] eq "x11"} { - bind $bindtag <Button-4> "$callback -1" - bind $bindtag <Button-5> "$callback +1" - } - if {[tk windowingsystem] eq "aqua"} { - bind $bindtag <MouseWheel> "$callback \[expr {-%D}\]" - bind $bindtag <Option-MouseWheel> "$callback \[expr {-10 * %D}\]" - } else { - bind $bindtag <MouseWheel> "$callback \[expr {-%D / 120}\]" - } + bind $bindtag <MouseWheel> "$callback %D -120.0" + bind $bindtag <Option-MouseWheel> "$callback %D -12.0" } ## Mousewheel bindings for standard scrollable widgets. # -if {[tk windowingsystem] eq "x11"} { - bind TtkScrollable <Button-4> { %W yview scroll -5 units } - bind TtkScrollable <Button-5> { %W yview scroll 5 units } - bind TtkScrollable <Shift-Button-4> { %W xview scroll -5 units } - bind TtkScrollable <Shift-Button-5> { %W xview scroll 5 units } -} -if {[tk windowingsystem] eq "aqua"} { - bind TtkScrollable <MouseWheel> \ - { %W yview scroll [expr {-%D}] units } - bind TtkScrollable <Shift-MouseWheel> \ - { %W xview scroll [expr {-%D}] units } - bind TtkScrollable <Option-MouseWheel> \ - { %W yview scroll [expr {-10 * %D}] units } - bind TtkScrollable <Shift-Option-MouseWheel> \ - { %W xview scroll [expr {-10 * %D}] units } -} else { - bind TtkScrollable <MouseWheel> \ - { %W yview scroll [expr {-%D / 120}] units } - bind TtkScrollable <Shift-MouseWheel> \ - { %W xview scroll [expr {-%D / 120}] units } -} +bind TtkScrollable <MouseWheel> \ + { tk::MouseWheel %W y %D -40.0 } +bind TtkScrollable <Option-MouseWheel> \ + { tk::MouseWheel %W y %D -12.0 } +bind TtkScrollable <Shift-MouseWheel> \ + { tk::MouseWheel %W x %D -40.0 } +bind TtkScrollable <Shift-Option-MouseWheel> \ + { tk::MouseWheel %W x %D -12.0 } #*EOF* diff --git a/library/ttk/vistaTheme.tcl b/library/ttk/vistaTheme.tcl index 0700353..d402bd4 100644 --- a/library/ttk/vistaTheme.tcl +++ b/library/ttk/vistaTheme.tcl @@ -22,30 +22,31 @@ namespace eval ttk::theme::vista { -selectforeground SystemHighlightText \ -selectbackground SystemHighlight \ -insertcolor SystemWindowText \ - -font TkDefaultFont \ - ; + -font TkDefaultFont ttk::style map "." \ - -foreground [list disabled SystemGrayText] \ - ; + -foreground {disabled SystemGrayText} - ttk::style configure TButton -anchor center -padding {1 1} -width -11 - ttk::style configure TRadiobutton -padding 2 - ttk::style configure TCheckbutton -padding 2 - ttk::style configure TMenubutton -padding {8 4} + ttk::style configure TButton -anchor center -padding 0.75p -width -11 + ttk::style configure TRadiobutton -padding 1.5p + ttk::style configure TCheckbutton -padding 1.5p + ttk::style configure TMenubutton -padding {6p 3p} ttk::style element create Menubutton.dropdown vsapi \ TOOLBAR 4 {{selected active} 6 {selected !active} 5 disabled 4 pressed 3 active 2 {} 1} \ -syssize {SM_CXVSCROLL SM_CYVSCROLL} - ttk::style configure TNotebook -tabmargins {2 2 2 0} + ttk::style configure TNotebook -tabmargins {1.5p 1.5p 1.5p 0} ttk::style map TNotebook.Tab \ - -expand [list selected {2 2 2 2}] + -expand {selected {1.5p 1.5p 1.5p 1.5p}} # Treeview: ttk::style configure Heading -font TkHeadingFont - ttk::style configure Treeview -background SystemWindow + ttk::style configure Treeview -background SystemWindow \ + -stripedbackground System3dLight + ttk::style configure Treeview.Separator \ + -background System3dLight ttk::style map Treeview \ -background [list disabled SystemButtonFace \ selected SystemHighlight] \ @@ -55,10 +56,10 @@ namespace eval ttk::theme::vista { # Label and Toolbutton ttk::style configure TLabelframe.Label -foreground SystemButtonText - ttk::style configure Toolbutton -padding {4 4} + ttk::style configure Toolbutton -padding 3p # Combobox - ttk::style configure TCombobox -padding 2 + ttk::style configure TCombobox -padding 1.5p ttk::style element create Combobox.border vsapi \ COMBOBOX 4 {disabled 4 focus 3 active 2 hover 2 {} 1} ttk::style element create Combobox.background vsapi \ @@ -91,10 +92,9 @@ namespace eval ttk::theme::vista { -selectforeground [list !focus SystemWindowText] \ -foreground [list \ disabled SystemGrayText \ - {readonly focus} SystemHighlightText \ + {readonly focus} SystemHighlightText \ ] \ - -focusfill [list {readonly focus} SystemHighlight] \ - ; + -focusfill [list {readonly focus} SystemHighlight] # Entry ttk::style configure TEntry -padding {1 1 1 1} ;# Needs lookup @@ -113,8 +113,7 @@ namespace eval ttk::theme::vista { } ttk::style map TEntry \ -selectbackground [list !focus SystemWindow] \ - -selectforeground [list !focus SystemWindowText] \ - ; + -selectforeground [list !focus SystemWindowText] # Spinbox ttk::style configure TSpinbox -padding 0 @@ -148,8 +147,7 @@ namespace eval ttk::theme::vista { } ttk::style map TSpinbox \ -selectbackground [list !focus SystemWindow] \ - -selectforeground [list !focus SystemWindowText] \ - ; + -selectforeground [list !focus SystemWindowText] # SCROLLBAR elements (Vista includes a state for 'hover') @@ -187,6 +185,7 @@ namespace eval ttk::theme::vista { ttk::style layout Horizontal.TProgressbar { Horizontal.Progressbar.trough -sticky nswe -children { Horizontal.Progressbar.pbar -side left -sticky ns + Horizontal.Progressbar.ctext -sticky nesw } } ttk::style element create Vertical.Progressbar.pbar vsapi \ @@ -222,7 +221,9 @@ namespace eval ttk::theme::vista { } # Treeview - ttk::style configure Item -padding {4 0 0 0} + ttk::style configure Item -padding {3p 0 0 0} + ttk::style configure Treeview -indent 15p + ttk::setTreeviewRowHeight package provide ttk::theme::vista 1.0 } diff --git a/library/ttk/winTheme.tcl b/library/ttk/winTheme.tcl index db05b45..834d177 100644 --- a/library/ttk/winTheme.tcl +++ b/library/ttk/winTheme.tcl @@ -3,6 +3,7 @@ # namespace eval ttk::theme::winnative { + ttk::style theme settings winnative { ttk::style configure "." \ @@ -13,65 +14,67 @@ namespace eval ttk::theme::winnative { -fieldbackground SystemWindow \ -insertcolor SystemWindowText \ -troughcolor SystemScrollbar \ - -font TkDefaultFont \ - ; + -font TkDefaultFont - ttk::style map "." -foreground [list disabled SystemGrayText] ; - ttk::style map "." -embossed [list disabled 1] ; + ttk::style map "." -foreground {disabled SystemGrayText} + ttk::style map "." -embossed {disabled 1} ttk::style configure TButton \ -anchor center -width -11 -relief raised -shiftrelief 1 - ttk::style configure TCheckbutton -padding "2 4" - ttk::style configure TRadiobutton -padding "2 4" - ttk::style configure TMenubutton \ - -padding "8 4" -arrowsize 3 -relief raised - ttk::style map TButton -relief {{!disabled pressed} sunken} + ttk::style configure TCheckbutton -padding {1.5p 3p} + ttk::style configure TRadiobutton -padding {1.5p 3p} + + ttk::style configure TMenubutton \ + -padding {6p 3p} -arrowsize 2.25p -relief raised + ttk::style configure TEntry \ -padding 2 -selectborderwidth 0 -insertwidth 1 ttk::style map TEntry \ -fieldbackground \ - [list readonly SystemButtonFace disabled SystemButtonFace] \ - -selectbackground [list !focus SystemWindow] \ - -selectforeground [list !focus SystemWindowText] \ - ; + {readonly SystemButtonFace disabled SystemButtonFace} \ + -selectbackground {!focus SystemWindow} \ + -selectforeground {!focus SystemWindowText} - ttk::style configure TCombobox -padding 2 + ttk::style configure TCombobox -padding 1.5p ttk::style map TCombobox \ -selectbackground [list !focus SystemWindow] \ -selectforeground [list !focus SystemWindowText] \ -fieldbackground [list \ - readonly SystemButtonFace \ + readonly SystemButtonFace \ disabled SystemButtonFace] \ -foreground [list \ disabled SystemGrayText \ - {readonly focus} SystemHighlightText \ + {readonly focus} SystemHighlightText \ ] \ - -focusfill [list {readonly focus} SystemHighlight] \ - ; + -focusfill {{readonly focus} SystemHighlight} ttk::style element create ComboboxPopdownFrame.border from default ttk::style configure ComboboxPopdownFrame \ -borderwidth 1 -relief solid - ttk::style configure TSpinbox -padding {2 0 16 0} + ttk::style configure TSpinbox -padding {1.5p 0 12p 0} ttk::style configure TLabelframe -borderwidth 2 -relief groove - ttk::style configure Toolbutton -relief flat -padding {8 4} + ttk::style configure Toolbutton -relief flat -padding {6p 3p} ttk::style map Toolbutton -relief \ - {disabled flat selected sunken pressed sunken active raised} + {disabled flat selected sunken pressed sunken active raised} - ttk::style configure TScale -groovewidth 4 + ttk::style configure TScale -groovewidth 3p - ttk::style configure TNotebook -tabmargins {2 2 2 0} - ttk::style configure TNotebook.Tab -padding {3 1} -borderwidth 1 - ttk::style map TNotebook.Tab -expand [list selected {2 2 2 0}] + ttk::style configure TNotebook -tabmargins {1.5p 1.5p 1.5p 0} + ttk::style configure TNotebook.Tab -padding {2.25p 0.75p} -borderwidth 1 + ttk::style map TNotebook.Tab -expand {selected {1.5p 1.5p 1.5p 0}} # Treeview: ttk::style configure Heading -font TkHeadingFont -relief raised - ttk::style configure Treeview -background SystemWindow + ttk::style configure Item -diameter 6.75p \ + -indicatormargins {1.5p 1.5p 3p 1.5p} + ttk::style configure Treeview -background SystemWindow \ + -stripedbackground System3dLight -indent 15p + ttk::setTreeviewRowHeight ttk::style map Treeview \ -background [list disabled SystemButtonFace \ selected SystemHighlight] \ @@ -79,6 +82,7 @@ namespace eval ttk::theme::winnative { selected SystemHighlightText] ttk::style configure TProgressbar \ - -background SystemHighlight -borderwidth 0 ; + -background SystemHighlight -borderwidth 0 \ + -barsize 22.5p -thickness 11.25p } } diff --git a/library/ttk/xpTheme.tcl b/library/ttk/xpTheme.tcl index da7b422..12ae979 100644 --- a/library/ttk/xpTheme.tcl +++ b/library/ttk/xpTheme.tcl @@ -12,21 +12,19 @@ namespace eval ttk::theme::xpnative { -selectforeground SystemHighlightText \ -selectbackground SystemHighlight \ -insertcolor SystemWindowText \ - -font TkDefaultFont \ - ; + -font TkDefaultFont ttk::style map "." \ - -foreground [list disabled SystemGrayText] \ - ; + -foreground [list disabled SystemGrayText] - ttk::style configure TButton -anchor center -padding {1 1} -width -11 - ttk::style configure TRadiobutton -padding 2 - ttk::style configure TCheckbutton -padding 2 - ttk::style configure TMenubutton -padding {8 4} + ttk::style configure TButton -anchor center -padding 0.75p -width -11 + ttk::style configure TRadiobutton -padding 1.5p + ttk::style configure TCheckbutton -padding 1.5p + ttk::style configure TMenubutton -padding {6p 3p} - ttk::style configure TNotebook -tabmargins {2 2 2 0} + ttk::style configure TNotebook -tabmargins {1.5p 1.5p 1.5p 0} ttk::style map TNotebook.Tab \ - -expand [list selected {2 2 2 2}] + -expand {selected {1.5p 1.5p 1.5p 1.5p}} ttk::style configure TLabelframe.Label -foreground "#0046d5" @@ -34,34 +32,35 @@ namespace eval ttk::theme::xpnative { ttk::style configure TEntry -padding {2 2 2 4} ttk::style map TEntry \ -selectbackground [list !focus SystemWindow] \ - -selectforeground [list !focus SystemWindowText] \ - ; - ttk::style configure TCombobox -padding 2 + -selectforeground [list !focus SystemWindowText] + ttk::style configure TCombobox -padding 1.5p ttk::style map TCombobox \ -selectbackground [list !focus SystemWindow] \ -selectforeground [list !focus SystemWindowText] \ -foreground [list \ disabled SystemGrayText \ - {readonly focus} SystemHighlightText \ + {readonly focus} SystemHighlightText \ ] \ - -focusfill [list {readonly focus} SystemHighlight] \ - ; + -focusfill [list {readonly focus} SystemHighlight] - ttk::style configure TSpinbox -padding {2 0 14 0} + ttk::style configure TSpinbox -padding {1.5p 0 10.5p 0} ttk::style map TSpinbox \ -selectbackground [list !focus SystemWindow] \ - -selectforeground [list !focus SystemWindowText] \ - ; + -selectforeground [list !focus SystemWindowText] - ttk::style configure Toolbutton -padding {4 4} + ttk::style configure Toolbutton -padding 3p # Treeview: ttk::style configure Heading -font TkHeadingFont -relief raised - ttk::style configure Treeview -background SystemWindow + ttk::style configure Item -diameter 6.75p \ + -indicatormargins {1.5p 1.5p 3p 1.5p} + ttk::style configure Treeview -background SystemWindow \ + -stripedbackground System3dLight -indent 15p + ttk::setTreeviewRowHeight ttk::style map Treeview \ -background [list disabled SystemButtonFace \ selected SystemHighlight] \ -foreground [list disabled SystemGrayText \ - selected SystemHighlightText]; + selected SystemHighlightText] } } diff --git a/library/xmfbox.tcl b/library/xmfbox.tcl index c26164a..e4d0db5 100644 --- a/library/xmfbox.tcl +++ b/library/xmfbox.tcl @@ -4,8 +4,8 @@ # Unix platform. This implementation is used only if the # "::tk_strictMotif" flag is set. # -# Copyright (c) 1996 Sun Microsystems, Inc. -# Copyright (c) 1998-2000 Scriptics Corporation +# Copyright © 1996 Sun Microsystems, Inc. +# Copyright © 1998-2000 Scriptics Corporation # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -210,7 +210,6 @@ proc ::tk::MotifFDialog_SetFilter {w type} { variable ::tk::Priv set data(filter) [lindex $type 1] - set Priv(selectFileType) [lindex [lindex $type 0] 0] MotifFDialog_Update $w } @@ -345,9 +344,9 @@ proc ::tk::MotifFDialog_BuildUI {w} { set f2a [frame $f2.a] set f2b [frame $f2.b] - grid $f2a -row 0 -column 0 -rowspan 1 -columnspan 1 -padx 4 -pady 4 \ + grid $f2a -row 0 -column 0 -rowspan 1 -columnspan 1 -padx 3p -pady 3p \ -sticky news - grid $f2b -row 0 -column 1 -rowspan 1 -columnspan 1 -padx 4 -pady 4 \ + grid $f2b -row 0 -column 1 -rowspan 1 -columnspan 1 -padx 3p -pady 3p \ -sticky news grid rowconfigure $f2 0 -minsize 0 -weight 1 grid columnconfigure $f2 0 -minsize 0 -weight 1 @@ -358,8 +357,8 @@ proc ::tk::MotifFDialog_BuildUI {w} { bind [::tk::AmpWidget label $f1.lab -text [mc "Fil&ter:"] -anchor w] \ <<AltUnderlined>> [list focus $f1.ent] entry $f1.ent - pack $f1.lab -side top -fill x -padx 6 -pady 4 - pack $f1.ent -side top -fill x -padx 4 -pady 0 + pack $f1.lab -side top -fill x -padx 4.5p -pady 3p + pack $f1.ent -side top -fill x -padx 3p -pady 0 set data(fEnt) $f1.ent # The file and directory lists @@ -374,8 +373,8 @@ proc ::tk::MotifFDialog_BuildUI {w} { bind [::tk::AmpWidget label $f3.lab -text [mc "&Selection:"] -anchor w] \ <<AltUnderlined>> [list focus $f3.ent] entry $f3.ent - pack $f3.lab -side top -fill x -padx 6 -pady 0 - pack $f3.ent -side top -fill x -padx 4 -pady 4 + pack $f3.lab -side top -fill x -padx 4.5p -pady 0 + pack $f3.ent -side top -fill x -padx 3p -pady 3p set data(sEnt) $f3.ent # The buttons @@ -392,7 +391,7 @@ proc ::tk::MotifFDialog_BuildUI {w} { -width $maxWidth \ -command [list tk::MotifFDialog_CancelCmd $w]] - pack $bot.ok $bot.filter $bot.cancel -padx 10 -pady 10 -expand yes \ + pack $bot.ok $bot.filter $bot.cancel -padx 7.5p -pady 7.5p -expand yes \ -side left # Create the bindings: @@ -442,7 +441,7 @@ proc ::tk::MotifFDialog_MakeSList {w f label cmdPrefix} { scrollbar $f.v -orient vertical -takefocus 0 -command [list $f.l yview] scrollbar $f.h -orient horizontal -takefocus 0 -command [list $f.l xview] grid $f.lab -row 0 -column 0 -sticky news -rowspan 1 -columnspan 2 \ - -padx 2 -pady 2 + -padx 1.5p -pady 1.5p grid $f.l -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news grid $f.v -row 1 -column 1 -rowspan 1 -columnspan 1 -sticky news grid $f.h -row 2 -column 0 -rowspan 1 -columnspan 1 -sticky news @@ -907,9 +906,9 @@ proc ::tk::MotifFDialog_CancelCmd {w} { } proc ::tk::ListBoxKeyAccel_Set {w} { - bind Listbox <Any-Key> "" + bind Listbox <Key> "" bind $w <Destroy> [list tk::ListBoxKeyAccel_Unset $w] - bind $w <Any-Key> [list tk::ListBoxKeyAccel_Key $w %A] + bind $w <Key> [list tk::ListBoxKeyAccel_Key $w %A] } proc ::tk::ListBoxKeyAccel_Unset {w} { @@ -981,9 +980,3 @@ proc ::tk::ListBoxKeyAccel_Reset {w} { unset -nocomplain Priv(lbAccel,$w) } -proc ::tk_getFileType {} { - variable ::tk::Priv - - return $Priv(selectFileType) -} - |
