diff options
Diffstat (limited to 'library')
88 files changed, 4393 insertions, 3441 deletions
diff --git a/library/bgerror.tcl b/library/bgerror.tcl index f46ab4c..b15387e 100644 --- a/library/bgerror.tcl +++ b/library/bgerror.tcl @@ -9,6 +9,7 @@ # 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> namespace eval ::tk::dialog::error { namespace import -force ::tk::msgcat::* @@ -26,13 +27,13 @@ namespace eval ::tk::dialog::error { } } -proc ::tk::dialog::error::Return {} { +proc ::tk::dialog::error::Return {which code} { variable button - .bgerrorDialog.ok configure -state active -relief sunken + .bgerrorDialog.$which state {active selected focus} update idletasks after 100 - set button 0 + set button $code } proc ::tk::dialog::error::Details {} { @@ -53,19 +54,19 @@ proc ::tk::dialog::error::SaveToLog {text} { } else { set allFiles * } - set types [list \ - [list [mc "Log Files"] .log] \ - [list [mc "Text Files"] .txt] \ + set types [list \ + [list [mc "Log Files"] .log] \ + [list [mc "Text Files"] .txt] \ [list [mc "All Files"] $allFiles] \ ] set filename [tk_getSaveFile -title [mc "Select Log File"] \ -filetypes $types -defaultextension .log -parent .bgerrorDialog] - if {![string length $filename]} { - return + if {$filename ne {}} { + set f [open $filename w] + puts -nonewline $f $text + close $f } - set f [open $filename w] - puts -nonewline $f $text - close $f + return } proc ::tk::dialog::error::Destroy {w} { @@ -75,16 +76,29 @@ proc ::tk::dialog::error::Destroy {w} { } } +proc ::tk::dialog::error::DeleteByProtocol {} { + variable button + set button 1 +} + +proc ::tk::dialog::error::ReturnInDetails w { + bind $w <Return> {}; # Remove this binding + $w invoke + return -code break +} + # ::tk::dialog::error::bgerror -- -# This is the default version of bgerror. -# It tries to execute tkerror, if that fails it posts a dialog box containing -# the error message and gives the user a chance to ask to see a stack -# trace. +# +# This is the default version of bgerror. +# It tries to execute tkerror, if that fails it posts a dialog box +# containing the error message and gives the user a chance to ask +# to see a stack trace. +# # Arguments: -# err - The error message. - +# err - The error message. +# proc ::tk::dialog::error::bgerror err { - global errorInfo tcl_platform + global errorInfo variable button set info $errorInfo @@ -130,12 +144,13 @@ proc ::tk::dialog::error::bgerror err { # and bottom parts. set dlg .bgerrorDialog + set bg [ttk::style lookup . -background] destroy $dlg - toplevel $dlg -class ErrorDialog + toplevel $dlg -class ErrorDialog -background $bg wm withdraw $dlg wm title $dlg $title wm iconname $dlg ErrorDialog - wm protocol $dlg WM_DELETE_WINDOW { } + wm protocol $dlg WM_DELETE_WINDOW [namespace code DeleteByProtocol] if {$windowingsystem eq "aqua"} { ::tk::unsupported::MacWindowStyle style $dlg moveableAlert {} @@ -143,23 +158,19 @@ proc ::tk::dialog::error::bgerror err { wm attributes $dlg -type dialog } - frame $dlg.bot - frame $dlg.top - if {$windowingsystem eq "x11"} { - $dlg.bot configure -relief raised -bd 1 - $dlg.top configure -relief raised -bd 1 - } + ttk::frame $dlg.bot + ttk::frame $dlg.top pack $dlg.bot -side bottom -fill both pack $dlg.top -side top -fill both -expand 1 - set W [frame $dlg.top.info] + set W [ttk::frame $dlg.top.info] text $W.text -setgrid true -height 10 -wrap char \ -yscrollcommand [list $W.scroll set] if {$windowingsystem ne "aqua"} { $W.text configure -width 40 } - scrollbar $W.scroll -command [list $W.text yview] + ttk::scrollbar $W.scroll -command [list $W.text yview] pack $W.scroll -side right -fill y pack $W.text -side left -expand yes -fill both $W.text insert 0.0 "$err\n$info" @@ -174,18 +185,11 @@ proc ::tk::dialog::error::bgerror err { # ...minus the width of the icon, padding and a fudge factor for # the window manager decorations and aesthetics. set wrapwidth [expr {$wrapwidth-60-[winfo pixels $dlg 9m]}] - label $dlg.msg -justify left -text $text -wraplength $wrapwidth - if {$windowingsystem eq "aqua"} { - # On the Macintosh, use the stop bitmap - label $dlg.bitmap -bitmap stop - } else { - # On other platforms, make the error icon - canvas $dlg.bitmap -width 32 -height 32 -highlightthickness 0 - $dlg.bitmap create oval 0 0 31 31 -fill red -outline black - $dlg.bitmap create line 9 9 23 23 -fill white -width 4 - $dlg.bitmap create line 9 23 23 9 -fill white -width 4 - } + ttk::label $dlg.msg -justify left -text $text -wraplength $wrapwidth + ttk::label $dlg.bitmap -image ::tk::icons::error + grid $dlg.bitmap $dlg.msg -in $dlg.top -row 0 -padx 3m -pady 3m + grid configure $dlg.bitmap -sticky ne grid configure $dlg.msg -sticky nsw -padx {0 3m} grid rowconfigure $dlg.top 1 -weight 1 grid columnconfigure $dlg.top 1 -weight 1 @@ -194,7 +198,7 @@ proc ::tk::dialog::error::bgerror err { set i 0 foreach {name caption} $buttons { - button $dlg.$name -text $caption -default normal \ + 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 columnconfigure $dlg.bot $i -weight 1 @@ -210,8 +214,10 @@ proc ::tk::dialog::error::bgerror err { # The "OK" button is the default for this dialog. $dlg.ok configure -default active - bind $dlg <Return> [namespace code Return] - bind $dlg <Destroy> [namespace code [list Destroy %W]] + bind $dlg <Return> [namespace code {Return ok 0}] + bind $dlg <Escape> [namespace code {Return dismiss 1}] + bind $dlg <Destroy> [namespace code {Destroy %W}] + bind $dlg.function <Return> [namespace code {ReturnInDetails %W}] $dlg.function configure -command [namespace code Details] # 6. Withdraw the window, then update all the geometry information @@ -220,7 +226,11 @@ proc ::tk::dialog::error::bgerror err { ::tk::PlaceWindow $dlg - # 7. Ensure that we are topmost. + # 7. Set a grab and claim the focus too. + + ::tk::SetFocusGrab $dlg $dlg.ok + + # 8. Ensure that we are topmost. raise $dlg if {[tk windowingsystem] eq "win32"} { @@ -228,13 +238,9 @@ proc ::tk::dialog::error::bgerror err { # order to ensure that it's seen if {[lindex [wm stackorder .] end] ne "$dlg"} { wm attributes $dlg -topmost 1 - } + } } - # 8. Set a grab and claim the focus too. - - ::tk::SetFocusGrab $dlg $dlg.ok - # 9. Wait for the user to respond, then restore the focus and # return the index of the selected button. Restore the focus # before deleting the window, since otherwise the window manager diff --git a/library/button.tcl b/library/button.tcl index 75378cc..b2bafb2 100644 --- a/library/button.tcl +++ b/library/button.tcl @@ -17,6 +17,7 @@ #------------------------------------------------------------------------- if {[tk windowingsystem] eq "aqua"} { + bind Radiobutton <Enter> { tk::ButtonEnter %W } @@ -143,7 +144,7 @@ bind Radiobutton <Leave> { if {"win32" eq [tk windowingsystem]} { ######################### -# Windows implementation +# Windows implementation ######################### # ::tk::ButtonEnter -- @@ -755,3 +756,10 @@ proc ::tk::CheckLeave {w} { set Priv(window) "" } + +return + +# Local Variables: +# mode: tcl +# fill-column: 78 +# End: diff --git a/library/choosedir.tcl b/library/choosedir.tcl index 00dca9d..68dd9b0 100644 --- a/library/choosedir.tcl +++ b/library/choosedir.tcl @@ -122,7 +122,7 @@ proc ::tk::dialog::file::chooseDir:: {args} { # Return value to user # - + return $Priv(selectFilePath) } @@ -164,7 +164,7 @@ proc ::tk::dialog::file::chooseDir::Config {dataName argList} { if {$data(-title) eq ""} { set data(-title) "[mc "Choose Directory"]" } - + # Stub out the -multiple value for the dialog; it doesn't make sense for # choose directory dialogs, but we have to have something there because we # share so much code with the file dialogs. @@ -186,7 +186,8 @@ proc ::tk::dialog::file::chooseDir::Config {dataName argList} { } if {![winfo exists $data(-parent)]} { - error "bad window path name \"$data(-parent)\"" + return -code error -errorcode [list TK LOOKUP WINDOW $data(-parent)] \ + "bad window path name \"$data(-parent)\"" } } @@ -209,9 +210,9 @@ proc ::tk::dialog::file::chooseDir::OkCmd {w} { # 4b. If the value is different from the current directory, change to # that directory. - set selection [tk::IconList_CurSelection $data(icons)] + set selection [$data(icons) selection get] if {[llength $selection] != 0} { - set iconText [tk::IconList_Get $data(icons) [lindex $selection 0]] + set iconText [$data(icons) get [lindex $selection 0]] set iconText [file join $data(selectPath) $iconText] Done $w $iconText } else { @@ -259,10 +260,9 @@ proc ::tk::dialog::file::chooseDir::IsOK? {w text} { proc ::tk::dialog::file::chooseDir::DblClick {w} { upvar ::tk::dialog::file::[winfo name $w] data - set selection [tk::IconList_CurSelection $data(icons)] + set selection [$data(icons) selection get] if {[llength $selection] != 0} { - set filenameFragment \ - [tk::IconList_Get $data(icons) [lindex $selection 0]] + set filenameFragment [$data(icons) get [lindex $selection 0]] set file $data(selectPath) if {[file isdirectory $file]} { ::tk::dialog::file::ListInvoke $w [list $filenameFragment] diff --git a/library/clrpick.tcl b/library/clrpick.tcl index 092915c..600be16 100644 --- a/library/clrpick.tcl +++ b/library/clrpick.tcl @@ -12,7 +12,7 @@ # # (1): Find out how many free colors are left in the colormap and # don't allocate too many colors. -# (2): Implement HSV color selection. +# (2): Implement HSV color selection. # # Make sure namespaces exist @@ -54,11 +54,11 @@ proc ::tk::dialog::color:: {args} { set data(BARS_WIDTH) 160 # PLGN_WIDTH is the number of pixels wide of the triangular selection - # polygon. This also results in the definition of the padding on the + # 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 - # PLGN_HEIGHT is the height of the selection polygon and the height of the + # 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 @@ -190,11 +190,13 @@ proc ::tk::dialog::color::Config {dataName argList} { set data(-title) " " } if {[catch {winfo rgb . $data(-initialcolor)} err]} { - error $err + return -code error -errorcode [list TK LOOKUP COLOR $data(-initialcolor)] \ + $err } if {![winfo exists $data(-parent)]} { - error "bad window path name \"$data(-parent)\"" + return -code error -errorcode [list TK LOOKUP WINDOW $data(-parent)] \ + "bad window path name \"$data(-parent)\"" } } @@ -326,7 +328,7 @@ proc ::tk::dialog::color::BuildDialog {w} { # Sets the current selection of the dialog box # proc ::tk::dialog::color::SetRGBValue {w color} { - upvar ::tk::dialog::color::[winfo name $w] data + upvar ::tk::dialog::color::[winfo name $w] data set data(red,intensity) [lindex $color 0] set data(green,intensity) [lindex $color 1] @@ -366,7 +368,7 @@ proc ::tk::dialog::color::RgbToX {w color} { } # ::tk::dialog::color::DrawColorScale -- -# +# # Draw color scale is called whenever the size of one of the color # scale canvases is changed. # @@ -505,7 +507,7 @@ proc ::tk::dialog::color::RedrawColorBars {w colorChanged} { upvar ::tk::dialog::color::[winfo name $w] data switch $colorChanged { - red { + red { DrawColorScale $w green DrawColorScale $w blue } @@ -535,7 +537,7 @@ proc ::tk::dialog::color::RedrawColorBars {w colorChanged} { # Handles a mousedown button event over the selector polygon. # Adds the bindings for moving the mouse while the button is # pressed. Sets the binding for the button-release event. -# +# # Params: sel is the selector canvas window, color is the color of the strip. # proc ::tk::dialog::color::StartMove {w sel color x delta {dontMove 0}} { @@ -547,7 +549,7 @@ proc ::tk::dialog::color::StartMove {w sel color x delta {dontMove 0}} { } # ::tk::dialog::color::MoveSelector -- -# +# # Moves the polygon selector so that its middle point has the same # x value as the specified x. If x is outside the bounds [0,255], # the selector is set to the closest endpoint. @@ -581,7 +583,7 @@ proc ::tk::dialog::color::MoveSelector {w sel color x delta} { # x is the x-coord of the mouse. # proc ::tk::dialog::color::ReleaseMouse {w sel color x delta} { - upvar ::tk::dialog::color::[winfo name $w] data + upvar ::tk::dialog::color::[winfo name $w] data set x [MoveSelector $w $sel $color $x $delta] @@ -600,7 +602,7 @@ proc ::tk::dialog::color::ResizeColorBars {w} { upvar ::tk::dialog::color::[winfo name $w] data if { - ($data(BARS_WIDTH) < $data(NUM_COLORBARS)) || + ($data(BARS_WIDTH) < $data(NUM_COLORBARS)) || (($data(BARS_WIDTH) % $data(NUM_COLORBARS)) != 0) } then { set data(BARS_WIDTH) $data(NUM_COLORBARS) @@ -658,7 +660,7 @@ proc ::tk::dialog::color::HandleRGBEntry {w} { SetRGBValue $w "$data(red,intensity) \ $data(green,intensity) $data(blue,intensity)" -} +} # mouse cursor enters a color bar # diff --git a/library/comdlg.tcl b/library/comdlg.tcl index 39d27d3..18df8a6 100644 --- a/library/comdlg.tcl +++ b/library/comdlg.tcl @@ -40,7 +40,8 @@ proc tclParseConfigSpec {w specs flags argList} { # foreach spec $specs { if {[llength $spec] < 4} { - error "\"spec\" should contain 5 or 4 elements" + return -code error -errorcode {TK VALUE CONFIG_SPEC} \ + "\"spec\" should contain 5 or 4 elements" } set cmdsw [lindex $spec 0] set cmd($cmdsw) "" @@ -53,9 +54,11 @@ proc tclParseConfigSpec {w specs flags argList} { if {[llength $argList] & 1} { set cmdsw [lindex $argList end] if {![info exists cmd($cmdsw)]} { - error "bad option \"$cmdsw\": must be [tclListValidFlags cmd]" + return -code error -errorcode [list TK LOOKUP OPTION $cmdsw] \ + "bad option \"$cmdsw\": must be [tclListValidFlags cmd]" } - error "value for \"$cmdsw\" missing" + return -code error -errorcode {TK VALUE_MISSING} \ + "value for \"$cmdsw\" missing" } # 2: set the default values @@ -68,7 +71,8 @@ proc tclParseConfigSpec {w specs flags argList} { # foreach {cmdsw value} $argList { if {![info exists cmd($cmdsw)]} { - error "bad option \"$cmdsw\": must be [tclListValidFlags cmd]" + return -code error -errorcode [list TK LOOKUP OPTION $cmdsw] \ + "bad option \"$cmdsw\": must be [tclListValidFlags cmd]" } set data($cmdsw) $value } @@ -120,7 +124,8 @@ proc tclListValidFlags {v} { proc ::tk::FocusGroup_Create {t} { variable ::tk::Priv if {[winfo toplevel $t] ne $t} { - error "$t is not a toplevel window" + return -code error -errorcode [list TK LOOKUP TOPLEVEL $t] \ + "$t is not a toplevel window" } if {![info exists Priv(fg,$t)]} { set Priv(fg,$t) 1 @@ -140,7 +145,8 @@ proc ::tk::FocusGroup_BindIn {t w cmd} { variable FocusIn variable ::tk::Priv if {![info exists Priv(fg,$t)]} { - error "focus group \"$t\" doesn't exist" + return -code error -errorcode [list TK LOOKUP FOCUS_GROUP $t] \ + "focus group \"$t\" doesn't exist" } set FocusIn($t,$w) $cmd } @@ -156,7 +162,8 @@ proc ::tk::FocusGroup_BindOut {t w cmd} { variable FocusOut variable ::tk::Priv if {![info exists Priv(fg,$t)]} { - error "focus group \"$t\" doesn't exist" + return -code error -errorcode [list TK LOOKUP FOCUS_GROUP $t] \ + "focus group \"$t\" doesn't exist" } set FocusOut($t,$w) $cmd } @@ -173,7 +180,7 @@ proc ::tk::FocusGroup_Destroy {t w} { if {$t eq $w} { unset Priv(fg,$t) - unset Priv(focus,$t) + unset Priv(focus,$t) foreach name [array names FocusIn $t,*] { unset FocusIn($name) @@ -255,7 +262,8 @@ proc ::tk::FocusGroup_Out {t w detail} { proc ::tk::FDGetFileTypes {string} { foreach t $string { if {[llength $t] < 2 || [llength $t] > 3} { - error "bad file type \"$t\", should be \"typeName {extension ?extensions ...?} ?{macType ?macTypes ...?}?\"" + return -code error -errorcode {TK VALUE FILE_TYPE} \ + "bad file type \"$t\", should be \"typeName {extension ?extensions ...?} ?{macType ?macTypes ...?}?\"" } lappend fileTypes([lindex $t 0]) {*}[lindex $t 1] } @@ -269,15 +277,16 @@ proc ::tk::FDGetFileTypes {string} { continue } - # Validate each macType. This is to agree with the + # Validate each macType. This is to agree with the # behaviour of TkGetFileFilters(). This list may be # empty. foreach macType [lindex $t 2] { if {[string length $macType] != 4} { - error "bad Macintosh file type \"$macType\"" + return -code error -errorcode {TK VALUE MAC_TYPE} \ + "bad Macintosh file type \"$macType\"" } } - + set name "$label \(" set sep "" set doAppend 1 diff --git a/library/console.tcl b/library/console.tcl index e44324f..ba68ccc 100644 --- a/library/console.tcl +++ b/library/console.tcl @@ -6,7 +6,7 @@ # # Copyright (c) 1995-1997 Sun Microsystems, Inc. # Copyright (c) 1998-2000 Ajuba Solutions. -# Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net> +# Copyright (c) 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. @@ -20,11 +20,10 @@ namespace eval ::tk::console { variable magicKeys 1 ; # enable brace matching and proc/var recognition variable maxLines 600 ; # maximum # of lines buffered in console variable showMatches 1 ; # show multiple expand matches - + variable useFontchooser [llength [info command ::tk::fontchooser]] variable inPlugin [info exists embed_args] variable defaultPrompt ; # default prompt if tcl_prompt1 isn't used - if {$inPlugin} { set defaultPrompt {subst {[history nextid] % }} } else { @@ -42,8 +41,6 @@ interp alias {} EvalAttached {} consoleinterp eval # None. proc ::tk::ConsoleInit {} { - global tcl_platform - if {![consoleinterp eval {set tcl_interactive}]} { wm withdraw . } @@ -79,7 +76,7 @@ proc ::tk::ConsoleInit {} { AmpMenuArgs .menubar.edit add command -label [mc P&aste] -accel "$mod+V"\ -command {event generate .console <<Paste>>} - if {$tcl_platform(platform) ne "windows"} { + if {[tk windowingsystem] ne "win32"} { AmpMenuArgs .menubar.edit add command -label [mc Cl&ear] \ -command {event generate .console <<Clear>>} } else { @@ -93,10 +90,35 @@ proc ::tk::ConsoleInit {} { } AmpMenuArgs .menubar.edit add separator + if {$::tk::console::useFontchooser} { + if {[tk windowingsystem] eq "aqua"} { + .menubar.edit add command -label tk_choose_font_marker + set index [.menubar.edit index tk_choose_font_marker] + .menubar.edit entryconfigure $index \ + -label [mc "Show Fonts"]\ + -accelerator "$mod-T"\ + -command [list ::tk::console::FontchooserToggle] + bind Console <<TkFontchooserVisibility>> \ + [list ::tk::console::FontchooserVisibility $index] + ::tk::console::FontchooserVisibility $index + } else { + AmpMenuArgs .menubar.edit add command -label [mc "&Font..."] \ + -command [list ::tk::console::FontchooserToggle] + } + bind Console <FocusIn> [list ::tk::console::FontchooserFocus %W 1] + bind Console <FocusOut> [list ::tk::console::FontchooserFocus %W 0] + } AmpMenuArgs .menubar.edit add command -label [mc "&Increase Font Size"] \ -accel "$mod++" -command {event generate .console <<Console_FontSizeIncr>>} AmpMenuArgs .menubar.edit add command -label [mc "&Decrease Font Size"] \ -accel "$mod+-" -command {event generate .console <<Console_FontSizeDecr>>} + AmpMenuArgs .menubar.edit add command -label [mc "Fit To Screen Width"] \ + -command {event generate .console <<Console_FitScreenWidth>>} + + if {[tk windowingsystem] eq "aqua"} { + .menubar add cascade -label [mc Window] -menu [menu .menubar.window] + .menubar add cascade -label [mc Help] -menu [menu .menubar.help] + } . configure -menu .menubar @@ -171,7 +193,7 @@ proc ::tk::ConsoleInit {} { $w mark set promptEnd insert $w mark gravity promptEnd left - if {$tcl_platform(platform) eq "windows"} { + if {[tk windowingsystem] ne "aqua"} { # Subtle work-around to erase the '% ' that tclMain.c prints out after idle [subst -nocommand { if {[$con get 1.0 output] eq "% "} { $con delete 1.0 output } @@ -289,7 +311,7 @@ proc ::tk::ConsoleHistory {cmd} { # ::tk::ConsolePrompt -- # This procedure draws the prompt. If tcl_prompt1 or tcl_prompt2 -# exists in the main interpreter it will be called to generate the +# exists in the main interpreter it will be called to generate the # prompt. Otherwise, a hard coded default prompt is printed. # # Arguments: @@ -356,6 +378,26 @@ proc ::tk::console::Paste {w} { } } +# Fit TkConsoleFont to window width +proc ::tk::console::FitScreenWidth {w} { + set width [winfo screenwidth $w] + set cwidth [$w cget -width] + set s -50 + set fit 0 + array set fi [font configure TkConsoleFont] + while {$s < 0} { + set fi(-size) $s + set f [font create {*}[array get fi]] + set c [font measure $f "eM"] + font delete $f + if {$c * $cwidth < 1.667 * $width} { + font configure TkConsoleFont -size $s + break + } + incr s 2 + } +} + # ::tk::ConsoleBind -- # This procedure first ensures that the default bindings for the Text # class have been defined. Then certain bindings are overridden for @@ -390,8 +432,6 @@ proc ::tk::ConsoleBind {w} { bind Console <Control-KeyPress> {# nothing} foreach {ev key} { - <<Console_Prev>> <Key-Up> - <<Console_Next>> <Key-Down> <<Console_NextImmediate>> <Control-Key-n> <<Console_PrevImmediate>> <Control-Key-p> <<Console_PrevSearch>> <Control-Key-r> @@ -426,6 +466,9 @@ proc ::tk::ConsoleBind {w} { event add $ev $key bind Console $key {} } + if {$::tk::console::useFontchooser} { + bind Console <Command-Key-t> [list ::tk::console::FontchooserToggle] + } } bind Console <<Console_Expand>> { if {[%W compare insert > promptEnd]} { @@ -474,18 +517,16 @@ proc ::tk::ConsoleBind {w} { } bind Console <Control-h> [bind Console <BackSpace>] - bind Console <Home> { + bind Console <<LineStart>> { if {[%W compare insert < promptEnd]} { tk::TextSetCursor %W {insert linestart} } else { tk::TextSetCursor %W promptEnd } } - bind Console <Control-a> [bind Console <Home>] - bind Console <End> { + bind Console <<LineEnd>> { tk::TextSetCursor %W {insert lineend} } - bind Console <Control-e> [bind Console <End>] bind Console <Control-d> { if {[%W compare insert < promptEnd]} { break @@ -535,10 +576,10 @@ proc ::tk::ConsoleBind {w} { %W delete insert {insert wordend} } } - bind Console <<Console_Prev>> { + bind Console <<PrevLine>> { tk::ConsoleHistory prev } - bind Console <<Console_Next>> { + bind Console <<NextLine>> { tk::ConsoleHistory next } bind Console <Insert> { @@ -562,11 +603,25 @@ proc ::tk::ConsoleBind {w} { bind Console <<Console_FontSizeIncr>> { set size [font configure TkConsoleFont -size] - font configure TkConsoleFont -size [incr size] + if {$size < 0} {set sign -1} else {set sign 1} + set size [expr {(abs($size) + 1) * $sign}] + font configure TkConsoleFont -size $size + if {$::tk::console::useFontchooser} { + tk fontchooser configure -font TkConsoleFont + } } bind Console <<Console_FontSizeDecr>> { set size [font configure TkConsoleFont -size] - font configure TkConsoleFont -size [incr size -1] + if {abs($size) < 2} { return } + if {$size < 0} {set sign -1} else {set sign 1} + set size [expr {(abs($size) - 1) * $sign}] + font configure TkConsoleFont -size $size + if {$::tk::console::useFontchooser} { + tk fontchooser configure -font TkConsoleFont + } + } + bind Console <<Console_FitScreenWidth>> { + ::tk::console::FitScreenWidth %W } ## @@ -671,6 +726,35 @@ Tcl $::tcl_patchLevel Tk $::tk_patchLevel" } +# ::tk::console::Fontchooser* -- +# Let the user select the console font (TIP 324). + +proc ::tk::console::FontchooserToggle {} { + if {[tk fontchooser configure -visible]} { + tk fontchooser hide + } else { + tk fontchooser show + } +} +proc ::tk::console::FontchooserVisibility {index} { + if {[tk fontchooser configure -visible]} { + .menubar.edit entryconfigure $index -label [msgcat::mc "Hide Fonts"] + } else { + .menubar.edit entryconfigure $index -label [msgcat::mc "Show Fonts"] + } +} +proc ::tk::console::FontchooserFocus {w isFocusIn} { + if {$isFocusIn} { + tk fontchooser configure -parent $w -font TkConsoleFont \ + -command [namespace code [list FontchooserApply]] + } else { + tk fontchooser configure -parent $w -font {} -command {} + } +} +proc ::tk::console::FontchooserApply {font args} { + catch {font configure TkConsoleFont {*}[font actual $font]} +} + # ::tk::console::TagProc -- # # Tags a procedure in the console if it's recognized @@ -720,7 +804,7 @@ proc ::tk::console::TagProc w { # c2 - second char of pair # # Calls: ::tk::console::Blink - + proc ::tk::console::MatchPair {w c1 c2 {lim 1.0}} { if {!$::tk::console::magicKeys} { return @@ -775,7 +859,7 @@ proc ::tk::console::MatchPair {w c1 c2 {lim 1.0}} { # w - console text widget # # Calls: ::tk::console::Blink - + proc ::tk::console::MatchQuote {w {lim 1.0}} { if {!$::tk::console::magicKeys} { return @@ -910,11 +994,11 @@ proc ::tk::console::Expand {w {type ""}} { # # Returns: list containing longest unique match followed by all the # possible further matches - + proc ::tk::console::ExpandPathname str { set pwd [EvalAttached pwd] - if {[catch {EvalAttached [list cd [file dirname $str]]} err]} { - return -code error $err + if {[catch {EvalAttached [list cd [file dirname $str]]} err opt]} { + return -options $opt $err } set dir [file tail $str] ## Check to see if it was known to be a directory and keep the trailing @@ -926,8 +1010,7 @@ proc ::tk::console::ExpandPathname str { set match {} } else { if {[llength $m] > 1} { - global tcl_platform - if {[string match windows $tcl_platform(platform)]} { + if { $::tcl_platform(platform) eq "windows" } { ## Windows is screwy because it's case insensitive set tmp [ExpandBestMatch [string tolower $m] \ [string tolower $dir]] diff --git a/library/demos/aniwave.tcl b/library/demos/aniwave.tcl index 6122132..a7539fb 100644 --- a/library/demos/aniwave.tcl +++ b/library/demos/aniwave.tcl @@ -17,7 +17,7 @@ wm title $w "Animated Wave Demonstration" wm iconname $w "aniwave" positionWindow $w -label $w.msg -font $font -wraplength 4i -justify left -text "This demonstration contains a canvas widget with a line item inside it. The animation routines work by adjusting the coordinates list of the line; a trace on a variable is used so updates to the variable result in a change of position of the line." +label $w.msg -font $font -wraplength 4i -justify left -text "This demonstration contains a canvas widget with a line item inside it. The animation routines work by adjusting the coordinates list of the line; a trace on a variable is used so updates to the variable result in a change of position of the line." pack $w.msg -side top ## See Code / Dismiss buttons diff --git a/library/demos/bind.tcl b/library/demos/bind.tcl index d9bc22f..03f6d3b 100644 --- a/library/demos/bind.tcl +++ b/library/demos/bind.tcl @@ -22,7 +22,7 @@ pack $btns -side bottom -fill x text $w.text -yscrollcommand "$w.scroll set" -setgrid true \ -width 60 -height 24 -font $font -wrap word -scrollbar $w.scroll -command "$w.text yview" +ttk::scrollbar $w.scroll -command "$w.text yview" pack $w.scroll -side right -fill y pack $w.text -expand yes -fill both diff --git a/library/demos/combo.tcl b/library/demos/combo.tcl index 5dad9f0..8631904 100644 --- a/library/demos/combo.tcl +++ b/library/demos/combo.tcl @@ -7,7 +7,6 @@ if {![info exists widgetDemo]} { } package require Tk -package require Ttk set w .combo catch {destroy $w} diff --git a/library/demos/ctext.tcl b/library/demos/ctext.tcl index e894bc2..4b8c644 100644 --- a/library/demos/ctext.tcl +++ b/library/demos/ctext.tcl @@ -17,7 +17,7 @@ wm iconname $w "Text" positionWindow $w set c $w.c -label $w.msg -font $font -wraplength 5i -justify left -text "This window displays a string of text to demonstrate the text facilities of canvas widgets. You can click in the boxes to adjust the position of the text relative to its positioning point or change its justification. The text also supports the following simple bindings for editing: +label $w.msg -font $font -wraplength 5i -justify left -text "This window displays a string of text to demonstrate the text facilities of canvas widgets. You can click in the boxes to adjust the position of the text relative to its positioning point or change its justification, and on a pie slice to change its angle. The text also supports the following simple bindings for editing: 1. You can point, click, and type. 2. You can also select with button 1. 3. You can copy the selection to the mouse position with button 2. @@ -50,36 +50,63 @@ $c bind text <Return> "textInsert $c \\n" $c bind text <Control-h> "textBs $c" $c bind text <BackSpace> "textBs $c" $c bind text <Delete> "textDel $c" -$c bind text <2> "textPaste $c @%x,%y" +$c bind text <2> "textPaste $c @%x,%y" # Next, create some items that allow the text's anchor position # to be edited. -proc mkTextConfig {w x y option value color} { +proc mkTextConfigBox {w x y option value color} { set item [$w create rect $x $y [expr {$x+30}] [expr {$y+30}] \ -outline black -fill $color -width 1] $w bind $item <1> "$w itemconf text $option $value" $w addtag config withtag $item } +proc mkTextConfigPie {w x y a option value color} { + set item [$w create arc $x $y [expr {$x+90}] [expr {$y+90}] \ + -start [expr {$a-15}] -extent 30 -outline black -fill $color \ + -width 1] + $w bind $item <1> "$w itemconf text $option $value" + $w addtag config withtag $item +} set x 50 set y 50 set color LightSkyBlue1 -mkTextConfig $c $x $y -anchor se $color -mkTextConfig $c [expr {$x+30}] [expr {$y }] -anchor s $color -mkTextConfig $c [expr {$x+60}] [expr {$y }] -anchor sw $color -mkTextConfig $c [expr {$x }] [expr {$y+30}] -anchor e $color -mkTextConfig $c [expr {$x+30}] [expr {$y+30}] -anchor center $color -mkTextConfig $c [expr {$x+60}] [expr {$y+30}] -anchor w $color -mkTextConfig $c [expr {$x }] [expr {$y+60}] -anchor ne $color -mkTextConfig $c [expr {$x+30}] [expr {$y+60}] -anchor n $color -mkTextConfig $c [expr {$x+60}] [expr {$y+60}] -anchor nw $color +mkTextConfigBox $c $x $y -anchor se $color +mkTextConfigBox $c [expr {$x+30}] [expr {$y }] -anchor s $color +mkTextConfigBox $c [expr {$x+60}] [expr {$y }] -anchor sw $color +mkTextConfigBox $c [expr {$x }] [expr {$y+30}] -anchor e $color +mkTextConfigBox $c [expr {$x+30}] [expr {$y+30}] -anchor center $color +mkTextConfigBox $c [expr {$x+60}] [expr {$y+30}] -anchor w $color +mkTextConfigBox $c [expr {$x }] [expr {$y+60}] -anchor ne $color +mkTextConfigBox $c [expr {$x+30}] [expr {$y+60}] -anchor n $color +mkTextConfigBox $c [expr {$x+60}] [expr {$y+60}] -anchor nw $color set item [$c create rect \ [expr {$x+40}] [expr {$y+40}] [expr {$x+50}] [expr {$y+50}] \ -outline black -fill red] $c bind $item <1> "$c itemconf text -anchor center" $c create text [expr {$x+45}] [expr {$y-5}] \ - -text {Text Position} -anchor s -font {Times 24} -fill brown + -text {Text Position} -anchor s -font {Times 20} -fill brown + +# Now create some items that allow the text's angle to be changed. + +set x 205 +set y 50 +set color Yellow +mkTextConfigPie $c $x $y 0 -angle 90 $color +mkTextConfigPie $c $x $y 30 -angle 120 $color +mkTextConfigPie $c $x $y 60 -angle 150 $color +mkTextConfigPie $c $x $y 90 -angle 180 $color +mkTextConfigPie $c $x $y 120 -angle 210 $color +mkTextConfigPie $c $x $y 150 -angle 240 $color +mkTextConfigPie $c $x $y 180 -angle 270 $color +mkTextConfigPie $c $x $y 210 -angle 300 $color +mkTextConfigPie $c $x $y 240 -angle 330 $color +mkTextConfigPie $c $x $y 270 -angle 0 $color +mkTextConfigPie $c $x $y 300 -angle 30 $color +mkTextConfigPie $c $x $y 330 -angle 60 $color +$c create text [expr {$x+45}] [expr {$y-5}] \ + -text {Text Angle} -anchor s -font {Times 20} -fill brown # Lastly, create some items that allow the text's justification to be # changed. @@ -87,11 +114,11 @@ $c create text [expr {$x+45}] [expr {$y-5}] \ set x 350 set y 50 set color SeaGreen2 -mkTextConfig $c $x $y -justify left $color -mkTextConfig $c [expr {$x+30}] $y -justify center $color -mkTextConfig $c [expr {$x+60}] $y -justify right $color +mkTextConfigBox $c $x $y -justify left $color +mkTextConfigBox $c [expr {$x+30}] $y -justify center $color +mkTextConfigBox $c [expr {$x+60}] $y -justify right $color $c create text [expr {$x+45}] [expr {$y-5}] \ - -text {Justification} -anchor s -font {Times 24} -fill brown + -text {Justification} -anchor s -font {Times 20} -fill brown $c bind config <Enter> "textEnter $c" $c bind config <Leave> "$c itemconf current -fill \$textConfigFill" diff --git a/library/demos/en.msg b/library/demos/en.msg index d4783fe..e364c81 100644 --- a/library/demos/en.msg +++ b/library/demos/en.msg @@ -18,7 +18,7 @@ ::msgcat::mcset en "Demo code: %s" ::msgcat::mcset en "About Widget Demo" ::msgcat::mcset en "Tk widget demonstration application" -::msgcat::mcset en "Copyright (c) %s" "Copyright \u00a9 %s" +::msgcat::mcset en "Copyright \u00a9 %s" ::msgcat::mcset en " @@title Tk Widget Demonstrations diff --git a/library/demos/entry2.tcl b/library/demos/entry2.tcl index d0ca35a..9e3f4ef 100644 --- a/library/demos/entry2.tcl +++ b/library/demos/entry2.tcl @@ -27,15 +27,15 @@ frame $w.frame -borderwidth 10 pack $w.frame -side top -fill x -expand 1 entry $w.frame.e1 -xscrollcommand "$w.frame.s1 set" -scrollbar $w.frame.s1 -relief sunken -orient horiz -command \ +ttk::scrollbar $w.frame.s1 -orient horiz -command \ "$w.frame.e1 xview" frame $w.frame.spacer1 -width 20 -height 10 entry $w.frame.e2 -xscrollcommand "$w.frame.s2 set" -scrollbar $w.frame.s2 -relief sunken -orient horiz -command \ +ttk::scrollbar $w.frame.s2 -orient horiz -command \ "$w.frame.e2 xview" frame $w.frame.spacer2 -width 20 -height 10 entry $w.frame.e3 -xscrollcommand "$w.frame.s3 set" -scrollbar $w.frame.s3 -relief sunken -orient horiz -command \ +ttk::scrollbar $w.frame.s3 -orient horiz -command \ "$w.frame.e3 xview" pack $w.frame.e1 $w.frame.s1 $w.frame.spacer1 $w.frame.e2 $w.frame.s2 \ $w.frame.spacer2 $w.frame.e3 $w.frame.s3 -side top -fill x diff --git a/library/demos/entry3.tcl b/library/demos/entry3.tcl index 3d76c2e..d4435c6 100644 --- a/library/demos/entry3.tcl +++ b/library/demos/entry3.tcl @@ -169,8 +169,8 @@ bind $w.l3.e <FocusIn> { after idle {%W selection clear} } } -bind $w.l3.e <Left> {phoneSkipLeft %W} -bind $w.l3.e <Right> {phoneSkipRight %W} +bind $w.l3.e <<PrevChar>> {phoneSkipLeft %W} +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" diff --git a/library/demos/filebox.tcl b/library/demos/filebox.tcl index 032e3d8..e06ebba 100644 --- a/library/demos/filebox.tcl +++ b/library/demos/filebox.tcl @@ -15,7 +15,10 @@ wm title $w "File Selection Dialogs" wm iconname $w "filebox" positionWindow $w -label $w.msg -font $font -wraplength 4i -justify left -text "Enter a file name in the entry box or click on the \"Browse\" buttons to select a file name using the file selection dialog." +ttk::frame $w._bg +place $w._bg -x 0 -y 0 -relwidth 1 -relheight 1 + +ttk::label $w.msg -font $font -wraplength 4i -justify left -text "Enter a file name in the entry box or click on the \"Browse\" buttons to select a file name using the file selection dialog." pack $w.msg -side top ## See Code / Dismiss buttons @@ -23,10 +26,10 @@ set btns [addSeeDismiss $w.buttons $w] pack $btns -side bottom -fill x foreach i {open save} { - set f [frame $w.$i] - label $f.lab -text "Select a file to $i: " -anchor e - entry $f.ent -width 20 - button $f.but -text "Browse ..." -command "fileDialog $w $f.ent $i" + set f [ttk::frame $w.$i] + ttk::label $f.lab -text "Select a file to $i: " -anchor e + ttk::entry $f.ent -width 20 + ttk::button $f.but -text "Browse ..." -command "fileDialog $w $f.ent $i" pack $f.lab -side left pack $f.ent -side left -expand yes -fill x pack $f.but -side left @@ -34,7 +37,7 @@ foreach i {open save} { } if {[tk windowingsystem] eq "x11"} { - checkbutton $w.strict -text "Use Motif Style Dialog" \ + ttk::checkbutton $w.strict -text "Use Motif Style Dialog" \ -variable tk_strictMotif -onvalue 1 -offvalue 0 pack $w.strict -anchor c diff --git a/library/demos/floor.tcl b/library/demos/floor.tcl index 827600b..c36979b 100644 --- a/library/demos/floor.tcl +++ b/library/demos/floor.tcl @@ -1307,8 +1307,8 @@ pack $btns -side bottom -fill x set f [frame $w.frame] pack $f -side top -fill both -expand yes -set h [scrollbar $f.hscroll -orient horizontal] -set v [scrollbar $f.vscroll -orient vertical] +set h [ttk::scrollbar $f.hscroll -orient horizontal] +set v [ttk::scrollbar $f.vscroll -orient vertical] set f1 [frame $f.f1 -borderwidth 2 -relief sunken] set c [canvas $f1.c -width 900 -height 500 -highlightthickness 0 \ -xscrollcommand [list $h set] \ diff --git a/library/demos/fontchoose.tcl b/library/demos/fontchoose.tcl new file mode 100644 index 0000000..8b34377 --- /dev/null +++ b/library/demos/fontchoose.tcl @@ -0,0 +1,69 @@ +# fontchoose.tcl -- +# +# Show off the stock font selector dialog + +if {![info exists widgetDemo]} { + error "This script should be run from the \"widget\" demo." +} + +package require Tk + +set w .fontchoose +catch {destroy $w} +toplevel $w +wm title $w "Font Selection Dialog" +wm iconname $w "fontchooser" +positionWindow $w + +catch {font create FontchooseDemoFont {*}[font actual TkDefaultFont]} + +# The font chooser needs to be configured and then shown. +proc SelectFont {parent} { + tk fontchooser configure -font FontchooseDemoFont \ + -command ApplyFont -parent $parent + tk fontchooser show +} + +proc ApplyFont {font} { + font configure FontchooseDemoFont {*}[font actual $font] +} + +# When the visibility of the fontchooser changes, the following event is fired +# to the parent widget. +# +bind $w <<TkFontchooserVisibility>> { + if {[tk fontchooser configure -visible]} { + %W.f.font state disabled + } else { + %W.f.font state !disabled + } +} + + +set f [ttk::frame $w.f -relief sunken -padding 2] + +text $f.msg -font FontchooseDemoFont -width 40 -height 6 -borderwidth 0 \ + -yscrollcommand [list $f.vs set] +ttk::scrollbar $f.vs -command [list $f.msg yview] + +$f.msg insert end "Press the buttons below to choose a new font for the\ + text shown in this window.\n" {} + +ttk::button $f.font -text "Set font ..." -command [list SelectFont $w] + +grid $f.msg $f.vs -sticky news +grid $f.font - -sticky e +grid columnconfigure $f 0 -weight 1 +grid rowconfigure $f 0 -weight 1 +bind $w <Visibility> { + bind %W <Visibility> {} + grid propagate %W.f 0 +} + +## See Code / Dismiss buttons +set btns [addSeeDismiss $w.buttons $w] + +grid $f -sticky news +grid $btns -sticky ew +grid columnconfigure $w 0 -weight 1 +grid rowconfigure $w 0 -weight 1 diff --git a/library/demos/image2.tcl b/library/demos/image2.tcl index 7b3d748..2d7ba03 100644 --- a/library/demos/image2.tcl +++ b/library/demos/image2.tcl @@ -36,7 +36,7 @@ proc loadDir w { proc selectAndLoadDir w { global dirName set dir [tk_chooseDirectory -initialdir $dirName -parent $w -mustexist 1] - if {[string length $dir] != 0} { + if {$dir ne ""} { set dirName $dir loadDir $w } @@ -92,7 +92,7 @@ pack $w.dir.b -side left -fill y -padx {0 2m} -pady 2m labelframe $w.f -text "File:" -padx 2m -pady 2m listbox $w.f.list -width 20 -height 10 -yscrollcommand "$w.f.scroll set" -scrollbar $w.f.scroll -command "$w.f.list yview" +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 bind $w.f.list <Double-1> "loadImage $w %x %y" diff --git a/library/demos/images/face.xbm b/library/demos/images/face.xbm deleted file mode 100644 index 03d829f..0000000 --- a/library/demos/images/face.xbm +++ /dev/null @@ -1,173 +0,0 @@ -#define face_width 108 -#define face_height 144 -#define face_x_hot 48 -#define face_y_hot 80 -static char face_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x20, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x08, 0x09, - 0x20, 0x80, 0x24, 0x05, 0x00, 0x80, 0x08, 0x00, 0x00, 0x00, 0x00, 0x88, - 0x24, 0x20, 0x80, 0x24, 0x00, 0x00, 0x00, 0x10, 0x80, 0x04, 0x00, 0x01, - 0x00, 0x01, 0x40, 0x0a, 0x09, 0x00, 0x92, 0x04, 0x80, 0x00, 0x00, 0x00, - 0x00, 0x00, 0x10, 0x40, 0x12, 0x00, 0x00, 0x10, 0x40, 0x00, 0x00, 0x84, - 0x24, 0x40, 0x22, 0xa8, 0x02, 0x14, 0x84, 0x92, 0x40, 0x42, 0x12, 0x04, - 0x10, 0x00, 0x00, 0x00, 0x00, 0x52, 0x00, 0x52, 0x11, 0x00, 0x12, 0x00, - 0x40, 0x02, 0x00, 0x20, 0x00, 0x08, 0x00, 0xaa, 0x02, 0x54, 0x85, 0x24, - 0x00, 0x10, 0x12, 0x00, 0x00, 0x81, 0x44, 0x00, 0x90, 0x5a, 0x00, 0xea, - 0x1b, 0x00, 0x80, 0x40, 0x40, 0x02, 0x00, 0x08, 0x00, 0x20, 0xa2, 0x05, - 0x8a, 0xb4, 0x6e, 0x45, 0x12, 0x04, 0x08, 0x00, 0x00, 0x00, 0x10, 0x02, - 0xa8, 0x92, 0x00, 0xda, 0x5f, 0x10, 0x00, 0x10, 0xa1, 0x04, 0x20, 0x41, - 0x02, 0x00, 0x5a, 0x25, 0xa0, 0xff, 0xfb, 0x05, 0x41, 0x02, 0x04, 0x00, - 0x00, 0x08, 0x40, 0x80, 0xec, 0x9b, 0xec, 0xfe, 0x7f, 0x01, 0x04, 0x20, - 0x90, 0x02, 0x04, 0x00, 0x08, 0x20, 0xfb, 0x2e, 0xf5, 0xff, 0xff, 0x57, - 0x00, 0x04, 0x02, 0x00, 0x00, 0x20, 0x01, 0xc1, 0x6e, 0xab, 0xfa, 0xff, - 0xff, 0x05, 0x90, 0x20, 0x48, 0x02, 0x00, 0x04, 0x20, 0xa8, 0xdf, 0xb5, - 0xfe, 0xff, 0xff, 0x0b, 0x01, 0x00, 0x01, 0x00, 0x80, 0x80, 0x04, 0xe0, - 0xbb, 0xef, 0xff, 0xff, 0x7f, 0x01, 0x00, 0x04, 0x48, 0x02, 0x00, 0x20, - 0x80, 0xf4, 0x6f, 0xfb, 0xff, 0xff, 0xff, 0x20, 0x90, 0x40, 0x02, 0x00, - 0x00, 0x04, 0x08, 0xb8, 0xf6, 0xff, 0xff, 0xdf, 0xbe, 0x12, 0x45, 0x10, - 0x90, 0x04, 0x90, 0x00, 0x22, 0xfa, 0xff, 0xff, 0xff, 0xbb, 0xd7, 0xe9, - 0x3a, 0x02, 0x02, 0x00, 0x04, 0x90, 0x80, 0xfe, 0xdf, 0xf6, 0xb7, 0xef, - 0xbe, 0x56, 0x57, 0x40, 0x48, 0x09, 0x00, 0x04, 0x00, 0xfa, 0xf5, 0xdf, - 0xed, 0x5a, 0xd5, 0xea, 0xbd, 0x09, 0x00, 0x00, 0x40, 0x00, 0x92, 0xfe, - 0xbf, 0x7d, 0xb7, 0x6a, 0x55, 0xbf, 0xf7, 0x02, 0x11, 0x01, 0x00, 0x91, - 0x00, 0xff, 0xff, 0xaf, 0x55, 0x55, 0x5b, 0xeb, 0xef, 0x22, 0x04, 0x04, - 0x04, 0x00, 0xa4, 0xff, 0xf7, 0xad, 0xaa, 0xaa, 0xaa, 0xbe, 0xfe, 0x03, - 0x20, 0x00, 0x10, 0x44, 0x80, 0xff, 0x7f, 0x55, 0x12, 0x91, 0x2a, 0xeb, - 0xbf, 0x0b, 0x82, 0x02, 0x00, 0x00, 0xd1, 0x7f, 0xdf, 0xa2, 0xa4, 0x54, - 0x55, 0xfd, 0xfd, 0x47, 0x08, 0x08, 0x00, 0x21, 0xe4, 0xff, 0x37, 0x11, - 0x09, 0xa5, 0xaa, 0xb6, 0xff, 0x0d, 0x80, 0x00, 0x00, 0x04, 0xd0, 0xff, - 0x4f, 0x44, 0x20, 0x48, 0x55, 0xfb, 0xff, 0x27, 0x11, 0x02, 0x40, 0x40, - 0xe2, 0xfb, 0x15, 0x11, 0x4a, 0x55, 0x4a, 0x7d, 0xf7, 0x0f, 0x00, 0x00, - 0x04, 0x08, 0xf8, 0xdf, 0x52, 0x44, 0x01, 0x52, 0xb5, 0xfa, 0xff, 0x0f, - 0x49, 0x02, 0x00, 0x02, 0xe9, 0xf6, 0x0a, 0x11, 0xa4, 0x88, 0x4a, 0x6d, - 0xff, 0x5f, 0x00, 0x00, 0x10, 0x20, 0xf0, 0x2f, 0x21, 0x44, 0x10, 0x52, - 0xb5, 0xfa, 0xff, 0x0f, 0x44, 0x04, 0x80, 0x08, 0xf8, 0xab, 0x8a, 0x00, - 0x81, 0xa4, 0xd4, 0xd6, 0xfe, 0x2f, 0x00, 0x00, 0x04, 0x40, 0xb5, 0x2d, - 0x21, 0x08, 0x04, 0x90, 0xaa, 0xfa, 0xff, 0x1f, 0x11, 0x01, 0x00, 0x04, - 0xf0, 0x57, 0x0a, 0x22, 0x40, 0x4a, 0xda, 0x5e, 0xfb, 0x1f, 0x40, 0x00, - 0x40, 0x20, 0xba, 0x95, 0x90, 0x00, 0x01, 0xa0, 0xaa, 0xea, 0xff, 0x5f, - 0x02, 0x02, 0x00, 0x01, 0xe8, 0x57, 0x05, 0x00, 0x00, 0x12, 0xd5, 0xfe, - 0xfd, 0x1f, 0x48, 0x00, 0x04, 0x48, 0x7a, 0x95, 0x08, 0x02, 0x10, 0x40, - 0xaa, 0x55, 0xf7, 0x1f, 0x00, 0x09, 0x20, 0x00, 0xf8, 0x57, 0x22, 0x10, - 0x00, 0x28, 0xa9, 0xfa, 0xff, 0x5f, 0x02, 0x00, 0x00, 0x49, 0xdd, 0x29, - 0x01, 0x00, 0x80, 0x80, 0xaa, 0xd7, 0xff, 0x0f, 0x10, 0x00, 0x08, 0x00, - 0xf8, 0x96, 0x08, 0x00, 0x00, 0x20, 0x54, 0xfa, 0xee, 0x3f, 0x81, 0x04, - 0x40, 0x24, 0xfe, 0x55, 0x82, 0x00, 0x00, 0x82, 0xd2, 0xad, 0xff, 0x0f, - 0x08, 0x00, 0x04, 0x80, 0x6c, 0x97, 0x00, 0x00, 0x02, 0x20, 0xa9, 0xf6, - 0xdf, 0x5f, 0x00, 0x02, 0x20, 0x09, 0xfa, 0x49, 0x12, 0x00, 0x20, 0x84, - 0x54, 0xdb, 0xfe, 0x1f, 0x91, 0x00, 0x00, 0x00, 0xf8, 0x2b, 0x00, 0x20, - 0x00, 0x40, 0xa4, 0xf6, 0xbb, 0x1f, 0x04, 0x00, 0x44, 0x92, 0x7e, 0x95, - 0x02, 0x00, 0x00, 0x89, 0xaa, 0xdd, 0xff, 0x1f, 0x20, 0x09, 0x10, 0x00, - 0xf4, 0x57, 0x20, 0x01, 0x08, 0x20, 0xa9, 0x76, 0xff, 0x5f, 0x02, 0x00, - 0x00, 0x21, 0xfc, 0x4a, 0x05, 0x00, 0x01, 0x80, 0x54, 0xdb, 0xff, 0x1e, - 0x08, 0x02, 0x04, 0x08, 0xf9, 0x2b, 0x00, 0x00, 0x40, 0x28, 0xd2, 0xf6, - 0xff, 0xbf, 0x80, 0x00, 0x90, 0x00, 0xbc, 0x92, 0x08, 0x10, 0x00, 0x82, - 0x54, 0xdb, 0xff, 0x1f, 0x20, 0x00, 0x00, 0x44, 0xf9, 0x55, 0x02, 0x01, - 0x00, 0x20, 0xaa, 0xbd, 0xfd, 0x3f, 0x08, 0x04, 0x04, 0x10, 0xf4, 0x2a, - 0x01, 0x00, 0x22, 0x80, 0xd4, 0xf6, 0xff, 0x5f, 0x82, 0x00, 0x40, 0x02, - 0xf8, 0x55, 0x20, 0x00, 0x00, 0x50, 0x6a, 0xdf, 0xfe, 0x3f, 0x00, 0x00, - 0x00, 0x48, 0xe9, 0x4a, 0x05, 0x08, 0x00, 0xa5, 0xd5, 0xf5, 0xff, 0x3f, - 0x10, 0x01, 0x10, 0x01, 0xb0, 0xab, 0x92, 0x02, 0x40, 0xf8, 0xbf, 0xde, - 0xfe, 0x5f, 0x02, 0x04, 0x04, 0x48, 0xfa, 0xd4, 0x6f, 0x20, 0x84, 0xef, - 0xff, 0xfb, 0xff, 0x1f, 0x20, 0x00, 0x00, 0x00, 0xe0, 0xed, 0xbf, 0x0b, - 0xa1, 0x7e, 0xff, 0xbf, 0xfd, 0x5f, 0x04, 0x01, 0x20, 0x49, 0xd2, 0xfb, - 0xfe, 0x55, 0xd4, 0xff, 0xff, 0xf6, 0xff, 0x07, 0x00, 0x04, 0x00, 0x00, - 0xc0, 0xaa, 0xfb, 0x2b, 0xa2, 0xfe, 0xff, 0xdf, 0xee, 0x1f, 0x91, 0x00, - 0x82, 0xa4, 0xa4, 0xf5, 0xff, 0x57, 0xd5, 0xff, 0xbf, 0xfd, 0xff, 0x4d, - 0x00, 0x00, 0x20, 0x00, 0x88, 0x5b, 0xff, 0x2f, 0x69, 0xff, 0xff, 0xdb, - 0xfe, 0x1f, 0x24, 0x02, 0x00, 0x49, 0xa2, 0xd6, 0xff, 0x5f, 0xea, 0xff, - 0x7f, 0x7f, 0x7f, 0x0d, 0x00, 0x00, 0x10, 0x00, 0x40, 0xab, 0xf7, 0xbb, - 0xf0, 0xdf, 0xff, 0xd5, 0xff, 0xbf, 0x82, 0x04, 0x42, 0x24, 0x91, 0xd5, - 0xaa, 0xae, 0xd4, 0xaa, 0x52, 0x7b, 0xff, 0x15, 0x08, 0x00, 0x00, 0x01, - 0x04, 0x55, 0xd5, 0x55, 0x70, 0x5b, 0x75, 0xdd, 0xdf, 0x1f, 0x40, 0x00, - 0x08, 0x48, 0xa0, 0x4a, 0xa9, 0x56, 0xea, 0x56, 0xad, 0x6a, 0x7d, 0x9b, - 0x04, 0x01, 0x00, 0x02, 0x42, 0x2a, 0xd5, 0xaa, 0xa8, 0xaa, 0xaa, 0xfa, - 0xdf, 0x2f, 0x10, 0x04, 0x22, 0x48, 0x08, 0x45, 0x2a, 0x15, 0x68, 0x55, - 0x55, 0xd7, 0x76, 0x1b, 0x00, 0x00, 0x00, 0x01, 0x40, 0x2a, 0x80, 0xa0, - 0xb2, 0x09, 0x48, 0xb9, 0xdf, 0x17, 0x22, 0x01, 0x00, 0x24, 0x45, 0x8a, - 0x24, 0x4a, 0x54, 0x51, 0x91, 0xf6, 0x6e, 0x4b, 0x00, 0x04, 0x90, 0x00, - 0x80, 0x52, 0x00, 0x20, 0x69, 0x05, 0xa4, 0xaa, 0xff, 0x1e, 0x48, 0x00, - 0x02, 0x92, 0x08, 0x05, 0x81, 0x94, 0xd4, 0x92, 0x40, 0xfd, 0xb6, 0x8b, - 0x00, 0x01, 0x40, 0x00, 0x82, 0x54, 0x00, 0x48, 0x68, 0x05, 0x90, 0xa4, - 0xef, 0x06, 0x24, 0x00, 0x08, 0x12, 0x10, 0x05, 0x00, 0x10, 0xb5, 0x01, - 0x42, 0xfb, 0xbf, 0x43, 0x00, 0x09, 0x00, 0x40, 0x81, 0xa8, 0x08, 0x4a, - 0xaa, 0x96, 0x90, 0xac, 0x6d, 0x15, 0x22, 0x00, 0x20, 0x09, 0x04, 0x15, - 0x80, 0x28, 0xdc, 0x01, 0x24, 0xfb, 0xbf, 0x01, 0x80, 0x04, 0x09, 0x00, - 0x40, 0x48, 0x02, 0x45, 0xb2, 0x2e, 0x41, 0x6d, 0xef, 0x05, 0x11, 0x00, - 0x40, 0x52, 0x02, 0x15, 0x29, 0x2a, 0xac, 0x42, 0x54, 0xfb, 0x3b, 0x51, - 0x84, 0x00, 0x08, 0x00, 0x20, 0x54, 0x80, 0x05, 0xb5, 0x3d, 0xa2, 0xb6, - 0xdf, 0x00, 0x20, 0x04, 0x20, 0x49, 0x89, 0xa8, 0x6a, 0x29, 0xac, 0xd6, - 0x54, 0xff, 0x3f, 0x84, 0x00, 0x01, 0x04, 0x10, 0x00, 0x94, 0xa8, 0x56, - 0xda, 0x5f, 0xab, 0xd5, 0x1e, 0x10, 0x48, 0x00, 0x90, 0x82, 0x48, 0xa8, - 0xb2, 0xac, 0xfd, 0x55, 0xd5, 0xfe, 0x9f, 0x80, 0x00, 0x0a, 0x02, 0x08, - 0x02, 0x55, 0x5a, 0x75, 0xff, 0xaf, 0xb6, 0xf7, 0x2d, 0x12, 0x92, 0x00, - 0x10, 0x20, 0x10, 0xa8, 0x54, 0xd5, 0xbf, 0x5d, 0xad, 0xdd, 0x0f, 0x00, - 0x00, 0x04, 0x40, 0x09, 0x84, 0xa8, 0xaa, 0x5a, 0xed, 0xeb, 0x6a, 0xff, - 0x9f, 0xa4, 0x24, 0x01, 0x02, 0xa0, 0x20, 0x50, 0x55, 0xd5, 0xbe, 0xae, - 0xad, 0xfd, 0x16, 0x00, 0x10, 0x04, 0x20, 0x0a, 0x08, 0xb4, 0xaa, 0x95, - 0xaa, 0x7b, 0xb7, 0xdb, 0x5f, 0x92, 0x04, 0x01, 0x84, 0x20, 0x21, 0x51, - 0xd5, 0x2a, 0xa9, 0xee, 0xd5, 0xfe, 0x0d, 0x00, 0x20, 0x04, 0x10, 0x00, - 0x08, 0x50, 0xe9, 0xd7, 0xd4, 0xfb, 0xb5, 0xff, 0x9f, 0x24, 0x09, 0x01, - 0x42, 0x4a, 0xa2, 0x64, 0xd5, 0x55, 0x7b, 0x7f, 0xda, 0x7d, 0x4f, 0x00, - 0x20, 0x04, 0x00, 0x80, 0x00, 0xa0, 0x2a, 0x13, 0x84, 0x6a, 0x55, 0xff, - 0x1d, 0x48, 0x8a, 0x00, 0x94, 0x24, 0x8a, 0xc8, 0xaa, 0x42, 0x20, 0x5d, - 0xf5, 0xff, 0x5f, 0x01, 0x00, 0x02, 0x01, 0x00, 0x20, 0xa2, 0x4a, 0x1a, - 0x82, 0x56, 0xda, 0xbd, 0x3f, 0x92, 0x92, 0x00, 0x90, 0x92, 0x00, 0x40, - 0x95, 0x6a, 0xf4, 0x55, 0x6d, 0xff, 0xd6, 0x00, 0x00, 0x0a, 0x04, 0x20, - 0x14, 0x49, 0x4b, 0xaa, 0xaa, 0x56, 0xf5, 0xff, 0xbf, 0xab, 0xa4, 0x00, - 0x20, 0x89, 0x40, 0x80, 0xaa, 0xaa, 0xaa, 0xaa, 0xde, 0xbf, 0xeb, 0x03, - 0x00, 0x02, 0x04, 0x02, 0x0a, 0x10, 0x2b, 0x2a, 0x55, 0x5b, 0xf5, 0xff, - 0xd7, 0x2f, 0x92, 0x00, 0x10, 0x28, 0x21, 0x01, 0x56, 0x95, 0xa0, 0x56, - 0xdf, 0xef, 0xea, 0x87, 0x40, 0x0a, 0x42, 0x41, 0x00, 0x90, 0xaa, 0x52, - 0xb6, 0xad, 0xfa, 0xff, 0xd5, 0x2f, 0x14, 0x00, 0x00, 0x04, 0x95, 0x04, - 0xaa, 0xac, 0x55, 0x6b, 0xff, 0xb7, 0xea, 0x9f, 0x40, 0x02, 0x28, 0x51, - 0x00, 0x40, 0x58, 0xd5, 0xda, 0xd6, 0x6e, 0x7f, 0xf9, 0x3f, 0x12, 0x04, - 0x02, 0x04, 0x49, 0x25, 0x55, 0xaa, 0x77, 0xab, 0xff, 0x2b, 0xfd, 0x3f, - 0x48, 0x01, 0x20, 0x41, 0x00, 0x00, 0x58, 0xa9, 0xda, 0xea, 0xfd, 0xaf, - 0xfa, 0xff, 0x02, 0x04, 0x08, 0x14, 0x29, 0x49, 0x52, 0x55, 0x55, 0x55, - 0xff, 0x8d, 0xfe, 0x3f, 0xa8, 0x00, 0x02, 0x41, 0x00, 0x02, 0xa0, 0xa2, - 0xaa, 0xea, 0xff, 0x53, 0xfd, 0xff, 0x02, 0x04, 0x50, 0x04, 0x25, 0xa8, - 0x54, 0x49, 0x52, 0xb5, 0xbf, 0x8a, 0xfe, 0xff, 0xa9, 0x08, 0x04, 0x50, - 0x80, 0x02, 0xa1, 0x2a, 0x95, 0xea, 0xff, 0xa1, 0xff, 0xff, 0x03, 0x02, - 0x90, 0x02, 0x09, 0x08, 0x44, 0x49, 0x52, 0xbd, 0x7f, 0xca, 0xff, 0xff, - 0x2b, 0x09, 0x04, 0x48, 0x40, 0x82, 0x90, 0x56, 0xa9, 0xf6, 0xbf, 0xd0, - 0xff, 0xff, 0x47, 0x00, 0x50, 0x02, 0x15, 0x11, 0x40, 0x95, 0xaa, 0xfd, - 0x2f, 0xe9, 0xff, 0xff, 0x8f, 0x0a, 0x84, 0x50, 0x40, 0x84, 0x14, 0xaa, - 0x6a, 0xff, 0x5f, 0xf2, 0xff, 0xff, 0x7f, 0x00, 0x10, 0x02, 0x09, 0x10, - 0x40, 0x7d, 0xf7, 0xff, 0x0b, 0xfc, 0xff, 0xff, 0xaf, 0x02, 0x84, 0x50, - 0x42, 0x85, 0x12, 0xd0, 0xdd, 0xff, 0xa7, 0xf2, 0xff, 0xff, 0xff, 0x04, - 0x00, 0x0a, 0x08, 0x10, 0x48, 0xf8, 0xff, 0xff, 0x0a, 0xfe, 0xff, 0xff, - 0x7f, 0x03, 0xa4, 0x80, 0xa2, 0x8a, 0x02, 0x68, 0xff, 0xff, 0x52, 0xfd, - 0xff, 0xff, 0xff, 0x07, 0x00, 0x2a, 0x08, 0x20, 0x28, 0xdc, 0xff, 0x5f, - 0x05, 0xff, 0xff, 0xff, 0xff, 0x0d, 0x92, 0x40, 0x22, 0x09, 0x02, 0xea, - 0xfb, 0xaf, 0x48, 0xff, 0xff, 0xff, 0xff, 0x0f, 0x00, 0x12, 0x81, 0xa0, - 0x48, 0x9c, 0x6e, 0x93, 0xa2, 0xff, 0xff, 0xff, 0xff, 0x07, 0xa8, 0x40, - 0x28, 0x0a, 0x02, 0x74, 0xb5, 0x45, 0x81, 0xff, 0xff, 0xff, 0xff, 0x0f, - 0x02, 0x0a, 0x81, 0x20, 0x08, 0xae, 0xaa, 0x90, 0xe8, 0xff, 0xff, 0xff, - 0xff, 0x0f, 0x90, 0x40, 0x28, 0x88, 0x12, 0x58, 0x15, 0x50, 0xd0, 0xff, - 0xff, 0xff, 0xff, 0x0f, 0x44, 0x0a, 0x41, 0x21, 0x08, 0xae, 0x04, 0x14, - 0xf0, 0xff, 0xff, 0xff, 0xff, 0x0f, 0x10, 0x40, 0x14, 0x88, 0x04, 0xba, - 0x02, 0x28, 0xe8, 0xff, 0xff, 0xff, 0xff, 0x0f, 0x42, 0x15, 0x41, 0x21, - 0x05, 0xad, 0x00, 0x05, 0xf8, 0xff, 0xff, 0xff, 0xff, 0x0f, 0x10, 0x40, - 0x24, 0x8a, 0x0e, 0x36, 0x00, 0x0a, 0xf4, 0xff, 0xff, 0xff, 0xff, 0x0f, - 0x42, 0x25, 0x90, 0xd0, 0x8b, 0xc2, 0x41, 0x05, 0xfc, 0xff, 0xff, 0xff, - 0xff, 0x0f, 0x10, 0x08, 0x05, 0xe8, 0x8e, 0x58, 0x80, 0x02, 0xfa, 0xff, - 0xff, 0xff, 0xff, 0x0f, 0x4a, 0x20, 0xa8, 0xba, 0x0b, 0x2b, 0x51, 0x01, - 0xfe, 0xff, 0xff, 0xff, 0xff, 0x0f, 0x00, 0x8a, 0x02, 0xe8, 0xaf, 0x84, - 0x90, 0x04, 0xfd, 0xff, 0xff, 0xff, 0xff, 0x0f, 0x52, 0x21, 0x54, 0xbf, - 0x1f, 0x15, 0xa5, 0x02, 0xfe, 0xff, 0xff, 0xff, 0xff, 0x0f, 0x00, 0x08, - 0x01, 0xfa, 0xb6, 0xa4, 0x52, 0x40, 0xff, 0xff, 0xff, 0xff, 0xff, 0x0f, - 0x4a, 0xa2, 0x54, 0xef, 0x5f, 0x4b, 0xa4, 0x80, 0xff, 0xff, 0xff, 0xff, - 0xff, 0x0f, 0x80, 0x10, 0x82, 0xfe, 0xbf, 0x92, 0x52, 0x42, 0xff, 0xff, - 0xff, 0xff, 0xff, 0x0f, 0x12, 0x42, 0xa8, 0xbf, 0x1f, 0x24, 0x80, 0xa0, - 0xff, 0xff, 0xff, 0xff, 0xff, 0x0f, 0x84, 0x28, 0x8a, 0xf7, 0x37, 0x80, - 0x52, 0x80, 0xff, 0xff, 0xff, 0xff, 0xff, 0x0f, 0x10, 0x82, 0xe0, 0xff, - 0x1f, 0x00, 0x20, 0xe1, 0xff, 0xff, 0xff, 0xff, 0xff, 0x0f, 0x84, 0x28, - 0xca, 0xff, 0x1f, 0x00, 0x00, 0xc0, 0xff, 0xff, 0xff, 0xff, 0xff, 0x0f, - 0x10, 0x42, 0xf0, 0xfd, 0x1b, 0x00, 0x50, 0xf0, 0xff, 0xff, 0xff, 0xff, - 0xff, 0x0f, 0xa4, 0x10, 0xc5, 0xff, 0x1f, 0x00, 0x00, 0xe0, 0xff, 0xff, - 0xff, 0xff, 0xff, 0x0f, 0x00, 0x22, 0xf8, 0xff, 0x0e, 0x00, 0x00, 0xf0, - 0xff, 0xff, 0xff, 0xff, 0xff, 0x0f, 0xaa, 0x88, 0xe2, 0xff, 0x0f, 0x10, - 0x00, 0xf0, 0xff, 0xff, 0xff, 0xff, 0xff, 0x0f, 0x00, 0x25, 0xfa, 0xff, - 0x0f, 0x01, 0x11, 0xfd, 0xff, 0xff, 0xff, 0xff, 0xff, 0x0f, 0xff, 0xfb, - 0xfb, 0xff, 0x7f, 0x5d, 0xd5, 0xfa, 0xff, 0xff, 0xff, 0xff, 0xff, 0x0f}; diff --git a/library/demos/images/ouster.png b/library/demos/images/ouster.png Binary files differnew file mode 100644 index 0000000..259b8f9 --- /dev/null +++ b/library/demos/images/ouster.png diff --git a/library/demos/items.tcl b/library/demos/items.tcl index 85bf5f3..000e4cb 100644 --- a/library/demos/items.tcl +++ b/library/demos/items.tcl @@ -31,8 +31,8 @@ canvas $c -scrollregion {0c 0c 30c 24c} -width 15c -height 10c \ -relief sunken -borderwidth 2 \ -xscrollcommand "$w.frame.hscroll set" \ -yscrollcommand "$w.frame.vscroll set" -scrollbar $w.frame.vscroll -command "$c yview" -scrollbar $w.frame.hscroll -orient horiz -command "$c xview" +ttk::scrollbar $w.frame.vscroll -command "$c yview" +ttk::scrollbar $w.frame.hscroll -orient horiz -command "$c xview" grid $c -in $w.frame \ -row 0 -column 0 -rowspan 1 -columnspan 1 -sticky news @@ -126,8 +126,8 @@ $c create text 25.5c 11c -anchor w -font $font1 -fill $blue \ -text "Several lines,\n each centered\nindividually,\nand all anchored\nat the left edge." \ -justify center -tags item $c create rectangle 24.9c 13.9c 25.1c 14.1c -$c create text 25c 14c -font $font2 -anchor c -fill $red -stipple gray50 \ - -text "Stippled characters" -tags item +$c create text 25c 14c -font $font2 -anchor c -fill $red -angle 15 \ + -text "Angled characters" -tags item $c create text 5c 16.2c -text Arcs -anchor n $c create arc 0.5c 17c 7c 20c -fill $green -outline black \ @@ -140,9 +140,13 @@ $c create arc 0.5c 20c 9.5c 24c -width 4m -style pieslice \ $c create arc 5.5c 20.5c 9.5c 23.5c -width 4m -style chord \ -fill $blue -outline {} -start 45 -extent 270 -tags item -$c create text 15c 16.2c -text Bitmaps -anchor n -$c create bitmap 13c 20c -tags item \ - -bitmap @[file join $tk_demoDirectory images face.xbm] +image create photo items.ousterhout \ + -file [file join $tk_demoDirectory images ouster.png] +image create photo items.ousterhout.active -format "png -alpha 0.5" \ + -file [file join $tk_demoDirectory images ouster.png] +$c create text 15c 16.2c -text "Bitmaps and Images" -anchor n +$c create image 13c 20c -tags item -image items.ousterhout \ + -activeimage items.ousterhout.active $c create bitmap 17c 18.5c -tags item \ -bitmap @[file join $tk_demoDirectory images noletter.xbm] $c create bitmap 17c 21.5c -tags item \ @@ -169,7 +173,7 @@ bind $c <2> "$c scan mark %x %y" bind $c <B2-Motion> "$c scan dragto %x %y" bind $c <3> "itemMark $c %x %y" bind $c <B3-Motion> "itemStroke $c %x %y" -bind $c <Control-f> "itemsUnderArea $c" +bind $c <<NextChar>> "itemsUnderArea $c" bind $c <1> "itemStartDrag $c %x %y" bind $c <B1-Motion> "itemDrag $c %x %y" @@ -183,15 +187,18 @@ proc itemEnter {c} { return } set type [$c type current] - if {$type == "window"} { + if {$type == "window" || $type == "image"} { set restoreCmd {} return - } - if {$type == "bitmap"} { + } elseif {$type == "bitmap"} { set bg [lindex [$c itemconf current -background] 4] set restoreCmd [list $c itemconfig current -background $bg] $c itemconfig current -background SteelBlue2 return + } elseif {$type == "image"} { + set restoreCmd [list $c itemconfig current -state normal] + $c itemconfig current -state active + return } set fill [lindex [$c itemconfig current -fill] 4] if {(($type == "rectangle") || ($type == "oval") || ($type == "arc")) @@ -279,6 +286,6 @@ proc itemDrag {c x y} { # is invoked. proc butPress {w color} { - set i [$w create text 25c 18.1c -text "Ouch!!" -fill $color -anchor n] + set i [$w create text 25c 18.1c -text "Oooohhh!!" -fill $color -anchor n] after 500 "$w delete $i" } diff --git a/library/demos/ixset b/library/demos/ixset index 06b644d..ee6e072 100644 --- a/library/demos/ixset +++ b/library/demos/ixset @@ -186,12 +186,12 @@ proc createwindows {} { # frame .buttons - button .buttons.ok -default active -command ok -text "Ok" + button .buttons.ok -default active -command ok -text "Ok" button .buttons.apply -default normal -command apply -text "Apply" \ -state disabled button .buttons.cancel -default normal -command cancel -text "Cancel" \ -state disabled - button .buttons.quit -default normal -command quit -text "Quit" + button .buttons.quit -default normal -command quit -text "Quit" pack .buttons.ok .buttons.apply .buttons.cancel .buttons.quit \ -side left -expand yes -pady 5 diff --git a/library/demos/knightstour.tcl b/library/demos/knightstour.tcl index b52e38f..6113db2 100644 --- a/library/demos/knightstour.tcl +++ b/library/demos/knightstour.tcl @@ -61,6 +61,8 @@ proc Next {square} { set minimum $count set nextSquare $testSquare } elseif {$count == $minimum} { + # to remove the enhancement to Warnsdorff's rule + # remove the next line: set nextSquare [Edgemost $nextSquare $testSquare] } } @@ -92,7 +94,7 @@ proc MovePiece {dlg last square} { $dlg.f.txt see end $dlg.f.c itemconfigure [expr {1+$last}] -state normal -outline black $dlg.f.c itemconfigure [expr {1+$square}] -state normal -outline red - $dlg.f.c coords knight [lrange [$dlg.f.c coords [expr {1+$square}]] 0 1] + $dlg.f.c moveto knight {*}[lrange [$dlg.f.c coords [expr {1+$square}]] 0 1] lappend visited $square set next [Next $square] if {$next ne -1} { @@ -125,8 +127,8 @@ proc Tour {dlg {square {}}} { $dlg.f.c itemconfigure $n -state disabled -outline black } if {$square eq {}} { - set square [expr {[$dlg.f.c find closest \ - {*}[$dlg.f.c coords knight] 0 65]-1}] + set coords [lrange [$dlg.f.c coords knight] 0 1] + set square [expr {[$dlg.f.c find closest {*}$coords 0 65]-1}] } variable initial $square after idle [list MovePiece $dlg $initial $initial] @@ -161,7 +163,7 @@ proc DragMotion {w x y} { } proc DragEnd {w x y} { set square [$w find closest $x $y 0 65] - $w coords selected [lrange [$w coords $square] 0 1] + $w moveto selected {*}[lrange [$w coords $square] 0 1] $w dtag selected variable dragging ; unset dragging } @@ -201,14 +203,25 @@ proc CreateGUI {} { -width 2 -state disabled } } - catch {eval font create KnightFont -size -24} - $c create text 0 0 -font KnightFont -text "\u265e" \ - -anchor nw -tags knight -fill black -activefill "#600000" - $c coords knight [lrange [$c coords [expr {1 + int(rand() * 64)}]] 0 1] + if {[tk windowingsystem] ne "x11"} { + catch {eval font create KnightFont -size -24} + $c create text 0 0 -font KnightFont -text "\u265e" \ + -anchor nw -tags knight -fill black -activefill "#600000" + } else { + # On X11 we cannot reliably tell if the \u265e 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 + 2 17 4 14 5 15 3 17 5 17 9 14 10 15 5 21 + } + $c create polygon $pts -tag knight -offset 8 \ + -fill black -activefill "#600000" + } + $c moveto knight {*}[lrange [$c coords [expr {1 + int(rand() * 64)}]] 0 1] $c bind knight <ButtonPress-1> [namespace code [list DragStart %W %x %y]] $c bind knight <Motion> [namespace code [list DragMotion %W %x %y]] $c bind knight <ButtonRelease-1> [namespace code [list DragEnd %W %x %y]] - + grid $c $f.txt $f.vs -sticky news grid rowconfigure $f 0 -weight 1 grid columnconfigure $f 1 -weight 1 @@ -231,7 +244,7 @@ proc CreateGUI {} { if {[info exists ::widgetDemo]} { grid [addSeeDismiss $dlg.buttons $dlg] - - - - - -sticky ew } - + grid rowconfigure $dlg 0 -weight 1 grid columnconfigure $dlg 0 -weight 1 diff --git a/library/demos/label.tcl b/library/demos/label.tcl index a5cab10..13463f7 100644 --- a/library/demos/label.tcl +++ b/library/demos/label.tcl @@ -16,7 +16,7 @@ wm title $w "Label Demonstration" wm iconname $w "label" positionWindow $w -label $w.msg -font $font -wraplength 4i -justify left -text "Five labels are displayed below: three textual ones on the left, and a bitmap label and a text label on the right. Labels are pretty boring because you can't do anything with them." +label $w.msg -font $font -wraplength 4i -justify left -text "Five labels are displayed below: three textual ones on the left, and an image label and a text label on the right. Labels are pretty boring because you can't do anything with them." pack $w.msg -side top ## See Code / Dismiss buttons @@ -33,7 +33,8 @@ label $w.left.l3 -text "Third label, sunken" -relief sunken pack $w.left.l1 $w.left.l2 $w.left.l3 -side top -expand yes -pady 2 -anchor w # Main widget program sets variable tk_demoDirectory -label $w.right.bitmap -borderwidth 2 -relief sunken \ - -bitmap @[file join $tk_demoDirectory images face.xbm] -label $w.right.caption -text "Tcl/Tk Proprietor" -pack $w.right.bitmap $w.right.caption -side top +image create photo label.ousterhout \ + -file [file join $tk_demoDirectory images ouster.png] +label $w.right.picture -borderwidth 2 -relief sunken -image label.ousterhout +label $w.right.caption -text "Tcl/Tk Creator" +pack $w.right.picture $w.right.caption -side top diff --git a/library/demos/mclist.tcl b/library/demos/mclist.tcl index 21dcf29..7a4dd4c 100644 --- a/library/demos/mclist.tcl +++ b/library/demos/mclist.tcl @@ -8,7 +8,6 @@ if {![info exists widgetDemo]} { } package require Tk -package require Ttk set w .mclist catch {destroy $w} @@ -27,19 +26,22 @@ pack [addSeeDismiss $w.seeDismiss $w] -side bottom -fill x ttk::frame $w.container ttk::treeview $w.tree -columns {country capital currency} -show headings \ -yscroll "$w.vsb set" -xscroll "$w.hsb set" -if {[tk windowingsystem] ne "aqua"} { - ttk::scrollbar $w.vsb -orient vertical -command "$w.tree yview" - ttk::scrollbar $w.hsb -orient horizontal -command "$w.tree xview" -} else { - scrollbar $w.vsb -orient vertical -command "$w.tree yview" - scrollbar $w.hsb -orient horizontal -command "$w.tree xview" -} +ttk::scrollbar $w.vsb -orient vertical -command "$w.tree yview" +ttk::scrollbar $w.hsb -orient horizontal -command "$w.tree xview" pack $w.container -fill both -expand 1 grid $w.tree $w.vsb -in $w.container -sticky nsew grid $w.hsb -in $w.container -sticky nsew grid column $w.container 0 -weight 1 grid row $w.container 0 -weight 1 +image create photo upArrow -data { + R0lGODlhDgAOAJEAANnZ2YCAgPz8/P///yH5BAEAAAAALAAAAAAOAA4AAAImhI+ + py+1LIsJHiBAh+BgmiEAJQITgW6DgUQIAECH4JN8IPqYuNxUAOw==} +image create photo downArrow -data { + R0lGODlhDgAOAJEAANnZ2YCAgPz8/P///yH5BAEAAAAALAAAAAAOAA4AAAInhI+ + py+1I4ocQ/IgDEYIPgYJICUCE4F+YIBolEoKPEJKZmVJK6ZACADs=} +image create photo noArrow -height 14 -width 14 + ## The data we're going to insert set data { Argentina {Buenos Aires} ARS @@ -60,11 +62,15 @@ set data { } ## Code to insert the data nicely -set font [ttk::style lookup [$w.tree cget -style] -font] +set font [ttk::style lookup Heading -font] foreach col {country capital currency} name {Country Capital Currency} { - $w.tree heading $col -command [list SortBy $w.tree $col 0] -text $name - $w.tree column $col -width [font measure $font $name] + $w.tree heading $col -text $name -image noArrow -anchor w \ + -command [list SortBy $w.tree $col 0] + $w.tree column $col -width [expr { + [font measure $font $name] + [image width noArrow] + 5 + }] } +set font [ttk::style lookup Treeview -font] foreach {country capital currency} $data { $w.tree insert {} end -values [list $country $capital $currency] foreach col {country capital currency} { @@ -82,7 +88,7 @@ proc SortBy {tree col direction} { set s [$tree heading $c state] if {("selected" in $s || "alternate" in $s) && $col ne $c} { # Sorted column has changed - $tree heading $c state {!selected !alternate !user1} + $tree heading $c -image noArrow state {!selected !alternate !user1} set direction [expr {"alternate" in $s}] } } @@ -104,8 +110,10 @@ proc SortBy {tree col direction} { # Switch the heading so that it will sort in the opposite direction $tree heading $col -command [list SortBy $tree $col [expr {!$direction}]] \ state [expr {$direction?"!selected alternate":"selected !alternate"}] - if {[tk windowingsystem] eq "aqua"} { + if {[ttk::style theme use] eq "aqua"} { # Aqua theme displays native sort arrows when user1 state is set $tree heading $col state "user1" + } else { + $tree heading $col -image [expr {$direction?"upArrow":"downArrow"}] } } diff --git a/library/demos/menu.tcl b/library/demos/menu.tcl index e19df57..e32b54f 100644 --- a/library/demos/menu.tcl +++ b/library/demos/menu.tcl @@ -16,7 +16,7 @@ wm title $w "Menu Demonstration" wm iconname $w "menu" positionWindow $w -label $w.msg -font $font -wraplength 4i -justify left +label $w.msg -font $font -wraplength 4i -justify left if {[tk windowingsystem] eq "aqua"} { catch {set origUseCustomMDEF $::tk::mac::useCustomMDEF; set ::tk::mac::useCustomMDEF 1} $w.msg configure -text "This window has a menubar with cascaded menus. You can invoke entries with an accelerator by typing Command+x, where \"x\" is the character next to the command key symbol. The rightmost menu can be torn off into a palette by selecting the first item in the menu." diff --git a/library/demos/menubu.tcl b/library/demos/menubu.tcl index 86326b5..96e3b15 100644 --- a/library/demos/menubu.tcl +++ b/library/demos/menubu.tcl @@ -21,7 +21,7 @@ pack $w.body -expand 1 -fill both if {[tk windowingsystem] eq "aqua"} {catch {set origUseCustomMDEF $::tk::mac::useCustomMDEF; set ::tk::mac::useCustomMDEF 1}} menubutton $w.body.below -text "Below" -underline 0 -direction below -menu $w.body.below.m -relief raised -menu $w.body.below.m -tearoff 0 +menu $w.body.below.m -tearoff 0 $w.body.below.m add command -label "Below menu: first item" -command "puts \"You have selected the first item from the Below menu.\"" $w.body.below.m add command -label "Below menu: second item" -command "puts \"You have selected the second item from the Below menu.\"" grid $w.body.below -row 0 -column 1 -sticky n diff --git a/library/demos/msgbox.tcl b/library/demos/msgbox.tcl index a8f7d17..2c2cc2d 100644 --- a/library/demos/msgbox.tcl +++ b/library/demos/msgbox.tcl @@ -7,7 +7,6 @@ if {![info exists widgetDemo]} { } package require Tk -package require Ttk set w .msgbox catch {destroy $w} @@ -24,7 +23,7 @@ pack [addSeeDismiss $w.buttons $w {} { }] -side bottom -fill x #pack $w.buttons.dismiss $w.buttons.code $w.buttons.vars -side left -expand 1 -frame $w.left +frame $w.left frame $w.right pack $w.left $w.right -side left -expand yes -fill y -pady .5c -padx .5c @@ -57,7 +56,7 @@ proc showMessageBox {w} { set button [tk_messageBox -icon $msgboxIcon -type $msgboxType \ -title Message -parent $w\ -message "This is a \"$msgboxType\" type messagebox with the \"$msgboxIcon\" icon"] - + tk_messageBox -icon info -message "You have selected \"$button\"" -type ok\ -parent $w } diff --git a/library/demos/nl.msg b/library/demos/nl.msg index b17ceaa..61832d8 100644 --- a/library/demos/nl.msg +++ b/library/demos/nl.msg @@ -18,7 +18,7 @@ ::msgcat::mcset nl "Demo code: %s" "Code van Demo %s" ::msgcat::mcset nl "About Widget Demo" "Over deze demonstratie" ::msgcat::mcset nl "Tk widget demonstration" "Demonstratie van Tk widgets" -::msgcat::mcset nl "Copyright (c) %s" "Copyright (c) %s" +::msgcat::mcset nl "Copyright \u00a9 %s" ::msgcat::mcset nl "Tk Widget Demonstrations" "Demostratie van Tk widgets" ::msgcat::mcset nl "This application provides a front end for several short scripts" \ diff --git a/library/demos/paned2.tcl b/library/demos/paned2.tcl index f481d14..c549249 100644 --- a/library/demos/paned2.tcl +++ b/library/demos/paned2.tcl @@ -54,7 +54,7 @@ listbox $f.list -listvariable paneList -yscrollcommand "$f.scr set" # Invert the first item to highlight it $f.list itemconfigure 0 \ -background [$f.list cget -fg] -foreground [$f.list cget -bg] -scrollbar $f.scr -orient vertical -command "$f.list yview" +ttk::scrollbar $f.scr -orient vertical -command "$f.list yview" pack $f.scr -side right -fill y pack $f.list -fill both -expand 1 @@ -62,8 +62,8 @@ pack $f.list -fill both -expand 1 set f [frame $w.pane.bottom] text $f.text -xscrollcommand "$f.xscr set" -yscrollcommand "$f.yscr set" \ -width 30 -height 8 -wrap none -scrollbar $f.xscr -orient horizontal -command "$f.text xview" -scrollbar $f.yscr -orient vertical -command "$f.text yview" +ttk::scrollbar $f.xscr -orient horizontal -command "$f.text xview" +ttk::scrollbar $f.yscr -orient vertical -command "$f.text yview" grid $f.text $f.yscr -sticky nsew grid $f.xscr -sticky nsew grid columnconfigure $f 0 -weight 1 diff --git a/library/demos/pendulum.tcl b/library/demos/pendulum.tcl index 2e3d459..d344d8d 100644 --- a/library/demos/pendulum.tcl +++ b/library/demos/pendulum.tcl @@ -49,9 +49,9 @@ for {set i 90} {$i>=0} {incr i -10} { # Coordinates of these items don't matter; they will be set properly below $w.k create line 0 0 1 1 -smooth true -tags graph$i -fill grey$i } -# FIXME: UNICODE labels -$w.k create text 0 0 -anchor ne -text "q" -font {Symbol 8} -tags label_theta -$w.k create text 0 0 -anchor ne -text "dq" -font {Symbol 8} -tags label_dtheta + +$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 pack $w.k -in $w.p.l2 -fill both -expand true # Initialize some variables diff --git a/library/demos/puzzle.tcl b/library/demos/puzzle.tcl index fb8ab4c..4f7f955 100644 --- a/library/demos/puzzle.tcl +++ b/library/demos/puzzle.tcl @@ -54,7 +54,7 @@ pack $btns -side bottom -fill x scrollbar $w.s # The button metrics are a bit bigger in Aqua, and since we are -# using place which doesn't autosize, then we need to have a +# using place which doesn't autosize, then we need to have a # slightly larger frame here... if {[tk windowingsystem] eq "aqua"} { diff --git a/library/demos/sayings.tcl b/library/demos/sayings.tcl index 4d26ffe..aa3479c 100644 --- a/library/demos/sayings.tcl +++ b/library/demos/sayings.tcl @@ -28,8 +28,8 @@ frame $w.frame -borderwidth 10 pack $w.frame -side top -expand yes -fill both -padx 1c -scrollbar $w.frame.yscroll -command "$w.frame.list yview" -scrollbar $w.frame.xscroll -orient horizontal \ +ttk::scrollbar $w.frame.yscroll -command "$w.frame.list yview" +ttk::scrollbar $w.frame.xscroll -orient horizontal \ -command "$w.frame.list xview" listbox $w.frame.list -width 20 -height 10 -setgrid 1 \ -yscroll "$w.frame.yscroll set" -xscroll "$w.frame.xscroll set" diff --git a/library/demos/search.tcl b/library/demos/search.tcl index 9f44e16..a1a3d7f 100644 --- a/library/demos/search.tcl +++ b/library/demos/search.tcl @@ -109,7 +109,7 @@ pack $w.string.button -side left -pady 5 -padx 10 bind $w.string.entry <Return> "textSearch $w.text \$searchString search" text $w.text -yscrollcommand "$w.scroll set" -setgrid true -scrollbar $w.scroll -command "$w.text yview" +ttk::scrollbar $w.scroll -command "$w.text yview" pack $w.file $w.string -side top -fill x pack $w.scroll -side right -fill y pack $w.text -expand yes -fill both diff --git a/library/demos/square b/library/demos/square index 08c362b..1d7eb20 100644 --- a/library/demos/square +++ b/library/demos/square @@ -7,7 +7,7 @@ exec wish "$0" ${1+"$@"} # widget. It's only usable in the "tktest" application or if Tk has # been compiled with tkSquare.c. This demo arranges the following # bindings for the widget: -# +# # Button-1 press/drag: moves square to mouse # "a": toggle size animation on/off diff --git a/library/demos/states.tcl b/library/demos/states.tcl index e76540d..92b1f1e 100644 --- a/library/demos/states.tcl +++ b/library/demos/states.tcl @@ -26,7 +26,7 @@ pack $btns -side bottom -fill x frame $w.frame -borderwidth .5c pack $w.frame -side top -expand yes -fill y -scrollbar $w.frame.scroll -command "$w.frame.list yview" +ttk::scrollbar $w.frame.scroll -command "$w.frame.list yview" listbox $w.frame.list -yscroll "$w.frame.scroll set" -setgrid 1 -height 12 pack $w.frame.scroll -side right -fill y pack $w.frame.list -side left -expand 1 -fill both diff --git a/library/demos/style.tcl b/library/demos/style.tcl index 614ea1f..a529a03 100644 --- a/library/demos/style.tcl +++ b/library/demos/style.tcl @@ -26,7 +26,7 @@ set family Courier text $w.text -yscrollcommand "$w.scroll set" -setgrid true \ -width 70 -height 32 -wrap word -font "$family 12" -scrollbar $w.scroll -command "$w.text yview" +ttk::scrollbar $w.scroll -command "$w.text yview" pack $w.scroll -side right -fill y pack $w.text -expand yes -fill both diff --git a/library/demos/text.tcl b/library/demos/text.tcl index 1b5f3b9..d1801d1 100644 --- a/library/demos/text.tcl +++ b/library/demos/text.tcl @@ -17,14 +17,39 @@ wm iconname $w "text" positionWindow $w ## See Code / Dismiss buttons -set btns [addSeeDismiss $w.buttons $w] +set btns [addSeeDismiss $w.buttons $w {} \ + {ttk::button $w.buttons.fontchooser -command fontchooserToggle}] pack $btns -side bottom -fill x text $w.text -yscrollcommand [list $w.scroll set] -setgrid 1 \ -height 30 -undo 1 -autosep 1 -scrollbar $w.scroll -command [list $w.text yview] +ttk::scrollbar $w.scroll -command [list $w.text yview] pack $w.scroll -side right -fill y pack $w.text -expand yes -fill both + +# TIP 324 Demo: [tk fontchooser] +proc fontchooserToggle {} { + tk fontchooser [expr {[tk fontchooser configure -visible] ? + "hide" : "show"}] +} +proc fontchooserVisibility {w} { + $w configure -text [expr {[tk fontchooser configure -visible] ? + "Hide Font Dialog" : "Show Font Dialog"}] +} +proc fontchooserFocus {w} { + tk fontchooser configure -font [$w cget -font] \ + -command [list fontchooserFontSel $w] +} +proc fontchooserFontSel {w font args} { + $w configure -font [font actual $font] +} +tk fontchooser configure -parent $w +bind $w.text <FocusIn> [list fontchooserFocus $w.text] +fontchooserVisibility $w.buttons.fontchooser +bind $w <<TkFontchooserVisibility>> [list \ + fontchooserVisibility $w.buttons.fontchooser] +focus $w.text + $w.text insert 0.0 \ {This window is a text widget. It displays one or more lines of text and allows you to edit the text. Here is a summary of the things you diff --git a/library/demos/textpeer.tcl b/library/demos/textpeer.tcl index e94284e..83e8e14 100644 --- a/library/demos/textpeer.tcl +++ b/library/demos/textpeer.tcl @@ -36,7 +36,7 @@ proc makeClone {w parent} { global count set t [$parent peer create $w.text[incr count] -yscroll "$w.sb$count set"\ -height 10 -wrap word] - set sb [scrollbar $w.sb$count -command "$t yview" -orient vertical] + set sb [ttk::scrollbar $w.sb$count -command "$t yview" -orient vertical] set b1 [button $w.clone$count -command "makeClone $w $t" \ -text "Make Peer"] set b2 [button $w.kill$count -command "killClone $w $count" \ diff --git a/library/demos/tree.tcl b/library/demos/tree.tcl index 14d5db8..71c32c1 100644 --- a/library/demos/tree.tcl +++ b/library/demos/tree.tcl @@ -8,7 +8,6 @@ if {![info exists widgetDemo]} { } package require Tk -package require Ttk set w .tree catch {destroy $w} @@ -72,13 +71,8 @@ proc populateTree {tree node} { ## Create the tree and set it up ttk::treeview $w.tree -columns {fullpath type size} -displaycolumns {size} \ -yscroll "$w.vsb set" -xscroll "$w.hsb set" -if {[tk windowingsystem] ne "aqua"} { - ttk::scrollbar $w.vsb -orient vertical -command "$w.tree yview" - ttk::scrollbar $w.hsb -orient horizontal -command "$w.tree xview" -} else { - scrollbar $w.vsb -orient vertical -command "$w.tree yview" - scrollbar $w.hsb -orient horizontal -command "$w.tree xview" -} +ttk::scrollbar $w.vsb -orient vertical -command "$w.tree yview" +ttk::scrollbar $w.hsb -orient horizontal -command "$w.tree xview" $w.tree heading \#0 -text "Directory Structure" $w.tree heading size -text "File Size" $w.tree column size -stretch 0 -width 70 diff --git a/library/demos/ttkbut.tcl b/library/demos/ttkbut.tcl index 66ff1d7..904cd31 100644 --- a/library/demos/ttkbut.tcl +++ b/library/demos/ttkbut.tcl @@ -9,7 +9,6 @@ if {![info exists widgetDemo]} { } package require Tk -package require Ttk set w .ttkbut catch {destroy $w} diff --git a/library/demos/ttkmenu.tcl b/library/demos/ttkmenu.tcl index c01c9af..0084dd6 100644 --- a/library/demos/ttkmenu.tcl +++ b/library/demos/ttkmenu.tcl @@ -8,7 +8,6 @@ if {![info exists widgetDemo]} { } package require Tk -package require Ttk set w .ttkmenu catch {destroy $w} diff --git a/library/demos/ttknote.tcl b/library/demos/ttknote.tcl index 5683892..50a9258 100644 --- a/library/demos/ttknote.tcl +++ b/library/demos/ttknote.tcl @@ -8,7 +8,6 @@ if {![info exists widgetDemo]} { } package require Tk -package require Ttk set w .ttknote catch {destroy $w} @@ -53,10 +52,6 @@ ttk::frame $w.note.editor $w.note add $w.note.editor -text "Text Editor" -underline 0 text $w.note.editor.t -width 40 -height 10 -wrap char \ -yscroll "$w.note.editor.s set" -if {[tk windowingsystem] ne "aqua"} { - ttk::scrollbar $w.note.editor.s -orient vertical -command "$w.note.editor.t yview" -} else { - scrollbar $w.note.editor.s -orient vertical -command "$w.note.editor.t yview" -} +ttk::scrollbar $w.note.editor.s -orient vertical -command "$w.note.editor.t yview" pack $w.note.editor.s -side right -fill y -padx {0 2} -pady 2 pack $w.note.editor.t -fill both -expand 1 -pady 2 -padx {2 0} diff --git a/library/demos/ttkpane.tcl b/library/demos/ttkpane.tcl index a4d5738..7575d76 100644 --- a/library/demos/ttkpane.tcl +++ b/library/demos/ttkpane.tcl @@ -7,7 +7,6 @@ if {![info exists widgetDemo]} { } package require Tk -package require Ttk set w .ttkpane catch {destroy $w} @@ -51,7 +50,7 @@ proc every {delay script} { uplevel #0 $script after $delay [list every $delay $script] } -set zones { +set testzones { :Europe/Berlin :America/Argentina/Buenos_Aires :Africa/Johannesburg @@ -65,7 +64,13 @@ set zones { } # Force a pre-load of all the timezones needed; otherwise can end up # poor-looking synch problems! -foreach zone $zones {clock format 0 -timezone $zone} +set zones {} +foreach zone $testzones { + if {![catch {clock format 0 -timezone $zone}]} { + lappend zones $zone + } +} +if {[llength $zones] < 2} { lappend zones -0200 :GMT :UTC +0200 } foreach zone $zones { set city [string map {_ " "} [regexp -inline {[^/]+$} $zone]] if {$i} { diff --git a/library/demos/ttkprogress.tcl b/library/demos/ttkprogress.tcl index 87765d7..8a72cf9 100644 --- a/library/demos/ttkprogress.tcl +++ b/library/demos/ttkprogress.tcl @@ -7,7 +7,6 @@ if {![info exists widgetDemo]} { } package require Tk -package require Ttk set w .ttkprogress catch {destroy $w} diff --git a/library/demos/twind.tcl b/library/demos/twind.tcl index e1d0b5b..bafb57e 100644 --- a/library/demos/twind.tcl +++ b/library/demos/twind.tcl @@ -25,7 +25,7 @@ set t $w.f.text text $t -yscrollcommand "$w.scroll set" -setgrid true -font $font -width 70 \ -height 35 -wrap word -highlightthickness 0 -borderwidth 0 pack $t -expand yes -fill both -scrollbar $w.scroll -command "$t yview" +ttk::scrollbar $w.scroll -command "$t yview" pack $w.scroll -side right -fill y panedwindow $w.pane pack $w.pane -expand yes -fill both @@ -162,11 +162,11 @@ $t window create end -window $t.smallP $t insert end "\n\nFinally, images fit comfortably in text widgets too:" $t image create end -image \ - [image create bitmap -file [file join $tk_demoDirectory images face.xbm]] + [image create photo -file [file join $tk_demoDirectory images ouster.png]] proc textWindBigB w { - $w configure -borderwidth 15 + $w configure -borderwidth 15 } proc textWindBigH w { @@ -193,7 +193,7 @@ proc textWindSmallP w { proc textWindOn w { catch {destroy $w.scroll2} set t $w.f.text - scrollbar $w.scroll2 -orient horizontal -command "$t xview" + ttk::scrollbar $w.scroll2 -orient horizontal -command "$t xview" pack $w.scroll2 -after $w.buttons -side bottom -fill x $t configure -xscrollcommand "$w.scroll2 set" -wrap none } @@ -230,7 +230,7 @@ proc createPlot {t} { $c create line 100 250 400 250 -width 2 $c create line 100 250 100 50 -width 2 $c create text 225 20 -text "A Simple Plot" -font $font -fill brown - + for {set i 0} {$i <= 10} {incr i} { set x [expr {100 + ($i*30)}] $c create line $x 250 $x 245 -width 2 @@ -241,7 +241,7 @@ proc createPlot {t} { $c create line 100 $y 105 $y -width 2 $c create text 96 $y -text [expr {$i*50}].0 -anchor e -font $font } - + foreach point { {12 56} {20 94} {33 98} {32 120} {61 180} {75 160} {98 223} } { @@ -303,7 +303,7 @@ proc textMakePeer {parent} { set t [$parent peer create $w.f.text -yscrollcommand "$w.scroll set" \ -borderwidth 0 -highlightthickness 0] pack $t -expand yes -fill both - scrollbar $w.scroll -command "$t yview" + ttk::scrollbar $w.scroll -command "$t yview" pack $w.scroll -side right -fill y pack $w.f -expand yes -fill both } diff --git a/library/demos/unicodeout.tcl b/library/demos/unicodeout.tcl index 11cc933..faa9f90 100644 --- a/library/demos/unicodeout.tcl +++ b/library/demos/unicodeout.tcl @@ -9,26 +9,6 @@ if {![info exists widgetDemo]} { package require Tk -# On Windows, we need to determine whether the font system will render -# right-to-left text. - -if {[tk windowingsystem] eq {win32}} { - set rkey [join { - HKEY_LOCAL_MACHINE - SOFTWARE - Microsoft - {Windows NT} - CurrentVersion - LanguagePack - } \\] - set w32langs {} - if {![catch {package require registry}]} { - if {[catch {registry values $rkey} w32langs]} { - set w32langs {} - } - } -} - set w .unicodeout catch {destroy $w} toplevel $w @@ -50,11 +30,9 @@ pack $w.msg -side top set btns [addSeeDismiss $w.buttons $w] pack $btns -side bottom -fill x -pack [label $w.wait -text "Please wait while loading fonts..." \ - -font {Helvetica 12 italic}] -pack [frame $w.f] -expand 1 -fill both -padx 2m -pady 1m +## The frame that will contain the sample texts. +pack [frame $w.f] -side bottom -expand 1 -fill both -padx 2m -pady 1m grid columnconfigure $w.f 1 -weight 1 - set i 0 proc addSample {w language args} { global font i @@ -66,42 +44,87 @@ proc addSample {w language args} { grid configure $w.f.l$j -padx 1m } -# Processing when some characters are missing might take a while, so make -# sure we're displaying something in the meantime... +## A helper procedure that determines what form to use to express languages +## that have complex rendering rules... +proc usePresentationFormsFor {language} { + switch [tk windowingsystem] { + aqua { + # OSX wants natural character order; the renderer knows how to + # compose things for display for all languages. + return false + } + x11 { + # The X11 font renderers that Tk supports all know nothing about + # composing characters, so we need to use presentation forms. + return true + } + win32 { + # On Windows, we need to determine whether the font system will + # render right-to-left text. This varies by language! + try { + package require registry + set rkey [join { + HKEY_LOCAL_MACHINE + SOFTWARE + Microsoft + {Windows NT} + CurrentVersion + LanguagePack + } \\] + return [expr { + [string toupper $language] ni [registry values $rkey] + }] + } trap error {} { + # Cannot work it out, so use presentation forms. + return true + } + } + default { + # Default to using presentation forms. + return true + } + } +} +## Processing when some characters are not currently cached by the display +## engine might take a while, so make sure we're displaying something in the +## meantime... +pack [label $w.wait -text "Please wait while loading fonts..." \ + -font {Helvetica 12 italic}] set oldCursor [$w cget -cursor] $w conf -cursor watch update -if {[tk windowingsystem] eq {x11} - || (([tk windowingsystem] eq {win32}) && ({ARABIC} ni $w32langs))} { +## 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" + "\uFE94\uFEF4\uFE91\uFEAE\uFECC\uFEDF\uFE8D " \ + "\uFE94\uFEE4\uFEE0\uFEDC\uFEDF\uFE8D" } else { # Using standard text characters addSample $w Arabic \ - "\u0627\u0644\u0643\u0644\u0645\u0629 " \ - "\u0627\u0644\u0639\u0631\u0628\u064A\u0629" + "\u0627\u0644\u0643\u0644\u0645\u0629 " \ + "\u0627\u0644\u0639\u0631\u0628\u064A\u0629" } -addSample $w "Trad. Chinese" "\u4E2D\u570B\u7684\u6F22\u5B57" +addSample $w "Trad. Chinese" "\u4E2D\u570B\u7684\u6F22\u5B57" addSample $w "Simpl. Chinese" "\u6C49\u8BED" +addSample $w French "Langue fran\u00E7aise" addSample $w Greek \ "\u0395\u03BB\u03BB\u03B7\u03BD\u03B9\u03BA\u03AE " \ "\u03B3\u03BB\u03CE\u03C3\u03C3\u03B1" -if {[tk windowingsystem] eq {x11} - || (([tk windowingsystem] eq {win32}) && ({HEBREW} ni $w32langs))} { +if {[usePresentationFormsFor Hebrew]} { # Visual order (pre-layouted) addSample $w Hebrew \ - "\u05EA\u05D9\u05E8\u05D1\u05E2 " \ - "\u05D1\u05EA\u05DB" + "\u05EA\u05D9\u05E8\u05D1\u05E2 \u05D1\u05EA\u05DB" } else { # Standard logical order addSample $w Hebrew \ - "\u05DB\u05EA\u05D1 " \ - "\u05E2\u05D1\u05E8\u05D9\u05EA" + "\u05DB\u05EA\u05D1 \u05E2\u05D1\u05E8\u05D9\u05EA" } +addSample $w Hindi \ + "\u0939\u093f\u0928\u094d\u0926\u0940 \u092d\u093e\u0937\u093e" +addSample $w Icelandic "\u00CDslenska" addSample $w Japanese \ "\u65E5\u672C\u8A9E\u306E\u3072\u3089\u304C\u306A, " \ "\u6F22\u5B57\u3068\u30AB\u30BF\u30AB\u30CA" @@ -109,6 +132,6 @@ addSample $w Korean "\uB300\uD55C\uBBFC\uAD6D\uC758 \uD55C\uAE00" addSample $w Russian \ "\u0420\u0443\u0441\u0441\u043A\u0438\u0439 \u044F\u0437\u044B\u043A" -# We're done processing, so change things back to normal running... +## We're done processing, so change things back to normal running... destroy $w.wait $w conf -cursor $oldCursor diff --git a/library/demos/widget b/library/demos/widget index d58f086..7604341 100644 --- a/library/demos/widget +++ b/library/demos/widget @@ -13,7 +13,6 @@ exec wish "$0" ${1+"$@"} package require Tcl 8.5 package require Tk 8.5 package require msgcat -package require Ttk eval destroy [winfo child .] set tk_demoDirectory [file join [pwd] [file dirname [info script]]] @@ -146,7 +145,7 @@ catch { } ttk::frame .textFrame -scrollbar .s -orient vertical -command {.t yview} -takefocus 1 +ttk::scrollbar .s -orient vertical -command {.t yview} -takefocus 1 pack .s -in .textFrame -side right -fill y text .t -yscrollcommand {.s set} -wrap word -width 70 -height $textheight \ -font mainFont -setgrid 1 -highlightthickness 0 \ @@ -318,16 +317,13 @@ addFormattedText { @@demo image1 Two labels displaying images @@demo image2 A simple user interface for viewing images @@demo labelframe Labelled frames - @@new @@demo ttkbut The simple Themed Tk widgets @@subtitle Listboxes and Trees @@demo states The 50 states @@demo colors Colors: change the color scheme for the application @@demo sayings A collection of famous and infamous sayings - @@new @@demo mclist A multi-column list of countries - @@new @@demo tree A directory browser tree @@subtitle Entries, Spin-boxes and Combo-boxes @@ -335,7 +331,6 @@ addFormattedText { @@demo entry2 Entries with scrollbars @@demo entry3 Validated entries and password fields @@demo spin Spin-boxes - @@new @@demo combo Combo-boxes @@demo form Simple Rolodex-like form @@ -345,7 +340,6 @@ addFormattedText { @@demo bind Hypertext (tag bindings) @@demo twind A text widget with embedded windows and other features @@demo search A search tool built with a text widget - @@new @@demo textpeer Peering text widgets @@subtitle Canvases @@ -356,7 +350,6 @@ addFormattedText { @@demo ruler A ruler with adjustable tab stops @@demo floor A building floor plan @@demo cscroll A simple scrollable canvas - @@new @@demo knightstour A Knight's tour of the chess board @@subtitle Scales and Progress Bars @@ -364,38 +357,30 @@ addFormattedText { @@demo vscale Vertical scale @@new @@demo ttkscale Themed scale linked to a label with traces - @@new @@demo ttkprogress Progress bar @@subtitle Paned Windows and Notebooks @@demo paned1 Horizontal paned window @@demo paned2 Vertical paned window - @@new @@demo ttkpane Themed nested panes - @@new @@demo ttknote Notebook widget @@subtitle Menus and Toolbars @@demo menu Menus and cascades (sub-menus) @@demo menubu Menu-buttons - @@new @@demo ttkmenu Themed menu buttons - @@new @@demo toolbar Themed toolbar @@subtitle Common Dialogs @@demo msgbox Message boxes @@demo filebox File selection dialog @@demo clrpick Color picker + @@demo fontchoose Font selection dialog @@subtitle Animation - @@new @@demo anilabel Animated labels - @@new @@demo aniwave Animated wave - @@new @@demo pendulum Pendulum simulation - @@new @@demo goldberg A celebration of Rube Goldberg @@subtitle Miscellaneous @@ -580,8 +565,10 @@ proc showCode w { -xscrollcommand [list $t.xscroll set] \ -yscrollcommand [list $t.yscroll set] \ -setgrid 1 -highlightthickness 0 -pady 2 -padx 3] - scrollbar $t.xscroll -command [list $t.text xview] -orient horizontal - scrollbar $t.yscroll -command [list $t.text yview] -orient vertical + ttk::scrollbar $t.xscroll -command [list $t.text xview] \ + -orient horizontal + ttk::scrollbar $t.yscroll -command [list $t.text yview] \ + -orient vertical grid $t.text $t.yscroll -sticky news #grid $t.xscroll @@ -724,10 +711,10 @@ 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 (c) %s} {1996-1997 Sun Microsystems, Inc.}] -[mc {Copyright (c) %s} {1997-2000 Ajuba Solutions, Inc.}] -[mc {Copyright (c) %s} {2001-2007 Donal K. Fellows}] -[mc {Copyright (c) %s} {2002-2007 Daniel A. Steffen}]" +"[mc "Copyright \u00a9 %s" {1996-1997 Sun Microsystems, Inc.}] +[mc "Copyright \u00a9 %s" {1997-2000 Ajuba Solutions, Inc.}] +[mc "Copyright \u00a9 %s" {2001-2009 Donal K. Fellows}] +[mc "Copyright \u00a9 %s" {2002-2007 Daniel A. Steffen}]" } # Local Variables: diff --git a/library/dialog.tcl b/library/dialog.tcl index 26ec7e0..c751621 100644 --- a/library/dialog.tcl +++ b/library/dialog.tcl @@ -28,14 +28,14 @@ # bottom of the dialog box. proc ::tk_dialog {w title text bitmap default args} { - global tcl_platform variable ::tk::Priv # Check that $default was properly given if {[string is integer -strict $default]} { if {$default >= [llength $args]} { - return -code error "default button index greater than number of\ - buttons specified for tk_dialog" + return -code error -errorcode {TK DIALOG BAD_DEFAULT} \ + "default button index greater than number of buttons\ + specified for tk_dialog" } } elseif {"" eq $default} { set default -1 @@ -136,7 +136,7 @@ proc ::tk_dialog {w title text bitmap default args} { bind $w <Return> [list $w.button$default invoke] } bind $w <<PrevWindow>> [list bind $w <Return> {[tk_focusPrev %W] invoke}] - bind $w <Tab> [list bind $w <Return> {[tk_focusNext %W] invoke}] + bind $w <<NextWindow>> [list bind $w <Return> {[tk_focusNext %W] invoke}] # 5. Create a <Destroy> binding for the window that sets the # button variable to -1; this is needed in case something happens @@ -148,7 +148,7 @@ proc ::tk_dialog {w title text bitmap default args} { # so we know how big it wants to be, then center the window in the # display (Motif style) and de-iconify it. - ::tk::PlaceWindow $w + ::tk::PlaceWindow $w tkwait visibility $w # 7. Set a grab and claim the focus too. diff --git a/library/entry.tcl b/library/entry.tcl index c3e573d..6243d26 100644 --- a/library/entry.tcl +++ b/library/entry.tcl @@ -46,7 +46,6 @@ bind Entry <<Copy>> { } } bind Entry <<Paste>> { - global tcl_platform catch { if {[tk windowingsystem] ne "x11"} { catch { @@ -69,8 +68,8 @@ bind Entry <<PasteSelection>> { } bind Entry <<TraverseIn>> { - %W selection range 0 end - %W icursor end + %W selection range 0 end + %W icursor end } # Standard Motif bindings: @@ -119,45 +118,45 @@ bind Entry <Control-1> { %W icursor @%x } -bind Entry <Left> { +bind Entry <<PrevChar>> { tk::EntrySetCursor %W [expr {[%W index insert] - 1}] } -bind Entry <Right> { +bind Entry <<NextChar>> { tk::EntrySetCursor %W [expr {[%W index insert] + 1}] } -bind Entry <Shift-Left> { +bind Entry <<SelectPrevChar>> { tk::EntryKeySelect %W [expr {[%W index insert] - 1}] tk::EntrySeeInsert %W } -bind Entry <Shift-Right> { +bind Entry <<SelectNextChar>> { tk::EntryKeySelect %W [expr {[%W index insert] + 1}] tk::EntrySeeInsert %W } -bind Entry <Control-Left> { +bind Entry <<PrevWord>> { tk::EntrySetCursor %W [tk::EntryPreviousWord %W insert] } -bind Entry <Control-Right> { +bind Entry <<NextWord>> { tk::EntrySetCursor %W [tk::EntryNextWord %W insert] } -bind Entry <Shift-Control-Left> { +bind Entry <<SelectPrevWord>> { tk::EntryKeySelect %W [tk::EntryPreviousWord %W insert] tk::EntrySeeInsert %W } -bind Entry <Shift-Control-Right> { +bind Entry <<SelectNextWord>> { tk::EntryKeySelect %W [tk::EntryNextWord %W insert] tk::EntrySeeInsert %W } -bind Entry <Home> { +bind Entry <<LineStart>> { tk::EntrySetCursor %W 0 } -bind Entry <Shift-Home> { +bind Entry <<SelectLineStart>> { tk::EntryKeySelect %W 0 tk::EntrySeeInsert %W } -bind Entry <End> { +bind Entry <<LineEnd>> { tk::EntrySetCursor %W end } -bind Entry <Shift-End> { +bind Entry <<SelectLineEnd>> { tk::EntryKeySelect %W end tk::EntrySeeInsert %W } @@ -185,10 +184,10 @@ bind Entry <Control-Shift-space> { bind Entry <Shift-Select> { %W selection adjust insert } -bind Entry <Control-slash> { +bind Entry <<SelectAll>> { %W selection range 0 end } -bind Entry <Control-backslash> { +bind Entry <<SelectNone>> { %W selection clear } bind Entry <KeyPress> { @@ -208,9 +207,14 @@ bind Entry <Escape> {# nothing} bind Entry <Return> {# nothing} 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-KeyPress> {# nothing} } +# Tk-on-Cocoa generates characters for these two keys. [Bug 2971663] +bind Entry <<NextLine>> {# nothing} +bind Entry <<PrevLine>> {# 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. @@ -222,31 +226,11 @@ if {[tk windowingsystem] ne "win32"} { # Additional emacs-like bindings: -bind Entry <Control-a> { - if {!$tk_strictMotif} { - tk::EntrySetCursor %W 0 - } -} -bind Entry <Control-b> { - if {!$tk_strictMotif} { - tk::EntrySetCursor %W [expr {[%W index insert] - 1}] - } -} bind Entry <Control-d> { if {!$tk_strictMotif} { %W delete insert } } -bind Entry <Control-e> { - if {!$tk_strictMotif} { - tk::EntrySetCursor %W end - } -} -bind Entry <Control-f> { - if {!$tk_strictMotif} { - tk::EntrySetCursor %W [expr {[%W index insert] + 1}] - } -} bind Entry <Control-h> { if {!$tk_strictMotif} { tk::EntryBackspace %W diff --git a/library/fontchooser.tcl b/library/fontchooser.tcl new file mode 100644 index 0000000..8f91ade --- /dev/null +++ b/library/fontchooser.tcl @@ -0,0 +1,449 @@ +# fontchooser.tcl - +# +# A themeable Tk font selection dialog. See TIP #324. +# +# Copyright (C) 2008 Keith Vetter +# Copyright (C) 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. + +namespace eval ::tk::fontchooser { + variable S + + set S(W) .__tk__fontchooser + set S(fonts) [lsort -dictionary [font families]] + set S(styles) [list \ + [::msgcat::mc "Regular"] \ + [::msgcat::mc "Italic"] \ + [::msgcat::mc "Bold"] \ + [::msgcat::mc "Bold Italic"] \ + ] + + set S(sizes) {8 9 10 11 12 14 16 18 20 22 24 26 28 36 48 72} + set S(strike) 0 + set S(under) 0 + set S(first) 1 + set S(sampletext) [::msgcat::mc "AaBbYyZz01"] + set S(-parent) . + set S(-title) [::msgcat::mc "Font"] + set S(-command) "" + set S(-font) TkDefaultFont +} + +proc ::tk::fontchooser::Setup {} { + variable S + + # Canonical versions of font families, styles, etc. for easier searching + set S(fonts,lcase) {} + foreach font $S(fonts) { lappend S(fonts,lcase) [string tolower $font]} + set S(styles,lcase) {} + foreach style $S(styles) { lappend S(styles,lcase) [string tolower $style]} + set S(sizes,lcase) $S(sizes) + + ::ttk::style layout FontchooserFrame { + Entry.field -sticky news -border true -children { + FontchooserFrame.padding -sticky news + } + } + bind [winfo class .] <<ThemeChanged>> \ + [list +ttk::style layout FontchooserFrame \ + [ttk::style layout FontchooserFrame]] + + namespace ensemble create -map { + show ::tk::fontchooser::Show + hide ::tk::fontchooser::Hide + configure ::tk::fontchooser::Configure + } +} +::tk::fontchooser::Setup + +proc ::tk::fontchooser::Show {} { + variable S + if {![winfo exists $S(W)]} { + Create + wm transient $S(W) [winfo toplevel $S(-parent)] + tk::PlaceWindow $S(W) widget $S(-parent) + } + wm deiconify $S(W) +} + +proc ::tk::fontchooser::Hide {} { + variable S + wm withdraw $S(W) +} + +proc ::tk::fontchooser::Configure {args} { + variable S + + set specs { + {-parent "" "" . } + {-title "" "" ""} + {-font "" "" ""} + {-command "" "" ""} + } + + if {[llength $args] == 0} { + set result {} + foreach spec $specs { + foreach {name xx yy default} $spec break + lappend result $name \ + [expr {[info exists S($name)] ? $S($name) : $default}] + } + lappend result -visible \ + [expr {[winfo exists $S(W)] && [winfo ismapped $S(W)]}] + return $result + } + if {[llength $args] == 1} { + set option [lindex $args 0] + if {[string equal $option "-visible"]} { + return [expr {[winfo exists $S(W)] && [winfo ismapped $S(W)]}] + } elseif {[info exists S($option)]} { + return $S($option) + } + return -code error -errorcode [list TK LOOKUP OPTION $option] \ + "bad option \"$option\": must be\ + -command, -font, -parent, -title or -visible" + } + + set cache [dict create -parent $S(-parent) -title $S(-title) \ + -font $S(-font) -command $S(-command)] + set r [tclParseConfigSpec [namespace which -variable S] $specs "" $args] + if {![winfo exists $S(-parent)]} { + set code [list TK LOOKUP WINDOW $S(-parent)] + set err "bad window path name \"$S(-parent)\"" + array set S $cache + return -code error -errorcode $code $err + } + if {[string trim $S(-title)] eq ""} { + set S(-title) [::msgcat::mc "Font"] + } + if {[winfo exists $S(W)] && [lsearch $args -font] != -1} { + Init $S(-font) + event generate $S(-parent) <<TkFontchooserFontChanged>> + } + return $r +} + +proc ::tk::fontchooser::Create {} { + variable S + set windowName __tk__fontchooser + if {$S(-parent) eq "."} { + set S(W) .$windowName + } else { + set S(W) $S(-parent).$windowName + } + + # Now build the dialog + if {![winfo exists $S(W)]} { + toplevel $S(W) -class TkFontDialog + if {[package provide tcltest] ne {}} {set ::tk_dialog $S(W)} + wm withdraw $S(W) + wm title $S(W) $S(-title) + wm transient $S(W) [winfo toplevel $S(-parent)] + + set outer [::ttk::frame $S(W).outer -padding {10 10}] + ::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:"] + ttk::entry $S(W).efont -width 18 \ + -textvariable [namespace which -variable S](font) + ttk::entry $S(W).estyle -width 10 \ + -textvariable [namespace which -variable S](style) + ttk::entry $S(W).esize -textvariable [namespace which -variable S](size) \ + -width 3 -validate key -validatecommand {string is double %P} + + ttk_slistbox $S(W).lfonts -height 7 -exportselection 0 \ + -selectmode browse -activestyle none \ + -listvariable [namespace which -variable S](fonts) + ttk_slistbox $S(W).lstyles -width 5 -height 7 -exportselection 0 \ + -selectmode browse -activestyle none \ + -listvariable [namespace which -variable S](styles) + ttk_slistbox $S(W).lsizes -width 4 -height 7 -exportselection 0 \ + -selectmode browse -activestyle none \ + -listvariable [namespace which -variable S](sizes) + + set WE $S(W).effects + ::ttk::labelframe $WE -text [::msgcat::mc "Effects"] + ::tk::AmpWidget ::ttk::checkbutton $WE.strike \ + -variable [namespace which -variable S](strike) \ + -text [::msgcat::mc "Stri&keout"] \ + -command [namespace code [list Click strike]] + ::tk::AmpWidget ::ttk::checkbutton $WE.under \ + -variable [namespace which -variable S](under) \ + -text [::msgcat::mc "&Underline"] \ + -command [namespace code [list Click under]] + + set bbox [::ttk::frame $S(W).bbox] + ::ttk::button $S(W).ok -text [::msgcat::mc OK] -default active\ + -command [namespace code [list Done 1]] + ::ttk::button $S(W).cancel -text [::msgcat::mc Cancel] \ + -command [namespace code [list Done 0]] + ::tk::AmpWidget ::ttk::button $S(W).apply -text [::msgcat::mc "&Apply"] \ + -command [namespace code [list Apply]] + wm protocol $S(W) WM_DELETE_WINDOW [namespace code [list Done 0]] + + # Calculate minimum sizes + ttk::scrollbar $S(W).tmpvs + set scroll_width [winfo reqwidth $S(W).tmpvs] + destroy $S(W).tmpvs + set minsize(gap) 10 + set minsize(bbox) [winfo reqwidth $S(W).ok] + set minsize(fonts) \ + [expr {[font measure TkDefaultFont "Helvetica"] + $scroll_width}] + set minsize(styles) \ + [expr {[font measure TkDefaultFont "Bold Italic"] + $scroll_width}] + set minsize(sizes) \ + [expr {[font measure TkDefaultFont "-99"] + $scroll_width}] + set min [expr {$minsize(gap) * 4}] + foreach {what width} [array get minsize] { incr min $width } + wm minsize $S(W) $min 260 + + bind $S(W) <Return> [namespace code [list Done 1]] + bind $S(W) <Escape> [namespace code [list Done 0]] + bind $S(W) <Map> [namespace code [list Visibility %W 1]] + bind $S(W) <Unmap> [namespace code [list Visibility %W 0]] + bind $S(W) <Destroy> [namespace code [list Visibility %W 0]] + bind $S(W).lfonts.list <<ListboxSelect>> [namespace code [list Click font]] + bind $S(W).lstyles.list <<ListboxSelect>> [namespace code [list Click style]] + bind $S(W).lsizes.list <<ListboxSelect>> [namespace code [list Click size]] + bind $S(W) <Alt-Key> [list ::tk::AltKeyInDialog $S(W) %A] + bind $S(W).font <<AltUnderlined>> [list ::focus $S(W).efont] + bind $S(W).style <<AltUnderlined>> [list ::focus $S(W).estyle] + bind $S(W).size <<AltUnderlined>> [list ::focus $S(W).esize] + bind $S(W).apply <<AltUnderlined>> [namespace code [list Apply]] + bind $WE.strike <<AltUnderlined>> [list $WE.strike invoke] + bind $WE.under <<AltUnderlined>> [list $WE.under invoke] + + set WS $S(W).sample + ::ttk::labelframe $WS -text [::msgcat::mc "Sample"] + ::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 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 + if {$S(-command) ne ""} { + grid $S(W).apply -in $bbox -sticky new -pady 2 + } + grid columnconfigure $bbox 0 -weight 1 + + grid $WE.strike -sticky w -padx 10 + grid $WE.under -sticky w -padx 10 -pady {0 30} + 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 configure $bbox -sticky n + grid columnconfigure $outer {1 3 5} -minsize $minsize(gap) + grid columnconfigure $outer {0 2 4} -weight 1 + grid columnconfigure $outer 0 -minsize $minsize(fonts) + grid columnconfigure $outer 2 -minsize $minsize(styles) + grid columnconfigure $outer 4 -minsize $minsize(sizes) + grid columnconfigure $outer 6 -minsize $minsize(bbox) + + grid $outer -sticky news + grid rowconfigure $S(W) 0 -weight 1 + grid columnconfigure $S(W) 0 -weight 1 + + Init $S(-font) + + trace add variable [namespace which -variable S](size) \ + write [namespace code [list Tracer]] + trace add variable [namespace which -variable S](style) \ + write [namespace code [list Tracer]] + trace add variable [namespace which -variable S](font) \ + write [namespace code [list Tracer]] + } else { + Init $S(-font) + } + + return +} + +# ::tk::fontchooser::Done -- +# +# Handles teardown of the dialog, calling -command if needed +# +# Arguments: +# ok true if user pressed OK +# +proc ::tk::::fontchooser::Done {ok} { + variable S + + if {! $ok} { + set S(result) "" + } + trace vdelete S(size) w [namespace code [list Tracer]] + trace vdelete S(style) w [namespace code [list Tracer]] + trace vdelete S(font) w [namespace code [list Tracer]] + destroy $S(W) + if {$ok && $S(-command) ne ""} { + uplevel #0 $S(-command) [list $S(result)] + } +} + +# ::tk::fontchooser::Apply -- +# +# Call the -command procedure appending the current font +# Errors are reported via the background error mechanism +# +proc ::tk::fontchooser::Apply {} { + variable S + if {$S(-command) ne ""} { + if {[catch {uplevel #0 $S(-command) [list $S(result)]} err]} { + ::bgerror $err + } + } + event generate $S(-parent) <<TkFontchooserFontChanged>> +} + +# ::tk::fontchooser::Init -- +# +# Initializes dialog to a default font +# +# Arguments: +# defaultFont font to use as the default +# +proc ::tk::fontchooser::Init {{defaultFont ""}} { + variable S + + if {$S(first) || $defaultFont ne ""} { + if {$defaultFont eq ""} { + set defaultFont [[entry .___e] cget -font] + destroy .___e + } + array set F [font actual $defaultFont] + set S(font) $F(-family) + set S(size) $F(-size) + set S(strike) $F(-overstrike) + set S(under) $F(-underline) + set S(style) "Regular" + if {$F(-weight) eq "bold" && $F(-slant) eq "italic"} { + set S(style) "Bold Italic" + } elseif {$F(-weight) eq "bold"} { + set S(style) "Bold" + } elseif {$F(-slant) eq "italic"} { + set S(style) "Italic" + } + + set S(first) 0 + } + + Tracer a b c + Update +} + +# ::tk::fontchooser::Click -- +# +# Handles all button clicks, updating the appropriate widgets +# +# Arguments: +# who which widget got pressed +# +proc ::tk::fontchooser::Click {who} { + variable S + + if {$who eq "font"} { + set S(font) [$S(W).lfonts get [$S(W).lfonts curselection]] + } elseif {$who eq "style"} { + set S(style) [$S(W).lstyles get [$S(W).lstyles curselection]] + } elseif {$who eq "size"} { + set S(size) [$S(W).lsizes get [$S(W).lsizes curselection]] + } + Update +} + +# ::tk::fontchooser::Tracer -- +# +# Handles traces on key variables, updating the appropriate widgets +# +# Arguments: +# standard trace arguments (not used) +# +proc ::tk::fontchooser::Tracer {var1 var2 op} { + variable S + + set bad 0 + set nstate normal + # Make selection in each listbox + foreach var {font style size} { + set value [string tolower $S($var)] + $S(W).l${var}s selection clear 0 end + set n [lsearch -exact $S(${var}s,lcase) $value] + $S(W).l${var}s selection set $n + if {$n != -1} { + set S($var) [lindex $S(${var}s) $n] + $S(W).e$var icursor end + $S(W).e$var selection clear + } else { ;# No match, try prefix + # Size is weird: valid numbers are legal but don't display + # unless in the font size list + set n [lsearch -glob $S(${var}s,lcase) "$value*"] + set bad 1 + if {$var ne "size" || ! [string is double -strict $value]} { + set nstate disabled + } + } + $S(W).l${var}s see $n + } + if {!$bad} { Update } + $S(W).ok configure -state $nstate +} + +# ::tk::fontchooser::Update -- +# +# Shows a sample of the currently selected font +# +proc ::tk::fontchooser::Update {} { + variable S + + set S(result) [list $S(font) $S(size)] + if {$S(style) eq "Bold"} { lappend S(result) bold } + if {$S(style) eq "Italic"} { lappend S(result) italic } + if {$S(style) eq "Bold Italic"} { lappend S(result) bold italic} + if {$S(strike)} { lappend S(result) overstrike} + if {$S(under)} { lappend S(result) underline} + + $S(sample) configure -font $S(result) +} + +# ::tk::fontchooser::Visibility -- +# +# Notify the parent when the dialog visibility changes +# +proc ::tk::fontchooser::Visibility {w visible} { + variable S + if {$w eq $S(W)} { + event generate $S(-parent) <<TkFontchooserVisibility>> + } +} + +# ::tk::fontchooser::ttk_listbox -- +# +# Create a properly themed scrolled listbox. +# 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] + if {[catch { + listbox $f.list -relief flat -highlightthickness 0 -borderwidth 0 {*}$args + ttk::scrollbar $f.vs -command [list $f.list yview] + $f.list configure -yscrollcommand [list $f.vs set] + grid $f.list $f.vs -sticky news + grid rowconfigure $f 0 -weight 1 + grid columnconfigure $f 0 -weight 1 + interp hide {} $w + interp alias {} $w {} $f.list + } err opt]} { + destroy $f + return -options $opt $err + } + return $w +} diff --git a/library/iconlist.tcl b/library/iconlist.tcl new file mode 100644 index 0000000..62b0b2d --- /dev/null +++ b/library/iconlist.tcl @@ -0,0 +1,696 @@ +# iconlist.tcl +# +# 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 +# +# See the file "license.terms" for information on usage and redistribution of +# this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# API Summary: +# tk::IconList <path> ?<option> <value>? ... +# <path> add <imageName> <itemList> +# <path> cget <option> +# <path> configure ?<option>? ?<value>? ... +# <path> deleteall +# <path> destroy +# <path> get <itemIndex> +# <path> index <index> +# <path> invoke +# <path> see <index> +# <path> selection anchor ?<int>? +# <path> selection clear <first> ?<last>? +# <path> selection get +# <path> selection includes <item> +# <path> selection set <first> ?<last>? + +package require Tk 8.6 + +::tk::Megawidget create ::tk::IconList ::tk::FocusableWidget { + variable w canvas sbar accel accelCB fill font index \ + itemList itemsPerColumn list maxIH maxIW maxTH maxTW noScroll \ + numItems oldX oldY options rect selected selection textList + constructor args { + next {*}$args + set accelCB {} + } + destructor { + my Reset + next + } + + method GetSpecs {} { + concat [next] { + {-command "" "" ""} + {-font "" "" "TkIconFont"} + {-multiple "" "" "0"} + } + } + + # ---------------------------------------------------------------------- + + method index i { + if {![info exist list]} { + set list {} + } + switch -regexp -- $i { + "^-?[0-9]+$" { + if {$i < 0} { + set i 0 + } + if {$i >= [llength $list]} { + set i [expr {[llength $list] - 1}] + } + return $i + } + "^anchor$" { + return $index(anchor) + } + "^end$" { + return [llength $list] + } + "@-?[0-9]+,-?[0-9]+" { + scan $i "@%d,%d" x y + set item [$canvas find closest \ + [$canvas canvasx $x] [$canvas canvasy $y]] + return [lindex [$canvas itemcget $item -tags] 1] + } + } + } + + method selection {op args} { + switch -exact -- $op { + anchor { + if {[llength $args] == 1} { + set index(anchor) [$w index [lindex $args 0]] + } else { + return $index(anchor) + } + } + clear { + switch [llength $args] { + 2 { + lassign $args first last + } + 1 { + set first [set last [lindex $args 0]] + } + default { + return -code error -errorcode {TCL WRONGARGS} \ + "wrong # args: should be\ + \"[lrange [info level 0] 0 1] first ?last?\"" + } + } + + set first [$w index $first] + set last [$w index $last] + if {$first > $last} { + set tmp $first + set first $last + set last $tmp + } + set ind 0 + foreach item $selection { + if {$item >= $first} { + set first $ind + break + } + incr ind + } + set ind [expr {[llength $selection] - 1}] + for {} {$ind >= 0} {incr ind -1} { + set item [lindex $selection $ind] + if {$item <= $last} { + set last $ind + break + } + } + + if {$first > $last} { + return + } + set selection [lreplace $selection $first $last] + event generate $w <<ListboxSelect>> + my DrawSelection + } + get { + return $selection + } + includes { + return [expr {[lindex $args 0] in $selection}] + } + set { + switch [llength $args] { + 2 { + lassign $args first last + } + 1 { + set first [set last [lindex $args 0]] + } + default { + return -code error -errorcode {TCL WRONGARGS} \ + "wrong # args: should be\ + \"[lrange [info level 0] 0 1] first ?last?\"" + } + } + + set first [$w index $first] + set last [$w index $last] + if {$first > $last} { + set tmp $first + set first $last + set last $tmp + } + + for {set i $first} {$i <= $last} {incr i} { + lappend selection $i + } + set selection [lsort -integer -unique $selection] + event generate $w <<ListboxSelect>> + my DrawSelection + } + } + } + + method get item { + set rTag [lindex $list $item 2] + lassign $itemList($rTag) iTag tTag text serial + return $text + } + + # Deletes all the items inside the canvas subwidget and reset the + # iconList's state. + # + method deleteall {} { + $canvas delete all + unset -nocomplain selected rect list itemList + set maxIW 1 + set maxIH 1 + set maxTW 1 + set maxTH 1 + set numItems 0 + set noScroll 1 + set selection {} + set index(anchor) "" + $sbar set 0.0 1.0 + $canvas xview moveto 0 + } + + # Adds an icon into the IconList with the designated image and text + # + method add {image items} { + foreach text $items { + set iID item$numItems + set iTag [$canvas create image 0 0 -image $image -anchor nw \ + -tags [list icon $numItems $iID]] + set tTag [$canvas create text 0 0 -text $text -anchor nw \ + -font $options(-font) -fill $fill \ + -tags [list text $numItems $iID]] + set rTag [$canvas create rect 0 0 0 0 -fill "" -outline "" \ + -tags [list rect $numItems $iID]] + + lassign [$canvas bbox $iTag] x1 y1 x2 y2 + set iW [expr {$x2 - $x1}] + set iH [expr {$y2 - $y1}] + if {$maxIW < $iW} { + set maxIW $iW + } + if {$maxIH < $iH} { + set maxIH $iH + } + + lassign [$canvas bbox $tTag] x1 y1 x2 y2 + set tW [expr {$x2 - $x1}] + set tH [expr {$y2 - $y1}] + if {$maxTW < $tW} { + set maxTW $tW + } + if {$maxTH < $tH} { + set maxTH $tH + } + + lappend list [list $iTag $tTag $rTag $iW $iH $tW $tH $numItems] + set itemList($rTag) [list $iTag $tTag $text $numItems] + set textList($numItems) [string tolower $text] + incr numItems + } + my WhenIdle Arrange + return + } + + # Gets called when the user invokes the IconList (usually by + # double-clicking or pressing the Return key). + # + method invoke {} { + if {$options(-command) ne "" && [llength $selection]} { + uplevel #0 $options(-command) + } + } + + # If the item is not (completely) visible, scroll the canvas so that it + # becomes visible. + # + method see rTag { + if {$noScroll} { + return + } + set sRegion [$canvas cget -scrollregion] + if {$sRegion eq ""} { + return + } + + if {$rTag < 0 || $rTag >= [llength $list]} { + return + } + + set bbox [$canvas bbox item$rTag] + set pad [expr {[$canvas cget -highlightthickness]+[$canvas cget -bd]}] + + set x1 [lindex $bbox 0] + set x2 [lindex $bbox 2] + incr x1 [expr {$pad * -2}] + incr x2 [expr {$pad * -1}] + + set cW [expr {[winfo width $canvas] - $pad*2}] + + set scrollW [expr {[lindex $sRegion 2]-[lindex $sRegion 0]+1}] + set dispX [expr {int([lindex [$canvas xview] 0]*$scrollW)}] + set oldDispX $dispX + + # check if out of the right edge + # + if {($x2 - $dispX) >= $cW} { + set dispX [expr {$x2 - $cW}] + } + # check if out of the left edge + # + if {($x1 - $dispX) < 0} { + set dispX $x1 + } + + if {$oldDispX ne $dispX} { + set fraction [expr {double($dispX) / double($scrollW)}] + $canvas xview moveto $fraction + } + } + + # ---------------------------------------------------------------------- + + # Places the icons in a column-major arrangement. + # + method Arrange {} { + if {![info exists list]} { + if {[info exists canvas] && [winfo exists $canvas]} { + set noScroll 1 + $sbar configure -command "" + } + return + } + + set W [winfo width $canvas] + set H [winfo height $canvas] + set pad [expr {[$canvas cget -highlightthickness]+[$canvas cget -bd]}] + if {$pad < 2} { + set pad 2 + } + + incr W [expr {$pad*-2}] + incr H [expr {$pad*-2}] + + set dx [expr {$maxIW + $maxTW + 8}] + if {$maxTH > $maxIH} { + set dy $maxTH + } else { + set dy $maxIH + } + incr dy 2 + set shift [expr {$maxIW + 4}] + + set x [expr {$pad * 2}] + set y [expr {$pad * 1}] ; # Why * 1 ? + set usedColumn 0 + foreach sublist $list { + set usedColumn 1 + lassign $sublist iTag tTag rTag iW iH tW tH + + set i_dy [expr {($dy - $iH)/2}] + set t_dy [expr {($dy - $tH)/2}] + + $canvas coords $iTag $x [expr {$y + $i_dy}] + $canvas coords $tTag [expr {$x + $shift}] [expr {$y + $t_dy}] + $canvas coords $rTag $x $y [expr {$x+$dx}] [expr {$y+$dy}] + + incr y $dy + if {($y + $dy) > $H} { + set y [expr {$pad * 1}] ; # *1 ? + incr x $dx + set usedColumn 0 + } + } + + if {$usedColumn} { + set sW [expr {$x + $dx}] + } else { + set sW $x + } + + if {$sW < $W} { + $canvas configure -scrollregion [list $pad $pad $sW $H] + $sbar configure -command "" + $canvas xview moveto 0 + set noScroll 1 + } else { + $canvas configure -scrollregion [list $pad $pad $sW $H] + $sbar configure -command [list $canvas xview] + set noScroll 0 + } + + set itemsPerColumn [expr {($H-$pad) / $dy}] + if {$itemsPerColumn < 1} { + set itemsPerColumn 1 + } + + my DrawSelection + } + + method DrawSelection {} { + $canvas delete selection + $canvas itemconfigure selectionText -fill black + $canvas dtag selectionText + set cbg [ttk::style lookup TEntry -selectbackground focus] + set cfg [ttk::style lookup TEntry -selectforeground focus] + foreach item $selection { + set rTag [lindex $list $item 2] + foreach {iTag tTag text serial} $itemList($rTag) { + break + } + + set bbox [$canvas bbox $tTag] + $canvas create rect $bbox -fill $cbg -outline $cbg \ + -tags selection + $canvas itemconfigure $tTag -fill $cfg -tags selectionText + } + $canvas lower selection + return + } + + # Creates an IconList widget by assembling a canvas widget and a + # scrollbar widget. Sets all the bindings necessary for the IconList's + # operations. + # + method Create {} { + variable hull + 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} + + $sbar configure -command [list $canvas xview] + $canvas configure -xscrollcommand [list $sbar set] + + # Initializes the max icon/text width and height and other variables + # + set maxIW 1 + set maxIH 1 + set maxTW 1 + set maxTH 1 + set numItems 0 + 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 + } + + # Creates the event bindings. + # + bind $canvas <Configure> [namespace code {my WhenIdle Arrange}] + + bind $canvas <1> [namespace code {my Btn1 %x %y}] + bind $canvas <B1-Motion> [namespace code {my Motion1 %x %y}] + bind $canvas <B1-Leave> [namespace code {my Leave1 %x %y}] + bind $canvas <Control-1> [namespace code {my CtrlBtn1 %x %y}] + bind $canvas <Shift-1> [namespace code {my ShiftBtn1 %x %y}] + bind $canvas <B1-Enter> [list tk::CancelRepeat] + bind $canvas <ButtonRelease-1> [list tk::CancelRepeat] + bind $canvas <Double-ButtonRelease-1> \ + [namespace code {my Double1 %x %y}] + + bind $canvas <Control-B1-Motion> {;} + bind $canvas <Shift-B1-Motion> [namespace code {my ShiftMotion1 %x %y}] + + bind $canvas <<PrevLine>> [namespace code {my UpDown -1}] + bind $canvas <<NextLine>> [namespace code {my UpDown 1}] + bind $canvas <<PrevChar>> [namespace code {my LeftRight -1}] + bind $canvas <<NextChar>> [namespace code {my LeftRight 1}] + bind $canvas <Return> [namespace code {my ReturnKey}] + bind $canvas <KeyPress> [namespace code {my KeyPress %A}] + bind $canvas <Control-KeyPress> ";" + bind $canvas <Alt-KeyPress> ";" + + bind $canvas <FocusIn> [namespace code {my FocusIn}] + bind $canvas <FocusOut> [namespace code {my FocusOut}] + + return $w + } + + # This procedure is invoked when the mouse leaves an entry window with + # button 1 down. It scrolls the window up, down, left, or right, + # depending on where the mouse left the window, and reschedules itself + # as an "after" command so that the window continues to scroll until the + # mouse moves back into the window or the mouse button is released. + # + method AutoScan {} { + if {![winfo exists $w]} return + set x $oldX + set y $oldY + if {$noScroll} { + return + } + if {$x >= [winfo width $canvas]} { + $canvas xview scroll 1 units + } elseif {$x < 0} { + $canvas xview scroll -1 units + } elseif {$y >= [winfo height $canvas]} { + # do nothing + } elseif {$y < 0} { + # do nothing + } else { + return + } + my Motion1 $x $y + set ::tk::Priv(afterId) [after 50 [namespace code {my AutoScan}]] + } + + # ---------------------------------------------------------------------- + + # Event handlers + method Btn1 {x y} { + focus $canvas + set i [$w index @$x,$y] + if {$i eq ""} { + return + } + $w selection clear 0 end + $w selection set $i + $w selection anchor $i + } + method CtrlBtn1 {x y} { + if {$options(-multiple)} { + focus $canvas + set i [$w index @$x,$y] + if {$i eq ""} { + return + } + if {[$w selection includes $i]} { + $w selection clear $i + } else { + $w selection set $i + $w selection anchor $i + } + } + } + method ShiftBtn1 {x y} { + if {$options(-multiple)} { + focus $canvas + set i [$w index @$x,$y] + if {$i eq ""} { + return + } + if {[$w index anchor] eq ""} { + $w selection anchor $i + } + $w selection clear 0 end + $w selection set anchor $i + } + } + + # Gets called on button-1 motions + # + method Motion1 {x y} { + set oldX $x + set oldY $y + set i [$w index @$x,$y] + if {$i eq ""} { + return + } + $w selection clear 0 end + $w selection set $i + } + method ShiftMotion1 {x y} { + set oldX $x + set oldY $y + set i [$w index @$x,$y] + if {$i eq ""} { + return + } + $w selection clear 0 end + $w selection set anchor $i + } + method Double1 {x y} { + if {[llength $selection]} { + $w invoke + } + } + method ReturnKey {} { + $w invoke + } + method Leave1 {x y} { + set oldX $x + set oldY $y + my AutoScan + } + method FocusIn {} { + $w state focus + if {![info exists list]} { + return + } + if {[llength $selection]} { + my DrawSelection + } + } + method FocusOut {} { + $w state !focus + $w selection clear 0 end + } + + # Moves the active element up or down by one element + # + # Arguments: + # amount - +1 to move down one item, -1 to move back one item. + # + method UpDown amount { + if {![info exists list]} { + return + } + set curr [$w selection get] + if {[llength $curr] == 0} { + set i 0 + } else { + set i [$w index anchor] + if {$i eq ""} { + return + } + incr i $amount + } + $w selection clear 0 end + $w selection set $i + $w selection anchor $i + $w see $i + } + + # Moves the active element left or right by one column + # + # Arguments: + # amount - +1 to move right one column, -1 to move left one + # column + # + method LeftRight amount { + if {![info exists list]} { + return + } + set curr [$w selection get] + if {[llength $curr] == 0} { + set i 0 + } else { + set i [$w index anchor] + if {$i eq ""} { + return + } + incr i [expr {$amount * $itemsPerColumn}] + } + $w selection clear 0 end + $w selection set $i + $w selection anchor $i + $w see $i + } + + # Gets called when user enters an arbitrary key in the listbox. + # + method KeyPress key { + append accel $key + my Goto $accel + after cancel $accelCB + set accelCB [after 500 [namespace code {my Reset}]] + } + + method Goto text { + if {![info exists list]} { + return + } + if {$text eq "" || $numItems == 0} { + return + } + + if {[llength [$w selection get]]} { + set start [$w index anchor] + } else { + set start 0 + } + set theIndex -1 + set less 0 + set len [string length $text] + set len0 [expr {$len - 1}] + set i $start + + # Search forward until we find a filename whose prefix is a + # case-insensitive match with $text + while {1} { + if {[string equal -nocase -length $len0 $textList($i) $text]} { + set theIndex $i + break + } + incr i + if {$i == $numItems} { + set i 0 + } + if {$i == $start} { + break + } + } + + if {$theIndex > -1} { + $w selection clear 0 end + $w selection set $theIndex + $w selection anchor $theIndex + $w see $theIndex + } + } + method Reset {} { + unset -nocomplain accel + } +} + +return + +# Local Variables: +# mode: tcl +# fill-column: 78 +# End: diff --git a/library/icons.tcl b/library/icons.tcl new file mode 100644 index 0000000..e53a1bd --- /dev/null +++ b/library/icons.tcl @@ -0,0 +1,153 @@ +# 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 +# unified set of high quality icons licensed under the +# Creative Commons Attribution Share-Alike license +# (http://creativecommons.org/licenses/by-sa/3.0/) +# +# See http://tango.freedesktop.org/Tango_Desktop_Project +# +# Copyright (c) 2009 Pat Thoyts <patthoyts@users.sourceforge.net> + +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= +} + +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::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::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= +} diff --git a/library/listbox.tcl b/library/listbox.tcl index 2d9af20..3270b5d 100644 --- a/library/listbox.tcl +++ b/library/listbox.tcl @@ -69,28 +69,28 @@ bind Listbox <B1-Enter> { tk::CancelRepeat } -bind Listbox <Up> { +bind Listbox <<PrevLine>> { tk::ListboxUpDown %W -1 } -bind Listbox <Shift-Up> { +bind Listbox <<SelectPrevLine>> { tk::ListboxExtendUpDown %W -1 } -bind Listbox <Down> { +bind Listbox <<NextLine>> { tk::ListboxUpDown %W 1 } -bind Listbox <Shift-Down> { +bind Listbox <<SelectNextLine>> { tk::ListboxExtendUpDown %W 1 } -bind Listbox <Left> { +bind Listbox <<PrevChar>> { %W xview scroll -1 units } -bind Listbox <Control-Left> { +bind Listbox <<PrevWord>> { %W xview scroll -1 pages } -bind Listbox <Right> { +bind Listbox <<NextChar>> { %W xview scroll 1 units } -bind Listbox <Control-Right> { +bind Listbox <<NextWord>> { %W xview scroll 1 pages } bind Listbox <Prior> { @@ -107,10 +107,10 @@ bind Listbox <Control-Prior> { bind Listbox <Control-Next> { %W xview scroll 1 pages } -bind Listbox <Home> { +bind Listbox <<LineStart>> { %W xview moveto 0 } -bind Listbox <End> { +bind Listbox <<LineEnd>> { %W xview moveto 1 } bind Listbox <Control-Home> { @@ -120,7 +120,7 @@ bind Listbox <Control-Home> { %W selection set 0 event generate %W <<ListboxSelect>> } -bind Listbox <Shift-Control-Home> { +bind Listbox <Control-Shift-Home> { tk::ListboxDataExtend %W 0 } bind Listbox <Control-End> { @@ -130,7 +130,7 @@ bind Listbox <Control-End> { %W selection set end event generate %W <<ListboxSelect>> } -bind Listbox <Shift-Control-End> { +bind Listbox <Control-Shift-End> { tk::ListboxDataExtend %W [%W index end] } bind Listbox <<Copy>> { @@ -157,10 +157,10 @@ bind Listbox <Shift-Select> { bind Listbox <Escape> { tk::ListboxCancel %W } -bind Listbox <Control-slash> { +bind Listbox <<SelectAll>> { tk::ListboxSelectAll %W } -bind Listbox <Control-backslash> { +bind Listbox <<SelectNone>> { if {[%W cget -selectmode] ne "browse"} { %W selection clear 0 end event generate %W <<ListboxSelect>> @@ -197,6 +197,9 @@ if {[tk windowingsystem] eq "aqua"} { bind Listbox <MouseWheel> { %W yview scroll [expr {- (%D / 120) * 4}] units } + bind Listbox <Shift-MouseWheel> { + %W xview scroll [expr {- (%D / 120) * 4}] units + } } if {"x11" eq [tk windowingsystem]} { @@ -209,11 +212,21 @@ if {"x11" eq [tk windowingsystem]} { %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 + } + } } # ::tk::ListboxBeginSelect -- diff --git a/library/megawidget.tcl b/library/megawidget.tcl new file mode 100644 index 0000000..9b9be92 --- /dev/null +++ b/library/megawidget.tcl @@ -0,0 +1,146 @@ +# megawidget.tcl +# +# Basic megawidget support classes. Experimental for any use other than +# the ::tk::IconList megawdget, which is itself only designed for use in +# the Unix file dialogs. +# +# Copyright (c) 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 8.6 + +::oo::class create ::tk::Megawidget { + superclass ::oo::class + method unknown {w args} { + if {[string match .* $w]} { + [self] create $w {*}$args + return $w + } + next $w {*}$args + } + unexport new unknown + self method create {name superclasses body} { + next $name [list \ + superclass ::tk::MegawidgetClass {*}$superclasses]\;$body + } +} + +::oo::class create ::tk::MegawidgetClass { + variable w hull OptionSpecification options IdleCallbacks + constructor args { + # Extract the "widget name" from the object name + set w [namespace tail [self]] + + # Configure things + set OptionSpecification [my GetSpecs] + my configure {*}$args + + # Move the object out of the way of the hull widget + rename [self] _tmp + + # Make the hull widget(s) + my CreateHull + bind $hull <Destroy> [list [namespace which my] destroy] + + # Rename things into their final places + rename ::$w theFrame + rename [self] ::$w + + # Make the contents + my Create + } + destructor { + foreach {name cb} [array get IdleCallbacks] { + after cancel $cb + unset IdleCallbacks($name) + } + if {[winfo exists $w]} { + bind $hull <Destroy> {} + destroy $w + } + } + + method configure args { + tclParseConfigSpec [my varname options] $OptionSpecification "" $args + } + method cget option { + return $options($option) + } + + method GetSpecs {} { + return { + {-takefocus takeFocus TakeFocus {}} + } + } + + method CreateHull {} { + return -code error -errorcode {TCL OO ABSTRACT_METHOD} \ + "method must be overridden" + } + method Create {} { + return -code error -errorcode {TCL OO ABSTRACT_METHOD} \ + "method must be overridden" + } + + method WhenIdle {method args} { + if {![info exists IdleCallbacks($method)]} { + set IdleCallbacks($method) [after idle [list \ + [namespace which my] DoWhenIdle $method $args]] + } + } + method DoWhenIdle {method arguments} { + unset IdleCallbacks($method) + tailcall my $method {*}$arguments + } +} + +::tk::Megawidget create ::tk::SimpleWidget {} { + variable w hull options + method GetSpecs {} { + return { + {-cursor cursor Cursor {}} + {-takefocus takeFocus TakeFocus {}} + } + } + method CreateHull {} { + set hull [::ttk::frame $w -cursor $options(-cursor)] + trace add variable options(-cursor) write \ + [namespace code {my UpdateCursorOption}] + } + method UpdateCursorOption args { + $hull configure -cursor $options(-cursor) + } + method state args { + tailcall $hull state {*}$args + } + method instate args { + tailcall $hull instate {*}$args + } +} + +::tk::Megawidget create ::tk::FocusableWidget ::tk::SimpleWidget { + variable w hull options + method GetSpecs {} { + return { + {-cursor cursor Cursor {}} + {-takefocus takeFocus TakeFocus ::ttk::takefocus} + } + } + 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 + trace add variable options(-cursor) write \ + [namespace code {my UpdateCursorOption}] + } +} + +return + +# Local Variables: +# mode: tcl +# fill-column: 78 +# End: diff --git a/library/menu.tcl b/library/menu.tcl index 4875477..a7aaa3f 100644 --- a/library/menu.tcl +++ b/library/menu.tcl @@ -156,16 +156,16 @@ bind Menu <Return> { bind Menu <Escape> { tk::MenuEscape %W } -bind Menu <Left> { +bind Menu <<PrevChar>> { tk::MenuLeftArrow %W } -bind Menu <Right> { +bind Menu <<NextChar>> { tk::MenuRightArrow %W } -bind Menu <Up> { +bind Menu <<PrevLine>> { tk::MenuUpArrow %W } -bind Menu <Down> { +bind Menu <<NextLine>> { tk::MenuDownArrow %W } bind Menu <KeyPress> { @@ -248,7 +248,6 @@ proc ::tk::MbLeave w { proc ::tk::MbPost {w {x {}} {y {}}} { global errorInfo variable ::tk::Priv - global tcl_platform if {[$w cget -state] eq "disabled" || $w eq $Priv(postedMb)} { return @@ -260,7 +259,8 @@ proc ::tk::MbPost {w {x {}} {y {}}} { set tearoff [expr {[tk windowingsystem] eq "x11" \ || [$menu cget -type] eq "tearoff"}] if {[string first $w $menu] != 0} { - error "can't post $menu: it isn't a descendant of $w (this is a new requirement in Tk versions 3.0 and later)" + return -code error -errorcode {TK MENUBUTTON POST_NONCHILD} \ + "can't post $menu: it isn't a descendant of $w" } set cur $Priv(postedMb) if {$cur ne ""} { @@ -330,7 +330,7 @@ proc ::tk::MbPost {w {x {}} {y {}}} { $menu activate $entry GenerateMenuSelect $menu } - } + } right { set x [expr {[winfo rootx $w] + [winfo width $w]}] set y [expr {(2 * [winfo rooty $w] + [winfo height $w]) / 2}] @@ -366,14 +366,12 @@ proc ::tk::MbPost {w {x {}} {y {}}} { } } } - } msg]} { + } msg opt]} { # Error posting menu (e.g. bogus -postcommand). Unpost it and # reflect the error. - set savedInfo $errorInfo MenuUnpost {} - error $msg $savedInfo - + return -options $opt $msg } set Priv(tearoff) $tearoff @@ -403,7 +401,6 @@ proc ::tk::MbPost {w {x {}} {y {}}} { # is a posted menubutton. proc ::tk::MenuUnpost menu { - global tcl_platform variable ::tk::Priv set mb $Priv(postedMb) @@ -532,7 +529,6 @@ proc ::tk::MbMotion {w upDown rootx rooty} { proc ::tk::MbButtonUp w { variable ::tk::Priv - global tcl_platform set menu [$w cget -menu] set tearoff [expr {[tk windowingsystem] eq "x11" || \ @@ -607,7 +603,6 @@ proc ::tk::MenuMotion {menu x y state} { proc ::tk::MenuButtonDown menu { variable ::tk::Priv - global tcl_platform if {![winfo viewable $menu]} { return @@ -1219,8 +1214,6 @@ proc ::tk::MenuFindName {menu s} { # upper-left corner goes at (x,y). proc ::tk::PostOverPoint {menu x y {entry {}}} { - global tcl_platform - if {$entry ne ""} { if {$entry == [$menu index last]} { incr y [expr {-([$menu yposition $entry] \ @@ -1235,8 +1228,8 @@ proc ::tk::PostOverPoint {menu x y {entry {}}} { if {[tk windowingsystem] eq "win32"} { # osVersion is not available in safe interps set ver 5 - if {[info exists tcl_platform(osVersion)]} { - scan $tcl_platform(osVersion) %d ver + if {[info exists ::tcl_platform(osVersion)]} { + scan $::tcl_platform(osVersion) %d ver } # We need to fix some problems with menu posting on Windows, @@ -1341,7 +1334,6 @@ proc ::tk::GenerateMenuSelect {menu} { proc ::tk_popup {menu x y {entry {}}} { variable ::tk::Priv - global tcl_platform if {$Priv(popup) ne "" || $Priv(postedMb) ne ""} { tk::MenuUnpost {} } diff --git a/library/mkpsenc.tcl b/library/mkpsenc.tcl index 9efb6de..b3fd13d 100644 --- a/library/mkpsenc.tcl +++ b/library/mkpsenc.tcl @@ -1,1365 +1,1487 @@ # mkpsenc.tcl -- # -# Creates Postscript encoding vector for given encoding -# +# This file generates the postscript prolog used by Tk. -proc ::tk::CreatePostscriptEncoding {encoding} { - # now check for known. Even if it is known, it can be other - # than we need. GhostScript seems to be happy with such approach - set result "/CurrentEncoding \[\n" - for {set i 0} {$i<256} {incr i 8} { - for {set j 0} {$j<8} {incr j} { - set enc [encoding convertfrom $encoding [format %c [expr {$i+$j}]]] - if {[catch {format %04X [scan $enc %c]} hexcode]} {set hexcode {}} - if [info exists ::tk::psglyphs($hexcode)] { - append result "/$::tk::psglyphs($hexcode)" - } else { - append result "/space" +namespace eval ::tk { + # Creates Postscript encoding vector for ISO-8859-1 (could theoretically + # handle any 8-bit encoding, but Tk never generates characters outside + # ASCII). + # + proc CreatePostscriptEncoding {} { + variable psglyphs + # Now check for known. Even if it is known, it can be other than we + # need. GhostScript seems to be happy with such approach + set result "\[\n" + for {set i 0} {$i<256} {incr i 8} { + for {set j 0} {$j<8} {incr j} { + set enc [encoding convertfrom "iso8859-1" \ + [format %c [expr {$i+$j}]]] + catch { + set hexcode {} + set hexcode [format %04X [scan $enc %c]] + } + if {[info exists psglyphs($hexcode)]} { + append result "/$psglyphs($hexcode)" + } else { + append result "/space" + } } + append result "\n" } - append result "\n" + append result "\]" + return $result } - append result "\] def\n" - return $result -} - -# List of adobe glyph names. Converted from glyphlist.txt, downloaded -# from Adobe - -namespace eval ::tk { -array set psglyphs { - 0020 space - 0021 exclam - 0022 quotedbl - 0023 numbersign - 0024 dollar - 0025 percent - 0026 ampersand - 0027 quotesingle - 0028 parenleft - 0029 parenright - 002A asterisk - 002B plus - 002C comma - 002D hyphen - 002E period - 002F slash - 0030 zero - 0031 one - 0032 two - 0033 three - 0034 four - 0035 five - 0036 six - 0037 seven - 0038 eight - 0039 nine - 003A colon - 003B semicolon - 003C less - 003D equal - 003E greater - 003F question - 0040 at - 0041 A - 0042 B - 0043 C - 0044 D - 0045 E - 0046 F - 0047 G - 0048 H - 0049 I - 004A J - 004B K - 004C L - 004D M - 004E N - 004F O - 0050 P - 0051 Q - 0052 R - 0053 S - 0054 T - 0055 U - 0056 V - 0057 W - 0058 X - 0059 Y - 005A Z - 005B bracketleft - 005C backslash - 005D bracketright - 005E asciicircum - 005F underscore - 0060 grave - 0061 a - 0062 b - 0063 c - 0064 d - 0065 e - 0066 f - 0067 g - 0068 h - 0069 i - 006A j - 006B k - 006C l - 006D m - 006E n - 006F o - 0070 p - 0071 q - 0072 r - 0073 s - 0074 t - 0075 u - 0076 v - 0077 w - 0078 x - 0079 y - 007A z - 007B braceleft - 007C bar - 007D braceright - 007E asciitilde - 00A0 space - 00A1 exclamdown - 00A2 cent - 00A3 sterling - 00A4 currency - 00A5 yen - 00A6 brokenbar - 00A7 section - 00A8 dieresis - 00A9 copyright - 00AA ordfeminine - 00AB guillemotleft - 00AC logicalnot - 00AD hyphen - 00AE registered - 00AF macron - 00B0 degree - 00B1 plusminus - 00B2 twosuperior - 00B3 threesuperior - 00B4 acute - 00B5 mu - 00B6 paragraph - 00B7 periodcentered - 00B8 cedilla - 00B9 onesuperior - 00BA ordmasculine - 00BB guillemotright - 00BC onequarter - 00BD onehalf - 00BE threequarters - 00BF questiondown - 00C0 Agrave - 00C1 Aacute - 00C2 Acircumflex - 00C3 Atilde - 00C4 Adieresis - 00C5 Aring - 00C6 AE - 00C7 Ccedilla - 00C8 Egrave - 00C9 Eacute - 00CA Ecircumflex - 00CB Edieresis - 00CC Igrave - 00CD Iacute - 00CE Icircumflex - 00CF Idieresis - 00D0 Eth - 00D1 Ntilde - 00D2 Ograve - 00D3 Oacute - 00D4 Ocircumflex - 00D5 Otilde - 00D6 Odieresis - 00D7 multiply - 00D8 Oslash - 00D9 Ugrave - 00DA Uacute - 00DB Ucircumflex - 00DC Udieresis - 00DD Yacute - 00DE Thorn - 00DF germandbls - 00E0 agrave - 00E1 aacute - 00E2 acircumflex - 00E3 atilde - 00E4 adieresis - 00E5 aring - 00E6 ae - 00E7 ccedilla - 00E8 egrave - 00E9 eacute - 00EA ecircumflex - 00EB edieresis - 00EC igrave - 00ED iacute - 00EE icircumflex - 00EF idieresis - 00F0 eth - 00F1 ntilde - 00F2 ograve - 00F3 oacute - 00F4 ocircumflex - 00F5 otilde - 00F6 odieresis - 00F7 divide - 00F8 oslash - 00F9 ugrave - 00FA uacute - 00FB ucircumflex - 00FC udieresis - 00FD yacute - 00FE thorn - 00FF ydieresis - 0100 Amacron - 0101 amacron - 0102 Abreve - 0103 abreve - 0104 Aogonek - 0105 aogonek - 0106 Cacute - 0107 cacute - 0108 Ccircumflex - 0109 ccircumflex - 010A Cdotaccent - 010B cdotaccent - 010C Ccaron - 010D ccaron - 010E Dcaron - 010F dcaron - 0110 Dcroat - 0111 dcroat - 0112 Emacron - 0113 emacron - 0114 Ebreve - 0115 ebreve - 0116 Edotaccent - 0117 edotaccent - 0118 Eogonek - 0119 eogonek - 011A Ecaron - 011B ecaron - 011C Gcircumflex - 011D gcircumflex - 011E Gbreve - 011F gbreve - 0120 Gdotaccent - 0121 gdotaccent - 0122 Gcommaaccent - 0123 gcommaaccent - 0124 Hcircumflex - 0125 hcircumflex - 0126 Hbar - 0127 hbar - 0128 Itilde - 0129 itilde - 012A Imacron - 012B imacron - 012C Ibreve - 012D ibreve - 012E Iogonek - 012F iogonek - 0130 Idotaccent - 0131 dotlessi - 0132 IJ - 0133 ij - 0134 Jcircumflex - 0135 jcircumflex - 0136 Kcommaaccent - 0137 kcommaaccent - 0138 kgreenlandic - 0139 Lacute - 013A lacute - 013B Lcommaaccent - 013C lcommaaccent - 013D Lcaron - 013E lcaron - 013F Ldot - 0140 ldot - 0141 Lslash - 0142 lslash - 0143 Nacute - 0144 nacute - 0145 Ncommaaccent - 0146 ncommaaccent - 0147 Ncaron - 0148 ncaron - 0149 napostrophe - 014A Eng - 014B eng - 014C Omacron - 014D omacron - 014E Obreve - 014F obreve - 0150 Ohungarumlaut - 0151 ohungarumlaut - 0152 OE - 0153 oe - 0154 Racute - 0155 racute - 0156 Rcommaaccent - 0157 rcommaaccent - 0158 Rcaron - 0159 rcaron - 015A Sacute - 015B sacute - 015C Scircumflex - 015D scircumflex - 015E Scedilla - 015F scedilla - 0160 Scaron - 0161 scaron - 0162 Tcommaaccent - 0163 tcommaaccent - 0164 Tcaron - 0165 tcaron - 0166 Tbar - 0167 tbar - 0168 Utilde - 0169 utilde - 016A Umacron - 016B umacron - 016C Ubreve - 016D ubreve - 016E Uring - 016F uring - 0170 Uhungarumlaut - 0171 uhungarumlaut - 0172 Uogonek - 0173 uogonek - 0174 Wcircumflex - 0175 wcircumflex - 0176 Ycircumflex - 0177 ycircumflex - 0178 Ydieresis - 0179 Zacute - 017A zacute - 017B Zdotaccent - 017C zdotaccent - 017D Zcaron - 017E zcaron - 017F longs - 0192 florin - 01A0 Ohorn - 01A1 ohorn - 01AF Uhorn - 01B0 uhorn - 01E6 Gcaron - 01E7 gcaron - 01FA Aringacute - 01FB aringacute - 01FC AEacute - 01FD aeacute - 01FE Oslashacute - 01FF oslashacute - 0218 Scommaaccent - 0219 scommaaccent - 021A Tcommaaccent - 021B tcommaaccent - 02BC afii57929 - 02BD afii64937 - 02C6 circumflex - 02C7 caron - 02C9 macron - 02D8 breve - 02D9 dotaccent - 02DA ring - 02DB ogonek - 02DC tilde - 02DD hungarumlaut - 0300 gravecomb - 0301 acutecomb - 0303 tildecomb - 0309 hookabovecomb - 0323 dotbelowcomb - 0384 tonos - 0385 dieresistonos - 0386 Alphatonos - 0387 anoteleia - 0388 Epsilontonos - 0389 Etatonos - 038A Iotatonos - 038C Omicrontonos - 038E Upsilontonos - 038F Omegatonos - 0390 iotadieresistonos - 0391 Alpha - 0392 Beta - 0393 Gamma - 0394 Delta - 0395 Epsilon - 0396 Zeta - 0397 Eta - 0398 Theta - 0399 Iota - 039A Kappa - 039B Lambda - 039C Mu - 039D Nu - 039E Xi - 039F Omicron - 03A0 Pi - 03A1 Rho - 03A3 Sigma - 03A4 Tau - 03A5 Upsilon - 03A6 Phi - 03A7 Chi - 03A8 Psi - 03A9 Omega - 03AA Iotadieresis - 03AB Upsilondieresis - 03AC alphatonos - 03AD epsilontonos - 03AE etatonos - 03AF iotatonos - 03B0 upsilondieresistonos - 03B1 alpha - 03B2 beta - 03B3 gamma - 03B4 delta - 03B5 epsilon - 03B6 zeta - 03B7 eta - 03B8 theta - 03B9 iota - 03BA kappa - 03BB lambda - 03BC mu - 03BD nu - 03BE xi - 03BF omicron - 03C0 pi - 03C1 rho - 03C2 sigma1 - 03C3 sigma - 03C4 tau - 03C5 upsilon - 03C6 phi - 03C7 chi - 03C8 psi - 03C9 omega - 03CA iotadieresis - 03CB upsilondieresis - 03CC omicrontonos - 03CD upsilontonos - 03CE omegatonos - 03D1 theta1 - 03D2 Upsilon1 - 03D5 phi1 - 03D6 omega1 - 0401 afii10023 - 0402 afii10051 - 0403 afii10052 - 0404 afii10053 - 0405 afii10054 - 0406 afii10055 - 0407 afii10056 - 0408 afii10057 - 0409 afii10058 - 040A afii10059 - 040B afii10060 - 040C afii10061 - 040E afii10062 - 040F afii10145 - 0410 afii10017 - 0411 afii10018 - 0412 afii10019 - 0413 afii10020 - 0414 afii10021 - 0415 afii10022 - 0416 afii10024 - 0417 afii10025 - 0418 afii10026 - 0419 afii10027 - 041A afii10028 - 041B afii10029 - 041C afii10030 - 041D afii10031 - 041E afii10032 - 041F afii10033 - 0420 afii10034 - 0421 afii10035 - 0422 afii10036 - 0423 afii10037 - 0424 afii10038 - 0425 afii10039 - 0426 afii10040 - 0427 afii10041 - 0428 afii10042 - 0429 afii10043 - 042A afii10044 - 042B afii10045 - 042C afii10046 - 042D afii10047 - 042E afii10048 - 042F afii10049 - 0430 afii10065 - 0431 afii10066 - 0432 afii10067 - 0433 afii10068 - 0434 afii10069 - 0435 afii10070 - 0436 afii10072 - 0437 afii10073 - 0438 afii10074 - 0439 afii10075 - 043A afii10076 - 043B afii10077 - 043C afii10078 - 043D afii10079 - 043E afii10080 - 043F afii10081 - 0440 afii10082 - 0441 afii10083 - 0442 afii10084 - 0443 afii10085 - 0444 afii10086 - 0445 afii10087 - 0446 afii10088 - 0447 afii10089 - 0448 afii10090 - 0449 afii10091 - 044A afii10092 - 044B afii10093 - 044C afii10094 - 044D afii10095 - 044E afii10096 - 044F afii10097 - 0451 afii10071 - 0452 afii10099 - 0453 afii10100 - 0454 afii10101 - 0455 afii10102 - 0456 afii10103 - 0457 afii10104 - 0458 afii10105 - 0459 afii10106 - 045A afii10107 - 045B afii10108 - 045C afii10109 - 045E afii10110 - 045F afii10193 - 0462 afii10146 - 0463 afii10194 - 0472 afii10147 - 0473 afii10195 - 0474 afii10148 - 0475 afii10196 - 0490 afii10050 - 0491 afii10098 - 04D9 afii10846 - 05B0 afii57799 - 05B1 afii57801 - 05B2 afii57800 - 05B3 afii57802 - 05B4 afii57793 - 05B5 afii57794 - 05B6 afii57795 - 05B7 afii57798 - 05B8 afii57797 - 05B9 afii57806 - 05BB afii57796 - 05BC afii57807 - 05BD afii57839 - 05BE afii57645 - 05BF afii57841 - 05C0 afii57842 - 05C1 afii57804 - 05C2 afii57803 - 05C3 afii57658 - 05D0 afii57664 - 05D1 afii57665 - 05D2 afii57666 - 05D3 afii57667 - 05D4 afii57668 - 05D5 afii57669 - 05D6 afii57670 - 05D7 afii57671 - 05D8 afii57672 - 05D9 afii57673 - 05DA afii57674 - 05DB afii57675 - 05DC afii57676 - 05DD afii57677 - 05DE afii57678 - 05DF afii57679 - 05E0 afii57680 - 05E1 afii57681 - 05E2 afii57682 - 05E3 afii57683 - 05E4 afii57684 - 05E5 afii57685 - 05E6 afii57686 - 05E7 afii57687 - 05E8 afii57688 - 05E9 afii57689 - 05EA afii57690 - 05F0 afii57716 - 05F1 afii57717 - 05F2 afii57718 - 060C afii57388 - 061B afii57403 - 061F afii57407 - 0621 afii57409 - 0622 afii57410 - 0623 afii57411 - 0624 afii57412 - 0625 afii57413 - 0626 afii57414 - 0627 afii57415 - 0628 afii57416 - 0629 afii57417 - 062A afii57418 - 062B afii57419 - 062C afii57420 - 062D afii57421 - 062E afii57422 - 062F afii57423 - 0630 afii57424 - 0631 afii57425 - 0632 afii57426 - 0633 afii57427 - 0634 afii57428 - 0635 afii57429 - 0636 afii57430 - 0637 afii57431 - 0638 afii57432 - 0639 afii57433 - 063A afii57434 - 0640 afii57440 - 0641 afii57441 - 0642 afii57442 - 0643 afii57443 - 0644 afii57444 - 0645 afii57445 - 0646 afii57446 - 0647 afii57470 - 0648 afii57448 - 0649 afii57449 - 064A afii57450 - 064B afii57451 - 064C afii57452 - 064D afii57453 - 064E afii57454 - 064F afii57455 - 0650 afii57456 - 0651 afii57457 - 0652 afii57458 - 0660 afii57392 - 0661 afii57393 - 0662 afii57394 - 0663 afii57395 - 0664 afii57396 - 0665 afii57397 - 0666 afii57398 - 0667 afii57399 - 0668 afii57400 - 0669 afii57401 - 066A afii57381 - 066D afii63167 - 0679 afii57511 - 067E afii57506 - 0686 afii57507 - 0688 afii57512 - 0691 afii57513 - 0698 afii57508 - 06A4 afii57505 - 06AF afii57509 - 06BA afii57514 - 06D2 afii57519 - 06D5 afii57534 - 1E80 Wgrave - 1E81 wgrave - 1E82 Wacute - 1E83 wacute - 1E84 Wdieresis - 1E85 wdieresis - 1EF2 Ygrave - 1EF3 ygrave - 200C afii61664 - 200D afii301 - 200E afii299 - 200F afii300 - 2012 figuredash - 2013 endash - 2014 emdash - 2015 afii00208 - 2017 underscoredbl - 2018 quoteleft - 2019 quoteright - 201A quotesinglbase - 201B quotereversed - 201C quotedblleft - 201D quotedblright - 201E quotedblbase - 2020 dagger - 2021 daggerdbl - 2022 bullet - 2024 onedotenleader - 2025 twodotenleader - 2026 ellipsis - 202C afii61573 - 202D afii61574 - 202E afii61575 - 2030 perthousand - 2032 minute - 2033 second - 2039 guilsinglleft - 203A guilsinglright - 203C exclamdbl - 2044 fraction - 2070 zerosuperior - 2074 foursuperior - 2075 fivesuperior - 2076 sixsuperior - 2077 sevensuperior - 2078 eightsuperior - 2079 ninesuperior - 207D parenleftsuperior - 207E parenrightsuperior - 207F nsuperior - 2080 zeroinferior - 2081 oneinferior - 2082 twoinferior - 2083 threeinferior - 2084 fourinferior - 2085 fiveinferior - 2086 sixinferior - 2087 seveninferior - 2088 eightinferior - 2089 nineinferior - 208D parenleftinferior - 208E parenrightinferior - 20A1 colonmonetary - 20A3 franc - 20A4 lira - 20A7 peseta - 20AA afii57636 - 20AB dong - 20AC Euro - 2105 afii61248 - 2111 Ifraktur - 2113 afii61289 - 2116 afii61352 - 2118 weierstrass - 211C Rfraktur - 211E prescription - 2122 trademark - 2126 Omega - 212E estimated - 2135 aleph - 2153 onethird - 2154 twothirds - 215B oneeighth - 215C threeeighths - 215D fiveeighths - 215E seveneighths - 2190 arrowleft - 2191 arrowup - 2192 arrowright - 2193 arrowdown - 2194 arrowboth - 2195 arrowupdn - 21A8 arrowupdnbse - 21B5 carriagereturn - 21D0 arrowdblleft - 21D1 arrowdblup - 21D2 arrowdblright - 21D3 arrowdbldown - 21D4 arrowdblboth - 2200 universal - 2202 partialdiff - 2203 existential - 2205 emptyset - 2206 Delta - 2207 gradient - 2208 element - 2209 notelement - 220B suchthat - 220F product - 2211 summation - 2212 minus - 2215 fraction - 2217 asteriskmath - 2219 periodcentered - 221A radical - 221D proportional - 221E infinity - 221F orthogonal - 2220 angle - 2227 logicaland - 2228 logicalor - 2229 intersection - 222A union - 222B integral - 2234 therefore - 223C similar - 2245 congruent - 2248 approxequal - 2260 notequal - 2261 equivalence - 2264 lessequal - 2265 greaterequal - 2282 propersubset - 2283 propersuperset - 2284 notsubset - 2286 reflexsubset - 2287 reflexsuperset - 2295 circleplus - 2297 circlemultiply - 22A5 perpendicular - 22C5 dotmath - 2302 house - 2310 revlogicalnot - 2320 integraltp - 2321 integralbt - 2329 angleleft - 232A angleright - 2500 SF100000 - 2502 SF110000 - 250C SF010000 - 2510 SF030000 - 2514 SF020000 - 2518 SF040000 - 251C SF080000 - 2524 SF090000 - 252C SF060000 - 2534 SF070000 - 253C SF050000 - 2550 SF430000 - 2551 SF240000 - 2552 SF510000 - 2553 SF520000 - 2554 SF390000 - 2555 SF220000 - 2556 SF210000 - 2557 SF250000 - 2558 SF500000 - 2559 SF490000 - 255A SF380000 - 255B SF280000 - 255C SF270000 - 255D SF260000 - 255E SF360000 - 255F SF370000 - 2560 SF420000 - 2561 SF190000 - 2562 SF200000 - 2563 SF230000 - 2564 SF470000 - 2565 SF480000 - 2566 SF410000 - 2567 SF450000 - 2568 SF460000 - 2569 SF400000 - 256A SF540000 - 256B SF530000 - 256C SF440000 - 2580 upblock - 2584 dnblock - 2588 block - 258C lfblock - 2590 rtblock - 2591 ltshade - 2592 shade - 2593 dkshade - 25A0 filledbox - 25A1 H22073 - 25AA H18543 - 25AB H18551 - 25AC filledrect - 25B2 triagup - 25BA triagrt - 25BC triagdn - 25C4 triaglf - 25CA lozenge - 25CB circle - 25CF H18533 - 25D8 invbullet - 25D9 invcircle - 25E6 openbullet - 263A smileface - 263B invsmileface - 263C sun - 2640 female - 2642 male - 2660 spade - 2663 club - 2665 heart - 2666 diamond - 266A musicalnote - 266B musicalnotedbl - F6BE dotlessj - F6BF LL - F6C0 ll - F6C1 Scedilla - F6C2 scedilla - F6C3 commaaccent - F6C4 afii10063 - F6C5 afii10064 - F6C6 afii10192 - F6C7 afii10831 - F6C8 afii10832 - F6C9 Acute - F6CA Caron - F6CB Dieresis - F6CC DieresisAcute - F6CD DieresisGrave - F6CE Grave - F6CF Hungarumlaut - F6D0 Macron - F6D1 cyrBreve - F6D2 cyrFlex - F6D3 dblGrave - F6D4 cyrbreve - F6D5 cyrflex - F6D6 dblgrave - F6D7 dieresisacute - F6D8 dieresisgrave - F6D9 copyrightserif - F6DA registerserif - F6DB trademarkserif - F6DC onefitted - F6DD rupiah - F6DE threequartersemdash - F6DF centinferior - F6E0 centsuperior - F6E1 commainferior - F6E2 commasuperior - F6E3 dollarinferior - F6E4 dollarsuperior - F6E5 hypheninferior - F6E6 hyphensuperior - F6E7 periodinferior - F6E8 periodsuperior - F6E9 asuperior - F6EA bsuperior - F6EB dsuperior - F6EC esuperior - F6ED isuperior - F6EE lsuperior - F6EF msuperior - F6F0 osuperior - F6F1 rsuperior - F6F2 ssuperior - F6F3 tsuperior - F6F4 Brevesmall - F6F5 Caronsmall - F6F6 Circumflexsmall - F6F7 Dotaccentsmall - F6F8 Hungarumlautsmall - F6F9 Lslashsmall - F6FA OEsmall - F6FB Ogoneksmall - F6FC Ringsmall - F6FD Scaronsmall - F6FE Tildesmall - F6FF Zcaronsmall - F721 exclamsmall - F724 dollaroldstyle - F726 ampersandsmall - F730 zerooldstyle - F731 oneoldstyle - F732 twooldstyle - F733 threeoldstyle - F734 fouroldstyle - F735 fiveoldstyle - F736 sixoldstyle - F737 sevenoldstyle - F738 eightoldstyle - F739 nineoldstyle - F73F questionsmall - F760 Gravesmall - F761 Asmall - F762 Bsmall - F763 Csmall - F764 Dsmall - F765 Esmall - F766 Fsmall - F767 Gsmall - F768 Hsmall - F769 Ismall - F76A Jsmall - F76B Ksmall - F76C Lsmall - F76D Msmall - F76E Nsmall - F76F Osmall - F770 Psmall - F771 Qsmall - F772 Rsmall - F773 Ssmall - F774 Tsmall - F775 Usmall - F776 Vsmall - F777 Wsmall - F778 Xsmall - F779 Ysmall - F77A Zsmall - F7A1 exclamdownsmall - F7A2 centoldstyle - F7A8 Dieresissmall - F7AF Macronsmall - F7B4 Acutesmall - F7B8 Cedillasmall - F7BF questiondownsmall - F7E0 Agravesmall - F7E1 Aacutesmall - F7E2 Acircumflexsmall - F7E3 Atildesmall - F7E4 Adieresissmall - F7E5 Aringsmall - F7E6 AEsmall - F7E7 Ccedillasmall - F7E8 Egravesmall - F7E9 Eacutesmall - F7EA Ecircumflexsmall - F7EB Edieresissmall - F7EC Igravesmall - F7ED Iacutesmall - F7EE Icircumflexsmall - F7EF Idieresissmall - F7F0 Ethsmall - F7F1 Ntildesmall - F7F2 Ogravesmall - F7F3 Oacutesmall - F7F4 Ocircumflexsmall - F7F5 Otildesmall - F7F6 Odieresissmall - F7F8 Oslashsmall - F7F9 Ugravesmall - F7FA Uacutesmall - F7FB Ucircumflexsmall - F7FC Udieresissmall - F7FD Yacutesmall - F7FE Thornsmall - F7FF Ydieresissmall - F8E5 radicalex - F8E6 arrowvertex - F8E7 arrowhorizex - F8E8 registersans - F8E9 copyrightsans - F8EA trademarksans - F8EB parenlefttp - F8EC parenleftex - F8ED parenleftbt - F8EE bracketlefttp - F8EF bracketleftex - F8F0 bracketleftbt - F8F1 bracelefttp - F8F2 braceleftmid - F8F3 braceleftbt - F8F4 braceex - F8F5 integralex - F8F6 parenrighttp - F8F7 parenrightex - F8F8 parenrightbt - F8F9 bracketrighttp - F8FA bracketrightex - F8FB bracketrightbt - F8FC bracerighttp - F8FD bracerightmid - F8FE bracerightbt - FB00 ff - FB01 fi - FB02 fl - FB03 ffi - FB04 ffl - FB1F afii57705 - FB2A afii57694 - FB2B afii57695 - FB35 afii57723 - FB4B afii57700 -} - -# precalculate entire prolog when this file is loaded -# (to speed things up) -set ps_preamable "%%BeginProlog\n" -append ps_preamable [CreatePostscriptEncoding [encoding system]] -append ps_preamable { -50 dict begin -% This is a standard prolog for Postscript generated by Tk's canvas -% widget. -% The definitions below just define all of the variables used in -% any of the procedures here. This is needed for obscure reasons -% explained on p. 716 of the Postscript manual (Section H.2.7, -% "Initializing Variables," in the section on Encapsulated Postscript). + # List of adobe glyph names. Converted from glyphlist.txt, downloaded from + # Adobe. -/baseline 0 def -/stipimage 0 def -/height 0 def -/justify 0 def -/lineLength 0 def -/spacing 0 def -/stipple 0 def -/strings 0 def -/xoffset 0 def -/yoffset 0 def -/tmpstip null def + variable psglyphs + array set psglyphs { + 0020 space + 0021 exclam + 0022 quotedbl + 0023 numbersign + 0024 dollar + 0025 percent + 0026 ampersand + 0027 quotesingle + 0028 parenleft + 0029 parenright + 002A asterisk + 002B plus + 002C comma + 002D hyphen + 002E period + 002F slash + 0030 zero + 0031 one + 0032 two + 0033 three + 0034 four + 0035 five + 0036 six + 0037 seven + 0038 eight + 0039 nine + 003A colon + 003B semicolon + 003C less + 003D equal + 003E greater + 003F question + 0040 at + 0041 A + 0042 B + 0043 C + 0044 D + 0045 E + 0046 F + 0047 G + 0048 H + 0049 I + 004A J + 004B K + 004C L + 004D M + 004E N + 004F O + 0050 P + 0051 Q + 0052 R + 0053 S + 0054 T + 0055 U + 0056 V + 0057 W + 0058 X + 0059 Y + 005A Z + 005B bracketleft + 005C backslash + 005D bracketright + 005E asciicircum + 005F underscore + 0060 grave + 0061 a + 0062 b + 0063 c + 0064 d + 0065 e + 0066 f + 0067 g + 0068 h + 0069 i + 006A j + 006B k + 006C l + 006D m + 006E n + 006F o + 0070 p + 0071 q + 0072 r + 0073 s + 0074 t + 0075 u + 0076 v + 0077 w + 0078 x + 0079 y + 007A z + 007B braceleft + 007C bar + 007D braceright + 007E asciitilde + 00A0 space + 00A1 exclamdown + 00A2 cent + 00A3 sterling + 00A4 currency + 00A5 yen + 00A6 brokenbar + 00A7 section + 00A8 dieresis + 00A9 copyright + 00AA ordfeminine + 00AB guillemotleft + 00AC logicalnot + 00AD hyphen + 00AE registered + 00AF macron + 00B0 degree + 00B1 plusminus + 00B2 twosuperior + 00B3 threesuperior + 00B4 acute + 00B5 mu + 00B6 paragraph + 00B7 periodcentered + 00B8 cedilla + 00B9 onesuperior + 00BA ordmasculine + 00BB guillemotright + 00BC onequarter + 00BD onehalf + 00BE threequarters + 00BF questiondown + 00C0 Agrave + 00C1 Aacute + 00C2 Acircumflex + 00C3 Atilde + 00C4 Adieresis + 00C5 Aring + 00C6 AE + 00C7 Ccedilla + 00C8 Egrave + 00C9 Eacute + 00CA Ecircumflex + 00CB Edieresis + 00CC Igrave + 00CD Iacute + 00CE Icircumflex + 00CF Idieresis + 00D0 Eth + 00D1 Ntilde + 00D2 Ograve + 00D3 Oacute + 00D4 Ocircumflex + 00D5 Otilde + 00D6 Odieresis + 00D7 multiply + 00D8 Oslash + 00D9 Ugrave + 00DA Uacute + 00DB Ucircumflex + 00DC Udieresis + 00DD Yacute + 00DE Thorn + 00DF germandbls + 00E0 agrave + 00E1 aacute + 00E2 acircumflex + 00E3 atilde + 00E4 adieresis + 00E5 aring + 00E6 ae + 00E7 ccedilla + 00E8 egrave + 00E9 eacute + 00EA ecircumflex + 00EB edieresis + 00EC igrave + 00ED iacute + 00EE icircumflex + 00EF idieresis + 00F0 eth + 00F1 ntilde + 00F2 ograve + 00F3 oacute + 00F4 ocircumflex + 00F5 otilde + 00F6 odieresis + 00F7 divide + 00F8 oslash + 00F9 ugrave + 00FA uacute + 00FB ucircumflex + 00FC udieresis + 00FD yacute + 00FE thorn + 00FF ydieresis + 0100 Amacron + 0101 amacron + 0102 Abreve + 0103 abreve + 0104 Aogonek + 0105 aogonek + 0106 Cacute + 0107 cacute + 0108 Ccircumflex + 0109 ccircumflex + 010A Cdotaccent + 010B cdotaccent + 010C Ccaron + 010D ccaron + 010E Dcaron + 010F dcaron + 0110 Dcroat + 0111 dcroat + 0112 Emacron + 0113 emacron + 0114 Ebreve + 0115 ebreve + 0116 Edotaccent + 0117 edotaccent + 0118 Eogonek + 0119 eogonek + 011A Ecaron + 011B ecaron + 011C Gcircumflex + 011D gcircumflex + 011E Gbreve + 011F gbreve + 0120 Gdotaccent + 0121 gdotaccent + 0122 Gcommaaccent + 0123 gcommaaccent + 0124 Hcircumflex + 0125 hcircumflex + 0126 Hbar + 0127 hbar + 0128 Itilde + 0129 itilde + 012A Imacron + 012B imacron + 012C Ibreve + 012D ibreve + 012E Iogonek + 012F iogonek + 0130 Idotaccent + 0131 dotlessi + 0132 IJ + 0133 ij + 0134 Jcircumflex + 0135 jcircumflex + 0136 Kcommaaccent + 0137 kcommaaccent + 0138 kgreenlandic + 0139 Lacute + 013A lacute + 013B Lcommaaccent + 013C lcommaaccent + 013D Lcaron + 013E lcaron + 013F Ldot + 0140 ldot + 0141 Lslash + 0142 lslash + 0143 Nacute + 0144 nacute + 0145 Ncommaaccent + 0146 ncommaaccent + 0147 Ncaron + 0148 ncaron + 0149 napostrophe + 014A Eng + 014B eng + 014C Omacron + 014D omacron + 014E Obreve + 014F obreve + 0150 Ohungarumlaut + 0151 ohungarumlaut + 0152 OE + 0153 oe + 0154 Racute + 0155 racute + 0156 Rcommaaccent + 0157 rcommaaccent + 0158 Rcaron + 0159 rcaron + 015A Sacute + 015B sacute + 015C Scircumflex + 015D scircumflex + 015E Scedilla + 015F scedilla + 0160 Scaron + 0161 scaron + 0162 Tcommaaccent + 0163 tcommaaccent + 0164 Tcaron + 0165 tcaron + 0166 Tbar + 0167 tbar + 0168 Utilde + 0169 utilde + 016A Umacron + 016B umacron + 016C Ubreve + 016D ubreve + 016E Uring + 016F uring + 0170 Uhungarumlaut + 0171 uhungarumlaut + 0172 Uogonek + 0173 uogonek + 0174 Wcircumflex + 0175 wcircumflex + 0176 Ycircumflex + 0177 ycircumflex + 0178 Ydieresis + 0179 Zacute + 017A zacute + 017B Zdotaccent + 017C zdotaccent + 017D Zcaron + 017E zcaron + 017F longs + 0192 florin + 01A0 Ohorn + 01A1 ohorn + 01AF Uhorn + 01B0 uhorn + 01E6 Gcaron + 01E7 gcaron + 01FA Aringacute + 01FB aringacute + 01FC AEacute + 01FD aeacute + 01FE Oslashacute + 01FF oslashacute + 0218 Scommaaccent + 0219 scommaaccent + 021A Tcommaaccent + 021B tcommaaccent + 02BC afii57929 + 02BD afii64937 + 02C6 circumflex + 02C7 caron + 02C9 macron + 02D8 breve + 02D9 dotaccent + 02DA ring + 02DB ogonek + 02DC tilde + 02DD hungarumlaut + 0300 gravecomb + 0301 acutecomb + 0303 tildecomb + 0309 hookabovecomb + 0323 dotbelowcomb + 0384 tonos + 0385 dieresistonos + 0386 Alphatonos + 0387 anoteleia + 0388 Epsilontonos + 0389 Etatonos + 038A Iotatonos + 038C Omicrontonos + 038E Upsilontonos + 038F Omegatonos + 0390 iotadieresistonos + 0391 Alpha + 0392 Beta + 0393 Gamma + 0394 Delta + 0395 Epsilon + 0396 Zeta + 0397 Eta + 0398 Theta + 0399 Iota + 039A Kappa + 039B Lambda + 039C Mu + 039D Nu + 039E Xi + 039F Omicron + 03A0 Pi + 03A1 Rho + 03A3 Sigma + 03A4 Tau + 03A5 Upsilon + 03A6 Phi + 03A7 Chi + 03A8 Psi + 03A9 Omega + 03AA Iotadieresis + 03AB Upsilondieresis + 03AC alphatonos + 03AD epsilontonos + 03AE etatonos + 03AF iotatonos + 03B0 upsilondieresistonos + 03B1 alpha + 03B2 beta + 03B3 gamma + 03B4 delta + 03B5 epsilon + 03B6 zeta + 03B7 eta + 03B8 theta + 03B9 iota + 03BA kappa + 03BB lambda + 03BC mu + 03BD nu + 03BE xi + 03BF omicron + 03C0 pi + 03C1 rho + 03C2 sigma1 + 03C3 sigma + 03C4 tau + 03C5 upsilon + 03C6 phi + 03C7 chi + 03C8 psi + 03C9 omega + 03CA iotadieresis + 03CB upsilondieresis + 03CC omicrontonos + 03CD upsilontonos + 03CE omegatonos + 03D1 theta1 + 03D2 Upsilon1 + 03D5 phi1 + 03D6 omega1 + 0401 afii10023 + 0402 afii10051 + 0403 afii10052 + 0404 afii10053 + 0405 afii10054 + 0406 afii10055 + 0407 afii10056 + 0408 afii10057 + 0409 afii10058 + 040A afii10059 + 040B afii10060 + 040C afii10061 + 040E afii10062 + 040F afii10145 + 0410 afii10017 + 0411 afii10018 + 0412 afii10019 + 0413 afii10020 + 0414 afii10021 + 0415 afii10022 + 0416 afii10024 + 0417 afii10025 + 0418 afii10026 + 0419 afii10027 + 041A afii10028 + 041B afii10029 + 041C afii10030 + 041D afii10031 + 041E afii10032 + 041F afii10033 + 0420 afii10034 + 0421 afii10035 + 0422 afii10036 + 0423 afii10037 + 0424 afii10038 + 0425 afii10039 + 0426 afii10040 + 0427 afii10041 + 0428 afii10042 + 0429 afii10043 + 042A afii10044 + 042B afii10045 + 042C afii10046 + 042D afii10047 + 042E afii10048 + 042F afii10049 + 0430 afii10065 + 0431 afii10066 + 0432 afii10067 + 0433 afii10068 + 0434 afii10069 + 0435 afii10070 + 0436 afii10072 + 0437 afii10073 + 0438 afii10074 + 0439 afii10075 + 043A afii10076 + 043B afii10077 + 043C afii10078 + 043D afii10079 + 043E afii10080 + 043F afii10081 + 0440 afii10082 + 0441 afii10083 + 0442 afii10084 + 0443 afii10085 + 0444 afii10086 + 0445 afii10087 + 0446 afii10088 + 0447 afii10089 + 0448 afii10090 + 0449 afii10091 + 044A afii10092 + 044B afii10093 + 044C afii10094 + 044D afii10095 + 044E afii10096 + 044F afii10097 + 0451 afii10071 + 0452 afii10099 + 0453 afii10100 + 0454 afii10101 + 0455 afii10102 + 0456 afii10103 + 0457 afii10104 + 0458 afii10105 + 0459 afii10106 + 045A afii10107 + 045B afii10108 + 045C afii10109 + 045E afii10110 + 045F afii10193 + 0462 afii10146 + 0463 afii10194 + 0472 afii10147 + 0473 afii10195 + 0474 afii10148 + 0475 afii10196 + 0490 afii10050 + 0491 afii10098 + 04D9 afii10846 + 05B0 afii57799 + 05B1 afii57801 + 05B2 afii57800 + 05B3 afii57802 + 05B4 afii57793 + 05B5 afii57794 + 05B6 afii57795 + 05B7 afii57798 + 05B8 afii57797 + 05B9 afii57806 + 05BB afii57796 + 05BC afii57807 + 05BD afii57839 + 05BE afii57645 + 05BF afii57841 + 05C0 afii57842 + 05C1 afii57804 + 05C2 afii57803 + 05C3 afii57658 + 05D0 afii57664 + 05D1 afii57665 + 05D2 afii57666 + 05D3 afii57667 + 05D4 afii57668 + 05D5 afii57669 + 05D6 afii57670 + 05D7 afii57671 + 05D8 afii57672 + 05D9 afii57673 + 05DA afii57674 + 05DB afii57675 + 05DC afii57676 + 05DD afii57677 + 05DE afii57678 + 05DF afii57679 + 05E0 afii57680 + 05E1 afii57681 + 05E2 afii57682 + 05E3 afii57683 + 05E4 afii57684 + 05E5 afii57685 + 05E6 afii57686 + 05E7 afii57687 + 05E8 afii57688 + 05E9 afii57689 + 05EA afii57690 + 05F0 afii57716 + 05F1 afii57717 + 05F2 afii57718 + 060C afii57388 + 061B afii57403 + 061F afii57407 + 0621 afii57409 + 0622 afii57410 + 0623 afii57411 + 0624 afii57412 + 0625 afii57413 + 0626 afii57414 + 0627 afii57415 + 0628 afii57416 + 0629 afii57417 + 062A afii57418 + 062B afii57419 + 062C afii57420 + 062D afii57421 + 062E afii57422 + 062F afii57423 + 0630 afii57424 + 0631 afii57425 + 0632 afii57426 + 0633 afii57427 + 0634 afii57428 + 0635 afii57429 + 0636 afii57430 + 0637 afii57431 + 0638 afii57432 + 0639 afii57433 + 063A afii57434 + 0640 afii57440 + 0641 afii57441 + 0642 afii57442 + 0643 afii57443 + 0644 afii57444 + 0645 afii57445 + 0646 afii57446 + 0647 afii57470 + 0648 afii57448 + 0649 afii57449 + 064A afii57450 + 064B afii57451 + 064C afii57452 + 064D afii57453 + 064E afii57454 + 064F afii57455 + 0650 afii57456 + 0651 afii57457 + 0652 afii57458 + 0660 afii57392 + 0661 afii57393 + 0662 afii57394 + 0663 afii57395 + 0664 afii57396 + 0665 afii57397 + 0666 afii57398 + 0667 afii57399 + 0668 afii57400 + 0669 afii57401 + 066A afii57381 + 066D afii63167 + 0679 afii57511 + 067E afii57506 + 0686 afii57507 + 0688 afii57512 + 0691 afii57513 + 0698 afii57508 + 06A4 afii57505 + 06AF afii57509 + 06BA afii57514 + 06D2 afii57519 + 06D5 afii57534 + 1E80 Wgrave + 1E81 wgrave + 1E82 Wacute + 1E83 wacute + 1E84 Wdieresis + 1E85 wdieresis + 1EF2 Ygrave + 1EF3 ygrave + 200C afii61664 + 200D afii301 + 200E afii299 + 200F afii300 + 2012 figuredash + 2013 endash + 2014 emdash + 2015 afii00208 + 2017 underscoredbl + 2018 quoteleft + 2019 quoteright + 201A quotesinglbase + 201B quotereversed + 201C quotedblleft + 201D quotedblright + 201E quotedblbase + 2020 dagger + 2021 daggerdbl + 2022 bullet + 2024 onedotenleader + 2025 twodotenleader + 2026 ellipsis + 202C afii61573 + 202D afii61574 + 202E afii61575 + 2030 perthousand + 2032 minute + 2033 second + 2039 guilsinglleft + 203A guilsinglright + 203C exclamdbl + 2044 fraction + 2070 zerosuperior + 2074 foursuperior + 2075 fivesuperior + 2076 sixsuperior + 2077 sevensuperior + 2078 eightsuperior + 2079 ninesuperior + 207D parenleftsuperior + 207E parenrightsuperior + 207F nsuperior + 2080 zeroinferior + 2081 oneinferior + 2082 twoinferior + 2083 threeinferior + 2084 fourinferior + 2085 fiveinferior + 2086 sixinferior + 2087 seveninferior + 2088 eightinferior + 2089 nineinferior + 208D parenleftinferior + 208E parenrightinferior + 20A1 colonmonetary + 20A3 franc + 20A4 lira + 20A7 peseta + 20AA afii57636 + 20AB dong + 20AC Euro + 2105 afii61248 + 2111 Ifraktur + 2113 afii61289 + 2116 afii61352 + 2118 weierstrass + 211C Rfraktur + 211E prescription + 2122 trademark + 2126 Omega + 212E estimated + 2135 aleph + 2153 onethird + 2154 twothirds + 215B oneeighth + 215C threeeighths + 215D fiveeighths + 215E seveneighths + 2190 arrowleft + 2191 arrowup + 2192 arrowright + 2193 arrowdown + 2194 arrowboth + 2195 arrowupdn + 21A8 arrowupdnbse + 21B5 carriagereturn + 21D0 arrowdblleft + 21D1 arrowdblup + 21D2 arrowdblright + 21D3 arrowdbldown + 21D4 arrowdblboth + 2200 universal + 2202 partialdiff + 2203 existential + 2205 emptyset + 2206 Delta + 2207 gradient + 2208 element + 2209 notelement + 220B suchthat + 220F product + 2211 summation + 2212 minus + 2215 fraction + 2217 asteriskmath + 2219 periodcentered + 221A radical + 221D proportional + 221E infinity + 221F orthogonal + 2220 angle + 2227 logicaland + 2228 logicalor + 2229 intersection + 222A union + 222B integral + 2234 therefore + 223C similar + 2245 congruent + 2248 approxequal + 2260 notequal + 2261 equivalence + 2264 lessequal + 2265 greaterequal + 2282 propersubset + 2283 propersuperset + 2284 notsubset + 2286 reflexsubset + 2287 reflexsuperset + 2295 circleplus + 2297 circlemultiply + 22A5 perpendicular + 22C5 dotmath + 2302 house + 2310 revlogicalnot + 2320 integraltp + 2321 integralbt + 2329 angleleft + 232A angleright + 2500 SF100000 + 2502 SF110000 + 250C SF010000 + 2510 SF030000 + 2514 SF020000 + 2518 SF040000 + 251C SF080000 + 2524 SF090000 + 252C SF060000 + 2534 SF070000 + 253C SF050000 + 2550 SF430000 + 2551 SF240000 + 2552 SF510000 + 2553 SF520000 + 2554 SF390000 + 2555 SF220000 + 2556 SF210000 + 2557 SF250000 + 2558 SF500000 + 2559 SF490000 + 255A SF380000 + 255B SF280000 + 255C SF270000 + 255D SF260000 + 255E SF360000 + 255F SF370000 + 2560 SF420000 + 2561 SF190000 + 2562 SF200000 + 2563 SF230000 + 2564 SF470000 + 2565 SF480000 + 2566 SF410000 + 2567 SF450000 + 2568 SF460000 + 2569 SF400000 + 256A SF540000 + 256B SF530000 + 256C SF440000 + 2580 upblock + 2584 dnblock + 2588 block + 258C lfblock + 2590 rtblock + 2591 ltshade + 2592 shade + 2593 dkshade + 25A0 filledbox + 25A1 H22073 + 25AA H18543 + 25AB H18551 + 25AC filledrect + 25B2 triagup + 25BA triagrt + 25BC triagdn + 25C4 triaglf + 25CA lozenge + 25CB circle + 25CF H18533 + 25D8 invbullet + 25D9 invcircle + 25E6 openbullet + 263A smileface + 263B invsmileface + 263C sun + 2640 female + 2642 male + 2660 spade + 2663 club + 2665 heart + 2666 diamond + 266A musicalnote + 266B musicalnotedbl + F6BE dotlessj + F6BF LL + F6C0 ll + F6C1 Scedilla + F6C2 scedilla + F6C3 commaaccent + F6C4 afii10063 + F6C5 afii10064 + F6C6 afii10192 + F6C7 afii10831 + F6C8 afii10832 + F6C9 Acute + F6CA Caron + F6CB Dieresis + F6CC DieresisAcute + F6CD DieresisGrave + F6CE Grave + F6CF Hungarumlaut + F6D0 Macron + F6D1 cyrBreve + F6D2 cyrFlex + F6D3 dblGrave + F6D4 cyrbreve + F6D5 cyrflex + F6D6 dblgrave + F6D7 dieresisacute + F6D8 dieresisgrave + F6D9 copyrightserif + F6DA registerserif + F6DB trademarkserif + F6DC onefitted + F6DD rupiah + F6DE threequartersemdash + F6DF centinferior + F6E0 centsuperior + F6E1 commainferior + F6E2 commasuperior + F6E3 dollarinferior + F6E4 dollarsuperior + F6E5 hypheninferior + F6E6 hyphensuperior + F6E7 periodinferior + F6E8 periodsuperior + F6E9 asuperior + F6EA bsuperior + F6EB dsuperior + F6EC esuperior + F6ED isuperior + F6EE lsuperior + F6EF msuperior + F6F0 osuperior + F6F1 rsuperior + F6F2 ssuperior + F6F3 tsuperior + F6F4 Brevesmall + F6F5 Caronsmall + F6F6 Circumflexsmall + F6F7 Dotaccentsmall + F6F8 Hungarumlautsmall + F6F9 Lslashsmall + F6FA OEsmall + F6FB Ogoneksmall + F6FC Ringsmall + F6FD Scaronsmall + F6FE Tildesmall + F6FF Zcaronsmall + F721 exclamsmall + F724 dollaroldstyle + F726 ampersandsmall + F730 zerooldstyle + F731 oneoldstyle + F732 twooldstyle + F733 threeoldstyle + F734 fouroldstyle + F735 fiveoldstyle + F736 sixoldstyle + F737 sevenoldstyle + F738 eightoldstyle + F739 nineoldstyle + F73F questionsmall + F760 Gravesmall + F761 Asmall + F762 Bsmall + F763 Csmall + F764 Dsmall + F765 Esmall + F766 Fsmall + F767 Gsmall + F768 Hsmall + F769 Ismall + F76A Jsmall + F76B Ksmall + F76C Lsmall + F76D Msmall + F76E Nsmall + F76F Osmall + F770 Psmall + F771 Qsmall + F772 Rsmall + F773 Ssmall + F774 Tsmall + F775 Usmall + F776 Vsmall + F777 Wsmall + F778 Xsmall + F779 Ysmall + F77A Zsmall + F7A1 exclamdownsmall + F7A2 centoldstyle + F7A8 Dieresissmall + F7AF Macronsmall + F7B4 Acutesmall + F7B8 Cedillasmall + F7BF questiondownsmall + F7E0 Agravesmall + F7E1 Aacutesmall + F7E2 Acircumflexsmall + F7E3 Atildesmall + F7E4 Adieresissmall + F7E5 Aringsmall + F7E6 AEsmall + F7E7 Ccedillasmall + F7E8 Egravesmall + F7E9 Eacutesmall + F7EA Ecircumflexsmall + F7EB Edieresissmall + F7EC Igravesmall + F7ED Iacutesmall + F7EE Icircumflexsmall + F7EF Idieresissmall + F7F0 Ethsmall + F7F1 Ntildesmall + F7F2 Ogravesmall + F7F3 Oacutesmall + F7F4 Ocircumflexsmall + F7F5 Otildesmall + F7F6 Odieresissmall + F7F8 Oslashsmall + F7F9 Ugravesmall + F7FA Uacutesmall + F7FB Ucircumflexsmall + F7FC Udieresissmall + F7FD Yacutesmall + F7FE Thornsmall + F7FF Ydieresissmall + F8E5 radicalex + F8E6 arrowvertex + F8E7 arrowhorizex + F8E8 registersans + F8E9 copyrightsans + F8EA trademarksans + F8EB parenlefttp + F8EC parenleftex + F8ED parenleftbt + F8EE bracketlefttp + F8EF bracketleftex + F8F0 bracketleftbt + F8F1 bracelefttp + F8F2 braceleftmid + F8F3 braceleftbt + F8F4 braceex + F8F5 integralex + F8F6 parenrighttp + F8F7 parenrightex + F8F8 parenrightbt + F8F9 bracketrighttp + F8FA bracketrightex + F8FB bracketrightbt + F8FC bracerighttp + F8FD bracerightmid + F8FE bracerightbt + FB00 ff + FB01 fi + FB02 fl + FB03 ffi + FB04 ffl + FB1F afii57705 + FB2A afii57694 + FB2B afii57695 + FB35 afii57723 + FB4B afii57700 + } + variable ps_preamble {} -/cstringshow { - { - dup type /stringtype eq - { show } { glyphshow } - ifelse + namespace eval ps { + namespace ensemble create + namespace export {[a-z]*} + proc literal {string} { + upvar 0 ::tk::ps_preamble preamble + foreach line [split $string \n] { + set line [string trim $line] + if {$line eq ""} continue + append preamble $line \n + } + return + } + proc variable {name value} { + upvar 0 ::tk::ps_preamble preamble + append preamble "/$name $value def\n" + return + } + proc function {name body} { + upvar 0 ::tk::ps_preamble preamble + append preamble "/$name \{" + foreach line [split $body \n] { + set line [string trim $line] + # Strip blank lines and comments from the bodies of functions + if {$line eq "" } continue + if {[string match {[%#]*} $line]} continue + append preamble $line " " + } + append preamble "\} bind def\n" + return + } } - forall -} bind def + ps literal { + %%BeginProlog + % This is a standard prolog for Postscript generated by Tk's canvas + % widget. + } + ps variable CurrentEncoding [CreatePostscriptEncoding] + ps literal {50 dict begin} + # The definitions below just define all of the variables used in any of + # the procedures here. This is needed for obscure reasons explained on + # p. 716 of the Postscript manual (Section H.2.7, "Initializing + # Variables," in the section on Encapsulated Postscript). + ps variable baseline 0 + ps variable stipimage 0 + ps variable height 0 + ps variable justify 0 + ps variable lineLength 0 + ps variable spacing 0 + ps variable stipple 0 + ps variable strings 0 + ps variable xoffset 0 + ps variable yoffset 0 + ps variable tmpstip null + ps variable baselineSampler "( TXygqPZ)" + # Put an extra-tall character in; done this way to avoid encoding trouble + ps literal {baselineSampler 0 196 put} -/cstringwidth { - 0 exch 0 exch - { - dup type /stringtype eq - { stringwidth } { - currentfont /Encoding get exch 1 exch put (\001) stringwidth - } - ifelse - exch 3 1 roll add 3 1 roll add exch + ps function cstringshow { + { + dup type /stringtype eq + { show } { glyphshow } + ifelse + } forall } - forall -} bind def -% font ISOEncode font -% This procedure changes the encoding of a font from the default -% Postscript encoding to current system encoding. It's typically invoked just -% before invoking "setfont". The body of this procedure comes from -% Section 5.6.1 of the Postscript book. + ps function cstringwidth { + 0 exch 0 exch + { + dup type /stringtype eq + { stringwidth } { + currentfont /Encoding get exch 1 exch put (\001) + stringwidth + } + ifelse + exch 3 1 roll add 3 1 roll add exch + } forall + } -/ISOEncode { - dup length dict begin + # font ISOEncode font + # + # This procedure changes the encoding of a font from the default + # Postscript encoding to current system encoding. It's typically invoked + # just before invoking "setfont". The body of this procedure comes from + # Section 5.6.1 of the Postscript book. + ps function ISOEncode { + dup length dict begin {1 index /FID ne {def} {pop pop} ifelse} forall /Encoding CurrentEncoding def currentdict - end - - % I'm not sure why it's necessary to use "definefont" on this new - % font, but it seems to be important; just use the name "Temporary" - % for the font. - - /Temporary exch definefont -} bind def - -% StrokeClip -% -% This procedure converts the current path into a clip area under -% the assumption of stroking. It's a bit tricky because some Postscript -% interpreters get errors during strokepath for dashed lines. If -% this happens then turn off dashes and try again. - -/StrokeClip { - {strokepath} stopped { - (This Postscript printer gets limitcheck overflows when) = - (stippling dashed lines; lines will be printed solid instead.) = - [] 0 setdash strokepath} if - clip -} bind def - -% desiredSize EvenPixels closestSize -% -% The procedure below is used for stippling. Given the optimal size -% of a dot in a stipple pattern in the current user coordinate system, -% compute the closest size that is an exact multiple of the device's -% pixel size. This allows stipple patterns to be displayed without -% aliasing effects. - -/EvenPixels { - % Compute exact number of device pixels per stipple dot. - dup 0 matrix currentmatrix dtransform - dup mul exch dup mul add sqrt - - % Round to an integer, make sure the number is at least 1, and compute - % user coord distance corresponding to this. - dup round dup 1 lt {pop 1} if - exch div mul -} bind def - -% width height string StippleFill -- -% -% Given a path already set up and a clipping region generated from -% it, this procedure will fill the clipping region with a stipple -% pattern. "String" contains a proper image description of the -% stipple pattern and "width" and "height" give its dimensions. Each -% stipple dot is assumed to be about one unit across in the current -% user coordinate system. This procedure trashes the graphics state. - -/StippleFill { - % The following code is needed to work around a NeWSprint bug. - - /tmpstip 1 index def - - % Change the scaling so that one user unit in user coordinates - % corresponds to the size of one stipple dot. - 1 EvenPixels dup scale - - % Compute the bounding box occupied by the path (which is now - % the clipping region), and round the lower coordinates down - % to the nearest starting point for the stipple pattern. Be - % careful about negative numbers, since the rounding works - % differently on them. - - pathbbox - 4 2 roll - 5 index div dup 0 lt {1 sub} if cvi 5 index mul 4 1 roll - 6 index div dup 0 lt {1 sub} if cvi 6 index mul 3 2 roll + end + % I'm not sure why it's necessary to use "definefont" on this new + % font, but it seems to be important; just use the name "Temporary" + % for the font. + /Temporary exch definefont + } - % Stack now: width height string y1 y2 x1 x2 - % Below is a doubly-nested for loop to iterate across this area - % in units of the stipple pattern size, going up columns then - % across rows, blasting out a stipple-pattern-sized rectangle at - % each position + # StrokeClip + # + # This procedure converts the current path into a clip area under the + # assumption of stroking. It's a bit tricky because some Postscript + # interpreters get errors during strokepath for dashed lines. If this + # happens then turn off dashes and try again. + ps function StrokeClip { + {strokepath} stopped { + (This Postscript printer gets limitcheck overflows when) = + (stippling dashed lines; lines will be printed solid instead.) = + [] 0 setdash strokepath} if + clip + } - 6 index exch { - 2 index 5 index 3 index { - % Stack now: width height string y1 y2 x y + # desiredSize EvenPixels closestSize + # + # The procedure below is used for stippling. Given the optimal size of a + # dot in a stipple pattern in the current user coordinate system, compute + # the closest size that is an exact multiple of the device's pixel + # size. This allows stipple patterns to be displayed without aliasing + # effects. + ps function EvenPixels { + % Compute exact number of device pixels per stipple dot. + dup 0 matrix currentmatrix dtransform + dup mul exch dup mul add sqrt + % Round to an integer, make sure the number is at least 1, and + % compute user coord distance corresponding to this. + dup round dup 1 lt {pop 1} if + exch div mul + } - gsave - 1 index exch translate - 5 index 5 index true matrix tmpstip imagemask - grestore + # width height string StippleFill -- + # + # Given a path already set up and a clipping region generated from it, + # this procedure will fill the clipping region with a stipple pattern. + # "String" contains a proper image description of the stipple pattern and + # "width" and "height" give its dimensions. Each stipple dot is assumed to + # be about one unit across in the current user coordinate system. This + # procedure trashes the graphics state. + ps function StippleFill { + % The following code is needed to work around a NeWSprint bug. + /tmpstip 1 index def + % Change the scaling so that one user unit in user coordinates + % corresponds to the size of one stipple dot. + 1 EvenPixels dup scale + % Compute the bounding box occupied by the path (which is now the + % clipping region), and round the lower coordinates down to the + % nearest starting point for the stipple pattern. Be careful about + % negative numbers, since the rounding works differently on them. + pathbbox + 4 2 roll + 5 index div dup 0 lt {1 sub} if cvi 5 index mul 4 1 roll + 6 index div dup 0 lt {1 sub} if cvi 6 index mul 3 2 roll + % Stack now: width height string y1 y2 x1 x2 + % Below is a doubly-nested for loop to iterate across this area + % in units of the stipple pattern size, going up columns then + % across rows, blasting out a stipple-pattern-sized rectangle at + % each position + 6 index exch { + 2 index 5 index 3 index { + % Stack now: width height string y1 y2 x y + gsave + 1 index exch translate + 5 index 5 index true matrix tmpstip imagemask + grestore + } for + pop } for - pop - } for - pop pop pop pop pop -} bind def - -% -- AdjustColor -- -% Given a color value already set for output by the caller, adjusts -% that value to a grayscale or mono value if requested by the CL -% variable. + pop pop pop pop pop + } -/AdjustColor { - CL 2 lt { - currentgray - CL 0 eq { - .5 lt {0} {1} ifelse + # -- AdjustColor -- + # + # Given a color value already set for output by the caller, adjusts that + # value to a grayscale or mono value if requested by the CL variable. + ps function AdjustColor { + CL 2 lt { + currentgray + CL 0 eq { + .5 lt {0} {1} ifelse + } if + setgray } if - setgray - } if -} bind def - -% x y strings spacing xoffset yoffset justify stipple DrawText -- -% This procedure does all of the real work of drawing text. The -% color and font must already have been set by the caller, and the -% following arguments must be on the stack: -% -% x, y - Coordinates at which to draw text. -% strings - An array of strings, one for each line of the text item, -% in order from top to bottom. -% spacing - Spacing between lines. -% xoffset - Horizontal offset for text bbox relative to x and y: 0 for -% nw/w/sw anchor, -0.5 for n/center/s, and -1.0 for ne/e/se. -% yoffset - Vertical offset for text bbox relative to x and y: 0 for -% nw/n/ne anchor, +0.5 for w/center/e, and +1.0 for sw/s/se. -% justify - 0 for left justification, 0.5 for center, 1 for right justify. -% stipple - Boolean value indicating whether or not text is to be -% drawn in stippled fashion. If text is stippled, -% procedure StippleText must have been defined to call -% StippleFill in the right way. -% -% Also, when this procedure is invoked, the color and font must already -% have been set for the text. - -/DrawText { - /stipple exch def - /justify exch def - /yoffset exch def - /xoffset exch def - /spacing exch def - /strings exch def - - % First scan through all of the text to find the widest line. + } - /lineLength 0 def - strings { - cstringwidth pop - dup lineLength gt {/lineLength exch def} {pop} ifelse + # x y strings spacing xoffset yoffset justify stipple DrawText -- + # + # This procedure does all of the real work of drawing text. The color and + # font must already have been set by the caller, and the following + # arguments must be on the stack: + # + # x, y - Coordinates at which to draw text. + # strings - An array of strings, one for each line of the text item, in + # order from top to bottom. + # spacing - Spacing between lines. + # xoffset - Horizontal offset for text bbox relative to x and y: 0 for + # nw/w/sw anchor, -0.5 for n/center/s, and -1.0 for ne/e/se. + # yoffset - Vertical offset for text bbox relative to x and y: 0 for + # nw/n/ne anchor, +0.5 for w/center/e, and +1.0 for sw/s/se. + # justify - 0 for left justification, 0.5 for center, 1 for right justify. + # stipple - Boolean value indicating whether or not text is to be drawn in + # stippled fashion. If text is stippled, function StippleText + # must have been defined to call StippleFill in the right way. + # + # Also, when this procedure is invoked, the color and font must already + # have been set for the text. + ps function DrawText { + /stipple exch def + /justify exch def + /yoffset exch def + /xoffset exch def + /spacing exch def + /strings exch def + % First scan through all of the text to find the widest line. + /lineLength 0 def + strings { + cstringwidth pop + dup lineLength gt {/lineLength exch def} {pop} ifelse + newpath + } forall + % Compute the baseline offset and the actual font height. + 0 0 moveto baselineSampler false charpath + pathbbox dup /baseline exch def + exch pop exch sub /height exch def pop newpath - } forall - - % Compute the baseline offset and the actual font height. - - 0 0 moveto (TXygqPZ) false charpath - pathbbox dup /baseline exch def - exch pop exch sub /height exch def pop - newpath - - % Translate coordinates first so that the origin is at the upper-left - % corner of the text's bounding box. Remember that x and y for - % positioning are still on the stack. - - translate - lineLength xoffset mul - strings length 1 sub spacing mul height add yoffset mul translate - - % Now use the baseline and justification information to translate so - % that the origin is at the baseline and positioning point for the - % first line of text. - - justify lineLength mul baseline neg translate - - % Iterate over each of the lines to output it. For each line, - % compute its width again so it can be properly justified, then - % display it. + % Translate and rotate coordinates first so that the origin is at + % the upper-left corner of the text's bounding box. Remember that + % angle for rotating, and x and y for positioning are still on the + % stack. + translate + rotate + lineLength xoffset mul + strings length 1 sub spacing mul height add yoffset mul translate + % Now use the baseline and justification information to translate + % so that the origin is at the baseline and positioning point for + % the first line of text. + justify lineLength mul baseline neg translate + % Iterate over each of the lines to output it. For each line, + % compute its width again so it can be properly justified, then + % display it. + strings { + dup cstringwidth pop + justify neg mul 0 moveto + stipple { + % The text is stippled, so turn it into a path and print + % by calling StippledText, which in turn calls + % StippleFill. Unfortunately, many Postscript interpreters + % will get overflow errors if we try to do the whole + % string at once, so do it a character at a time. + gsave + /char (X) def + { + dup type /stringtype eq { + % This segment is a string. + { + char 0 3 -1 roll put + currentpoint + gsave + char true charpath clip StippleText + grestore + char stringwidth translate + moveto + } forall + } { + % This segment is glyph name + % Temporary override + currentfont /Encoding get exch 1 exch put + currentpoint + gsave (\001) true charpath clip StippleText + grestore + (\001) stringwidth translate + moveto + } ifelse + } forall + grestore + } {cstringshow} ifelse + 0 spacing neg translate + } forall + } - strings { - dup cstringwidth pop - justify neg mul 0 moveto - stipple { - - - % The text is stippled, so turn it into a path and print - % by calling StippledText, which in turn calls StippleFill. - % Unfortunately, many Postscript interpreters will get - % overflow errors if we try to do the whole string at - % once, so do it a character at a time. + # Define the "TkPhoto" function variants, which are modified versions + # of the original "transparentimage" function posted by ian@five-d.com + # (Ian Kemmish) to comp.lang.postscript. For a monochrome colorLevel + # this is a slightly different version that uses the imagemask command + # instead of image. - gsave - /char (X) def + ps function TkPhotoColor { + gsave + 32 dict begin + /tinteger exch def + /transparent 1 string def + transparent 0 tinteger put + /olddict exch def + olddict /DataSource get dup type /filetype ne { + olddict /DataSource 3 -1 roll + 0 () /SubFileDecode filter put + } { + pop + } ifelse + /newdict olddict maxlength dict def + olddict newdict copy pop + /w newdict /Width get def + /crpp newdict /Decode get length 2 idiv def + /str w string def + /pix w crpp mul string def + /substrlen 2 w log 2 log div floor exp cvi def + /substrs [ { + substrlen string + 0 1 substrlen 1 sub { + 1 index exch tinteger put + } for + /substrlen substrlen 2 idiv def + substrlen 0 eq {exit} if + } loop ] def + /h newdict /Height get def + 1 w div 1 h div matrix scale + olddict /ImageMatrix get exch matrix concatmatrix + matrix invertmatrix concat + newdict /Height 1 put + newdict /DataSource pix put + /mat [w 0 0 h 0 0] def + newdict /ImageMatrix mat put + 0 1 h 1 sub { + mat 5 3 -1 roll neg put + olddict /DataSource get str readstring pop pop + /tail str def + /x 0 def + olddict /DataSource get pix readstring pop pop { - dup type /stringtype eq { - % This segment is a string. - { - char 0 3 -1 roll put - currentpoint - gsave - char true charpath clip StippleText - grestore - char stringwidth translate - moveto - } forall - } { - % This segment is glyph name - % Temporary override - currentfont /Encoding get exch 1 exch put - currentpoint - gsave (\001) true charpath clip StippleText - grestore - (\001) stringwidth translate - moveto - } ifelse - } forall - grestore - } {cstringshow} ifelse - 0 spacing neg translate - } forall -} bind def - -%%EndProlog -} + tail transparent search dup /done exch not def + {exch pop exch pop} if + /w1 exch length def + w1 0 ne { + newdict /DataSource + pix x crpp mul w1 crpp mul getinterval put + newdict /Width w1 put + mat 4 x neg put + /x x w1 add def + newdict image + /tail tail w1 tail length w1 sub getinterval def + } if + done {exit} if + tail substrs { + anchorsearch {pop} if + } forall + /tail exch def + tail length 0 eq {exit} if + /x w tail length sub def + } loop + } for + end + grestore + } + ps function TkPhotoMono { + gsave + 32 dict begin + /dummyInteger exch def + /olddict exch def + olddict /DataSource get dup type /filetype ne { + olddict /DataSource 3 -1 roll + 0 () /SubFileDecode filter put + } { + pop + } ifelse + /newdict olddict maxlength dict def + olddict newdict copy pop + /w newdict /Width get def + /pix w 7 add 8 idiv string def + /h newdict /Height get def + 1 w div 1 h div matrix scale + olddict /ImageMatrix get exch matrix concatmatrix + matrix invertmatrix concat + newdict /Height 1 put + newdict /DataSource pix put + /mat [w 0 0 h 0 0] def + newdict /ImageMatrix mat put + 0 1 h 1 sub { + mat 5 3 -1 roll neg put + 0.000 0.000 0.000 setrgbcolor + olddict /DataSource get pix readstring pop pop + newdict /DataSource pix put + newdict imagemask + 1.000 1.000 1.000 setrgbcolor + olddict /DataSource get pix readstring pop pop + newdict /DataSource pix put + newdict imagemask + } for + end + grestore + } + ps literal %%EndProlog } proc tk::ensure_psenc_is_loaded {} { diff --git a/library/msgbox.tcl b/library/msgbox.tcl index 572510a..6d329c2 100644 --- a/library/msgbox.tcl +++ b/library/msgbox.tcl @@ -111,7 +111,7 @@ static unsigned char w3_bits[] = { 0x00, 0xc0, 0x03, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};" - + # ::tk::MessageBox -- # # Pops up a messagebox with an application-supplied message with @@ -129,7 +129,7 @@ static unsigned char w3_bits[] = { # See the user documentation for details on what tk_messageBox does. # proc ::tk::MessageBox {args} { - global tcl_platform tk_strictMotif + global tk_strictMotif variable ::tk::Priv set w ::tk::PrivMsgBox @@ -137,7 +137,7 @@ proc ::tk::MessageBox {args} { # # The default value of the title is space (" ") not the empty string - # because for some window managers, a + # because for some window managers, a # wm title .foo "" # causes the window title to be "foo" instead of the empty string. # @@ -153,8 +153,9 @@ proc ::tk::MessageBox {args} { tclParseConfigSpec $w $specs "" $args - if {[lsearch -exact {info warning error question} $data(-icon)] == -1} { - error "bad -icon value \"$data(-icon)\": must be error, info, question, or warning" + if {$data(-icon) ni {info warning error question}} { + return -code error -errorcode [list TK LOOKUP ICON $data(-icon)] \ + "bad -icon value \"$data(-icon)\": must be error, info, question, or warning" } set windowingsystem [tk windowingsystem] if {$windowingsystem eq "aqua"} { @@ -169,11 +170,12 @@ proc ::tk::MessageBox {args} { } if {![winfo exists $data(-parent)]} { - error "bad window path name \"$data(-parent)\"" + return -code error -errorcode [list TK LOOKUP WINDOW $data(-parent)] \ + "bad window path name \"$data(-parent)\"" } switch -- $data(-type) { - abortretryignore { + abortretryignore { set names [list abort retry ignore] set labels [list &Abort &Retry &Ignore] set cancel abort @@ -204,9 +206,10 @@ proc ::tk::MessageBox {args} { set cancel cancel } default { - error "bad -type value \"$data(-type)\": must be\ - abortretryignore, ok, okcancel, retrycancel,\ - yesno, or yesnocancel" + return -code error -errorcode [list TK LOOKUP DLG_TYPE $data(-type)] \ + "bad -type value \"$data(-type)\": must be\ + abortretryignore, ok, okcancel, retrycancel,\ + yesno, or yesnocancel" } } @@ -215,7 +218,7 @@ proc ::tk::MessageBox {args} { lappend buttons [list $name -text [mc $lab]] } - # If no default button was specified, the default default is the + # If no default button was specified, the default default is the # first button (Bug: 2218). if {$data(-default) eq ""} { @@ -230,7 +233,8 @@ proc ::tk::MessageBox {args} { } } if {!$valid} { - error "invalid default button \"$data(-default)\"" + return -code error -errorcode {TK MSGBOX DEFAULT} \ + "invalid default button \"$data(-default)\"" } # 2. Set the dialog to be a child window of $parent @@ -271,15 +275,11 @@ proc ::tk::MessageBox {args} { wm attributes $w -type dialog } - ttk::frame $w.bot;# -background $bg + ttk::frame $w.bot grid anchor $w.bot center pack $w.bot -side bottom -fill both - ttk::frame $w.top;# -background $bg + ttk::frame $w.top pack $w.top -side top -fill both -expand 1 - if {$windowingsystem ne "aqua"} { - #$w.bot configure -relief raised -bd 1 - #$w.top configure -relief raised -bd 1 - } # 4. Fill the top part with bitmap, message and detail (use the # option database for -wraplength and -font so that they can be @@ -291,53 +291,32 @@ proc ::tk::MessageBox {args} { option add *Dialog.dtl.font TkDefaultFont widgetDefault ttk::label $w.msg -anchor nw -justify left -text $data(-message) - #-background $bg if {$data(-detail) ne ""} { ttk::label $w.dtl -anchor nw -justify left -text $data(-detail) - #-background $bg } if {$data(-icon) ne ""} { - if {$windowingsystem eq "aqua" - || ([winfo depth $w] < 4) || $tk_strictMotif} { + if {([winfo depth $w] < 4) || $tk_strictMotif} { # ttk::label has no -bitmap option - label $w.bitmap -bitmap $data(-icon);# -background $bg + label $w.bitmap -bitmap $data(-icon) -background $bg } else { - canvas $w.bitmap -width 32 -height 32 -highlightthickness 0 \ - -background $bg switch $data(-icon) { - error { - $w.bitmap create oval 0 0 31 31 -fill red -outline black - $w.bitmap create line 9 9 23 23 -fill white -width 4 - $w.bitmap create line 9 23 23 9 -fill white -width 4 - } - info { - $w.bitmap create image 0 0 -anchor nw \ - -image ::tk::dialog::b1 - $w.bitmap create image 0 0 -anchor nw \ - -image ::tk::dialog::b2 - $w.bitmap create image 0 0 -anchor nw \ - -image ::tk::dialog::i - } - question { - $w.bitmap create image 0 0 -anchor nw \ - -image ::tk::dialog::b1 - $w.bitmap create image 0 0 -anchor nw \ - -image ::tk::dialog::b2 - $w.bitmap create image 0 0 -anchor nw \ - -image ::tk::dialog::q - } - default { - $w.bitmap create image 0 0 -anchor nw \ - -image ::tk::dialog::w1 - $w.bitmap create image 0 0 -anchor nw \ - -image ::tk::dialog::w2 - $w.bitmap create image 0 0 -anchor nw \ - -image ::tk::dialog::w3 - } + error { + ttk::label $w.bitmap -image ::tk::icons::error + } + info { + ttk::label $w.bitmap -image ::tk::icons::information + } + question { + ttk::label $w.bitmap -image ::tk::icons::question + } + default { + ttk::label $w.bitmap -image ::tk::icons::warning + } } } } grid $w.bitmap $w.msg -in $w.top -sticky news -padx 2m -pady 2m + grid configure $w.bitmap -sticky nw grid columnconfigure $w.top 1 -weight 1 if {$data(-detail) ne ""} { grid ^ $w.dtl -in $w.top -sticky news -padx 2m -pady {0 2m} @@ -360,7 +339,6 @@ proc ::tk::MessageBox {args} { eval [list tk::AmpWidget ttk::button $w.$name] $opts \ [list -command [list set tk::Priv(button) $name]] - # -padx 3m if {$name eq $data(-default)} { $w.$name configure -default active diff --git a/library/msgs/cs.msg b/library/msgs/cs.msg index cd86ca9..d6be730 100644 --- a/library/msgs/cs.msg +++ b/library/msgs/cs.msg @@ -1,72 +1,65 @@ namespace eval ::tk { ::msgcat::mcset cs "&Abort" "&P\u0159eru\u0161it" ::msgcat::mcset cs "&About..." "&O programu..." - ::msgcat::mcset cs "&Blue" "&Modr\341" - ::msgcat::mcset cs "&Cancel" "&Zru\u0161it" - ::msgcat::mcset cs "&Clear Console" "&Smazat konzolu" - ::msgcat::mcset cs "&Copy" "&Kop\355rovat" - ::msgcat::mcset cs "&Delete" "&Smazat" - ::msgcat::mcset cs "&Directory:" "&Adres\341\u0159:" - ::msgcat::mcset cs "&Edit" "&\332pravy" - ::msgcat::mcset cs "&File" "&Soubor" - ::msgcat::mcset cs "&Filter" "&Filtr" - ::msgcat::mcset cs "&Green" "Ze&len\341" - ::msgcat::mcset cs "&Help" "&N\341pov\u011bda" - ::msgcat::mcset cs "&Hide Console" "&Schovat Konzolu" - ::msgcat::mcset cs "&Ignore" "&Ignorovat" - ::msgcat::mcset cs "&No" "&Ne" - ::msgcat::mcset cs "&OK" - ::msgcat::mcset cs "&Open" "&Otev\u0159\355t" - ::msgcat::mcset cs "&Quit" "&Ukon\u010dit" - ::msgcat::mcset cs "&Red" "\u010ce&rven\341" - ::msgcat::mcset cs "&Retry" "Z&novu" - ::msgcat::mcset cs "&Save" "&Ulo\u017eit" - ::msgcat::mcset cs "&Selection:" "&V\375b\u011br:" - ::msgcat::mcset cs "&Source..." "&Zdroj..." - ::msgcat::mcset cs "&Yes" "&Ano" - ::msgcat::mcset cs "About..." "O programu..." ::msgcat::mcset cs "All Files" "V\u0161echny 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 "Cl&ear" "Sma&zat" - ::msgcat::mcset cs "Clear" "Smazat" + ::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 "&Copy" "&Kop\355rovat" ::msgcat::mcset cs "Cu&t" "V&y\u0159\355znout" - ::msgcat::mcset cs "Cut" "Vy\u0159\355znout" - ::msgcat::mcset cs "Delete" "Smazat" + ::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 "E&xit" "&Konec" + ::msgcat::mcset cs "&Directory:" "&Adres\341\u0159:" + ::msgcat::mcset cs "&Edit" "&\332pravy" ::msgcat::mcset cs "Error: %1\$s" "Chyba: %1\$s" - ::msgcat::mcset cs "Exit" "Konec" - ::msgcat::mcset cs "Fi&les:" "Sou&bory:" - ::msgcat::mcset cs "Fil&ter:" "Fil&tr:" - ::msgcat::mcset cs "File \"%1\$s\" already exists.\n\n" "Soubor \"%1\$s\" ji\u017e existuje.\n\n" + ::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\" 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 "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 "Hi" "Ahoj" - ::msgcat::mcset cs "Hide Console" "Skr\375t konsolu" + ::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 "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 "Paste" "Vlo\u017eit" - ::msgcat::mcset cs "Quit" "Skon\u010dit" + ::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 "&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 "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 "Source..." "Nahr\341t..." + ::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" diff --git a/library/msgs/da.msg b/library/msgs/da.msg index c749608..c302c79 100644 --- a/library/msgs/da.msg +++ b/library/msgs/da.msg @@ -4,10 +4,11 @@ namespace eval ::tk { ::msgcat::mcset da "All Files" "Alle filer" ::msgcat::mcset da "Application Error" "Programfejl" ::msgcat::mcset da "&Blue" "&Bl\u00E5" + ::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 "&Clear" "&Ryd" + ::msgcat::mcset da "Cl&ear" "&Ryd" ::msgcat::mcset da "&Clear Console" "&Ryd konsolen" ::msgcat::mcset da "Color" "Farve" ::msgcat::mcset da "Console" "Konsol" @@ -38,8 +39,8 @@ namespace eval ::tk { ::msgcat::mcset da "Invalid file name \"%1\$s\"." "Ugyldig fil navn \"%1\$s\"." ::msgcat::mcset da "Log Files" "Logfiler" ::msgcat::mcset da "&No" "&Nej" - ::msgcat::mcset da "OK" "O.K." ::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" diff --git a/library/msgs/de.msg b/library/msgs/de.msg index 7750313..e420f8a 100644 --- a/library/msgs/de.msg +++ b/library/msgs/de.msg @@ -3,7 +3,11 @@ namespace eval ::tk { ::msgcat::mcset de "&About..." "&\u00dcber..." ::msgcat::mcset de "All Files" "Alle Dateien" ::msgcat::mcset de "Application Error" "Applikationsfehler" + ::msgcat::mcset de "&Apply" "&Anwenden" + ::msgcat::mcset de "Bold" "Fett" + ::msgcat::mcset de "Bold Italic" "Fett kursiv" ::msgcat::mcset de "&Blue" "&Blau" + ::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" @@ -18,6 +22,7 @@ namespace eval ::tk { ::msgcat::mcset de "Directory \"%1\$s\" does not exist." "Das Verzeichnis \"%1\$s\" existiert nicht." ::msgcat::mcset de "&Directory:" "&Verzeichnis:" ::msgcat::mcset de "&Edit" "&Bearbeiten" + ::msgcat::mcset de "Effects" "Effekte" ::msgcat::mcset de "Error: %1\$s" "Fehler: %1\$s" ::msgcat::mcset de "E&xit" "&Ende" ::msgcat::mcset de "&File" "&Datei" @@ -30,15 +35,20 @@ namespace eval ::tk { ::msgcat::mcset de "Fi&les:" "Dat&eien:" ::msgcat::mcset de "&Filter" ::msgcat::mcset de "Fil&ter:" + ::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 "&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 "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" @@ -46,21 +56,26 @@ namespace eval ::tk { ::msgcat::mcset de "P&aste" "E&inf\u00fcgen" ::msgcat::mcset de "&Quit" "&Beenden" ::msgcat::mcset de "&Red" "&Rot" + ::msgcat::mcset de "Regular" "Standard" ::msgcat::mcset de "Replace existing file?" "Existierende Datei ersetzen?" ::msgcat::mcset de "&Retry" "&Wiederholen" + ::msgcat::mcset de "Sample" "Beispiel" ::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 "&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 "Stri&keout" "&Durchgestrichen" ::msgcat::mcset de "Tcl Scripts" "Tcl-Skripte" ::msgcat::mcset de "Tcl for Windows" "Tcl f\u00fcr Windows" ::msgcat::mcset de "Text Files" "Textdateien" + ::msgcat::mcset de "&Underline" "&Unterstrichen" ::msgcat::mcset de "&Yes" "&Ja" ::msgcat::mcset de "abort" "abbrechen" ::msgcat::mcset de "blue" "blau" diff --git a/library/msgs/el.msg b/library/msgs/el.msg index 1dcc451..2e3f236 100644 --- a/library/msgs/el.msg +++ b/library/msgs/el.msg @@ -47,12 +47,13 @@ namespace eval ::tk { ::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 "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" ::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 "Paste" "\u0395\u03c0\u03b9\u03ba\u03cc\u03bb\u03bb\u03b7\u03c3\u03b7" + ::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 "Replace existing file?" \ @@ -66,7 +67,7 @@ namespace eval ::tk { "\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 "&Source..." "\u0395\u03ba\u03c4\u03ad\u03bb\u03b5\u03c3\u03b7..." ::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" @@ -83,4 +84,3 @@ namespace eval ::tk { ::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" } - diff --git a/library/msgs/en.msg b/library/msgs/en.msg index b4e51bf..5ad1094 100644 --- a/library/msgs/en.msg +++ b/library/msgs/en.msg @@ -3,7 +3,11 @@ namespace eval ::tk { ::msgcat::mcset en "&About..." ::msgcat::mcset en "All Files" ::msgcat::mcset en "Application Error" + ::msgcat::mcset en "&Apply" + ::msgcat::mcset en "Bold" + ::msgcat::mcset en "Bold Italic" ::msgcat::mcset en "&Blue" + ::msgcat::mcset en "Cancel" ::msgcat::mcset en "&Cancel" ::msgcat::mcset en "Cannot change to the directory \"%1\$s\".\nPermission denied." ::msgcat::mcset en "Choose Directory" @@ -18,6 +22,7 @@ namespace eval ::tk { ::msgcat::mcset en "Directory \"%1\$s\" does not exist." ::msgcat::mcset en "&Directory:" ::msgcat::mcset en "&Edit" + ::msgcat::mcset en "Effects" ::msgcat::mcset en "Error: %1\$s" ::msgcat::mcset en "E&xit" ::msgcat::mcset en "&File" @@ -30,15 +35,20 @@ namespace eval ::tk { ::msgcat::mcset en "Fi&les:" ::msgcat::mcset en "&Filter" ::msgcat::mcset en "Fil&ter:" + ::msgcat::mcset en "Font" + ::msgcat::mcset en "&Font:" + ::msgcat::mcset en "Font st&yle:" ::msgcat::mcset en "&Green" ::msgcat::mcset en "&Help" ::msgcat::mcset en "Hi" ::msgcat::mcset en "&Hide Console" ::msgcat::mcset en "&Ignore" ::msgcat::mcset en "Invalid file name \"%1\$s\"." + ::msgcat::mcset en "Italic" ::msgcat::mcset en "Log Files" ::msgcat::mcset en "&No" ::msgcat::mcset en "&OK" + ::msgcat::mcset en "OK" ::msgcat::mcset en "Ok" ::msgcat::mcset en "Open" ::msgcat::mcset en "&Open" @@ -46,21 +56,26 @@ namespace eval ::tk { ::msgcat::mcset en "P&aste" ::msgcat::mcset en "&Quit" ::msgcat::mcset en "&Red" + ::msgcat::mcset en "Regular" ::msgcat::mcset en "Replace existing file?" ::msgcat::mcset en "&Retry" + ::msgcat::mcset en "Sample" ::msgcat::mcset en "&Save" ::msgcat::mcset en "Save As" ::msgcat::mcset en "Save To Log" ::msgcat::mcset en "Select Log File" ::msgcat::mcset en "Select a file to source" ::msgcat::mcset en "&Selection:" + ::msgcat::mcset en "&Size:" ::msgcat::mcset en "Show &Hidden Directories" ::msgcat::mcset en "Show &Hidden Files and Directories" ::msgcat::mcset en "Skip Messages" ::msgcat::mcset en "&Source..." + ::msgcat::mcset en "Stri&keout" ::msgcat::mcset en "Tcl Scripts" ::msgcat::mcset en "Tcl for Windows" ::msgcat::mcset en "Text Files" + ::msgcat::mcset en "&Underline" ::msgcat::mcset en "&Yes" ::msgcat::mcset en "abort" ::msgcat::mcset en "blue" diff --git a/library/msgs/eo.msg b/library/msgs/eo.msg index 85436c3..3645630 100644 --- a/library/msgs/eo.msg +++ b/library/msgs/eo.msg @@ -4,10 +4,11 @@ namespace eval ::tk { ::msgcat::mcset eo "All Files" "\u0108ioj dosieroj" ::msgcat::mcset eo "Application Error" "Aplikoerraro" ::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 \u0109angi al dosierulon \"%1\$s\".\nVi ne rajtas tion." ::msgcat::mcset eo "Choose Directory" "Elektu Dosierujo" - ::msgcat::mcset eo "&Clear" "&Klaru" + ::msgcat::mcset eo "Cl&ear" "&Klaru" ::msgcat::mcset eo "&Clear Console" "&Klaru konzolon" ::msgcat::mcset eo "Color" "Farbo" ::msgcat::mcset eo "Console" "Konzolo" @@ -38,6 +39,7 @@ namespace eval ::tk { ::msgcat::mcset eo "Invalid file name \"%1\$s\"." "Malvalida dosieronomo \"%1\$s\"." ::msgcat::mcset eo "Log Files" "Protokolo" ::msgcat::mcset eo "&No" "&Ne" + ::msgcat::mcset eo "&OK" ::msgcat::mcset eo "OK" ::msgcat::mcset eo "Ok" ::msgcat::mcset eo "Open" "Malfermu" diff --git a/library/msgs/es.msg b/library/msgs/es.msg index ceb12d6..578c52c 100644 --- a/library/msgs/es.msg +++ b/library/msgs/es.msg @@ -1,15 +1,16 @@ 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 "All Files" "Todos los archivos" ::msgcat::mcset es "Application Error" "Error de la aplicaci\u00f3n" ::msgcat::mcset es "&Blue" "&Azul" + ::msgcat::mcset es "Cancel" "Cancelar" ::msgcat::mcset es "&Cancel" "&Cancelar" ::msgcat::mcset es "Cannot change to the directory \"%1\$s\".\nPermission denied." "No es posible acceder al directorio \"%1\$s\".\nPermiso denegado." ::msgcat::mcset es "Choose Directory" "Elegir directorio" ::msgcat::mcset es "Cl&ear" "&Borrar" ::msgcat::mcset es "&Clear Console" "&Borrar consola" - ::msgcat::mcset es "Color" "Color" + ::msgcat::mcset es "Color" ::msgcat::mcset es "Console" "Consola" ::msgcat::mcset es "&Copy" "&Copiar" ::msgcat::mcset es "Cu&t" "Cor&tar" @@ -18,7 +19,7 @@ namespace eval ::tk { ::msgcat::mcset es "Directory \"%1\$s\" does not exist." "El directorio \"%1\$s\" no existe." ::msgcat::mcset es "&Directory:" "&Directorio:" ::msgcat::mcset es "&Edit" "&Editar" - ::msgcat::mcset es "Error: %1\$s" "Error: %1\$s" + ::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?" @@ -37,9 +38,10 @@ namespace eval ::tk { ::msgcat::mcset es "&Ignore" "&Ignorar" ::msgcat::mcset es "Invalid file name \"%1\$s\"." "Nombre de archivo inv\u00e1lido \"%1\$s\"." ::msgcat::mcset es "Log Files" "Ficheros de traza" - ::msgcat::mcset es "&No" "&No" - ::msgcat::mcset es "&OK" "&OK" - ::msgcat::mcset es "Ok" "Ok" + ::msgcat::mcset es "&No" + ::msgcat::mcset es "&OK" + ::msgcat::mcset es "OK" + ::msgcat::mcset es "Ok" ::msgcat::mcset es "Open" "Abrir" ::msgcat::mcset es "&Open" "&Abrir" ::msgcat::mcset es "Open Multiple Files" "Abrir m\u00faltiples archivos" @@ -59,7 +61,7 @@ namespace eval ::tk { ::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\u00ed" ::msgcat::mcset es "abort" "abortar" ::msgcat::mcset es "blue" "azul" ::msgcat::mcset es "cancel" "cancelar" @@ -67,7 +69,7 @@ namespace eval ::tk { ::msgcat::mcset es "extensions" "extensiones" ::msgcat::mcset es "green" "verde" ::msgcat::mcset es "ignore" "ignorar" - ::msgcat::mcset es "ok" "ok" + ::msgcat::mcset es "ok" ::msgcat::mcset es "red" "rojo" ::msgcat::mcset es "retry" "reintentar" ::msgcat::mcset es "yes" "s\u00ed" diff --git a/library/msgs/fr.msg b/library/msgs/fr.msg index b1eb7e3..7f42aca 100644 --- a/library/msgs/fr.msg +++ b/library/msgs/fr.msg @@ -4,20 +4,21 @@ namespace eval ::tk { ::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 "Clear" "Effacer" + ::msgcat::mcset fr "Cl&ear" "Effacer" ::msgcat::mcset fr "Color" "Couleur" ::msgcat::mcset fr "Console" ::msgcat::mcset fr "Copy" "Copier" - ::msgcat::mcset fr "Cut" "Couper" + ::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 "Error: %1\$s" "Erreur: %1\$s" - ::msgcat::mcset fr "Exit" "Quitter" + ::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\" does not exist." "Le fichier \"%1\$s\" n'existe pas." @@ -29,18 +30,19 @@ namespace eval ::tk { ::msgcat::mcset fr "Fil&ter:" "Fil&tre:" ::msgcat::mcset fr "&Green" "&Vert" ::msgcat::mcset fr "Hi" "Salut" - ::msgcat::mcset fr "Hide Console" "Cacher la Console" + ::msgcat::mcset fr "&Hide Console" "Cacher la Console" ::msgcat::mcset fr "&Ignore" "&Ignorer" ::msgcat::mcset fr "Invalid file name \"%1\$s\"." "Nom de fichier invalide \"%1\$s\"." ::msgcat::mcset fr "Log Files" "Fichiers de trace" ::msgcat::mcset fr "&No" "&Non" ::msgcat::mcset fr "&OK" + ::msgcat::mcset fr "OK" ::msgcat::mcset fr "Ok" ::msgcat::mcset fr "Open" "Ouvrir" ::msgcat::mcset fr "&Open" "&Ouvrir" ::msgcat::mcset fr "Open Multiple Files" "Ouvrir plusieurs fichiers" - ::msgcat::mcset fr "Paste" "Coller" - ::msgcat::mcset fr "Quit" "Quitter" + ::msgcat::mcset fr "P&aste" "Coller" + ::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" @@ -51,7 +53,7 @@ namespace eval ::tk { ::msgcat::mcset fr "Select a file to source" "Choisir un fichier \u00e0 \u00e9valuer" ::msgcat::mcset fr "&Selection:" "&S\u00e9lection:" ::msgcat::mcset fr "Skip Messages" "Omettre les messages" - ::msgcat::mcset fr "Source..." "\u00c9valuer..." + ::msgcat::mcset fr "&Source..." "\u00c9valuer..." ::msgcat::mcset fr "Tcl Scripts" "Scripts Tcl" ::msgcat::mcset fr "Tcl for Windows" "Tcl pour Windows" ::msgcat::mcset fr "Text Files" "Fichiers texte" diff --git a/library/msgs/hu.msg b/library/msgs/hu.msg index fc4700f..38ef0b8 100644 --- a/library/msgs/hu.msg +++ b/library/msgs/hu.msg @@ -1,14 +1,14 @@ namespace eval ::tk { ::msgcat::mcset hu "&Abort" "&Megszak\u00edt\u00e1s" - ::msgcat::mcset hu "About..." "N\u00e9vjegy..." + ::msgcat::mcset hu "&About..." "N\u00e9vjegy..." ::msgcat::mcset hu "All Files" "Minden f\u00e1jl" - ::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 "Clear" "T\u00f6rl\u00e9s" + ::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 "Console" "Konzol" @@ -41,6 +41,7 @@ namespace eval ::tk { ::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" diff --git a/library/msgs/it.msg b/library/msgs/it.msg index 52394cd..2e1b4bd 100644 --- a/library/msgs/it.msg +++ b/library/msgs/it.msg @@ -1,23 +1,25 @@ namespace eval ::tk { ::msgcat::mcset it "&Abort" "&Interrompi" - ::msgcat::mcset it "About..." "Informazioni..." + ::msgcat::mcset it "&About..." "Informazioni..." ::msgcat::mcset it "All Files" "Tutti i file" ::msgcat::mcset it "Application Error" "Errore dell' applicazione" ::msgcat::mcset it "&Blue" "&Blu" + ::msgcat::mcset it "Cancel" "Annulla" ::msgcat::mcset it "&Cancel" "&Annulla" ::msgcat::mcset it "Cannot change to the directory \"%1\$s\".\nPermission denied." "Impossibile accedere alla directory \"%1\$s\".\nPermesso negato." ::msgcat::mcset it "Choose Directory" "Scegli una directory" - ::msgcat::mcset it "Clear" "Azzera" + ::msgcat::mcset it "Cl&ear" "Azzera" + ::msgcat::mcset it "&Clear Console" "Azzera Console" ::msgcat::mcset it "Color" "Colore" ::msgcat::mcset it "Console" - ::msgcat::mcset it "Copy" "Copia" - ::msgcat::mcset it "Cut" "Taglia" + ::msgcat::mcset it "&Copy" "Copia" + ::msgcat::mcset it "Cu&t" "Taglia" ::msgcat::mcset it "Delete" "Cancella" ::msgcat::mcset it "Details >>" "Dettagli >>" ::msgcat::mcset it "Directory \"%1\$s\" does not exist." "La directory \"%1\$s\" non esiste." ::msgcat::mcset it "&Directory:" ::msgcat::mcset it "Error: %1\$s" "Errore: %1\$s" - ::msgcat::mcset it "Exit" "Esci" + ::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\" does not exist." "Il file \"%1\$s\" non esiste." @@ -29,18 +31,19 @@ namespace eval ::tk { ::msgcat::mcset it "Fil&ter:" "Fil&tro:" ::msgcat::mcset it "&Green" "&Verde" ::msgcat::mcset it "Hi" "Salve" - ::msgcat::mcset it "Hide Console" "Nascondi la console" + ::msgcat::mcset it "&Hide Console" "Nascondi la console" ::msgcat::mcset it "&Ignore" "&Ignora" ::msgcat::mcset it "Invalid file name \"%1\$s\"." "Nome di file non valido \"%1\$s\"." ::msgcat::mcset it "Log Files" "File di log" ::msgcat::mcset it "&No" ::msgcat::mcset it "&OK" + ::msgcat::mcset it "OK" ::msgcat::mcset it "Ok" - ::msgcat::mcset it "&Open" "A&pri" ::msgcat::mcset it "Open" "Apri" + ::msgcat::mcset it "&Open" "A&pri" ::msgcat::mcset it "Open Multiple Files" "Apri file multipli" - ::msgcat::mcset it "Paste" "Incolla" - ::msgcat::mcset it "Quit" "Esci" + ::msgcat::mcset it "P&aste" "Incolla" + ::msgcat::mcset it "&Quit" "Esci" ::msgcat::mcset it "&Red" "&Rosso" ::msgcat::mcset it "Replace existing file?" "Sostituisci il file esistente?" ::msgcat::mcset it "&Retry" "&Riprova" diff --git a/library/msgs/nl.msg b/library/msgs/nl.msg index 90446c8..148a9e6 100644 --- a/library/msgs/nl.msg +++ b/library/msgs/nl.msg @@ -1,37 +1,33 @@ namespace eval ::tk { - ::msgcat::mcset nl "\"%1\$s\" must be an absolute pathname" "\"%1\$s\" moet een absolute pad-naam zijn" - ::msgcat::mcset nl "%1\$s is not a toplevel window" "%1\$s is geen toplevel window" - ::msgcat::mcset nl ", or" ", of" - ::msgcat::mcset nl "-default, -icon, -message, -parent, -title, or -type" "-default, -icon, -message, -parent, -title, of -type" - ::msgcat::mcset nl "-initialdir, -mustexist, -parent, or -title" "-initialdir, -mustexist, -parent, of -title" ::msgcat::mcset nl "&Abort" "&Afbreken" - ::msgcat::mcset nl "About..." "Over..." + ::msgcat::mcset nl "&About..." "Over..." ::msgcat::mcset nl "All Files" "Alle Bestanden" ::msgcat::mcset nl "Application Error" "Toepassingsfout" + ::msgcat::mcset nl "&Apply" "Toepassen" + ::msgcat::mcset nl "Bold" "Vet" + ::msgcat::mcset nl "Bold Italic" "Vet Cursief" ::msgcat::mcset nl "&Blue" "&Blauw" + ::msgcat::mcset nl "Cancel" "Annuleren" ::msgcat::mcset nl "&Cancel" "&Annuleren" ::msgcat::mcset nl "Cannot change to the directory \"%1\$s\".\nPermission denied." "Kan niet naar map \"%1\$s\" gaan.\nU heeft hiervoor geen toestemming." ::msgcat::mcset nl "Choose Directory" "Kies map" - ::msgcat::mcset nl "Clear" "Wissen" - ::msgcat::mcset nl "Clear entry, Press OK; Enter %1\$s, press OK" "Wis veld, Druk op OK; typ %1\$s in, druk op OK" + ::msgcat::mcset nl "Cl&ear" "Wissen" ::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 "Cut" "Knippen" - ::msgcat::mcset nl "Delete" "Wissen" - ::msgcat::mcset nl "Details" + ::msgcat::mcset nl "&Copy" "Kopi\u00ebren" + ::msgcat::mcset nl "Cu&t" "Knippen" + ::msgcat::mcset nl "&Delete" "Wissen" ::msgcat::mcset nl "Details >>" ::msgcat::mcset nl "Directory \"%1\$s\" does not exist." "Map \"%1\$s\" bestaat niet." ::msgcat::mcset nl "&Directory:" "&Map:" - ::msgcat::mcset nl "Edit" "Bewerken" - ::msgcat::mcset nl "Enter \"%1\$s\", press OK" "Typ \"%1\$s\", druk op OK" - ::msgcat::mcset nl "Enter \"%1\$s\", press OK, enter \"%2\$s\", press OK" "Typ \"%1\$s\", druk op OK, typ \"%2\$s\", druk op OK" + ::msgcat::mcset nl "&Edit" "Bewerken" + ::msgcat::mcset nl "Effects" "Effecten" ::msgcat::mcset nl "Error: %1\$s" "Fout: %1\$s" - ::msgcat::mcset nl "Exit" "Be\u00ebindigen" - ::msgcat::mcset nl "File" "Bestand" - ::msgcat::mcset nl "File \"%1\$s\" already exists.\n\n" "Bestand \"%1\$s\" bestaat al.\n\n" + ::msgcat::mcset nl "E&xit" "Be\u00ebindigen" + ::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" ::msgcat::mcset nl "File \"%1\$s\" does not exist." "Bestand \"%1\$s\" bestaat niet." ::msgcat::mcset nl "File &name:" "Bestands&naam:" ::msgcat::mcset nl "File &names:" "Bestands&namen:" @@ -39,71 +35,57 @@ namespace eval ::tk { ::msgcat::mcset nl "Fi&les:" "&Bestanden:" ::msgcat::mcset nl "&Filter" ::msgcat::mcset nl "Fil&ter:" + ::msgcat::mcset nl "Font" + ::msgcat::mcset nl "&Font:" + ::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 "Hide Console" "Verberg Console" + ::msgcat::mcset nl "&Hide Console" "Verberg Console" ::msgcat::mcset nl "&Ignore" "&Negeren" ::msgcat::mcset nl "Invalid file name \"%1\$s\"." "Ongeldige bestandsnaam \"%1\$s\"." + ::msgcat::mcset nl "Italic" "Cursief" ::msgcat::mcset nl "Log Files" "Log Bestanden" ::msgcat::mcset nl "&No" "&Nee" ::msgcat::mcset nl "&OK" + ::msgcat::mcset nl "OK" ::msgcat::mcset nl "Ok" - ::msgcat::mcset nl "&Open" "&Openen" ::msgcat::mcset nl "Open" "Openen" + ::msgcat::mcset nl "&Open" "&Openen" ::msgcat::mcset nl "Open Multiple Files" "Open meerdere bestanden" - ::msgcat::mcset nl "Paste" "Plakken" - ::msgcat::mcset nl "Please press %1\$s" "Druk op %1\$s, A.U.B." - ::msgcat::mcset nl "Please press ok" "Druk op ok, A.U.B." - ::msgcat::mcset nl "Press Cancel" "Druk op Annuleren" - ::msgcat::mcset nl "Press Ok" "Druk op Ok" - ::msgcat::mcset nl "Quit" "Stoppen" + ::msgcat::mcset nl "P&aste" "Pl&akken" + ::msgcat::mcset nl "&Quit" "Stoppen" ::msgcat::mcset nl "&Red" "&Rood" + ::msgcat::mcset nl "Regular" "Standaard" ::msgcat::mcset nl "Replace existing file?" "Vervang bestaand bestand?" ::msgcat::mcset nl "&Retry" "&Herhalen" + ::msgcat::mcset nl "Sample" ::msgcat::mcset nl "&Save" "Op&slaan" ::msgcat::mcset nl "Save As" "Opslaan als" ::msgcat::mcset nl "Save To Log" "Opslaan naar Log" ::msgcat::mcset nl "Select Log File" "Selecteer Log bestand" ::msgcat::mcset nl "Select a file to source" "Selecteer bronbestand" ::msgcat::mcset nl "&Selection:" "&Selectie:" + ::msgcat::mcset nl "&Size:" "Grootte" + ::msgcat::mcset nl "Show &Hidden Directories" "Laat verborgen mappen zien" + ::msgcat::mcset nl "Show &Hidden Files and Directories" "Laat verborgen bestanden mappen zien" ::msgcat::mcset nl "Skip Messages" "Berichten overslaan" - ::msgcat::mcset nl "Source..." "Bron..." + ::msgcat::mcset nl "&Source..." "Bron..." + ::msgcat::mcset nl "Stri&keout" ::msgcat::mcset nl "Tcl Scripts" ::msgcat::mcset nl "Tcl for Windows" "Tcl voor Windows" ::msgcat::mcset nl "Text Files" "Tekstbestanden" + ::msgcat::mcset nl "&Underline" "Onderstreept" ::msgcat::mcset nl "&Yes" "&Ja" ::msgcat::mcset nl "abort" "afbreken" - ::msgcat::mcset nl "abort, retry, ignore, ok, cancel, no, or yes" "afbreken, opnieuw, negeren, ok, annuleren, nee, of ja" - ::msgcat::mcset nl "abortretryignore, ok, okcancel, retrycancel, yesno, or yesnocancel" "abortretryignore, ok, okcancel, retrycancel, yesno, of yesnocancel" - ::msgcat::mcset nl "bad %1\$s value \"%2\$s\": must be %3\$s" "verkeerde %1\$s waarde \"%2\$s\": moet zijn %3\$s" - ::msgcat::mcset nl "bad file type \"%1\$s\", should be" "verkeerd bestandstype \"%1\$s\", moet zijn" - ::msgcat::mcset nl "bad option \"%1\$s\": should be %2\$s" "verkeerde optie \"%1\$s\": moet zijn %2\$s" - ::msgcat::mcset nl "bad window path name \"%1\$s\"" "verkeerde window-padnaam \"%1\$s\"" ::msgcat::mcset nl "blue" "blauw" - ::msgcat::mcset nl "can't post %1\$s: it isn't a descendant of %2\$s (this is a new requirement in Tk versions 3.0 and later)" "kan %1\$s niet verzenden: het is geen afstammeling van %2\$s (dit is een nieuwe eis in Tk versies 3.0 en later)" ::msgcat::mcset nl "cancel" "annuleren" - ::msgcat::mcset nl "default button index greater than number of buttons specified for tk_dialog" "default knop index is groter dan het aantal knoppen beschikbaar voor tk_dialog" - ::msgcat::mcset nl "display name to use (current one otherwise)" "te gebruiken schermnaam (anders huidige scherm)" - ::msgcat::mcset nl "error, info, question, or warning" "error, info, question, of warning" ::msgcat::mcset nl "extension" ::msgcat::mcset nl "extensions" - ::msgcat::mcset nl "focus group \"%1\$s\" doesn't exist" "focusgroep \"%1\$s\" bestaat niet" ::msgcat::mcset nl "green" "groen" - ::msgcat::mcset nl "history event %1\$s" ::msgcat::mcset nl "ignore" "negeren" - ::msgcat::mcset nl "invalid default button \"%1\$s\"" "ongeldige default knop \"%1\$s\"" - ::msgcat::mcset nl "macType" - ::msgcat::mcset nl "macTypes" - ::msgcat::mcset nl "must specify a background color" "een achtergrondkleur is verplicht" - ::msgcat::mcset nl "name of the slave interpreter" "naam van de slaaf-interpreter" - ::msgcat::mcset nl "no winfo screen . nor env(DISPLAY)" "geen winfo scherm . noch env(DISPLAY)" ::msgcat::mcset nl "ok" ::msgcat::mcset nl "red" "rood" ::msgcat::mcset nl "retry" "opnieuw" - ::msgcat::mcset nl "should contain 5 or 4 elements" "moet 4 of 5 elementen bevatten" - ::msgcat::mcset nl "spec" - ::msgcat::mcset nl "tk_chooseDirectory command" "tk_chooseDirectory opdracht" - ::msgcat::mcset nl "tk_chooseDirectory command, cancel gives null" "tk_chooseDirectory opdracht, annuleren geeft lege waarde" - ::msgcat::mcset nl "tk_chooseDirectory command, initialdir" "tk_chooseDirectory opdracht, initi\u00eble map" ::msgcat::mcset nl "yes" "ja" } diff --git a/library/msgs/pl.msg b/library/msgs/pl.msg index debebcb..c20f41e 100644 --- a/library/msgs/pl.msg +++ b/library/msgs/pl.msg @@ -3,7 +3,11 @@ namespace eval ::tk { ::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 "&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 "Choose Directory" "Wybierz katalog" @@ -18,6 +22,7 @@ namespace eval ::tk { ::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 "&File" "&Plik" @@ -30,35 +35,47 @@ namespace eval ::tk { ::msgcat::mcset pl "Fi&les:" "Pli&ki:" ::msgcat::mcset pl "&Filter" "&Filtr" ::msgcat::mcset pl "Fil&ter:" "&Filtr:" + ::msgcat::mcset pl "Font" "Czcionka" + ::msgcat::mcset pl "&Font:" "Czcio&nka:" + ::msgcat::mcset pl "Font st&yle:" "&Styl czcionki:" ::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 "&Ignore" "&Ignoruj" ::msgcat::mcset pl "Invalid file name \"%1\$s\"." "Niew\u0142a\u015bciwa 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" "OK" - ::msgcat::mcset pl "Ok" "Ok" + ::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 "P&aste" "&Wklej" ::msgcat::mcset pl "&Quit" "&Zako\u0144cz" ::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 "&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 "&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 "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 "&Yes" "&Tak" ::msgcat::mcset pl "abort" "przerwij" ::msgcat::mcset pl "blue" "niebieski" @@ -67,6 +84,7 @@ namespace eval ::tk { ::msgcat::mcset pl "extensions" "rozszerzenia" ::msgcat::mcset pl "green" "zielony" ::msgcat::mcset pl "ignore" "ignoruj" + ::msgcat::mcset pl "ok" ::msgcat::mcset pl "red" "czerwony" ::msgcat::mcset pl "retry" "pon\u00f3w" ::msgcat::mcset pl "yes" "tak" diff --git a/library/msgs/pt.msg b/library/msgs/pt.msg index 259f82e..c29e293 100644 --- a/library/msgs/pt.msg +++ b/library/msgs/pt.msg @@ -1,70 +1,74 @@ namespace eval ::tk { - ::msgcat::mcset pt_br "&Abort" "&Abortar" - ::msgcat::mcset pt_br "About..." "Sobre ..." - ::msgcat::mcset pt_br "All Files" "Todos os arquivos" - ::msgcat::mcset pt_br "Application Error" "Erro de aplica\u00e7\u00e3o" - ::msgcat::mcset pt_br "&Blue" "&Azul" - ::msgcat::mcset pt_br "&Cancel" "&Cancelar" - ::msgcat::mcset pt_br "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_br "Choose Directory" "Escolha um diret\u00f3rio" - ::msgcat::mcset pt_br "Clear" "Apagar" - ::msgcat::mcset pt_br "Color" "Cor" - ::msgcat::mcset pt_br "Console" "Console" - ::msgcat::mcset pt_br "Copy" "Copiar" - ::msgcat::mcset pt_br "Cut" "Recortar" - ::msgcat::mcset pt_br "Delete" "Excluir" - ::msgcat::mcset pt_br "Details >>" "Detalhes >>" - ::msgcat::mcset pt_br "Directory \"%1\$s\" does not exist." "O diret\u00f3rio \"%1\$s\" n\u00e3o existe." - ::msgcat::mcset pt_br "&Directory:" "&Diret\u00f3rio:" - ::msgcat::mcset pt_br "Error: %1\$s" "Erro: %1\$s" - ::msgcat::mcset pt_br "Exit" "Sair" - ::msgcat::mcset pt_br "File \"%1\$s\" already exists.\nDo you want to overwrite it?" "O arquivo \"%1\$s\" j\u00e1 existe.\nDeseja sobrescreve-lo?" - ::msgcat::mcset pt_br "File \"%1\$s\" already exists.\n\n" "O arquivo \"%1\$s\" j\u00e1 existe.\n\n" - ::msgcat::mcset pt_br "File \"%1\$s\" does not exist." "Arquivo \"%1\$s\" n\u00e3o existe." - ::msgcat::mcset pt_br "File &name:" "&Nome do arquivo:" - ::msgcat::mcset pt_br "File &names:" "&Nomes dos arquivos:" - ::msgcat::mcset pt_br "Files of &type:" "Arquivos do &tipo:" - ::msgcat::mcset pt_br "Fi&les:" "&Arquivos:" - ::msgcat::mcset pt_br "&Filter" "&Filtro" - ::msgcat::mcset pt_br "Fil&ter:" "Fil&tro:" - ::msgcat::mcset pt_br "&Green" "&Verde" - ::msgcat::mcset pt_br "Hi" "Oi" - ::msgcat::mcset pt_br "Hide Console" "Ocultar console" - ::msgcat::mcset pt_br "&Ignore" "&Ignorar" - ::msgcat::mcset pt_br "Invalid file name \"%1\$s\"." "O nome do arquivo \u00e9 inv\u00e1lido \"%1\$s\"." - ::msgcat::mcset pt_br "Log Files" "Arquivos de log" - ::msgcat::mcset pt_br "&No" "&N\u00e3o" - ::msgcat::mcset pt_br "&OK" "&OK" - ::msgcat::mcset pt_br "Ok" "Ok" - ::msgcat::mcset pt_br "Open" "Abrir" - ::msgcat::mcset pt_br "&Open" "&Abrir" - ::msgcat::mcset pt_br "Open Multiple Files" "Abrir m\u00faltiplos arquivos" - ::msgcat::mcset pt_br "Paste" "Colar" - ::msgcat::mcset pt_br "Quit" "Encerrar" - ::msgcat::mcset pt_br "&Red" "&Vermelho" - ::msgcat::mcset pt_br "Replace existing file?" "Substituir arquivo existente?" - ::msgcat::mcset pt_br "&Retry" "Tenta&r novamente" - ::msgcat::mcset pt_br "&Save" "&Salvar" - ::msgcat::mcset pt_br "Save As" "Salvar como" - ::msgcat::mcset pt_br "Save To Log" "Salvar arquivo de log" - ::msgcat::mcset pt_br "Select Log File" "Selecionar arquivo de log" - ::msgcat::mcset pt_br "Select a file to source" "Selecione um arquivo como fonte(source)" - ::msgcat::mcset pt_br "&Selection:" "&Sele\u00e7\u00e3o:" - ::msgcat::mcset pt_br "Skip Messages" "Omitir as mensagens" - ::msgcat::mcset pt_br "Source..." "Source..." - ::msgcat::mcset pt_br "Tcl Scripts" "Scripts Tcl" - ::msgcat::mcset pt_br "Tcl for Windows" "Tcl para Windows" - ::msgcat::mcset pt_br "Text Files" "Arquivos de texto" - ::msgcat::mcset pt_br "&Yes" "&Sim" - ::msgcat::mcset pt_br "abort" "abortar" - ::msgcat::mcset pt_br "blue" "azul" - ::msgcat::mcset pt_br "cancel" "cancelar" - ::msgcat::mcset pt_br "extension" "extens\u00e3o" - ::msgcat::mcset pt_br "extensions" "extens\u00f5es" - ::msgcat::mcset pt_br "green" "verde" - ::msgcat::mcset pt_br "ignore" "ignorar" - ::msgcat::mcset pt_br "ok" "ok" - ::msgcat::mcset pt_br "red" "vermelho" - ::msgcat::mcset pt_br "retry" "tentar novamente" - ::msgcat::mcset pt_br "yes" "sim" + ::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 "&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 "Cl&ear" "Apagar" + ::msgcat::mcset pt "&Clear Console" "Apagar Console" + ::msgcat::mcset pt "Color" "Cor" + ::msgcat::mcset pt "Console" + ::msgcat::mcset pt "&Copy" "Copiar" + ::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 "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 &name:" "&Nome do arquivo:" + ::msgcat::mcset pt "File &names:" "&Nomes dos arquivos:" + ::msgcat::mcset pt "Files of &type:" "Arquivos do &tipo:" + ::msgcat::mcset pt "Fi&les:" "&Arquivos:" + ::msgcat::mcset pt "&Filter" "&Filtro" + ::msgcat::mcset pt "Fil&ter:" "Fil&tro:" + ::msgcat::mcset pt "&Green" "&Verde" + ::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 "Log Files" "Arquivos de log" + ::msgcat::mcset pt "&No" "&N\u00e3o" + ::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 "P&aste" "Col&ar" + ::msgcat::mcset pt "Quit" "Encerrar" + ::msgcat::mcset pt "&Red" "&Vermelho" + ::msgcat::mcset pt "Replace existing file?" "Substituir arquivo existente?" + ::msgcat::mcset pt "&Retry" "Tenta&r novamente" + ::msgcat::mcset pt "&Save" "&Salvar" + ::msgcat::mcset pt "Save As" "Salvar como" + ::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 "Skip Messages" "Omitir as mensagens" + ::msgcat::mcset pt "&Source..." "&Fonte..." + ::msgcat::mcset pt "Tcl Scripts" "Scripts Tcl" + ::msgcat::mcset pt "Tcl for Windows" "Tcl para Windows" + ::msgcat::mcset pt "Text Files" "Arquivos de texto" + ::msgcat::mcset pt "&Yes" "&Sim" + ::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 "green" "verde" + ::msgcat::mcset pt "ignore" "ignorar" + ::msgcat::mcset pt "ok" + ::msgcat::mcset pt "red" "vermelho" + ::msgcat::mcset pt "retry" "tentar novamente" + ::msgcat::mcset pt "yes" "sim" } diff --git a/library/msgs/ru.msg b/library/msgs/ru.msg index 9f6aa80..2aac5bb 100644 --- a/library/msgs/ru.msg +++ b/library/msgs/ru.msg @@ -1,24 +1,25 @@ 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 "&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 "&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 "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 "Clear" "\u041e\u0447\u0438\u0441\u0442\u0438\u0442\u044c" + ::msgcat::mcset ru "Cl&ear" "\u041e\u0447\u0438\u0441\u0442\u0438\u0442\u044c" ::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 "Cut" "\u0412\u044b\u0440\u0435\u0437\u0430\u0442\u044c" - ::msgcat::mcset ru "Delete" "\u0423\u0434\u0430\u043b\u0438\u0442\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 "Error: %1\$s" "\u041e\u0448\u0438\u0431\u043a\u0430: %1\$s" - ::msgcat::mcset ru "Exit" "\u0412\u044b\u0445\u043e\u0434" + ::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 "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" @@ -31,18 +32,19 @@ namespace eval ::tk { ::msgcat::mcset ru "Fil&ter:" "\u0424\u0438\u043b\u044c&\u0442\u0440:" ::msgcat::mcset ru "&Green" " &\u0417\u0435\u043b\u0435\u043d\u044b\u0439" ::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 "&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 "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 "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 "Paste" "\u0412\u0441\u0442\u0430\u0432\u0438\u0442\u044c" - ::msgcat::mcset ru "Quit" "\u0412\u044b\u0445\u043e\u0434" + ::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 "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" @@ -51,9 +53,9 @@ namespace eval ::tk { ::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 "&Selection:" ::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 "&Source..." "\u0418\u043d\u0442\u0435\u0440\u043f\u0440\u0435\u0442\u0438\u0440\u043e\u0432\u0430\u0442\u044c \u0444\u0430\u0439\u043b..." ::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" diff --git a/library/msgs/sv.msg b/library/msgs/sv.msg index 14ce14d..62bfcbd 100644 --- a/library/msgs/sv.msg +++ b/library/msgs/sv.msg @@ -4,10 +4,11 @@ namespace eval ::tk { ::msgcat::mcset sv "All Files" "Samtliga filer" ::msgcat::mcset sv "Application Error" "Programfel" ::msgcat::mcset sv "&Blue" "&Bl\u00e5" + ::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 "&Clear" "&Radera" + ::msgcat::mcset sv "Cl&ear" "&Radera" ::msgcat::mcset sv "&Clear Console" "&Radera konsollen" ::msgcat::mcset sv "Color" "F\u00e4rg" ::msgcat::mcset sv "Console" "Konsoll" @@ -38,6 +39,7 @@ namespace eval ::tk { ::msgcat::mcset sv "Invalid file name \"%1\$s\"." "Ogiltigt filnamn \"%1\$s\"." ::msgcat::mcset sv "Log Files" "Loggfiler" ::msgcat::mcset sv "&No" "&Nej" + ::msgcat::mcset sv "&OK" ::msgcat::mcset sv "OK" ::msgcat::mcset sv "Ok" ::msgcat::mcset sv "Open" "\u00d6ppna" diff --git a/library/palette.tcl b/library/palette.tcl index 21be8dc..9cecf5b 100644 --- a/library/palette.tcl +++ b/library/palette.tcl @@ -36,7 +36,8 @@ proc ::tk_setPalette {args} { array set new $args } if {![info exists new(background)]} { - error "must specify a background color" + return -code error -errorcode {TK SET_PALETTE BACKGROUND} \ + "must specify a background color" } set bg [winfo rgb . $new(background)] if {![info exists new(foreground)]} { @@ -99,7 +100,7 @@ proc ::tk_setPalette {args} { set new(troughColor) $darkerBg } - # let's make one of each of the widgets so we know what the + # let's make one of each of the widgets so we know what the # defaults are currently for this platform. toplevel .___tk_set_palette wm withdraw .___tk_set_palette @@ -112,12 +113,12 @@ proc ::tk_setPalette {args} { } # Walk the widget hierarchy, recoloring all existing windows. - # The option database must be set according to what we do here, - # but it breaks things if we set things in the database while + # The option database must be set according to what we do here, + # but it breaks things if we set things in the database while # we are changing colors...so, ::tk::RecolorTree now returns the # option database changes that need to be made, and they # need to be evalled here to take effect. - # We have to walk the whole widget tree instead of just + # We have to walk the whole widget tree instead of just # relying on the widgets we've created above to do the work # because different extensions may provide other kinds # of widgets that we don't currently know about, so we'll @@ -143,7 +144,7 @@ proc ::tk_setPalette {args} { # ::tk::RecolorTree -- # This procedure changes the colors in a window and all of its # descendants, according to information provided by the colors -# argument. This looks at the defaults provided by the option +# argument. This looks at the defaults provided by the option # database, if it exists, and if not, then it looks at the default # value of the widget itself. # diff --git a/library/safetk.tcl b/library/safetk.tcl index c975fd6..9f8e25d 100644 --- a/library/safetk.tcl +++ b/library/safetk.tcl @@ -85,14 +85,12 @@ proc ::safe::loadTk {} {} if {![::tcl::OptProcArgGiven "-use"]} { # create a decorated toplevel - ::tcl::Lassign [tkTopLevel $slave $display] w use + lassign [tkTopLevel $slave $display] w use # set our delete hook (slave arg is added by interpDelete) # to clean up both window related code and tkInit(slave) set state(cleanupHook) [list tkDelete {} $w] - } else { - # set our delete hook (slave arg is added by interpDelete) # to clean up tkInit(slave) set state(cleanupHook) [list disallowTk] @@ -116,8 +114,8 @@ proc ::safe::loadTk {} {} } if {$nDisplay ne $display} { if {$displayGiven} { - error "conflicting -display $display and -use\ - $use -> $nDisplay" + return -code error -errorcode {TK DISPLAY SAFE} \ + "conflicting -display $display and -use $use -> $nDisplay" } else { set display $nDisplay } @@ -141,7 +139,7 @@ proc ::safe::TkInit {interpPath} { } else { Log $interpPath "TkInit called for interp with clearance:\ preventing Tk init" ERROR - error "not allowed" + return -code error -errorcode {TK SAFE PERMISSION} "not allowed" } } @@ -221,8 +219,8 @@ proc ::safe::tkTopLevel {slave display} { incr tkSafeId set w ".safe$tkSafeId" if {[catch {toplevel $w -screen $display -class SafeTk} msg]} { - return -code error "Unable to create toplevel for\ - safe slave \"$slave\" ($msg)" + return -code error -errorcode {TK TOPLEVEL SAFE} \ + "Unable to create toplevel for safe slave \"$slave\" ($msg)" } Log $slave "New toplevel $w" NOTICE diff --git a/library/scale.tcl b/library/scale.tcl index 771c7a4..fb9b81b 100644 --- a/library/scale.tcl +++ b/library/scale.tcl @@ -71,34 +71,34 @@ if {[tk windowingsystem] eq "win32"} { bind Scale <Control-1> { tk::ScaleControlPress %W %x %y } -bind Scale <Up> { +bind Scale <<PrevLine>> { tk::ScaleIncrement %W up little noRepeat } -bind Scale <Down> { +bind Scale <<NextLine>> { tk::ScaleIncrement %W down little noRepeat } -bind Scale <Left> { +bind Scale <<PrevChar>> { tk::ScaleIncrement %W up little noRepeat } -bind Scale <Right> { +bind Scale <<NextChar>> { tk::ScaleIncrement %W down little noRepeat } -bind Scale <Control-Up> { +bind Scale <<PrevPara>> { tk::ScaleIncrement %W up big noRepeat } -bind Scale <Control-Down> { +bind Scale <<NextPara>> { tk::ScaleIncrement %W down big noRepeat } -bind Scale <Control-Left> { +bind Scale <<PrevWord>> { tk::ScaleIncrement %W up big noRepeat } -bind Scale <Control-Right> { +bind Scale <<NextWord>> { tk::ScaleIncrement %W down big noRepeat } -bind Scale <Home> { +bind Scale <<LineStart>> { %W set [%W cget -from] } -bind Scale <End> { +bind Scale <<LineEnd>> { %W set [%W cget -to] } diff --git a/library/scrlbar.tcl b/library/scrlbar.tcl index 4b25325..e17442f 100644 --- a/library/scrlbar.tcl +++ b/library/scrlbar.tcl @@ -91,28 +91,28 @@ bind Scrollbar <Control-2> { tk::ScrollTopBottom %W %x %y } -bind Scrollbar <Up> { +bind Scrollbar <<PrevLine>> { tk::ScrollByUnits %W v -1 } -bind Scrollbar <Down> { +bind Scrollbar <<NextLine>> { tk::ScrollByUnits %W v 1 } -bind Scrollbar <Control-Up> { +bind Scrollbar <<PrevPara>> { tk::ScrollByPages %W v -1 } -bind Scrollbar <Control-Down> { +bind Scrollbar <<NextPara>> { tk::ScrollByPages %W v 1 } -bind Scrollbar <Left> { +bind Scrollbar <<PrevChar>> { tk::ScrollByUnits %W h -1 } -bind Scrollbar <Right> { +bind Scrollbar <<NextChar>> { tk::ScrollByUnits %W h 1 } -bind Scrollbar <Control-Left> { +bind Scrollbar <<PrevWord>> { tk::ScrollByPages %W h -1 } -bind Scrollbar <Control-Right> { +bind Scrollbar <<NextWord>> { tk::ScrollByPages %W h 1 } bind Scrollbar <Prior> { @@ -121,25 +121,41 @@ bind Scrollbar <Prior> { bind Scrollbar <Next> { tk::ScrollByPages %W hv 1 } -bind Scrollbar <Home> { +bind Scrollbar <<LineStart>> { tk::ScrollToPos %W 0 } -bind Scrollbar <End> { +bind Scrollbar <<LineEnd>> { tk::ScrollToPos %W 1 } } -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)}] +switch [tk windowingsystem] { + "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)}] + } } - bind Scrollbar <Shift-MouseWheel> { - tk::ScrollByUnits %W h [expr {- (%D)}] + "win32" { + bind Scrollbar <MouseWheel> { + tk::ScrollByUnits %W v [expr {- (%D / 120) * 4}] + } + bind Scrollbar <Shift-MouseWheel> { + tk::ScrollByUnits %W h [expr {- (%D / 120) * 4}] + } } - bind Scrollbar <Shift-Option-MouseWheel> { - tk::ScrollByUnits %W h [expr {-10 * (%D)}] + "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} } } # tk::ScrollButtonDown -- diff --git a/library/spinbox.tcl b/library/spinbox.tcl index cb501ee..6a5f829 100644 --- a/library/spinbox.tcl +++ b/library/spinbox.tcl @@ -52,7 +52,6 @@ bind Spinbox <<Copy>> { } } bind Spinbox <<Paste>> { - global tcl_platform catch { if {[tk windowingsystem] ne "x11"} { catch { @@ -74,8 +73,8 @@ bind Spinbox <<PasteSelection>> { } bind Spinbox <<TraverseIn>> { - %W selection range 0 end - %W icursor end + %W selection range 0 end + %W icursor end } # Standard Motif bindings: @@ -120,52 +119,52 @@ bind Spinbox <Control-1> { %W icursor @%x } -bind Spinbox <Up> { +bind Spinbox <<PrevLine>> { %W invoke buttonup } -bind Spinbox <Down> { +bind Spinbox <<NextLine>> { %W invoke buttondown } -bind Spinbox <Left> { +bind Spinbox <<PrevChar>> { ::tk::EntrySetCursor %W [expr {[%W index insert] - 1}] } -bind Spinbox <Right> { +bind Spinbox <<NextChar>> { ::tk::EntrySetCursor %W [expr {[%W index insert] + 1}] } -bind Spinbox <Shift-Left> { +bind Spinbox <<SelectPrevChar>> { ::tk::EntryKeySelect %W [expr {[%W index insert] - 1}] ::tk::EntrySeeInsert %W } -bind Spinbox <Shift-Right> { +bind Spinbox <<SelectNextChar>> { ::tk::EntryKeySelect %W [expr {[%W index insert] + 1}] ::tk::EntrySeeInsert %W } -bind Spinbox <Control-Left> { +bind Spinbox <<PrevWord>> { ::tk::EntrySetCursor %W [::tk::EntryPreviousWord %W insert] } -bind Spinbox <Control-Right> { +bind Spinbox <<NextWord>> { ::tk::EntrySetCursor %W [::tk::EntryNextWord %W insert] } -bind Spinbox <Shift-Control-Left> { +bind Spinbox <<SelectPrevWord>> { ::tk::EntryKeySelect %W [::tk::EntryPreviousWord %W insert] ::tk::EntrySeeInsert %W } -bind Spinbox <Shift-Control-Right> { +bind Spinbox <<SelectNextWord>> { ::tk::EntryKeySelect %W [::tk::EntryNextWord %W insert] ::tk::EntrySeeInsert %W } -bind Spinbox <Home> { +bind Spinbox <<LineStart>> { ::tk::EntrySetCursor %W 0 } -bind Spinbox <Shift-Home> { +bind Spinbox <<SelectLineStart>> { ::tk::EntryKeySelect %W 0 ::tk::EntrySeeInsert %W } -bind Spinbox <End> { +bind Spinbox <<LineEnd>> { ::tk::EntrySetCursor %W end } -bind Spinbox <Shift-End> { +bind Spinbox <<SelectLineEnd>> { ::tk::EntryKeySelect %W end ::tk::EntrySeeInsert %W } @@ -193,10 +192,10 @@ bind Spinbox <Control-Shift-space> { bind Spinbox <Shift-Select> { %W selection adjust insert } -bind Spinbox <Control-slash> { +bind Spinbox <<SelectAll>> { %W selection range 0 end } -bind Spinbox <Control-backslash> { +bind Spinbox <<SelectNone>> { %W selection clear } bind Spinbox <KeyPress> { @@ -215,6 +214,8 @@ bind Spinbox <Escape> {# nothing} bind Spinbox <Return> {# nothing} 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-KeyPress> {# nothing} } @@ -229,31 +230,11 @@ if {[tk windowingsystem] ne "win32"} { # Additional emacs-like bindings: -bind Spinbox <Control-a> { - if {!$tk_strictMotif} { - ::tk::EntrySetCursor %W 0 - } -} -bind Spinbox <Control-b> { - if {!$tk_strictMotif} { - ::tk::EntrySetCursor %W [expr {[%W index insert] - 1}] - } -} bind Spinbox <Control-d> { if {!$tk_strictMotif} { %W delete insert } } -bind Spinbox <Control-e> { - if {!$tk_strictMotif} { - ::tk::EntrySetCursor %W end - } -} -bind Spinbox <Control-f> { - if {!$tk_strictMotif} { - ::tk::EntrySetCursor %W [expr {[%W index insert] + 1}] - } -} bind Spinbox <Control-h> { if {!$tk_strictMotif} { ::tk::EntryBackspace %W @@ -394,7 +375,8 @@ proc ::tk::spinbox::ButtonDown {w x y} { $w selection clear } default { - return -code error "unknown spinbox element \"$Priv(element)\"" + return -code error -errorcode {TK SPINBOX UNKNOWN_ELEMENT} \ + "unknown spinbox element \"$Priv(element)\"" } } } diff --git a/library/tclIndex b/library/tclIndex index e7f5b81..b3f37fa 100644 --- a/library/tclIndex +++ b/library/tclIndex @@ -79,6 +79,7 @@ set auto_index(tk_focusNext) [list source [file join $dir focus.tcl]] set auto_index(tk_focusPrev) [list source [file join $dir focus.tcl]] set auto_index(::tk::FocusOK) [list source [file join $dir focus.tcl]] set auto_index(tk_focusFollowsMouse) [list source [file join $dir focus.tcl]] +set auto_index(::tk::IconList) [list source [file join $dir iconlist.tcl]] set auto_index(::tk::ListboxBeginSelect) [list source [file join $dir listbox.tcl]] set auto_index(::tk::ListboxMotion) [list source [file join $dir listbox.tcl]] set auto_index(::tk::ListboxBeginExtend) [list source [file join $dir listbox.tcl]] @@ -89,6 +90,7 @@ set auto_index(::tk::ListboxExtendUpDown) [list source [file join $dir listbox.t set auto_index(::tk::ListboxDataExtend) [list source [file join $dir listbox.tcl]] set auto_index(::tk::ListboxCancel) [list source [file join $dir listbox.tcl]] set auto_index(::tk::ListboxSelectAll) [list source [file join $dir listbox.tcl]] +set auto_index(::tk::Megawidget) [list source [file join $dir megawidget.tcl]] set auto_index(::tk::MbEnter) [list source [file join $dir menu.tcl]] set auto_index(::tk::MbLeave) [list source [file join $dir menu.tcl]] set auto_index(::tk::MbPost) [list source [file join $dir menu.tcl]] @@ -198,34 +200,6 @@ 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::TabToWindow) [list source [file join $dir tk.tcl]] -set auto_index(::tk::IconList) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_Index) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_Selection) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_CurSelection) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_DrawSelection) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_Get) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_Config) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_Create) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_AutoScan) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_DeleteAll) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_Add) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_Arrange) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_Invoke) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_See) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_Btn1) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_CtrlBtn1) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_ShiftBtn1) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_Motion1) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_Double1) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_ReturnKey) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_Leave1) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_FocusIn) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_FocusOut) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_UpDown) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_LeftRight) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_KeyPress) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_Goto) [list source [file join $dir tkfbox.tcl]] -set auto_index(::tk::IconList_Reset) [list source [file join $dir tkfbox.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]] set auto_index(::tk::dialog::file::Create) [list source [file join $dir tkfbox.tcl]] @@ -276,3 +250,4 @@ set auto_index(::tk::ListBoxKeyAccel_Reset) [list source [file join $dir xmfbox. 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 6da2a0f..b500023 100644 --- a/library/tearoff.tcl +++ b/library/tearoff.tcl @@ -150,7 +150,7 @@ proc ::tk::MenuDup {src dst type} { set tags [bindtags $src] set srcLen [string length $src] - + # Copy tags to x, replacing each substring of src with dst. while {[set index [string first $src $tags]] != -1} { diff --git a/library/text.tcl b/library/text.tcl index 68ca0f5..2bf1b2b 100644 --- a/library/text.tcl +++ b/library/text.tcl @@ -95,52 +95,52 @@ bind Text <Control-1> { bind Text <Double-Control-1> { # nothing } # stop an accidental movement triggering <B1-Motion> bind Text <Control-B1-Motion> { # nothing } -bind Text <Left> { +bind Text <<PrevChar>> { tk::TextSetCursor %W insert-1displayindices } -bind Text <Right> { +bind Text <<NextChar>> { tk::TextSetCursor %W insert+1displayindices } -bind Text <Up> { +bind Text <<PrevLine>> { tk::TextSetCursor %W [tk::TextUpDownLine %W -1] } -bind Text <Down> { +bind Text <<NextLine>> { tk::TextSetCursor %W [tk::TextUpDownLine %W 1] } -bind Text <Shift-Left> { +bind Text <<SelectPrevChar>> { tk::TextKeySelect %W [%W index {insert - 1displayindices}] } -bind Text <Shift-Right> { +bind Text <<SelectNextChar>> { tk::TextKeySelect %W [%W index {insert + 1displayindices}] } -bind Text <Shift-Up> { +bind Text <<SelectPrevLine>> { tk::TextKeySelect %W [tk::TextUpDownLine %W -1] } -bind Text <Shift-Down> { +bind Text <<SelectNextLine>> { tk::TextKeySelect %W [tk::TextUpDownLine %W 1] } -bind Text <Control-Left> { +bind Text <<PrevWord>> { tk::TextSetCursor %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord] } -bind Text <Control-Right> { +bind Text <<NextWord>> { tk::TextSetCursor %W [tk::TextNextWord %W insert] } -bind Text <Control-Up> { +bind Text <<PrevPara>> { tk::TextSetCursor %W [tk::TextPrevPara %W insert] } -bind Text <Control-Down> { +bind Text <<NextPara>> { tk::TextSetCursor %W [tk::TextNextPara %W insert] } -bind Text <Shift-Control-Left> { +bind Text <<SelectPrevWord>> { tk::TextKeySelect %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord] } -bind Text <Shift-Control-Right> { +bind Text <<SelectNextWord>> { tk::TextKeySelect %W [tk::TextNextWord %W insert] } -bind Text <Shift-Control-Up> { +bind Text <<SelectPrevPara>> { tk::TextKeySelect %W [tk::TextPrevPara %W insert] } -bind Text <Shift-Control-Down> { +bind Text <<SelectNextPara>> { tk::TextKeySelect %W [tk::TextNextPara %W insert] } bind Text <Prior> { @@ -162,16 +162,16 @@ bind Text <Control-Next> { %W xview scroll 1 page } -bind Text <Home> { +bind Text <<LineStart>> { tk::TextSetCursor %W {insert display linestart} } -bind Text <Shift-Home> { +bind Text <<SelectLineStart>> { tk::TextKeySelect %W {insert display linestart} } -bind Text <End> { +bind Text <<LineEnd>> { tk::TextSetCursor %W {insert display lineend} } -bind Text <Shift-End> { +bind Text <<SelectLineEnd>> { tk::TextKeySelect %W {insert display lineend} } bind Text <Control-Home> { @@ -217,18 +217,22 @@ bind Text <Return> { bind Text <Delete> { if {[tk::TextCursorInSelection %W]} { %W delete sel.first sel.last - } elseif {[%W compare end != insert+1c]} { - %W delete insert + } else { + if {[%W compare end != insert+1c]} { + %W delete insert + } + %W see insert } - %W see insert } bind Text <BackSpace> { if {[tk::TextCursorInSelection %W]} { %W delete sel.first sel.last - } elseif {[%W compare insert != 1.0]} { - %W delete insert-1c + } else { + if {[%W compare insert != 1.0]} { + %W delete insert-1c + } + %W see insert } - %W see insert } bind Text <Control-space> { @@ -245,10 +249,10 @@ bind Text <Shift-Select> { set tk::Priv(selectMode) char tk::TextKeyExtend %W insert } -bind Text <Control-slash> { +bind Text <<SelectAll>> { %W tag add sel 1.0 end } -bind Text <Control-backslash> { +bind Text <<SelectNone>> { %W tag remove sel 1.0 end # An operation that clears the selection must insert an autoseparator, # because the selection operation may have moved the insert mark @@ -305,31 +309,11 @@ if {[tk windowingsystem] eq "aqua"} { # Additional emacs-like bindings: -bind Text <Control-a> { - if {!$tk_strictMotif} { - tk::TextSetCursor %W {insert display linestart} - } -} -bind Text <Control-b> { - if {!$tk_strictMotif} { - tk::TextSetCursor %W insert-1displayindices - } -} bind Text <Control-d> { if {!$tk_strictMotif && [%W compare end != insert+1c]} { %W delete insert } } -bind Text <Control-e> { - if {!$tk_strictMotif} { - tk::TextSetCursor %W {insert display lineend} - } -} -bind Text <Control-f> { - if {!$tk_strictMotif} { - tk::TextSetCursor %W insert+1displayindices - } -} bind Text <Control-k> { if {!$tk_strictMotif && [%W compare end != insert+1c]} { if {[%W compare insert == {insert lineend}]} { @@ -339,22 +323,12 @@ bind Text <Control-k> { } } } -bind Text <Control-n> { - if {!$tk_strictMotif} { - tk::TextSetCursor %W [tk::TextUpDownLine %W 1] - } -} bind Text <Control-o> { if {!$tk_strictMotif} { %W insert insert \n %W mark set insert insert-1c } } -bind Text <Control-p> { - if {!$tk_strictMotif} { - tk::TextSetCursor %W [tk::TextUpDownLine %W -1] - } -} bind Text <Control-t> { if {!$tk_strictMotif} { tk::TextTranspose %W @@ -417,30 +391,6 @@ bind Text <Meta-Delete> { # Macintosh only bindings: if {[tk windowingsystem] eq "aqua"} { -bind Text <Option-Left> { - tk::TextSetCursor %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord] -} -bind Text <Option-Right> { - tk::TextSetCursor %W [tk::TextNextWord %W insert] -} -bind Text <Option-Up> { - tk::TextSetCursor %W [tk::TextPrevPara %W insert] -} -bind Text <Option-Down> { - tk::TextSetCursor %W [tk::TextNextPara %W insert] -} -bind Text <Shift-Option-Left> { - tk::TextKeySelect %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord] -} -bind Text <Shift-Option-Right> { - tk::TextKeySelect %W [tk::TextNextWord %W insert] -} -bind Text <Shift-Option-Up> { - tk::TextKeySelect %W [tk::TextPrevPara %W insert] -} -bind Text <Shift-Option-Down> { - tk::TextKeySelect %W [tk::TextNextPara %W insert] -} bind Text <Control-v> { tk::TextScrollPages %W 1 } @@ -500,6 +450,13 @@ if {[tk windowingsystem] eq "aqua"} { %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 + } + } } if {"x11" eq [tk windowingsystem]} { @@ -517,6 +474,16 @@ if {"x11" eq [tk windowingsystem]} { %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 + } + } } # ::tk::TextClosestGap -- @@ -607,7 +574,6 @@ proc ::tk::TextAnchor {w} { } proc ::tk::TextSelectTo {w x y {extend 0}} { - global tcl_platform variable ::tk::Priv set anchorname [tk::TextAnchor $w] @@ -904,16 +870,17 @@ proc ::tk::TextInsert {w s} { } set compound 0 if {[TextCursorInSelection $w]} { - set compound [$w cget -autoseparators] - if {$compound} { + set oldSeparator [$w cget -autoseparators] + if {$oldSeparator} { $w configure -autoseparators 0 $w edit separator + set compound 1 } $w delete sel.first sel.last } $w insert insert $s $w see insert - if {$compound} { + if {$compound && $oldSeparator} { $w edit separator $w configure -autoseparators 1 } @@ -1108,7 +1075,6 @@ proc ::tk_textCut w { # w - Name of a text widget. proc ::tk_textPaste w { - global tcl_platform if {![catch {::tk::GetSelection $w CLIPBOARD} sel]} { set oldSeparator [$w cget -autoseparators] if {$oldSeparator} { diff --git a/library/tk.tcl b/library/tk.tcl index a9db8cb..9a6a581 100644 --- a/library/tk.tcl +++ b/library/tk.tcl @@ -10,21 +10,19 @@ # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. -package require Tcl 8.5 ;# Guard against [source] in an 8.4- interp before - ;# using 8.5 [package] features. # Insist on running with compatible version of Tcl -package require Tcl 8.5.0 +package require Tcl 8.6 # Verify that we have Tk binary and script components from the same release -package require -exact Tk 8.5.18 - +package require -exact Tk 8.6.4 + # Create a ::tk namespace namespace eval ::tk { # Set up the msgcat commands namespace eval msgcat { namespace export mc mcmax if {[interp issafe] || [catch {package require msgcat}]} { - # The msgcat package is not available. Supply our own minimal - # replacement. + # The msgcat package is not available. Supply our own + # minimal replacement. proc mc {src args} { return [format $src {*}$args] } @@ -59,7 +57,8 @@ namespace eval ::ttk { # isn't already on the path: if {[info exists ::auto_path] && ($::tk_library ne "") - && ($::tk_library ni $::auto_path)} { + && ($::tk_library ni $::auto_path) +} then { lappend ::auto_path $::tk_library $::ttk::library } @@ -67,13 +66,13 @@ if {[info exists ::auto_path] && ($::tk_library ne "") set ::tk_strictMotif 0 -# Turn on useinputmethods (X Input Methods) by default. We catch this because -# safe interpreters may not allow the call. +# Turn on useinputmethods (X Input Methods) by default. +# We catch this because safe interpreters may not allow the call. catch {tk useinputmethods 1} # ::tk::PlaceWindow -- -# Place a toplevel at a particular position +# place a toplevel at a particular position # Arguments: # toplevel name of toplevel window # ?placement? pointer ?center? ; places $w centered on the pointer @@ -125,7 +124,9 @@ proc ::tk::PlaceWindow {w {place ""} {anchor ""}} { } if {[tk windowingsystem] eq "aqua"} { # Avoid the native menu bar which sits on top of everything. - if {$y < 22} { set y 22 } + if {$y < 22} { + set y 22 + } } } wm maxsize $w [winfo vrootwidth $w] [winfo vrootheight $w] @@ -134,7 +135,7 @@ proc ::tk::PlaceWindow {w {place ""} {anchor ""}} { } # ::tk::SetFocusGrab -- -# Swap out current focus and grab temporarily (for dialogs) +# swap out current focus and grab temporarily (for dialogs) # Arguments: # grab new window to grab # focus window to give focus to @@ -151,8 +152,8 @@ proc ::tk::SetFocusGrab {grab {focus {}}} { if {[winfo exists $oldGrab]} { lappend data [grab status $oldGrab] } - # The "grab" command will fail if another application already holds the - # grab. So catch it. + # The "grab" command will fail if another application + # already holds the grab. So catch it. catch {grab $grab} if {[winfo exists $focus]} { focus $focus @@ -160,7 +161,7 @@ proc ::tk::SetFocusGrab {grab {focus {}}} { } # ::tk::RestoreFocusGrab -- -# Restore old focus and grab (for dialogs) +# restore old focus and grab (for dialogs) # Arguments: # grab window that had taken grab # focus window that had taken focus @@ -194,10 +195,10 @@ proc ::tk::RestoreFocusGrab {grab focus {destroy destroy}} { } # ::tk::GetSelection -- -# This tries to obtain the default selection. On Unix, we first try and get -# a UTF8_STRING, a type supported by modern Unix apps for passing Unicode -# data safely. We fall back on the default STRING type otherwise. On -# Windows, only the STRING type is necessary. +# This tries to obtain the default selection. On Unix, we first try +# and get a UTF8_STRING, a type supported by modern Unix apps for +# passing Unicode data safely. We fall back on the default STRING +# type otherwise. On Windows, only the STRING type is necessary. # Arguments: # w The widget for which the selection will be retrieved. # Important for the -displayof property. @@ -207,18 +208,24 @@ proc ::tk::RestoreFocusGrab {grab focus {destroy destroy}} { # if {[tk windowingsystem] ne "win32"} { proc ::tk::GetSelection {w {sel PRIMARY}} { - if {[catch {selection get -displayof $w -selection $sel \ - -type UTF8_STRING} txt] \ - && [catch {selection get -displayof $w -selection $sel} txt]} { - return -code error "could not find default selection" + if {[catch { + selection get -displayof $w -selection $sel -type UTF8_STRING + } txt] && [catch { + selection get -displayof $w -selection $sel + } txt]} then { + return -code error -errorcode {TK SELECTION NONE} \ + "could not find default selection" } else { return $txt } } } else { proc ::tk::GetSelection {w {sel PRIMARY}} { - if {[catch {selection get -displayof $w -selection $sel} txt]} { - return -code error "could not find default selection" + if {[catch { + selection get -displayof $w -selection $sel + } txt]} then { + return -code error -errorcode {TK SELECTION NONE} \ + "could not find default selection" } else { return $txt } @@ -226,22 +233,18 @@ if {[tk windowingsystem] ne "win32"} { } # ::tk::ScreenChanged -- -# This procedure is invoked by the binding mechanism whenever the "current" -# screen is changing. The procedure does two things. First, it uses "upvar" -# to make variable "::tk::Priv" point at an array variable that holds state -# for the current display. Second, it initializes the array if it didn't -# already exist. +# This procedure is invoked by the binding mechanism whenever the +# "current" screen is changing. The procedure does two things. +# First, it uses "upvar" to make variable "::tk::Priv" point at an +# array variable that holds state for the current display. Second, +# it initializes the array if it didn't already exist. # # Arguments: # screen - The name of the new screen. -proc ::tk::ScreenChanged {screen} { - set x [string last . $screen] - if {$x > 0} { - set disp [string range $screen 0 [expr {$x - 1}]] - } else { - set disp $screen - } +proc ::tk::ScreenChanged screen { + # Extract the display name. + set disp [string range $screen 0 [string last . $screen]-1] # Ensure that namespace separators never occur in the display name (as # they cause problems in variable names). Double-colons exist in some VNC @@ -250,7 +253,6 @@ proc ::tk::ScreenChanged {screen} { uplevel #0 [list upvar #0 ::tk::Priv.$disp ::tk::Priv] variable ::tk::Priv - global tcl_platform if {[info exists Priv]} { set Priv(screen) $screen @@ -290,41 +292,54 @@ proc ::tk::ScreenChanged {screen} { tk::ScreenChanged [winfo screen .] # ::tk::EventMotifBindings -- -# This procedure is invoked as a trace whenever ::tk_strictMotif is changed. -# It is used to turn on or turn off the motif virtual bindings. +# This procedure is invoked as a trace whenever ::tk_strictMotif is +# changed. It is used to turn on or turn off the motif virtual +# bindings. # # Arguments: # n1 - the name of the variable being changed ("::tk_strictMotif"). proc ::tk::EventMotifBindings {n1 dummy dummy} { upvar $n1 name - + if {$name} { set op delete } else { set op add } - event $op <<Cut>> <Control-Key-w> - event $op <<Copy>> <Meta-Key-w> - event $op <<Paste>> <Control-Key-y> + 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 <<Undo>> <Control-underscore> + 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> } #---------------------------------------------------------------------- -# Define common dialogs on platforms where they are not implemented using -# compiled code. +# Define common dialogs on platforms where they are not implemented +# using compiled code. #---------------------------------------------------------------------- if {![llength [info commands tk_chooseColor]]} { proc ::tk_chooseColor {args} { - return [tk::dialog::color:: {*}$args] + return [::tk::dialog::color:: {*}$args] } } if {![llength [info commands tk_getOpenFile]]} { proc ::tk_getOpenFile {args} { if {$::tk_strictMotif} { - return [tk::MotifFDialog open {*}$args] + return [::tk::MotifFDialog open {*}$args] } else { return [::tk::dialog::file:: open {*}$args] } @@ -333,7 +348,7 @@ if {![llength [info commands tk_getOpenFile]]} { if {![llength [info commands tk_getSaveFile]]} { proc ::tk_getSaveFile {args} { if {$::tk_strictMotif} { - return [tk::MotifFDialog save {*}$args] + return [::tk::MotifFDialog save {*}$args] } else { return [::tk::dialog::file:: save {*}$args] } @@ -341,7 +356,7 @@ if {![llength [info commands tk_getSaveFile]]} { } if {![llength [info commands tk_messageBox]]} { proc ::tk_messageBox {args} { - return [tk::MessageBox {*}$args] + return [::tk::MessageBox {*}$args] } } if {![llength [info command tk_chooseDirectory]]} { @@ -356,49 +371,129 @@ if {![llength [info command tk_chooseDirectory]]} { 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 <<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> + # 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 <<NextChar>> <Right> + event add <<SelectNextChar>> <Shift-Right> + event add <<PrevChar>> <Left> + event add <<SelectPrevChar>> <Shift-Left> + event add <<NextWord>> <Control-Right> + event add <<SelectNextWord>> <Control-Shift-Right> + event add <<PrevWord>> <Control-Left> + event add <<SelectPrevWord>> <Control-Shift-Left> + event add <<LineStart>> <Home> + event add <<SelectLineStart>> <Shift-Home> + event add <<LineEnd>> <End> + event add <<SelectLineEnd>> <Shift-End> + event add <<PrevLine>> <Up> + event add <<NextLine>> <Down> + event add <<SelectPrevLine>> <Shift-Up> + event add <<SelectNextLine>> <Shift-Down> + event add <<PrevPara>> <Control-Up> + event add <<NextPara>> <Control-Down> + event add <<SelectPrevPara>> <Control-Shift-Up> + event add <<SelectNextPara>> <Control-Shift-Down> + event add <<ToggleSelection>> <Control-ButtonPress-1> + # Some OS's define a goofy (as in, not <Shift-Tab>) keysym that is # returned when the user presses <Shift-Tab>. In order for tab # traversal to work, we have to add these keysyms to the PrevWindow - # event. We use catch just in case the keysym isn't recognized. This - # is needed for XFree86 systems + # event. We use catch just in case the keysym isn't recognized. + + # This is needed for XFree86 systems catch { event add <<PrevWindow>> <ISO_Left_Tab> } # This seems to be correct on *some* HP systems. catch { event add <<PrevWindow>> <hpBackTab> } trace add variable ::tk_strictMotif write ::tk::EventMotifBindings set ::tk_strictMotif $::tk_strictMotif - # On unix, we want to always display entry/text selection, regardless - # of which window has focus + # On unix, we want to always display entry/text selection, + # regardless of which window has focus 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 <<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 <<NextChar>> <Right> + event add <<SelectNextChar>> <Shift-Right> + event add <<PrevChar>> <Left> + event add <<SelectPrevChar>> <Shift-Left> + event add <<NextWord>> <Control-Right> + event add <<SelectNextWord>> <Control-Shift-Right> + event add <<PrevWord>> <Control-Left> + event add <<SelectPrevWord>> <Control-Shift-Left> + event add <<LineStart>> <Home> + event add <<SelectLineStart>> <Shift-Home> + event add <<LineEnd>> <End> + event add <<SelectLineEnd>> <Shift-End> + event add <<PrevLine>> <Up> + event add <<NextLine>> <Down> + event add <<SelectPrevLine>> <Shift-Up> + event add <<SelectNextLine>> <Shift-Down> + event add <<PrevPara>> <Control-Up> + event add <<NextPara>> <Control-Down> + event add <<SelectPrevPara>> <Control-Shift-Up> + event add <<SelectNextPara>> <Control-Shift-Down> + event add <<ToggleSelection>> <Control-ButtonPress-1> } "aqua" { - event add <<Cut>> <Command-Key-x> <Key-F2> <Control-Lock-Key-X> - event add <<Copy>> <Command-Key-c> <Key-F3> <Control-Lock-Key-C> - event add <<Paste>> <Command-Key-v> <Key-F4> <Control-Lock-Key-V> - event add <<PasteSelection>> <ButtonRelease-2> - event add <<Clear>> <Clear> - event add <<Undo>> <Command-Key-z> <Control-Lock-Key-Z> - event add <<Redo>> <Command-Key-y> <Control-Lock-Key-Y> + 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 <<Clear>> <Clear> + event add <<ContextMenu>> <Button-2> + + # Official bindings + # See http://support.apple.com/kb/HT1343 + event add <<SelectAll>> <Command-Key-a> + event add <<SelectNone>> <Option-Command-Key-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> + event add <<SelectNextChar>> <Shift-Right> <Shift-Control-Key-F> <Shift-Control-Lock-Key-F> + event add <<PrevChar>> <Left> <Control-Key-b> <Control-Lock-Key-B> + event add <<SelectPrevChar>> <Shift-Left> <Shift-Control-Key-B> <Shift-Control-Lock-Key-B> + event add <<NextWord>> <Option-Right> + 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> + # Not official, but logical extensions of above. Also derived from + # bindings present in MS Word on OSX. + event add <<PrevPara>> <Option-Up> + event add <<NextPara>> <Option-Down> + event add <<SelectPrevPara>> <Shift-Option-Up> + event add <<SelectNextPara>> <Shift-Option-Down> + event add <<ToggleSelection>> <Command-ButtonPress-1> } } - + # ---------------------------------------------------------------------- # Read in files that define all of the class bindings. # ---------------------------------------------------------------------- @@ -408,6 +503,7 @@ if {$::tk_library ne ""} { namespace eval :: [list source [file join $::tk_library $file.tcl]] } namespace eval ::tk { + SourceLibFile icons SourceLibFile button SourceLibFile entry SourceLibFile listbox @@ -425,13 +521,15 @@ if {$::tk_library ne ""} { # ---------------------------------------------------------------------- event add <<PrevWindow>> <Shift-Tab> -bind all <Tab> {tk::TabToWindow [tk_focusNext %W]} +event add <<NextWindow>> <Tab> +bind all <<NextWindow>> {tk::TabToWindow [tk_focusNext %W]} bind all <<PrevWindow>> {tk::TabToWindow [tk_focusPrev %W]} # ::tk::CancelRepeat -- -# This procedure is invoked to cancel an auto-repeat action described by -# ::tk::Priv(afterId). It's used by several widgets to auto-scroll the widget -# when the mouse is dragged out of the widget with a button pressed. +# This procedure is invoked to cancel an auto-repeat action described +# by ::tk::Priv(afterId). It's used by several widgets to auto-scroll +# the widget when the mouse is dragged out of the widget with a +# button pressed. # # Arguments: # None. @@ -444,9 +542,9 @@ proc ::tk::CancelRepeat {} { # ::tk::TabToWindow -- # This procedure moves the focus to the given widget. -# It sends a <<TraverseOut>> virtual event to the previous focus window, if -# any, before changing the focus, and a <<TraverseIn>> event to the new focus -# window afterwards. +# It sends a <<TraverseOut>> virtual event to the previous focus window, +# if any, before changing the focus, and a <<TraverseIn>> event +# to the new focus window afterwards. # # Arguments: # w - Window to which focus should be set. @@ -461,9 +559,10 @@ proc ::tk::TabToWindow {w} { } # ::tk::UnderlineAmpersand -- -# This procedure takes some text with ampersand and returns text w/o ampersand -# and position of the ampersand. Double ampersands are converted to single -# ones. Position returned is -1 when there is no ampersand. +# This procedure takes some text with ampersand and returns text w/o +# ampersand and position of the ampersand. Double ampersands are +# converted to single ones. Position returned is -1 when there is no +# ampersand. # proc ::tk::UnderlineAmpersand {text} { set s [string map {&& & & \ufeff} $text] @@ -471,9 +570,9 @@ proc ::tk::UnderlineAmpersand {text} { return [list [string map {\ufeff {}} $s] $idx] } -# ::tk::SetAmpText -- -# Given widget path and text with "magic ampersands", sets -text and -# -underline options for the widget +# ::tk::SetAmpText -- +# Given widget path and text with "magic ampersands", sets -text and +# -underline options for the widget # proc ::tk::SetAmpText {widget text} { lassign [UnderlineAmpersand $text] newtext under @@ -481,8 +580,8 @@ proc ::tk::SetAmpText {widget text} { } # ::tk::AmpWidget -- -# Creates new widget, turning -text option into -text and -underline options, -# returned by ::tk::UnderlineAmpersand. +# Creates new widget, turning -text option into -text and -underline +# options, returned by ::tk::UnderlineAmpersand. # proc ::tk::AmpWidget {class path args} { set options {} @@ -502,8 +601,8 @@ proc ::tk::AmpWidget {class path args} { } # ::tk::AmpMenuArgs -- -# Processes arguments for a menu entry, turning -label option into -label and -# -underline options, returned by ::tk::UnderlineAmpersand. +# Processes arguments for a menu entry, turning -label option into +# -label and -underline options, returned by ::tk::UnderlineAmpersand. # proc ::tk::AmpMenuArgs {widget add type args} { set options {} @@ -517,47 +616,53 @@ proc ::tk::AmpMenuArgs {widget add type args} { } $widget add $type {*}$options } - + # ::tk::FindAltKeyTarget -- -# Search recursively through the hierarchy of visible widgets to find button -# or label which has $char as underlined character +# Search recursively through the hierarchy of visible widgets to find +# button or label which has $char as underlined character. # proc ::tk::FindAltKeyTarget {path char} { - switch -- [winfo class $path] { - Button - Label - - TButton - TLabel - TCheckbutton { - if {[string equal -nocase $char \ - [string index [$path cget -text] [$path cget -underline]]]} { - return $path - } else { - return {} + set class [winfo class $path] + if {$class in { + Button Checkbutton Label Radiobutton + TButton TCheckbutton TLabel TRadiobutton + } && [string equal -nocase $char \ + [string index [$path cget -text] [$path cget -underline]]]} { + return $path + } + set subwins [concat [grid slaves $path] [pack slaves $path] \ + [place slaves $path]] + if {$class eq "Canvas"} { + foreach item [$path find all] { + if {[$path type $item] eq "window"} { + set w [$path itemcget $item -window] + if {$w ne ""} {lappend subwins $w} } } - default { - foreach child [concat [grid slaves $path] \ - [pack slaves $path] [place slaves $path]] { - set target [FindAltKeyTarget $child $char] - if {$target ne ""} { - return $target - } - } + } elseif {$class eq "Text"} { + lappend subwins {*}[$path window names] + } + foreach child $subwins { + set target [FindAltKeyTarget $child $char] + if {$target ne ""} { + return $target } } - return {} } # ::tk::AltKeyInDialog -- -# <Alt-Key> event handler for standard dialogs. Sends <<AltUnderlined>> to -# button or label which has appropriate underlined character +# <Alt-Key> event handler for standard dialogs. Sends <<AltUnderlined>> +# to button or label which has appropriate underlined character. # proc ::tk::AltKeyInDialog {path key} { set target [FindAltKeyTarget $path $key] - if { $target eq ""} return - event generate $target <<AltUnderlined>> + if {$target ne ""} { + event generate $target <<AltUnderlined>> + } } - + # ::tk::mcmaxamp -- -# Replacement for mcmax, used for texts with "magic ampersand" in it. +# Replacement for mcmax, used for texts with "magic ampersand" in it. # proc ::tk::mcmaxamp {args} { @@ -577,13 +682,13 @@ proc ::tk::mcmaxamp {args} { if {[tk windowingsystem] eq "aqua"} { namespace eval ::tk::mac { - variable useCustomMDEF 0 + set useCustomMDEF 0 } } # Run the Ttk themed widget set initialization if {$::ttk::library ne ""} { - uplevel \#0 [list source [file join $::ttk::library ttk.tcl]] + uplevel \#0 [list source $::ttk::library/ttk.tcl] } # Local Variables: diff --git a/library/tkfbox.tcl b/library/tkfbox.tcl index fd0f6d7..a52465a 100644 --- a/library/tkfbox.tcl +++ b/library/tkfbox.tcl @@ -1,15 +1,14 @@ # tkfbox.tcl -- # -# Implements the "TK" standard file selection dialog box. This -# dialog box is used on the Unix platforms whenever the tk_strictMotif -# flag is not set. +# Implements the "TK" standard file selection dialog box. This dialog +# box is used on the Unix platforms whenever the tk_strictMotif flag is +# not set. # -# The "TK" standard file selection dialog box is similar to the -# file selection dialog box on Win95(TM). The user can navigate -# the directories by clicking on the folder icons or by -# selecting the "Directory" option menu. The user can select -# files by clicking on the file icons or by entering a filename -# in the "Filename:" entry. +# The "TK" standard file selection dialog box is similar to the file +# selection dialog box on Win95(TM). The user can navigate the +# directories by clicking on the folder icons or by selecting the +# "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. # @@ -17,794 +16,78 @@ # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -package require Ttk - -#---------------------------------------------------------------------- -# -# I C O N L I S T -# -# This is a pseudo-widget that implements the icon list inside the -# ::tk::dialog::file:: dialog box. -# -#---------------------------------------------------------------------- - -# ::tk::IconList -- -# -# Creates an IconList widget. -# -proc ::tk::IconList {w args} { - IconList_Config $w $args - IconList_Create $w -} - -proc ::tk::IconList_Index {w i} { - upvar #0 ::tk::$w data ::tk::$w:itemList itemList - if {![info exists data(list)]} { - set data(list) {} - } - switch -regexp -- $i { - "^-?[0-9]+$" { - if {$i < 0} { - set i 0 - } - if {$i >= [llength $data(list)]} { - set i [expr {[llength $data(list)] - 1}] - } - return $i - } - "^active$" { - return $data(index,active) - } - "^anchor$" { - return $data(index,anchor) - } - "^end$" { - return [llength $data(list)] - } - "@-?[0-9]+,-?[0-9]+" { - foreach {x y} [scan $i "@%d,%d"] { - break - } - set item [$data(canvas) find closest \ - [$data(canvas) canvasx $x] [$data(canvas) canvasy $y]] - return [lindex [$data(canvas) itemcget $item -tags] 1] - } - } -} - -proc ::tk::IconList_Selection {w op args} { - upvar ::tk::$w data - switch -exact -- $op { - "anchor" { - if {[llength $args] == 1} { - set data(index,anchor) [tk::IconList_Index $w [lindex $args 0]] - } else { - return $data(index,anchor) - } - } - "clear" { - if {[llength $args] == 2} { - foreach {first last} $args { - break - } - } elseif {[llength $args] == 1} { - set first [set last [lindex $args 0]] - } else { - error "wrong # args: should be [lindex [info level 0] 0] path\ - clear first ?last?" - } - set first [IconList_Index $w $first] - set last [IconList_Index $w $last] - if {$first > $last} { - set tmp $first - set first $last - set last $tmp - } - set ind 0 - foreach item $data(selection) { - if { $item >= $first } { - set first $ind - break - } - incr ind - } - set ind [expr {[llength $data(selection)] - 1}] - for {} {$ind >= 0} {incr ind -1} { - set item [lindex $data(selection) $ind] - if { $item <= $last } { - set last $ind - break - } - } - - if { $first > $last } { - return - } - set data(selection) [lreplace $data(selection) $first $last] - event generate $w <<ListboxSelect>> - IconList_DrawSelection $w - } - "includes" { - set index [lsearch -exact $data(selection) [lindex $args 0]] - return [expr {$index != -1}] - } - "set" { - if { [llength $args] == 2 } { - foreach {first last} $args { - break - } - } elseif { [llength $args] == 1 } { - set last [set first [lindex $args 0]] - } else { - error "wrong # args: should be [lindex [info level 0] 0] path\ - set first ?last?" - } - - set first [IconList_Index $w $first] - set last [IconList_Index $w $last] - if { $first > $last } { - set tmp $first - set first $last - set last $tmp - } - for {set i $first} {$i <= $last} {incr i} { - lappend data(selection) $i - } - set data(selection) [lsort -integer -unique $data(selection)] - event generate $w <<ListboxSelect>> - IconList_DrawSelection $w - } - } -} - -proc ::tk::IconList_CurSelection {w} { - upvar ::tk::$w data - return $data(selection) -} - -proc ::tk::IconList_DrawSelection {w} { - upvar ::tk::$w data - upvar ::tk::$w:itemList itemList - - $data(canvas) delete selection - $data(canvas) itemconfigure selectionText -fill black - $data(canvas) dtag selectionText - set cbg [ttk::style lookup TEntry -selectbackground focus] - set cfg [ttk::style lookup TEntry -selectforeground focus] - foreach item $data(selection) { - set rTag [lindex [lindex $data(list) $item] 2] - foreach {iTag tTag text serial} $itemList($rTag) { - break - } - - set bbox [$data(canvas) bbox $tTag] - $data(canvas) create rect $bbox -fill $cbg -outline $cbg \ - -tags selection - $data(canvas) itemconfigure $tTag -fill $cfg -tags selectionText - } - $data(canvas) lower selection - return -} - -proc ::tk::IconList_Get {w item} { - upvar ::tk::$w data - upvar ::tk::$w:itemList itemList - set rTag [lindex [lindex $data(list) $item] 2] - foreach {iTag tTag text serial} $itemList($rTag) { - break - } - return $text -} - -# ::tk::IconList_Config -- -# -# Configure the widget variables of IconList, according to the command -# line arguments. -# -proc ::tk::IconList_Config {w argList} { - - # 1: the configuration specs - # - set specs { - {-command "" "" ""} - {-multiple "" "" "0"} - } - - # 2: parse the arguments - # - tclParseConfigSpec ::tk::$w $specs "" $argList -} - -# ::tk::IconList_Create -- -# -# Creates an IconList widget by assembling a canvas widget and a -# scrollbar widget. Sets all the bindings necessary for the IconList's -# operations. -# -proc ::tk::IconList_Create {w} { - upvar ::tk::$w data - - ttk::frame $w - ttk::entry $w.cHull -takefocus 0 -cursor {} - set data(sbar) [ttk::scrollbar $w.cHull.sbar -orient horizontal -takefocus 0] - catch {$data(sbar) configure -highlightthickness 0} - set data(canvas) [canvas $w.cHull.canvas -highlightthick 0 \ - -width 400 -height 120 -takefocus 1 -background white] - pack $data(sbar) -side bottom -fill x -padx 2 -in $w.cHull -pady {0 2} - pack $data(canvas) -expand yes -fill both -padx 2 -pady {2 0} - pack $w.cHull -expand yes -fill both -ipadx 2 -ipady 2 - - $data(sbar) configure -command [list $data(canvas) xview] - $data(canvas) configure -xscrollcommand [list $data(sbar) set] - - # Initializes the max icon/text width and height and other variables - # - set data(maxIW) 1 - set data(maxIH) 1 - set data(maxTW) 1 - set data(maxTH) 1 - set data(numItems) 0 - set data(noScroll) 1 - set data(selection) {} - set data(index,anchor) "" - set fg [option get $data(canvas) foreground Foreground] - if {$fg eq ""} { - set data(fill) black - } else { - set data(fill) $fg - } - - # Creates the event bindings. - # - bind $data(canvas) <Configure> [list tk::IconList_Arrange $w] - - bind $data(canvas) <1> [list tk::IconList_Btn1 $w %x %y] - bind $data(canvas) <B1-Motion> [list tk::IconList_Motion1 $w %x %y] - bind $data(canvas) <B1-Leave> [list tk::IconList_Leave1 $w %x %y] - bind $data(canvas) <Control-1> [list tk::IconList_CtrlBtn1 $w %x %y] - bind $data(canvas) <Shift-1> [list tk::IconList_ShiftBtn1 $w %x %y] - bind $data(canvas) <B1-Enter> [list tk::CancelRepeat] - bind $data(canvas) <ButtonRelease-1> [list tk::CancelRepeat] - bind $data(canvas) <Double-ButtonRelease-1> \ - [list tk::IconList_Double1 $w %x %y] - - bind $data(canvas) <Control-B1-Motion> {;} - bind $data(canvas) <Shift-B1-Motion> \ - [list tk::IconList_ShiftMotion1 $w %x %y] - - bind $data(canvas) <Up> [list tk::IconList_UpDown $w -1] - bind $data(canvas) <Down> [list tk::IconList_UpDown $w 1] - bind $data(canvas) <Left> [list tk::IconList_LeftRight $w -1] - bind $data(canvas) <Right> [list tk::IconList_LeftRight $w 1] - bind $data(canvas) <Return> [list tk::IconList_ReturnKey $w] - bind $data(canvas) <KeyPress> [list tk::IconList_KeyPress $w %A] - bind $data(canvas) <Control-KeyPress> ";" - bind $data(canvas) <Alt-KeyPress> ";" - - bind $data(canvas) <FocusIn> [list tk::IconList_FocusIn $w] - bind $data(canvas) <FocusOut> [list tk::IconList_FocusOut $w] - - return $w -} - -# ::tk::IconList_AutoScan -- -# -# This procedure is invoked when the mouse leaves an entry window -# with button 1 down. It scrolls the window up, down, left, or -# right, depending on where the mouse left the window, and reschedules -# itself as an "after" command so that the window continues to scroll until -# the mouse moves back into the window or the mouse button is released. -# -# Arguments: -# w - The IconList window. -# -proc ::tk::IconList_AutoScan {w} { - upvar ::tk::$w data - variable ::tk::Priv - - if {![winfo exists $w]} return - set x $Priv(x) - set y $Priv(y) - - if {$data(noScroll)} { - return - } - if {$x >= [winfo width $data(canvas)]} { - $data(canvas) xview scroll 1 units - } elseif {$x < 0} { - $data(canvas) xview scroll -1 units - } elseif {$y >= [winfo height $data(canvas)]} { - # do nothing - } elseif {$y < 0} { - # do nothing - } else { - return - } - - IconList_Motion1 $w $x $y - set Priv(afterId) [after 50 [list tk::IconList_AutoScan $w]] -} - -# Deletes all the items inside the canvas subwidget and reset the IconList's -# state. -# -proc ::tk::IconList_DeleteAll {w} { - upvar ::tk::$w data - upvar ::tk::$w:itemList itemList - - $data(canvas) delete all - unset -nocomplain data(selected) data(rect) data(list) itemList - set data(maxIW) 1 - set data(maxIH) 1 - set data(maxTW) 1 - set data(maxTH) 1 - set data(numItems) 0 - set data(noScroll) 1 - set data(selection) {} - set data(index,anchor) "" - $data(sbar) set 0.0 1.0 - $data(canvas) xview moveto 0 -} - -# Adds an icon into the IconList with the designated image and text -# -proc ::tk::IconList_Add {w image items} { - upvar ::tk::$w data - upvar ::tk::$w:itemList itemList - upvar ::tk::$w:textList textList - - foreach text $items { - set iTag [$data(canvas) create image 0 0 -image $image -anchor nw \ - -tags [list icon $data(numItems) item$data(numItems)]] - set tTag [$data(canvas) create text 0 0 -text $text -anchor nw \ - -font $data(font) -fill $data(fill) \ - -tags [list text $data(numItems) item$data(numItems)]] - set rTag [$data(canvas) create rect 0 0 0 0 -fill "" -outline "" \ - -tags [list rect $data(numItems) item$data(numItems)]] - - foreach {x1 y1 x2 y2} [$data(canvas) bbox $iTag] { - break - } - set iW [expr {$x2 - $x1}] - set iH [expr {$y2 - $y1}] - if {$data(maxIW) < $iW} { - set data(maxIW) $iW - } - if {$data(maxIH) < $iH} { - set data(maxIH) $iH - } - - foreach {x1 y1 x2 y2} [$data(canvas) bbox $tTag] { - break - } - set tW [expr {$x2 - $x1}] - set tH [expr {$y2 - $y1}] - if {$data(maxTW) < $tW} { - set data(maxTW) $tW - } - if {$data(maxTH) < $tH} { - set data(maxTH) $tH - } - - lappend data(list) [list $iTag $tTag $rTag $iW $iH $tW \ - $tH $data(numItems)] - set itemList($rTag) [list $iTag $tTag $text $data(numItems)] - set textList($data(numItems)) [string tolower $text] - incr data(numItems) - } -} - -# Places the icons in a column-major arrangement. -# -proc ::tk::IconList_Arrange {w} { - upvar ::tk::$w data - - if {![info exists data(list)]} { - if {[info exists data(canvas)] && [winfo exists $data(canvas)]} { - set data(noScroll) 1 - $data(sbar) configure -command "" - } - return - } - - set W [winfo width $data(canvas)] - set H [winfo height $data(canvas)] - set pad [expr {[$data(canvas) cget -highlightthickness] + \ - [$data(canvas) cget -bd]}] - if {$pad < 2} { - set pad 2 - } - - incr W -[expr {$pad*2}] - incr H -[expr {$pad*2}] - - set dx [expr {$data(maxIW) + $data(maxTW) + 8}] - if {$data(maxTH) > $data(maxIH)} { - set dy $data(maxTH) - } else { - set dy $data(maxIH) - } - incr dy 2 - set shift [expr {$data(maxIW) + 4}] - - set x [expr {$pad * 2}] - set y [expr {$pad * 1}] ; # Why * 1 ? - set usedColumn 0 - foreach sublist $data(list) { - set usedColumn 1 - foreach {iTag tTag rTag iW iH tW tH} $sublist { - break - } - - set i_dy [expr {($dy - $iH)/2}] - set t_dy [expr {($dy - $tH)/2}] - - $data(canvas) coords $iTag $x [expr {$y + $i_dy}] - $data(canvas) coords $tTag [expr {$x + $shift}] [expr {$y + $t_dy}] - $data(canvas) coords $rTag $x $y [expr {$x+$dx}] [expr {$y+$dy}] - - incr y $dy - if {($y + $dy) > $H} { - set y [expr {$pad * 1}] ; # *1 ? - incr x $dx - set usedColumn 0 - } - } - - if {$usedColumn} { - set sW [expr {$x + $dx}] - } else { - set sW $x - } - - if {$sW < $W} { - $data(canvas) configure -scrollregion [list $pad $pad $sW $H] - $data(sbar) configure -command "" - $data(canvas) xview moveto 0 - set data(noScroll) 1 - } else { - $data(canvas) configure -scrollregion [list $pad $pad $sW $H] - $data(sbar) configure -command [list $data(canvas) xview] - set data(noScroll) 0 - } - - set data(itemsPerColumn) [expr {($H-$pad)/$dy}] - if {$data(itemsPerColumn) < 1} { - set data(itemsPerColumn) 1 - } - - IconList_DrawSelection $w -} - -# Gets called when the user invokes the IconList (usually by double-clicking -# or pressing the Return key). -# -proc ::tk::IconList_Invoke {w} { - upvar ::tk::$w data - - if {$data(-command) ne "" && [llength $data(selection)]} { - uplevel #0 $data(-command) - } -} - -# ::tk::IconList_See -- -# -# If the item is not (completely) visible, scroll the canvas so that -# it becomes visible. -proc ::tk::IconList_See {w rTag} { - upvar ::tk::$w data - upvar ::tk::$w:itemList itemList - - if {$data(noScroll)} { - return - } - set sRegion [$data(canvas) cget -scrollregion] - if {$sRegion eq ""} { - return - } - - if { $rTag < 0 || $rTag >= [llength $data(list)] } { - return - } - - set bbox [$data(canvas) bbox item$rTag] - set pad [expr {[$data(canvas) cget -highlightthickness] + \ - [$data(canvas) cget -bd]}] - - set x1 [lindex $bbox 0] - set x2 [lindex $bbox 2] - incr x1 -[expr {$pad * 2}] - incr x2 -[expr {$pad * 1}] ; # *1 ? - - set cW [expr {[winfo width $data(canvas)] - $pad*2}] - - set scrollW [expr {[lindex $sRegion 2]-[lindex $sRegion 0]+1}] - set dispX [expr {int([lindex [$data(canvas) xview] 0]*$scrollW)}] - set oldDispX $dispX - - # check if out of the right edge - # - if {($x2 - $dispX) >= $cW} { - set dispX [expr {$x2 - $cW}] - } - # check if out of the left edge - # - if {($x1 - $dispX) < 0} { - set dispX $x1 - } - - if {$oldDispX ne $dispX} { - set fraction [expr {double($dispX)/double($scrollW)}] - $data(canvas) xview moveto $fraction - } -} - -proc ::tk::IconList_Btn1 {w x y} { - upvar ::tk::$w data - - focus $data(canvas) - set i [IconList_Index $w @$x,$y] - if {$i eq ""} { - return - } - IconList_Selection $w clear 0 end - IconList_Selection $w set $i - IconList_Selection $w anchor $i -} - -proc ::tk::IconList_CtrlBtn1 {w x y} { - upvar ::tk::$w data - - if { $data(-multiple) } { - focus $data(canvas) - set i [IconList_Index $w @$x,$y] - if {$i eq ""} { - return - } - if { [IconList_Selection $w includes $i] } { - IconList_Selection $w clear $i - } else { - IconList_Selection $w set $i - IconList_Selection $w anchor $i - } - } -} - -proc ::tk::IconList_ShiftBtn1 {w x y} { - upvar ::tk::$w data - - if { $data(-multiple) } { - focus $data(canvas) - set i [IconList_Index $w @$x,$y] - if {$i eq ""} { - return - } - if {[IconList_Index $w anchor] eq ""} { - IconList_Selection $w anchor $i - } - IconList_Selection $w clear 0 end - IconList_Selection $w set anchor $i - } -} - -# Gets called on button-1 motions -# -proc ::tk::IconList_Motion1 {w x y} { - variable ::tk::Priv - set Priv(x) $x - set Priv(y) $y - set i [IconList_Index $w @$x,$y] - if {$i eq ""} { - return - } - IconList_Selection $w clear 0 end - IconList_Selection $w set $i -} - -proc ::tk::IconList_ShiftMotion1 {w x y} { - upvar ::tk::$w data - variable ::tk::Priv - set Priv(x) $x - set Priv(y) $y - set i [IconList_Index $w @$x,$y] - if {$i eq ""} { - return - } - IconList_Selection $w clear 0 end - IconList_Selection $w set anchor $i -} - -proc ::tk::IconList_Double1 {w x y} { - upvar ::tk::$w data - - if {[llength $data(selection)]} { - IconList_Invoke $w - } -} - -proc ::tk::IconList_ReturnKey {w} { - IconList_Invoke $w -} - -proc ::tk::IconList_Leave1 {w x y} { - variable ::tk::Priv - - set Priv(x) $x - set Priv(y) $y - IconList_AutoScan $w -} - -proc ::tk::IconList_FocusIn {w} { - upvar ::tk::$w data - - $w.cHull state focus - if {![info exists data(list)]} { - return - } - - if {[llength $data(selection)]} { - IconList_DrawSelection $w - } -} - -proc ::tk::IconList_FocusOut {w} { - $w.cHull state !focus - IconList_Selection $w clear 0 end -} - -# ::tk::IconList_UpDown -- -# -# Moves the active element up or down by one element -# -# Arguments: -# w - The IconList widget. -# amount - +1 to move down one item, -1 to move back one item. -# -proc ::tk::IconList_UpDown {w amount} { - upvar ::tk::$w data - - if {![info exists data(list)]} { - return - } - - set curr [tk::IconList_CurSelection $w] - if { [llength $curr] == 0 } { - set i 0 - } else { - set i [tk::IconList_Index $w anchor] - if {$i eq ""} { - return - } - incr i $amount - } - IconList_Selection $w clear 0 end - IconList_Selection $w set $i - IconList_Selection $w anchor $i - IconList_See $w $i -} - -# ::tk::IconList_LeftRight -- -# -# Moves the active element left or right by one column -# -# Arguments: -# w - The IconList widget. -# amount - +1 to move right one column, -1 to move left one column. -# -proc ::tk::IconList_LeftRight {w amount} { - upvar ::tk::$w data - - if {![info exists data(list)]} { - return - } - - set curr [IconList_CurSelection $w] - if { [llength $curr] == 0 } { - set i 0 - } else { - set i [IconList_Index $w anchor] - if {$i eq ""} { - return - } - incr i [expr {$amount*$data(itemsPerColumn)}] - } - IconList_Selection $w clear 0 end - IconList_Selection $w set $i - IconList_Selection $w anchor $i - IconList_See $w $i -} - -#---------------------------------------------------------------------- -# Accelerator key bindings -#---------------------------------------------------------------------- - -# ::tk::IconList_KeyPress -- -# -# Gets called when user enters an arbitrary key in the listbox. -# -proc ::tk::IconList_KeyPress {w key} { - variable ::tk::Priv - - append Priv(ILAccel,$w) $key - IconList_Goto $w $Priv(ILAccel,$w) - catch { - after cancel $Priv(ILAccel,$w,afterId) - } - set Priv(ILAccel,$w,afterId) [after 500 [list tk::IconList_Reset $w]] -} - -proc ::tk::IconList_Goto {w text} { - upvar ::tk::$w data - upvar ::tk::$w:textList textList - - if {![info exists data(list)]} { - return - } - - if {$text eq "" || $data(numItems) == 0} { - return - } - - if {[llength [IconList_CurSelection $w]]} { - set start [IconList_Index $w anchor] - } else { - set start 0 - } - - set theIndex -1 - set less 0 - set len [string length $text] - set len0 [expr {$len-1}] - set i $start - - # Search forward until we find a filename whose prefix is a - # case-insensitive match with $text - while {1} { - if {[string equal -nocase -length $len0 $textList($i) $text]} { - set theIndex $i - break - } - incr i - if {$i == $data(numItems)} { - set i 0 - } - if {$i == $start} { - break - } - } - - if {$theIndex > -1} { - IconList_Selection $w clear 0 end - IconList_Selection $w set $theIndex - IconList_Selection $w anchor $theIndex - IconList_See $w $theIndex - } -} - -proc ::tk::IconList_Reset {w} { - variable ::tk::Priv - - unset -nocomplain Priv(ILAccel,$w) -} - -#---------------------------------------------------------------------- -# -# F I L E D I A L O G -# -#---------------------------------------------------------------------- - namespace eval ::tk::dialog {} namespace eval ::tk::dialog::file { namespace import -force ::tk::msgcat::* - set ::tk::dialog::file::showHiddenBtn 0 - set ::tk::dialog::file::showHiddenVar 1 + variable showHiddenBtn 0 + variable showHiddenVar 1 + + # 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 + }] + } + 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= + }] + } + 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 + }] + } } # ::tk::dialog::file:: -- # -# Implements the TK file selection dialog. This dialog is used when -# the tk_strictMotif flag is set to false. This procedure shouldn't -# be called directly. Call tk_getOpenFile or tk_getSaveFile instead. +# Implements the TK file selection dialog. This dialog is used when the +# tk_strictMotif flag is set to false. This procedure shouldn't be +# called directly. Call tk_getOpenFile or tk_getSaveFile instead. # # Arguments: # type "open" or "save" @@ -813,6 +96,7 @@ namespace eval ::tk::dialog::file { proc ::tk::dialog::file:: {type args} { variable ::tk::Priv + variable showHiddenBtn set dataName __tk_filedialog upvar ::tk::dialog::file::$dataName data @@ -845,7 +129,7 @@ proc ::tk::dialog::file:: {type args} { set data(hiddenBtn) $w.contents.f2.hidden SetSelectMode $w $data(-multiple) } - if {$::tk::dialog::file::showHiddenBtn} { + if {$showHiddenBtn} { $data(hiddenBtn) configure -state normal grid $data(hiddenBtn) } else { @@ -856,12 +140,12 @@ proc ::tk::dialog::file:: {type args} { # Make sure subseqent uses of this dialog are independent [Bug 845189] unset -nocomplain data(extUsed) - # Dialog boxes should be transient with respect to their parent, - # so that they will always stay on top of their parent window. However, - # some window managers will create the window as withdrawn if the parent - # window is withdrawn or iconified. Combined with the grab we put on the - # window, this can hang the entire application. Therefore we only make - # the dialog transient if the parent is viewable. + # Dialog boxes should be transient with respect to their parent, so that + # they will always stay on top of their parent window. However, some + # window managers will create the window as withdrawn if the parent window + # is withdrawn or iconified. Combined with the grab we put on the window, + # this can hang the entire application. Therefore we only make the dialog + # transient if the parent is viewable. if {[winfo viewable [winfo toplevel $data(-parent)]]} { wm transient $w $data(-parent) @@ -897,7 +181,7 @@ proc ::tk::dialog::file:: {type args} { set filter [lindex $type 1] $data(typeMenu) add command -label $title \ -command [list ::tk::dialog::file::SetFilter $w $type] - # string first avoids glob-pattern char issues + # [string first] avoids glob-pattern char issues if {[string first ${initialTypeName} $title] == 0} { set initialtype $type } @@ -927,11 +211,10 @@ proc ::tk::dialog::file:: {type args} { $data(ent) selection range 0 end $data(ent) icursor end - # Wait for the user to respond, then restore the focus and - # return the index of the selected button. Restore the focus - # before deleting the window, since otherwise the window manager - # may take the focus away so we can't redirect it. Finally, - # restore any grab that was in effect. + # Wait for the user to respond, then restore the focus and return the + # index of the selected button. Restore the focus before deleting the + # window, since otherwise the window manager may take the focus away so we + # can't redirect it. Finally, restore any grab that was in effect. vwait ::tk::Priv(selectFilePath) @@ -941,7 +224,7 @@ proc ::tk::dialog::file:: {type args} { # foreach trace [trace info variable data(selectPath)] { - trace remove variable data(selectPath) [lindex $trace 0] [lindex $trace 1] + trace remove variable data(selectPath) {*}$trace } $data(dirMenuBtn) configure -textvariable {} @@ -962,7 +245,7 @@ proc ::tk::dialog::file::Config {dataName type argList} { # if the dialog is now used with a different -parent option. foreach trace [trace info variable data(selectPath)] { - trace remove variable data(selectPath) [lindex $trace 0] [lindex $trace 1] + trace remove variable data(selectPath) {*}$trace } # 1: the configuration specs @@ -1030,11 +313,12 @@ proc ::tk::dialog::file::Config {dataName type argList} { set data(-filetypes) [::tk::FDGetFileTypes $data(-filetypes)] if {![winfo exists $data(-parent)]} { - error "bad window path name \"$data(-parent)\"" + return -code error -errorcode [list TK LOOKUP WINDOW $data(-parent)] \ + "bad window path name \"$data(-parent)\"" } - # Set -multiple to a one or zero value (not other boolean types - # like "yes") so we can use it in tests more easily. + # Set -multiple to a one or zero value (not other boolean types like + # "yes") so we can use it in tests more easily. if {$type eq "save"} { set data(-multiple) 0 } elseif {$data(-multiple)} { @@ -1068,21 +352,10 @@ proc ::tk::dialog::file::Create {w class} { set data(dirMenu) $f1.menu.menu ttk::menubutton $f1.menu -menu $data(dirMenu) -direction flush \ -textvariable [format %s(selectPath) ::tk::dialog::file::$dataName] - [menu $data(dirMenu) -tearoff 0] add radiobutton -label "" -variable \ + menu $data(dirMenu) -tearoff 0 + $data(dirMenu) add radiobutton -label "" -variable \ [format %s(selectPath) ::tk::dialog::file::$dataName] set data(upBtn) [ttk::button $f1.up] - if {![info exists Priv(updirImage)]} { - set Priv(updirImage) [image create bitmap -data { -#define updir_width 28 -#define updir_height 16 -static char updir_bits[] = { - 0x00, 0x00, 0x00, 0x00, 0x80, 0x1f, 0x00, 0x00, 0x40, 0x20, 0x00, 0x00, - 0x20, 0x40, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x01, 0x10, 0x00, 0x00, 0x01, - 0x10, 0x02, 0x00, 0x01, 0x10, 0x07, 0x00, 0x01, 0x90, 0x0f, 0x00, 0x01, - 0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01, - 0x10, 0xfe, 0x07, 0x01, 0x10, 0x00, 0x00, 0x01, 0x10, 0x00, 0x00, 0x01, - 0xf0, 0xff, 0xff, 0x01};}] - } $data(upBtn) configure -image $Priv(updirImage) $f1.menu configure -takefocus 1;# -highlightthickness 2 @@ -1119,8 +392,8 @@ static char updir_bits[] = { # -pady 0 set data(ent) [ttk::entry $f2.ent] - # The font to use for the icons. The default Canvas font on Unix - # is just deviant. + # The font to use for the icons. The default Canvas font on Unix is just + # deviant. set ::tk::$w.contents.icons(font) [$data(ent) cget -font] # Make the file types bits only if this is a File Dialog @@ -1137,9 +410,9 @@ static char updir_bits[] = { focus $data(typeMenuBtn)] } - # The hidden button is displayed when ::tk::dialog::file::showHiddenBtn - # is true. Create it disabled so the binding doesn't trigger if it - # isn't shown. + # The hidden button is displayed when ::tk::dialog::file::showHiddenBtn is + # true. Create it disabled so the binding doesn't trigger if it isn't + # shown. if {$class eq "TkFDialog"} { set text [mc "Show &Hidden Files and Directories"] } else { @@ -1242,36 +515,32 @@ proc ::tk::dialog::file::SetSelectMode {w multi} { } set iconListCommand [list ::tk::dialog::file::OkCmd $w] ::tk::SetAmpText $w.contents.f2.lab $fNameCaption - ::tk::IconList_Config $data(icons) \ - [list -multiple $multi -command $iconListCommand] + $data(icons) configure -multiple $multi -command $iconListCommand return } # ::tk::dialog::file::UpdateWhenIdle -- # -# Creates an idle event handler which updates the dialog in idle -# time. This is important because loading the directory may take a long -# time and we don't want to load the same directory for multiple times -# due to multiple concurrent events. +# Creates an idle event handler which updates the dialog in idle time. +# This is important because loading the directory may take a long time +# and we don't want to load the same directory for multiple times due to +# multiple concurrent events. # proc ::tk::dialog::file::UpdateWhenIdle {w} { upvar ::tk::dialog::file::[winfo name $w] data if {[info exists data(updateId)]} { return - } else { - set data(updateId) [after idle [list ::tk::dialog::file::Update $w]] } + set data(updateId) [after idle [list ::tk::dialog::file::Update $w]] } # ::tk::dialog::file::Update -- # -# Loads the files and directories into the IconList widget. Also -# sets up the directory option menu for quick access to parent -# directories. +# Loads the files and directories into the IconList widget. Also sets up +# the directory option menu for quick access to parent directories. # proc ::tk::dialog::file::Update {w} { - # This proc may be called within an idle handler. Make sure that the # window has not been destroyed before this proc is called if {![winfo exists $w]} { @@ -1285,30 +554,24 @@ proc ::tk::dialog::file::Update {w} { set dataName [winfo name $w] upvar ::tk::dialog::file::$dataName data variable ::tk::Priv + variable showHiddenVar global tk_library unset -nocomplain data(updateId) - if {![info exists Priv(folderImage)]} { - set Priv(folderImage) [image create photo -data { -R0lGODlhEAAMAKEAAAD//wAAAPD/gAAAACH5BAEAAAAALAAAAAAQAAwAAAIghINhyycvVFsB -QtmS3rjaH1Hg141WaT5ouprt2HHcUgAAOw==}] - set Priv(fileImage) [image create photo -data { -R0lGODlhDAAMAKEAALLA3AAAAP//8wAAACH5BAEAAAAALAAAAAAMAAwAAAIgRI4Ha+IfWHsO -rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}] - } set folder $Priv(folderImage) set file $Priv(fileImage) set appPWD [pwd] if {[catch { cd $data(selectPath) - }]} { + }]} then { # We cannot change directory to $data(selectPath). $data(selectPath) - # should have been checked before ::tk::dialog::file::Update is called, so - # we normally won't come to here. Anyways, give an error and abort - # action. - tk_messageBox -type ok -parent $w -icon warning -message \ - [mc "Cannot change to the directory \"%1\$s\".\nPermission denied." $data(selectPath)] + # should have been checked before ::tk::dialog::file::Update is + # called, so we normally won't come to here. Anyways, give an error + # and abort action. + tk_messageBox -type ok -parent $w -icon warning -message [mc \ + "Cannot change to the directory \"%1\$s\".\nPermission denied."\ + $data(selectPath)] cd $appPWD return } @@ -1322,24 +585,21 @@ rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}] $w configure -cursor watch update idletasks - ::tk::IconList_DeleteAll $data(icons) + $data(icons) deleteall - set showHidden $::tk::dialog::file::showHiddenVar + set showHidden $showHiddenVar # Make the dir list. Note that using an explicit [pwd] (instead of '.') is # better in some VFS cases. - ::tk::IconList_Add $data(icons) $folder [GlobFiltered [pwd] d 1] + $data(icons) add $folder [GlobFiltered [pwd] d 1] if {$class eq "TkFDialog"} { # Make the file list if this is a File Dialog, selecting all but # 'd'irectory type files. # - ::tk::IconList_Add $data(icons) $file \ - [GlobFiltered [pwd] {f b c l p s}] + $data(icons) add $file [GlobFiltered [pwd] {f b c l p s}] } - ::tk::IconList_Arrange $data(icons) - # Update the Directory: option menu # set list "" @@ -1382,9 +642,10 @@ rSASvJTGhnhcV3EJlo3kh53ltF5nAhQAOw==}] proc ::tk::dialog::file::SetPathSilently {w path} { upvar ::tk::dialog::file::[winfo name $w] data - trace remove variable data(selectPath) write [list ::tk::dialog::file::SetPath $w] + set cb [list ::tk::dialog::file::SetPath $w] + trace remove variable data(selectPath) write $cb set data(selectPath) $path - trace add variable data(selectPath) write [list ::tk::dialog::file::SetPath $w] + trace add variable data(selectPath) write $cb } @@ -1406,14 +667,13 @@ proc ::tk::dialog::file::SetPath {w name1 name2 op} { # proc ::tk::dialog::file::SetFilter {w type} { upvar ::tk::dialog::file::[winfo name $w] data - upvar ::tk::$data(icons) icons set data(filterType) $type set data(filter) [lindex $type 1] $data(typeMenuBtn) configure -text [lindex $type 0] ;#-indicatoron 1 - # If we aren't using a default extension, use the one suppled - # by the filter. + # If we aren't using a default extension, use the one suppled by the + # filter. if {![info exists data(extUsed)]} { if {[string length $data(-defaultextension)]} { set data(extUsed) 1 @@ -1423,8 +683,8 @@ proc ::tk::dialog::file::SetFilter {w type} { } if {!$data(extUsed)} { - # Get the first extension in the list that matches {^\*\.\w+$} - # and remove all * from the filter. + # Get the first extension in the list that matches {^\*\.\w+$} and + # remove all * from the filter. set index [lsearch -regexp $data(filter) {^\*\.\w+$}] if {$index >= 0} { set data(-defaultextension) \ @@ -1435,15 +695,14 @@ proc ::tk::dialog::file::SetFilter {w type} { } } - $icons(sbar) set 0.0 0.0 + $data(icons) see 0 UpdateWhenIdle $w } # tk::dialog::file::ResolveFile -- # -# Interpret the user's text input in a file selection dialog. -# Performs: +# Interpret the user's text input in a file selection dialog. Performs: # # (1) ~ substitution # (2) resolve all instances of . and .. @@ -1464,25 +723,24 @@ proc ::tk::dialog::file::SetFilter {w type} { # flag = OK : valid input # = PATTERN : valid directory/pattern # = PATH : the directory does not exist -# = FILE : the directory exists by the file doesn't -# exist +# = FILE : the directory exists by the file doesn't exist # = CHDIR : Cannot change to the directory # = ERROR : Invalid entry # # directory : valid only if flag = OK or PATTERN or FILE # file : valid only if flag = OK or PATTERN # -# directory may not be the same as context, because text may contain -# a subdirectory name +# directory may not be the same as context, because text may contain a +# subdirectory name # proc ::tk::dialog::file::ResolveFile {context text defaultext {expandEnv 1}} { set appPWD [pwd] set path [JoinFile $context $text] - # If the file has no extension, append the default. Be careful not - # to do this for directories, otherwise typing a dirname in the box - # will give back "dirname.extension" instead of trying to change dir. + # If the file has no extension, append the default. Be careful not to do + # this for directories, otherwise typing a dirname in the box will give + # back "dirname.extension" instead of trying to change dir. if { ![file isdirectory $path] && ([file ext $path] eq "") && ![string match {$*} [file tail $path]] @@ -1491,8 +749,8 @@ proc ::tk::dialog::file::ResolveFile {context text defaultext {expandEnv 1}} { } if {[catch {file exists $path}]} { - # This "if" block can be safely removed if the following code - # stop generating errors. + # This "if" block can be safely removed if the following code stop + # generating errors. # # file exists ~nonsuchuser # @@ -1691,8 +949,8 @@ proc ::tk::dialog::file::UpDirCmd {w} { } } -# Join a file name to a path name. The "file join" command will break -# if the filename begins with ~ +# Join a file name to a path name. The "file join" command will break if the +# filename begins with ~ # proc ::tk::dialog::file::JoinFile {path file} { if {[string match {~*} $file] && [file exists $path/$file]} { @@ -1708,12 +966,14 @@ proc ::tk::dialog::file::OkCmd {w} { upvar ::tk::dialog::file::[winfo name $w] data set filenames {} - foreach item [::tk::IconList_CurSelection $data(icons)] { - lappend filenames [::tk::IconList_Get $data(icons) $item] + foreach item [$data(icons) selection get] { + lappend filenames [$data(icons) get $item] } - if {([llength $filenames] && !$data(-multiple)) || \ - ($data(-multiple) && ([llength $filenames] == 1))} { + if { + ([llength $filenames] && !$data(-multiple)) || + ($data(-multiple) && ([llength $filenames] == 1)) + } then { set filename [lindex $filenames 0] set file [JoinFile $data(selectPath) $filename] if {[file isdirectory $file]} { @@ -1751,8 +1011,8 @@ proc ::tk::dialog::file::ListBrowse {w} { upvar ::tk::dialog::file::[winfo name $w] data set text {} - foreach item [::tk::IconList_CurSelection $data(icons)] { - lappend text [::tk::IconList_Get $data(icons) $item] + foreach item [$data(icons) selection get] { + lappend text [$data(icons) get $item] } if {[llength $text] == 0} { return @@ -1788,8 +1048,8 @@ proc ::tk::dialog::file::ListBrowse {w} { } } -# Gets called when user invokes the IconList widget (double-click, -# Return key, etc) +# Gets called when user invokes the IconList widget (double-click, Return key, +# etc) # proc ::tk::dialog::file::ListInvoke {w filenames} { upvar ::tk::dialog::file::[winfo name $w] data @@ -1822,11 +1082,11 @@ proc ::tk::dialog::file::ListInvoke {w filenames} { # ::tk::dialog::file::Done -- # -# Gets called when user has input a valid filename. Pops up a -# dialog box to confirm selection when necessary. Sets the -# tk::Priv(selectFilePath) variable, which will break the "vwait" -# loop in ::tk::dialog::file:: and return the selected filename to the -# script that calls tk_getOpenFile or tk_getSaveFile +# Gets called when user has input a valid filename. Pops up a dialog +# box to confirm selection when necessary. Sets the +# tk::Priv(selectFilePath) variable, which will break the "vwait" loop +# in ::tk::dialog::file:: and return the selected filename to the script +# that calls tk_getOpenFile or tk_getSaveFile # proc ::tk::dialog::file::Done {w {selectFilePath ""}} { upvar ::tk::dialog::file::[winfo name $w] data @@ -1853,9 +1113,11 @@ proc ::tk::dialog::file::Done {w {selectFilePath ""}} { return } } - if {[info exists data(-typevariable)] && $data(-typevariable) ne "" - && [info exists data(-filetypes)] && [llength $data(-filetypes)] - && [info exists data(filterType)] && $data(filterType) ne ""} { + if { + [info exists data(-typevariable)] && $data(-typevariable) ne "" + && [info exists data(-filetypes)] && [llength $data(-filetypes)] + && [info exists data(filterType)] && $data(filterType) ne "" + } then { upvar #0 $data(-typevariable) typeVariable set typeVariable [lindex $data(filterType) 0] } @@ -1864,11 +1126,22 @@ proc ::tk::dialog::file::Done {w {selectFilePath ""}} { set Priv(selectFilePath) $selectFilePath } +# ::tk::dialog::file::GlobFiltered -- +# +# Gets called to do globbing, returning the results and filtering them +# according to the current filter (and removing the entries for '.' and +# '..' which are never shown). Deals with evil cases such as where the +# user is supplying a filter which is an invalid list or where it has an +# unbalanced brace. The resulting list will be dictionary sorted. +# +# Arguments: +# dir Which directory to search +# type List of filetypes to look for ('d' or 'f b c l p s') +# overrideFilter Whether to ignore the filter for this search. +# +# NB: Assumes that the caller has mapped the state variable to 'data'. +# proc ::tk::dialog::file::GlobFiltered {dir type {overrideFilter 0}} { - # $dir == where to search - # $type == what to look for ('d' or 'f b c l p s') - # $overrideFilter == whether to ignore the filter - variable showHiddenVar upvar 1 data(filter) filter diff --git a/library/ttk/entry.tcl b/library/ttk/entry.tcl index f16cf8b..b3ebcbd 100644 --- a/library/ttk/entry.tcl +++ b/library/ttk/entry.tcl @@ -42,7 +42,7 @@ option add *TEntry.cursor [ttk::cursor text] # # <Control-Key-space>, <Control-Shift-Key-space>, # <Key-Select>, <Shift-Key-Select>: -# ttk::entry widget doesn't use selection anchor. +# Ttk entry widget doesn't use selection anchor. # <Key-Insert>: # Inserts PRIMARY selection (on non-Windows platforms). # This is inconsistent with typical platform bindings. @@ -78,7 +78,7 @@ bind TEntry <B1-Leave> { ttk::entry::DragOut %W %m } bind TEntry <B1-Enter> { ttk::entry::DragIn %W } bind TEntry <ButtonRelease-1> { ttk::entry::Release %W } -bind TEntry <Control-ButtonPress-1> { +bind TEntry <<ToggleSelection>> { %W instate {!readonly !disabled} { %W icursor @%x ; focus %W } } @@ -93,22 +93,22 @@ bind TEntry <<PasteSelection>> { ttk::entry::ScanRelease %W %x } ## Keyboard navigation bindings: # -bind TEntry <Key-Left> { ttk::entry::Move %W prevchar } -bind TEntry <Key-Right> { ttk::entry::Move %W nextchar } -bind TEntry <Control-Key-Left> { ttk::entry::Move %W prevword } -bind TEntry <Control-Key-Right> { ttk::entry::Move %W nextword } -bind TEntry <Key-Home> { ttk::entry::Move %W home } -bind TEntry <Key-End> { ttk::entry::Move %W end } +bind TEntry <<PrevChar>> { ttk::entry::Move %W prevchar } +bind TEntry <<NextChar>> { ttk::entry::Move %W nextchar } +bind TEntry <<PrevWord>> { ttk::entry::Move %W prevword } +bind TEntry <<NextWord>> { ttk::entry::Move %W nextword } +bind TEntry <<LineStart>> { ttk::entry::Move %W home } +bind TEntry <<LineEnd>> { ttk::entry::Move %W end } -bind TEntry <Shift-Key-Left> { ttk::entry::Extend %W prevchar } -bind TEntry <Shift-Key-Right> { ttk::entry::Extend %W nextchar } -bind TEntry <Shift-Control-Key-Left> { ttk::entry::Extend %W prevword } -bind TEntry <Shift-Control-Key-Right> { ttk::entry::Extend %W nextword } -bind TEntry <Shift-Key-Home> { ttk::entry::Extend %W home } -bind TEntry <Shift-Key-End> { ttk::entry::Extend %W end } +bind TEntry <<SelectPrevChar>> { ttk::entry::Extend %W prevchar } +bind TEntry <<SelectNextChar>> { ttk::entry::Extend %W nextchar } +bind TEntry <<SelectPrevWord>> { ttk::entry::Extend %W prevword } +bind TEntry <<SelectNextWord>> { ttk::entry::Extend %W nextword } +bind TEntry <<SelectLineStart>> { ttk::entry::Extend %W home } +bind TEntry <<SelectLineEnd>> { ttk::entry::Extend %W end } -bind TEntry <Control-Key-slash> { %W selection range 0 end } -bind TEntry <Control-Key-backslash> { %W selection clear } +bind TEntry <<SelectAll>> { %W selection range 0 end } +bind TEntry <<SelectNone>> { %W selection clear } bind TEntry <<TraverseIn>> { %W selection range 0 end; %W icursor end } @@ -136,16 +136,12 @@ if {[tk windowingsystem] eq "aqua"} { bind TEntry <Command-KeyPress> {# nothing} } # Tk-on-Cocoa generates characters for these two keys. [Bug 2971663] -bind TEntry <Down> {# nothing} -bind TEntry <Up> {# nothing} +bind TEntry <<PrevLine>> {# nothing} +bind TEntry <<NextLine>> {# nothing} ## Additional emacs-like bindings: # -bind TEntry <Control-Key-a> { ttk::entry::Move %W home } -bind TEntry <Control-Key-b> { ttk::entry::Move %W prevchar } -bind TEntry <Control-Key-d> { ttk::entry::Delete %W } -bind TEntry <Control-Key-e> { ttk::entry::Move %W end } -bind TEntry <Control-Key-f> { ttk::entry::Move %W nextchar } +bind TEntry <Control-Key-d> { ttk::entry::Delete %W } bind TEntry <Control-Key-h> { ttk::entry::Backspace %W } bind TEntry <Control-Key-k> { %W delete insert end } diff --git a/library/ttk/notebook.tcl b/library/ttk/notebook.tcl index d424b6c..72b85e6 100644 --- a/library/ttk/notebook.tcl +++ b/library/ttk/notebook.tcl @@ -108,7 +108,7 @@ proc ttk::notebook::enableTraversal {nb} { bind $top <Control-Key-Next> {+ttk::notebook::TLCycleTab %W 1} bind $top <Control-Key-Prior> {+ttk::notebook::TLCycleTab %W -1} bind $top <Control-Key-Tab> {+ttk::notebook::TLCycleTab %W 1} - bind $top <Shift-Control-Key-Tab> {+ttk::notebook::TLCycleTab %W -1} + bind $top <Control-Shift-Key-Tab> {+ttk::notebook::TLCycleTab %W -1} catch { bind $top <Control-Key-ISO_Left_Tab> {+ttk::notebook::TLCycleTab %W -1} } @@ -170,7 +170,7 @@ proc ttk::notebook::EnclosingNotebook {w} { } # TLCycleTab -- -# toplevel binding procedure for Control-Tab / Shift-Control-Tab +# toplevel binding procedure for Control-Tab / Control-Shift-Tab # Select the next/previous tab in the nearest ancestor notebook. # proc ttk::notebook::TLCycleTab {w dir} { diff --git a/library/ttk/scale.tcl b/library/ttk/scale.tcl index 4a534de..62c85bf 100644 --- a/library/ttk/scale.tcl +++ b/library/ttk/scale.tcl @@ -21,16 +21,19 @@ bind TScale <ButtonPress-3> { ttk::scale::Jump %W %x %y } bind TScale <B3-Motion> { ttk::scale::Drag %W %x %y } bind TScale <ButtonRelease-3> { ttk::scale::Release %W %x %y } -bind TScale <Left> { ttk::scale::Increment %W -1 } -bind TScale <Up> { ttk::scale::Increment %W -1 } -bind TScale <Right> { ttk::scale::Increment %W 1 } -bind TScale <Down> { ttk::scale::Increment %W 1 } -bind TScale <Control-Left> { ttk::scale::Increment %W -10 } -bind TScale <Control-Up> { ttk::scale::Increment %W -10 } -bind TScale <Control-Right> { ttk::scale::Increment %W 10 } -bind TScale <Control-Down> { ttk::scale::Increment %W 10 } -bind TScale <Home> { %W set [%W cget -from] } -bind TScale <End> { %W set [%W cget -to] } +## Keyboard navigation bindings: +# +bind TScale <<LineStart>> { %W set [%W cget -from] } +bind TScale <<LineEnd>> { %W set [%W cget -to] } + +bind TScale <<PrevChar>> { ttk::scale::Increment %W -1 } +bind TScale <<PrevLine>> { ttk::scale::Increment %W -1 } +bind TScale <<NextChar>> { ttk::scale::Increment %W 1 } +bind TScale <<NextLine>> { ttk::scale::Increment %W 1 } +bind TScale <<PrevWord>> { ttk::scale::Increment %W -10 } +bind TScale <<PrevPara>> { ttk::scale::Increment %W -10 } +bind TScale <<NextWord>> { ttk::scale::Increment %W 10 } +bind TScale <<NextPara>> { ttk::scale::Increment %W 10 } proc ttk::scale::Press {w x y} { variable State diff --git a/library/ttk/treeview.tcl b/library/ttk/treeview.tcl index 1160e9b..8772587 100644 --- a/library/ttk/treeview.tcl +++ b/library/ttk/treeview.tcl @@ -43,7 +43,7 @@ bind Treeview <KeyPress-space> { ttk::treeview::ToggleFocus %W } bind Treeview <Shift-ButtonPress-1> \ { ttk::treeview::Select %W %x %y extend } -bind Treeview <Control-ButtonPress-1> \ +bind Treeview <<ToggleSelection>> \ { ttk::treeview::Select %W %x %y toggle } ttk::copyBindings TtkScrollable Treeview diff --git a/library/unsupported.tcl b/library/unsupported.tcl index aeece38..b5f404a 100644 --- a/library/unsupported.tcl +++ b/library/unsupported.tcl @@ -16,7 +16,7 @@ namespace eval ::tk::unsupported { # Map from the old global names of Tk private commands to their # new namespace-encapsulated names. - variable PrivateCommands + variable PrivateCommands array set PrivateCommands { tkButtonAutoInvoke ::tk::ButtonAutoInvoke tkButtonDown ::tk::ButtonDown @@ -86,34 +86,6 @@ namespace eval ::tk::unsupported { tkFocusOK ::tk::FocusOK tkGenerateMenuSelect ::tk::GenerateMenuSelect tkIconList ::tk::IconList - tkIconList_Add ::tk::IconList_Add - tkIconList_Arrange ::tk::IconList_Arrange - tkIconList_AutoScan ::tk::IconList_AutoScan - tkIconList_Btn1 ::tk::IconList_Btn1 - tkIconList_Config ::tk::IconList_Config - tkIconList_Create ::tk::IconList_Create - tkIconList_CtrlBtn1 ::tk::IconList_CtrlBtn1 - tkIconList_Curselection ::tk::IconList_CurSelection - tkIconList_DeleteAll ::tk::IconList_DeleteAll - tkIconList_Double1 ::tk::IconList_Double1 - tkIconList_DrawSelection ::tk::IconList_DrawSelection - tkIconList_FocusIn ::tk::IconList_FocusIn - tkIconList_FocusOut ::tk::IconList_FocusOut - tkIconList_Get ::tk::IconList_Get - tkIconList_Goto ::tk::IconList_Goto - tkIconList_Index ::tk::IconList_Index - tkIconList_Invoke ::tk::IconList_Invoke - tkIconList_KeyPress ::tk::IconList_KeyPress - tkIconList_Leave1 ::tk::IconList_Leave1 - tkIconList_LeftRight ::tk::IconList_LeftRight - tkIconList_Motion1 ::tk::IconList_Motion1 - tkIconList_Reset ::tk::IconList_Reset - tkIconList_ReturnKey ::tk::IconList_ReturnKey - tkIconList_See ::tk::IconList_See - tkIconList_Select ::tk::IconList_Select - tkIconList_Selection ::tk::IconList_Selection - tkIconList_ShiftBtn1 ::tk::IconList_ShiftBtn1 - tkIconList_UpDown ::tk::IconList_UpDown tkListbox ::tk::Listbox tkListboxAutoScan ::tk::ListboxAutoScan tkListboxBeginExtend ::tk::ListboxBeginExtend @@ -259,7 +231,8 @@ proc ::tk::unsupported::ExposePrivateCommand {cmd} { variable PrivateCommands set cmds [array get PrivateCommands $cmd] if {[llength $cmds] == 0} { - return -code error "No compatibility support for \[$cmd]" + return -code error -errorcode {TK EXPOSE_PRIVATE_COMMAND} \ + "No compatibility support for \[$cmd]" } foreach {old new} $cmds { namespace eval :: [list interp alias {} $old {}] $new @@ -286,7 +259,8 @@ proc ::tk::unsupported::ExposePrivateVariable {var} { variable PrivateVariables set vars [array get PrivateVariables $var] if {[llength $vars] == 0} { - return -code error "No compatibility support for \$$var" + return -code error -errorcode {TK EXPOSE_PRIVATE_VARIABLE} \ + "No compatibility support for \$$var" } namespace eval ::tk::mac {} foreach {old new} $vars { diff --git a/library/xmfbox.tcl b/library/xmfbox.tcl index 0cbf251..aa66f7f 100644 --- a/library/xmfbox.tcl +++ b/library/xmfbox.tcl @@ -27,7 +27,7 @@ namespace eval ::tk::dialog::file {} # When -multiple is set to 0, this returns the absolute pathname # of the selected file. (NOTE: This is not the same as a single # element list.) -# +# # When -multiple is set to > 0, this returns a Tcl list of absolute # pathnames. The argument for -multiple is ignored, but for consistency # with Windows it defines the maximum amount of memory to allocate for @@ -159,7 +159,7 @@ proc ::tk::MotifFDialog_FileTypes {w} { set initialTypeName [lindex $data(-filetypes) 0 0] if {$data(-typevariable) ne ""} { upvar #0 $data(-typevariable) typeVariable - if {[info exist typeVariable]} { + if {[info exists typeVariable]} { set initialTypeName $typeVariable } } @@ -305,7 +305,8 @@ proc ::tk::MotifFDialog_Config {dataName type argList} { set data(filter) * } if {![winfo exists $data(-parent)]} { - error "bad window path name \"$data(-parent)\"" + return -code error -errorcode [list TK LOOKUP WINDOW $data(-parent)] \ + "bad window path name \"$data(-parent)\"" } } @@ -504,7 +505,7 @@ proc ::tk::MotifFDialog_InterpFilter {w} { if {[file pathtype $text] eq "relative"} { set relative 1 } elseif {$badTilde} { - set relative 1 + set relative 1 } if {$relative} { @@ -551,7 +552,7 @@ proc ::tk::MotifFDialog_Update {w} { $data(sEnt) delete 0 end $data(sEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) \ $data(selectFile)] - + MotifFDialog_LoadFiles $w } @@ -625,7 +626,7 @@ proc ::tk::MotifFDialog_LoadFiles {w} { # w The pathname of the dialog box. # # Results: -# None. +# None. proc ::tk::MotifFDialog_BrowseDList {w} { upvar ::tk::dialog::file::[winfo name $w] data @@ -671,7 +672,7 @@ proc ::tk::MotifFDialog_BrowseDList {w} { # w The pathname of the dialog box. # # Results: -# None. +# None. proc ::tk::MotifFDialog_ActivateDList {w} { upvar ::tk::dialog::file::[winfo name $w] data @@ -719,7 +720,7 @@ proc ::tk::MotifFDialog_ActivateDList {w} { # w The pathname of the dialog box. # # Results: -# None. +# None. proc ::tk::MotifFDialog_BrowseFList {w} { upvar ::tk::dialog::file::[winfo name $w] data @@ -739,9 +740,9 @@ proc ::tk::MotifFDialog_BrowseFList {w} { $data(fEnt) insert 0 [::tk::dialog::file::JoinFile $data(selectPath) \ $data(filter)] $data(fEnt) xview end - - # if it's a multiple selection box, just put in the filenames - # otherwise put in the full path as usual + + # if it's a multiple selection box, just put in the filenames + # otherwise put in the full path as usual $data(sEnt) delete 0 end if {$data(-multiple) != 0} { $data(sEnt) insert 0 $data(selectFile) @@ -761,7 +762,7 @@ proc ::tk::MotifFDialog_BrowseFList {w} { # w The pathname of the dialog box. # # Results: -# None. +# None. proc ::tk::MotifFDialog_ActivateFList {w} { upvar ::tk::dialog::file::[winfo name $w] data @@ -787,7 +788,7 @@ proc ::tk::MotifFDialog_ActivateFList {w} { # w The pathname of the dialog box. # # Results: -# None. +# None. proc ::tk::MotifFDialog_ActivateFEnt {w} { upvar ::tk::dialog::file::[winfo name $w] data @@ -802,7 +803,7 @@ proc ::tk::MotifFDialog_ActivateFEnt {w} { # ::tk::MotifFDialog_ActivateSEnt -- # # This procedure is called when the user presses Return inside -# the "selection" entry. It sets the ::tk::Priv(selectFilePath) +# the "selection" entry. It sets the ::tk::Priv(selectFilePath) # variable so that the vwait loop in tk::MotifFDialog will be # terminated. # @@ -810,7 +811,7 @@ proc ::tk::MotifFDialog_ActivateFEnt {w} { # w The pathname of the dialog box. # # Results: -# None. +# None. proc ::tk::MotifFDialog_ActivateSEnt {w} { variable ::tk::Priv @@ -929,7 +930,7 @@ proc ::tk::ListBoxKeyAccel_Unset {w} { # key The key which the user just pressed. # # Results: -# None. +# None. proc ::tk::ListBoxKeyAccel_Key {w key} { variable ::tk::Priv |
