summaryrefslogtreecommitdiffstats
path: root/library/console.tcl
diff options
context:
space:
mode:
Diffstat (limited to 'library/console.tcl')
-rw-r--r--library/console.tcl251
1 files changed, 157 insertions, 94 deletions
diff --git a/library/console.tcl b/library/console.tcl
index 93f4f30..0ad6959 100644
--- a/library/console.tcl
+++ b/library/console.tcl
@@ -4,7 +4,7 @@
# can be used by non-unix systems that do not have built-in support
# for shells.
#
-# RCS: @(#) $Id: console.tcl,v 1.22 2003/02/21 03:34:29 das Exp $
+# RCS: @(#) $Id: console.tcl,v 1.23 2003/05/19 14:44:03 dkf Exp $
#
# Copyright (c) 1995-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-2000 Ajuba Solutions.
@@ -23,7 +23,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} {
@@ -49,57 +49,58 @@ proc ::tk::ConsoleInit {} {
wm withdraw .
}
- if {[string equal $tcl_platform(platform) "macintosh"]
- || [string equal [tk windowingsystem] "aqua"]} {
+ if {$tcl_platform(platform) eq "macintosh"
+ || [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 {[string equal $tcl_platform(platform) "macintosh"]
- || [string equal [tk windowingsystem] "aqua"]} {
- .menubar.file add command -label [mc "Quit"] \
- -command exit -accel Cmd-Q
+ 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 {$tcl_platform(platform) eq "macintosh" || \
+ [tk windowingsystem] eq "aqua"} {
+ AmpMenuArgs .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 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 {[string compare $tcl_platform(platform) "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
}
. configure -menu .menubar
- set con [text .console -yscrollcommand [list .sb set] -setgrid true]
+ 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
@@ -111,7 +112,7 @@ proc ::tk::ConsoleInit {} {
$con configure -font systemfixed
}
"unix" {
- if {[string equal [tk windowingsystem] "aqua"]} {
+ if {[tk windowingsystem] eq "aqua"} {
$con configure -font {Monaco 9 normal} -highlightthickness 0
}
}
@@ -180,13 +181,13 @@ proc ::tk::ConsoleInvoke {args} {
incr pos
}
}
- if {[string equal $cmd ""]} {
+ if {$cmd eq ""} {
ConsolePrompt
} elseif {[info complete $cmd]} {
.console mark set output end
.console tag delete input
set result [consoleinterp record $cmd]
- if {[string compare $result ""]} {
+ if {$result ne ""} {
puts $result
}
ConsoleHistory reset
@@ -235,7 +236,7 @@ proc ::tk::ConsoleHistory {cmd} {
} else {
set cmd "history event $HistNum"
}
- if {[string compare $cmd ""]} {
+ if {$cmd ne ""} {
catch {consoleinterp eval $cmd} cmd
}
.console delete promptEnd end
@@ -257,7 +258,7 @@ proc ::tk::ConsoleHistory {cmd} {
proc ::tk::ConsolePrompt {{partial normal}} {
set w .console
- if {[string equal $partial "normal"]} {
+ if {$partial eq "normal"} {
set temp [$w index "end - 1 char"]
$w mark set output end
if {[consoleinterp eval "info exists tcl_prompt1"]} {
@@ -295,7 +296,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>>)
@@ -341,16 +344,24 @@ proc ::tk::ConsoleBind {w} {
}
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}
@@ -359,7 +370,7 @@ proc ::tk::ConsoleBind {w} {
break
}
bind Console <Delete> {
- if {[string compare {} [%W tag nextrange sel 1.0 end]] \
+ 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]} {
@@ -368,7 +379,7 @@ proc ::tk::ConsoleBind {w} {
}
}
bind Console <BackSpace> {
- if {[string compare {} [%W tag nextrange sel 1.0 end]] \
+ 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] && \
@@ -392,11 +403,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 {
@@ -450,17 +465,19 @@ proc ::tk::ConsoleBind {w} {
}
bind Console <F9> {
eval destroy [winfo child .]
- if {[string equal $tcl_platform(platform) "macintosh"]} {
- if {[catch {source [file join $tk_library console.tcl]}]} {source -rsrc console}
+ 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]
}
}
- if {[string equal $::tcl_platform(platform) "macintosh"]
- || [string equal [tk windowingsystem] "aqua"]} {
- bind Console <Command-q> {
- exit
- }
+ if {$::tcl_platform(platform) eq "macintosh" \
+ || [tk windowingsystem] eq "aqua"} {
+ bind Console <Command-q> {
+ exit
+ }
}
bind Console <<Cut>> {
# Same as the copy event
@@ -493,22 +510,22 @@ proc ::tk::ConsoleBind {w} {
## Bindings for doing special things based on certain keys
##
bind PostConsole <Key-parenright> {
- if {[string compare \\ [%W get insert-2c]]} {
+ if {"\\" ne [%W get insert-2c]} {
::tk::console::MatchPair %W \( \) promptEnd
}
}
bind PostConsole <Key-bracketright> {
- if {[string compare \\ [%W get insert-2c]]} {
+ if {"\\" ne [%W get insert-2c]} {
::tk::console::MatchPair %W \[ \] promptEnd
}
}
bind PostConsole <Key-braceright> {
- if {[string compare \\ [%W get insert-2c]]} {
+ if {"\\" ne [%W get insert-2c]} {
::tk::console::MatchPair %W \{ \} promptEnd
}
}
bind PostConsole <Key-quotedbl> {
- if {[string compare \\ [%W get insert-2c]]} {
+ if {"\\" ne [%W get insert-2c]} {
::tk::console::MatchQuote %W promptEnd
}
}
@@ -532,11 +549,11 @@ proc ::tk::ConsoleBind {w} {
# s - The string to insert (usually just a single character)
proc ::tk::ConsoleInsert {w s} {
- if {[string equal $s ""]} {
+ if {$s eq ""} {
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
@@ -602,10 +619,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 == ""} {set i promptEnd} else {append i +2c}
+ if {$i == ""} {
+ 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"
@@ -637,31 +660,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 {[string compare {} [set ix [$w search -back $c1 insert $lim]]]} {
+ if {!$::tk::console::magicKeys} {
+ return
+ }
+ if {{} ne [set ix [$w search -back $c1 insert $lim]]} {
while {
[string match {\\} [$w get $ix-1c]] &&
- [string compare {} [set ix [$w search -back $c1 $ix-1c $lim]]]
+ [set ix [$w search -back $c1 $ix-1c $lim]] ne {}
} {}
set i1 insert-1c
- while {[string compare {} $ix]} {
+ while {$ix ne {}} {
set i0 $ix
set j 0
- while {[string compare {} [set i0 [$w search $c2 $i0 $i1]]]} {
+ 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 && [string compare {} \
- [set ix [$w search -back $c1 $ix $lim]]]} {
- 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 {
@@ -681,12 +715,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 {[string compare [set i [$w search -back \" $i $lim]] {}]} {
- 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} {
@@ -754,17 +794,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 == ""} {set tmp promptEnd} else {append tmp +2c}
- if {[$w compare $tmp >= insert]} { return }
+ if {$tmp == ""} {
+ 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 != "")} { break }
+ if {![catch {Expand$t $str} res] && ($res != "")} {
+ break
+ }
}
}
}
@@ -773,11 +827,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 \
- && [string equal $repl $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]
}
@@ -802,7 +857,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 {
@@ -829,7 +886,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]} {
@@ -894,9 +953,13 @@ proc ::tk::console::ExpandVariable str {
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
- } else {set match $ary\($match\)}
+ } else {
+ set match $ary\($match\)
+ }
## Space transformation avoided for array names.
} else {
set match [EvalAttached [list info vars $str*]]
@@ -925,8 +988,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]]