diff options
Diffstat (limited to 'library/console.tcl')
| -rw-r--r-- | library/console.tcl | 361 |
1 files changed, 235 insertions, 126 deletions
diff --git a/library/console.tcl b/library/console.tcl index b473dd4..e44324f 100644 --- a/library/console.tcl +++ b/library/console.tcl @@ -22,7 +22,7 @@ namespace eval ::tk::console { variable showMatches 1 ; # show multiple expand matches variable inPlugin [info exists embed_args] - variable defaultPrompt ; # default prompt if tcl_prompt1 isn't used + variable defaultPrompt ; # default prompt if tcl_prompt1 isn't used if {$inPlugin} { @@ -48,74 +48,92 @@ proc ::tk::ConsoleInit {} { wm withdraw . } - if {$tcl_platform(platform) eq "macintosh" - || [tk windowingsystem] eq "aqua"} { + if {[tk windowingsystem] eq "aqua"} { set mod "Cmd" } else { set mod "Ctrl" } - if {[catch {menu .menubar} err]} { bgerror "INIT: $err" } - .menubar add cascade -label File -menu .menubar.file -underline 0 - .menubar add cascade -label Edit -menu .menubar.edit -underline 0 + if {[catch {menu .menubar} err]} { + bgerror "INIT: $err" + } + AmpMenuArgs .menubar add cascade -label [mc &File] -menu .menubar.file + AmpMenuArgs .menubar add cascade -label [mc &Edit] -menu .menubar.edit menu .menubar.file -tearoff 0 - .menubar.file add command -label [mc "Source..."] \ - -underline 0 -command tk::ConsoleSource - .menubar.file add command -label [mc "Hide Console"] \ - -underline 0 -command {wm withdraw .} - .menubar.file add command -label [mc "Clear Console"] \ - -underline 0 -command {.console delete 1.0 "promptEnd linestart"} - if {$tcl_platform(platform) eq "macintosh" - || [tk windowingsystem] eq "aqua"} { - .menubar.file add command -label [mc "Quit"] \ - -command exit -accel Cmd-Q - } else { - .menubar.file add command -label [mc "Exit"] \ - -underline 1 -command exit + AmpMenuArgs .menubar.file add command -label [mc "&Source..."] \ + -command {tk::ConsoleSource} + AmpMenuArgs .menubar.file add command -label [mc "&Hide Console"] \ + -command {wm withdraw .} + AmpMenuArgs .menubar.file add command -label [mc "&Clear Console"] \ + -command {.console delete 1.0 "promptEnd linestart"} + if {[tk windowingsystem] ne "aqua"} { + AmpMenuArgs .menubar.file add command -label [mc E&xit] -command {exit} } menu .menubar.edit -tearoff 0 - .menubar.edit add command -label [mc "Cut"] -underline 2 \ - -command { event generate .console <<Cut>> } -accel "$mod+X" - .menubar.edit add command -label [mc "Copy"] -underline 0 \ - -command { event generate .console <<Copy>> } -accel "$mod+C" - .menubar.edit add command -label [mc "Paste"] -underline 1 \ - -command { event generate .console <<Paste>> } -accel "$mod+V" + AmpMenuArgs .menubar.edit add command -label [mc Cu&t] -accel "$mod+X"\ + -command {event generate .console <<Cut>>} + AmpMenuArgs .menubar.edit add command -label [mc &Copy] -accel "$mod+C"\ + -command {event generate .console <<Copy>>} + AmpMenuArgs .menubar.edit add command -label [mc P&aste] -accel "$mod+V"\ + -command {event generate .console <<Paste>>} if {$tcl_platform(platform) ne "windows"} { - .menubar.edit add command -label [mc "Clear"] -underline 2 \ - -command { event generate .console <<Clear>> } + AmpMenuArgs .menubar.edit add command -label [mc Cl&ear] \ + -command {event generate .console <<Clear>>} } else { - .menubar.edit add command -label [mc "Delete"] -underline 0 \ - -command { event generate .console <<Clear>> } -accel "Del" - - .menubar add cascade -label Help -menu .menubar.help -underline 0 + AmpMenuArgs .menubar.edit add command -label [mc &Delete] \ + -command {event generate .console <<Clear>>} -accel "Del" + + AmpMenuArgs .menubar add cascade -label [mc &Help] -menu .menubar.help menu .menubar.help -tearoff 0 - .menubar.help add command -label [mc "About..."] \ - -underline 0 -command tk::ConsoleAbout + AmpMenuArgs .menubar.help add command -label [mc &About...] \ + -command tk::ConsoleAbout } + AmpMenuArgs .menubar.edit add separator + 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>>} + . configure -menu .menubar - set con [text .console -yscrollcommand [list .sb set] -setgrid true] - scrollbar .sb -command [list $con yview] - pack .sb -side right -fill both - pack $con -fill both -expand 1 -side left - switch -exact $tcl_platform(platform) { - "macintosh" { - $con configure -font {Monaco 10 normal} -highlightthickness 0 - } - "windows" { - $con configure -font systemfixed - } - "unix" { - if {[tk windowingsystem] eq "aqua"} { - $con configure -font {Monaco 10 normal} -highlightthickness 0 - } - } + # See if we can find a better font than the TkFixedFont + catch {font create TkConsoleFont {*}[font configure TkFixedFont]} + set families [font families] + switch -exact -- [tk windowingsystem] { + aqua { set preferred {Monaco 10} } + win32 { set preferred {ProFontWindows 8 Consolas 8} } + default { set preferred {} } + } + foreach {family size} $preferred { + if {[lsearch -exact $families $family] != -1} { + font configure TkConsoleFont -family $family -size $size + break + } } + # Provide the right border for the text widget (platform dependent). + ::ttk::style layout ConsoleFrame { + Entry.field -sticky news -border 1 -children { + ConsoleFrame.padding -sticky news + } + } + ::ttk::frame .consoleframe -style ConsoleFrame + + set con [text .console -yscrollcommand [list .sb set] -setgrid true \ + -borderwidth 0 -highlightthickness 0 -font TkConsoleFont] + if {[tk windowingsystem] eq "aqua"} { + scrollbar .sb -command [list $con yview] + } else { + ::ttk::scrollbar .sb -command [list $con yview] + } + pack .sb -in .consoleframe -fill both -side right -padx 1 -pady 1 + pack $con -in .consoleframe -fill both -expand 1 -side left -padx 1 -pady 1 + pack .consoleframe -fill both -expand 1 -side left + ConsoleBind $con $con tag configure stderr -foreground red @@ -129,6 +147,9 @@ proc ::tk::ConsoleInit {} { focus $con + # Avoid listing this console in [winfo interps] + if {[info command ::send] eq "::send"} {rename ::send {}} + wm protocol . WM_DELETE_WINDOW { wm withdraw . } wm title . [mc "Console"] flush stdout @@ -302,6 +323,39 @@ proc ::tk::ConsolePrompt {{partial normal}} { $w see end } +# Copy selected text from the console +proc ::tk::console::Copy {w} { + if {![catch {set data [$w get sel.first sel.last]}]} { + clipboard clear -displayof $w + clipboard append -displayof $w $data + } +} +# Copies selected text. If the selection is within the current active edit +# region then it will be cut, if not it is only copied. +proc ::tk::console::Cut {w} { + if {![catch {set data [$w get sel.first sel.last]}]} { + clipboard clear -displayof $w + clipboard append -displayof $w $data + if {[$w compare sel.first >= output]} { + $w delete sel.first sel.last + } + } +} +# Paste text from the clipboard +proc ::tk::console::Paste {w} { + catch { + set clip [::tk::GetSelection $w CLIPBOARD] + set list [split $clip \n\r] + tk::ConsoleInsert $w [lindex $list 0] + foreach x [lrange $list 1 end] { + $w mark set insert {end - 1c} + tk::ConsoleInsert $w "\n" + tk::ConsoleInvoke + tk::ConsoleInsert $w $x + } + } +} + # ::tk::ConsoleBind -- # This procedure first ensures that the default bindings for the Text # class have been defined. Then certain bindings are overridden for @@ -314,7 +368,9 @@ proc ::tk::ConsoleBind {w} { bindtags $w [list $w Console PostConsole [winfo toplevel $w] all] ## Get all Text bindings into Console - foreach ev [bind Text] { bind Console $ev [bind Text $ev] } + foreach ev [bind Text] { + bind Console $ev [bind Text $ev] + } ## We really didn't want the newline insertion... bind Console <Control-Key-o> {} ## ...or any Control-v binding (would block <<Paste>>) @@ -326,6 +382,8 @@ proc ::tk::ConsoleBind {w} { # Ignore all Alt, Meta, and Control keypresses unless explicitly bound. # Otherwise, if a widget binding for one of these is defined, the + # <Keypress> class binding will also fire and insert the character + # which is wrong. bind Console <Alt-KeyPress> {# nothing } bind Console <Meta-KeyPress> {# nothing} @@ -354,22 +412,40 @@ proc ::tk::ConsoleBind {w} { <<Console_Transpose>> <Control-Key-t> <<Console_ClearLine>> <Control-Key-u> <<Console_SaveCommand>> <Control-Key-z> + <<Console_FontSizeIncr>> <Control-Key-plus> + <<Console_FontSizeDecr>> <Control-Key-minus> } { event add $ev $key bind Console $key {} } - + if {[tk windowingsystem] eq "aqua"} { + foreach {ev key} { + <<Console_FontSizeIncr>> <Command-Key-plus> + <<Console_FontSizeDecr>> <Command-Key-minus> + } { + event add $ev $key + bind Console $key {} + } + } bind Console <<Console_Expand>> { - if {[%W compare insert > promptEnd]} {::tk::console::Expand %W} + if {[%W compare insert > promptEnd]} { + ::tk::console::Expand %W + } } bind Console <<Console_ExpandFile>> { - if {[%W compare insert > promptEnd]} {::tk::console::Expand %W path} + if {[%W compare insert > promptEnd]} { + ::tk::console::Expand %W path + } } bind Console <<Console_ExpandProc>> { - if {[%W compare insert > promptEnd]} {::tk::console::Expand %W proc} + if {[%W compare insert > promptEnd]} { + ::tk::console::Expand %W proc + } } bind Console <<Console_ExpandVar>> { - if {[%W compare insert > promptEnd]} {::tk::console::Expand %W var} + if {[%W compare insert > promptEnd]} { + ::tk::console::Expand %W var + } } bind Console <<Console_Eval>> { %W mark set insert {end - 1c} @@ -378,7 +454,8 @@ proc ::tk::ConsoleBind {w} { break } bind Console <Delete> { - if {[%W tag nextrange sel 1.0 end] ne "" && [%W compare sel.first >= promptEnd]} { + if {{} ne [%W tag nextrange sel 1.0 end] \ + && [%W compare sel.first >= promptEnd]} { %W delete sel.first sel.last } elseif {[%W compare insert >= promptEnd]} { %W delete insert @@ -386,7 +463,8 @@ proc ::tk::ConsoleBind {w} { } } bind Console <BackSpace> { - if {[%W tag nextrange sel 1.0 end] ne "" && [%W compare sel.first >= promptEnd]} { + if {{} ne [%W tag nextrange sel 1.0 end] \ + && [%W compare sel.first >= promptEnd]} { %W delete sel.first sel.last } elseif {[%W compare insert != 1.0] && \ [%W compare insert > promptEnd]} { @@ -409,11 +487,15 @@ proc ::tk::ConsoleBind {w} { } bind Console <Control-e> [bind Console <End>] bind Console <Control-d> { - if {[%W compare insert < promptEnd]} break + if {[%W compare insert < promptEnd]} { + break + } %W delete insert } bind Console <<Console_KillLine>> { - if {[%W compare insert < promptEnd]} break + if {[%W compare insert < promptEnd]} { + break + } if {[%W compare insert == {insert lineend}]} { %W delete insert } else { @@ -467,42 +549,24 @@ proc ::tk::ConsoleBind {w} { } bind Console <F9> { eval destroy [winfo child .] - if {$tcl_platform(platform) eq "macintosh"} { - if {[catch {source [file join $tk_library console.tcl]}]} {source -rsrc console} - } else { - source [file join $tk_library console.tcl] + source [file join $tk_library console.tcl] + } + if {[tk windowingsystem] eq "aqua"} { + bind Console <Command-q> { + exit } } - if {$::tcl_platform(platform) eq "macintosh" || [tk windowingsystem] eq "aqua"} { - bind Console <Command-q> { - exit - } + bind Console <<Cut>> { ::tk::console::Cut %W } + bind Console <<Copy>> { ::tk::console::Copy %W } + bind Console <<Paste>> { ::tk::console::Paste %W } + + bind Console <<Console_FontSizeIncr>> { + set size [font configure TkConsoleFont -size] + font configure TkConsoleFont -size [incr size] } - bind Console <<Cut>> { - # Same as the copy event - if {![catch {set data [%W get sel.first sel.last]}]} { - clipboard clear -displayof %W - clipboard append -displayof %W $data - } - } - bind Console <<Copy>> { - if {![catch {set data [%W get sel.first sel.last]}]} { - clipboard clear -displayof %W - clipboard append -displayof %W $data - } - } - bind Console <<Paste>> { - catch { - set clip [::tk::GetSelection %W CLIPBOARD] - set list [split $clip \n\r] - tk::ConsoleInsert %W [lindex $list 0] - foreach x [lrange $list 1 end] { - %W mark set insert {end - 1c} - tk::ConsoleInsert %W "\n" - tk::ConsoleInvoke - tk::ConsoleInsert %W $x - } - } + bind Console <<Console_FontSizeDecr>> { + set size [font configure TkConsoleFont -size] + font configure TkConsoleFont -size [incr size -1] } ## @@ -533,7 +597,6 @@ proc ::tk::ConsoleBind {w} { if {"%A" ne ""} { ::tk::console::TagProc %W } - break } } @@ -552,7 +615,7 @@ proc ::tk::ConsoleInsert {w s} { return } catch { - if {[$w compare sel.first <= insert] + if {[$w compare sel.first <= insert] \ && [$w compare sel.last >= insert]} { $w tag remove sel sel.first promptEnd $w delete sel.first sel.last @@ -618,10 +681,16 @@ Tk $::tk_patchLevel" # w - console text widget proc ::tk::console::TagProc w { - if {!$::tk::console::magicKeys} { return } + if {!$::tk::console::magicKeys} { + return + } set exp "\[^\\\\\]\[\[ \t\n\r\;{}\"\$\]" set i [$w search -backwards -regexp $exp insert-1c promptEnd-1c] - if {$i eq ""} {set i promptEnd} else {append i +2c} + if {$i eq ""} { + set i promptEnd + } else { + append i +2c + } regsub -all "\[\[\\\\\\?\\*\]" [$w get $i "insert-1c wordend"] {\\\0} c if {[llength [EvalAttached [list info commands $c]]]} { $w tag add proc $i "insert-1c wordend" @@ -653,30 +722,42 @@ proc ::tk::console::TagProc w { # Calls: ::tk::console::Blink proc ::tk::console::MatchPair {w c1 c2 {lim 1.0}} { - if {!$::tk::console::magicKeys} { return } - if {[set ix [$w search -back $c1 insert $lim]] ne ""} { + if {!$::tk::console::magicKeys} { + return + } + if {{} ne [set ix [$w search -back $c1 insert $lim]]} { while { [string match {\\} [$w get $ix-1c]] && - [set ix [$w search -back $c1 $ix-1c $lim]] ne "" + [set ix [$w search -back $c1 $ix-1c $lim]] ne {} } {} set i1 insert-1c - while {$ix ne ""} { + while {$ix ne {}} { set i0 $ix set j 0 - while {[set i0 [$w search $c2 $i0 $i1]] ne ""} { + while {[set i0 [$w search $c2 $i0 $i1]] ne {}} { append i0 +1c - if {[string match {\\} [$w get $i0-2c]]} continue + if {[string match {\\} [$w get $i0-2c]]} { + continue + } incr j } - if {!$j} break + if {!$j} { + break + } set i1 $ix - while {$j && [set ix [$w search -back $c1 $ix $lim]] ne ""} { - if {[string match {\\} [$w get $ix-1c]]} continue + while {$j && [set ix [$w search -back $c1 $ix $lim]] ne {}} { + if {[string match {\\} [$w get $ix-1c]]} { + continue + } incr j -1 } } - if {[string match {} $ix]} { set ix [$w index $lim] } - } else { set ix [$w index $lim] } + if {[string match {} $ix]} { + set ix [$w index $lim] + } + } else { + set ix [$w index $lim] + } if {$::tk::console::blinkRange} { Blink $w $ix [$w index insert] } else { @@ -696,12 +777,18 @@ proc ::tk::console::MatchPair {w c1 c2 {lim 1.0}} { # Calls: ::tk::console::Blink proc ::tk::console::MatchQuote {w {lim 1.0}} { - if {!$::tk::console::magicKeys} { return } + if {!$::tk::console::magicKeys} { + return + } set i insert-1c set j 0 - while {[set i [$w search -back \" $i $lim]] ne ""} { - if {[string match {\\} [$w get $i-1c]]} continue - if {!$j} {set i0 $i} + while {[set i [$w search -back \" $i $lim]] ne {}} { + if {[string match {\\} [$w get $i-1c]]} { + continue + } + if {!$j} { + set i0 $i + } incr j } if {$j&1} { @@ -769,17 +856,31 @@ proc ::tk::console::ConstrainBuffer {w size} { proc ::tk::console::Expand {w {type ""}} { set exp "\[^\\\\\]\[\[ \t\n\r\\\{\"\\\\\$\]" set tmp [$w search -backwards -regexp $exp insert-1c promptEnd-1c] - if {$tmp eq ""} {set tmp promptEnd} else {append tmp +2c} - if {[$w compare $tmp >= insert]} { return } + if {$tmp eq ""} { + set tmp promptEnd + } else { + append tmp +2c + } + if {[$w compare $tmp >= insert]} { + return + } set str [$w get $tmp insert] switch -glob $type { - path* { set res [ExpandPathname $str] } - proc* { set res [ExpandProcname $str] } - var* { set res [ExpandVariable $str] } + path* { + set res [ExpandPathname $str] + } + proc* { + set res [ExpandProcname $str] + } + var* { + set res [ExpandVariable $str] + } default { set res {} foreach t {Pathname Procname Variable} { - if {![catch {Expand$t $str} res] && ($res ne "")} { break } + if {![catch {Expand$t $str} res] && ($res ne "")} { + break + } } } } @@ -788,10 +889,12 @@ proc ::tk::console::Expand {w {type ""}} { set repl [lindex $res 0] $w delete $tmp insert $w insert $tmp $repl {input stdin} - if {($len > 1) && $::tk::console::showMatches && $repl eq $str} { + if {($len > 1) && ($::tk::console::showMatches) && ($repl eq $str)} { puts stdout [lsort [lreplace $res 0 0]] } - } else { bell } + } else { + bell + } return [incr len -1] } @@ -816,7 +919,9 @@ proc ::tk::console::ExpandPathname str { set dir [file tail $str] ## Check to see if it was known to be a directory and keep the trailing ## slash if so (file tail cuts it off) - if {[string match */ $str]} { append dir / } + if {[string match */ $str]} { + append dir / + } if {[catch {lsort [EvalAttached [list glob $dir*]]} m]} { set match {} } else { @@ -843,7 +948,9 @@ proc ::tk::console::ExpandPathname str { } else { ## This may look goofy, but it handles spaces in path names eval append match $m - if {[file isdir $match]} {append match /} + if {[file isdir $match]} { + append match / + } if {[string match ?*/* $str]} { set match [file dirname $str]/$match } elseif {[string match /* $str]} { @@ -903,12 +1010,14 @@ proc ::tk::console::ExpandProcname str { # possible further matches proc ::tk::console::ExpandVariable str { - if {[regexp {([^\(]*)\((.*)} $str junk ary str]} { + if {[regexp {([^\(]*)\((.*)} $str -> ary str]} { ## Looks like they're trying to expand an array. set match [EvalAttached [list array names $ary $str*]] if {[llength $match] > 1} { set vars $ary\([ExpandBestMatch $match $str] - foreach var $match {lappend vars $ary\($var\)} + foreach var $match { + lappend vars $ary\($var\) + } return $vars } elseif {[llength $match] == 1} { set match $ary\($match\) @@ -941,8 +1050,8 @@ proc ::tk::console::ExpandVariable str { proc ::tk::console::ExpandBestMatch {l {e {}}} { set ec [lindex $l 0] if {[llength $l]>1} { - set e [string length $e]; incr e -1 - set ei [string length $ec]; incr ei -1 + set e [expr {[string length $e] - 1}] + set ei [expr {[string length $ec] - 1}] foreach l $l { while {$ei>=$e && [string first $ec $l]} { set ec [string range $ec 0 [incr ei -1]] @@ -953,4 +1062,4 @@ proc ::tk::console::ExpandBestMatch {l {e {}}} { } # now initialize the console -::tk::ConsoleInit +::tk::ConsoleInit |