|
Description:
Right click Copy and Paste.
And when you source a script from the command line, you lose the focus, and have to click the mouse button somewhere in the console screen to be able to type again.
Fixed that around line # 616. Inserted "focus $w" and now it works better.
Source: Text Source
namespace eval ::tk::console {
variable blinkTime 500 ;
variable blinkRange 1 ;
variable magicKeys 1 ;
variable maxLines 600 ;
variable showMatches 1 ;
variable inPlugin [info exists embed_args]
variable defaultPrompt ;
if {$inPlugin} {
set defaultPrompt {subst {[history nextid] % }}
} else {
set defaultPrompt {subst {([file tail [pwd]]) [history nextid] % }}
}
}
interp alias {} EvalAttached {} consoleinterp eval
proc ::tk::ConsoleInit {} {
global tcl_platform
if {![consoleinterp eval {set tcl_interactive}]} {
wm withdraw .
}
if {[string equal $tcl_platform(platform) "macintosh"]
|| [string equal [tk windowingsystem] "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
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
} else {
.menubar.file add command -label [mc "Exit"] \
-underline 1 -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"
if {[string compare $tcl_platform(platform) "windows"]} {
.menubar.edit add command -label [mc "Clear"] -underline 2 \
-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
menu .menubar.help -tearoff 0
.menubar.help add command -label [mc "About..."] \
-underline 0 -command tk::ConsoleAbout
}
. 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 9 normal} -highlightthickness 0
}
"windows" {
$con configure -font systemfixed
}
"unix" {
if {[string equal [tk windowingsystem] "aqua"]} {
$con configure -font {Monaco 9 normal} -highlightthickness 0
}
}
}
if {[catch {menu .cutPasteMenu -tearoff 0 -type normal} err]} { bgerror "INIT: $err" }
.cutPasteMenu add command -label [mc "Copy"] -underline 0 \
-command { event generate .console <<Copy>> } -accel "$mod+C"
.cutPasteMenu add command -label [mc "Paste"] -underline 1 \
-command { event generate .console <<Paste>> } -accel "$mod+V"
ConsoleBind $con
$con tag configure stderr -foreground red
$con tag configure stdin -foreground blue
$con tag configure prompt -foreground \#8F4433
$con tag configure proc -foreground \#008800
$con tag configure var -background \#FFC0D0
$con tag raise sel
$con tag configure blink -background \#FFFF00
$con tag configure find -background \#FFFF00
focus $con
wm protocol . WM_DELETE_WINDOW {
if {[wm state .]=="normal"} {
exit
} else {
wm withdraw .
}
}
wm title . [mc "Console"]
flush stdout
$con mark set output [$con index "end - 1 char"]
tk::TextSetCursor $con end
$con mark set promptEnd insert
$con mark gravity promptEnd left
bind all <Button-3> {
.cutPasteMenu entryconfigure 0 -state normal
if {[catch {%W get sel.first sel.last}]} {
.cutPasteMenu entryconfigure 0 -state disabled
}
tk_popup .cutPasteMenu [winfo pointerx %W] [winfo pointery %W]
}
set w $con
set temp [$w index "end - 1 char"]
$w mark set output end
if {![consoleinterp eval "info exists tcl_prompt1"]} {
set string [EvalAttached $::tk::console::defaultPrompt]
$w insert output $string stdout
}
$w mark set output $temp
::tk::TextSetCursor $w end
$w mark set promptEnd insert
$w mark gravity promptEnd left
if {$tcl_platform(platform) eq "windows"} {
after idle [list $con delete 1.0 output]
}
}
proc ::tk::ConsoleSource {} {
set filename [tk_getOpenFile -defaultextension .tcl -parent . \
-title [mc "Select a file to source"] \
-filetypes [list \
[list [mc "Tcl Scripts"] .tcl] \
[list [mc "All Files"] *]]]
if {[string compare $filename ""]} {
set cmd [list source $filename]
if {[catch {consoleinterp eval $cmd} result]} {
ConsoleOutput stderr "$result\n"
}
}
}
proc ::tk::ConsoleInvoke {args} {
set ranges [.console tag ranges input]
set cmd ""
if {[llength $ranges]} {
set pos 0
while {[string compare [lindex $ranges $pos] ""]} {
set start [lindex $ranges $pos]
set end [lindex $ranges [incr pos]]
append cmd [.console get $start $end]
incr pos
}
}
if {[string equal $cmd ""]} {
ConsolePrompt
} elseif {[info complete $cmd]} {
.console mark set output end
.console tag delete input
set result [consoleinterp record $cmd]
if {[string compare $result ""]} {
puts $result
}
ConsoleHistory reset
ConsolePrompt
} else {
ConsolePrompt partial
}
.console yview -pickplace insert
}
set ::tk::HistNum 1
proc ::tk::ConsoleHistory {cmd} {
variable HistNum
switch $cmd {
prev {
incr HistNum -1
if {$HistNum == 0} {
set cmd {history event [expr {[history nextid] -1}]}
} else {
set cmd "history event $HistNum"
}
if {[catch {consoleinterp eval $cmd} cmd]} {
incr HistNum
return
}
.console delete promptEnd end
.console insert promptEnd $cmd {input stdin}
}
next {
incr HistNum
if {$HistNum == 0} {
set cmd {history event [expr {[history nextid] -1}]}
} elseif {$HistNum > 0} {
set cmd ""
set HistNum 1
} else {
set cmd "history event $HistNum"
}
if {[string compare $cmd ""]} {
catch {consoleinterp eval $cmd} cmd
}
.console delete promptEnd end
.console insert promptEnd $cmd {input stdin}
}
reset {
set HistNum 1
}
}
}
proc ::tk::ConsolePrompt {{partial normal}} {
set w .console
if {[string equal $partial "normal"]} {
set temp [$w index "end - 1 char"]
$w mark set output end
if {[consoleinterp eval "info exists tcl_prompt1"]} {
consoleinterp eval "eval \[set tcl_prompt1\]"
} else {
puts -nonewline [EvalAttached $::tk::console::defaultPrompt]
}
} else {
set temp [$w index output]
$w mark set output end
if {[consoleinterp eval "info exists tcl_prompt2"]} {
consoleinterp eval "eval \[set tcl_prompt2\]"
} else {
puts -nonewline "> "
}
}
flush stdout
$w mark set output $temp
::tk::TextSetCursor $w end
$w mark set promptEnd insert
$w mark gravity promptEnd left
::tk::console::ConstrainBuffer $w $::tk::console::maxLines
$w see end
}
proc ::tk::ConsoleBind {w} {
bindtags $w [list $w Console PostConsole [winfo toplevel $w] all]
foreach ev [bind Text] { bind Console $ev [bind Text $ev] }
bind Console <Control-Key-o> {}
bind Console <Control-Key-v> {}
bind Console <Control-Key-t> {}
bind Console <Alt-KeyPress> {# nothing }
bind Console <Meta-KeyPress> {# nothing}
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>
<<Console_NextSearch>> <Control-Key-s>
<<Console_Expand>> <Key-Tab>
<<Console_Expand>> <Key-Escape>
<<Console_ExpandFile>> <Control-Shift-Key-F>
<<Console_ExpandProc>> <Control-Shift-Key-P>
<<Console_ExpandVar>> <Control-Shift-Key-V>
<<Console_Tab>> <Control-Key-i>
<<Console_Tab>> <Meta-Key-i>
<<Console_Eval>> <Key-Return>
<<Console_Eval>> <Key-KP_Enter>
<<Console_Clear>> <Control-Key-l>
<<Console_KillLine>> <Control-Key-k>
<<Console_Transpose>> <Control-Key-t>
<<Console_ClearLine>> <Control-Key-u>
<<Console_SaveCommand>> <Control-Key-z>
} {
event add $ev $key
bind Console $key {}
}
bind Console <<Console_Expand>> {
if {[%W compare insert > promptEnd]} {::tk::console::Expand %W}
}
bind Console <<Console_ExpandFile>> {
if {[%W compare insert > promptEnd]} {::tk::console::Expand %W path}
}
bind Console <<Console_ExpandProc>> {
if {[%W compare insert > promptEnd]} {::tk::console::Expand %W proc}
}
bind Console <<Console_ExpandVar>> {
if {[%W compare insert > promptEnd]} {::tk::console::Expand %W var}
}
bind Console <<Console_Eval>> {
%W mark set insert {end - 1c}
tk::ConsoleInsert %W "\n"
tk::ConsoleInvoke
break
}
bind Console <Delete> {
if {[string compare {} [%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
%W see insert
}
}
bind Console <BackSpace> {
if {[string compare {} [%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]} {
%W delete insert-1c
%W see insert
}
}
bind Console <Control-h> [bind Console <BackSpace>]
bind Console <Home> {
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> {
tk::TextSetCursor %W {insert lineend}
}
bind Console <Control-e> [bind Console <End>]
bind Console <Control-d> {
if {[%W compare insert < promptEnd]} break
%W delete insert
}
bind Console <<Console_KillLine>> {
if {[%W compare insert < promptEnd]} break
if {[%W compare insert == {insert lineend}]} {
%W delete insert
} else {
%W delete insert {insert lineend}
}
}
bind Console <<Console_Clear>> {
%W delete 1.0 "promptEnd linestart"
}
bind Console <<Console_ClearLine>> {
%W delete promptEnd end
}
bind Console <Meta-d> {
if {[%W compare insert >= promptEnd]} {
%W delete insert {insert wordend}
}
}
bind Console <Meta-BackSpace> {
if {[%W compare {insert -1c wordstart} >= promptEnd]} {
%W delete {insert -1c wordstart} insert
}
}
bind Console <Meta-d> {
if {[%W compare insert >= promptEnd]} {
%W delete insert {insert wordend}
}
}
bind Console <Meta-BackSpace> {
if {[%W compare {insert -1c wordstart} >= promptEnd]} {
%W delete {insert -1c wordstart} insert
}
}
bind Console <Meta-Delete> {
if {[%W compare insert >= promptEnd]} {
%W delete insert {insert wordend}
}
}
bind Console <<Console_Prev>> {
tk::ConsoleHistory prev
}
bind Console <<Console_Next>> {
tk::ConsoleHistory next
}
bind Console <Insert> {
catch {tk::ConsoleInsert %W [::tk::GetSelection %W PRIMARY]}
}
bind Console <KeyPress> {
tk::ConsoleInsert %W %A
}
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}
} 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
}
}
bind Console <<Cut>> {
clipboard clear -displayof %W
if {![catch {set data [%W get sel.first sel.last]}]} {
clipboard append -displayof %W $data
}
}
bind Console <<Copy>> {
clipboard clear -displayof %W
if {![catch {set data [%W get sel.first sel.last]}]} {
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 PostConsole <Key-parenright> {
if {[string compare \\ [%W get insert-2c]]} {
::tk::console::MatchPair %W \( \) promptEnd
}
}
bind PostConsole <Key-bracketright> {
if {[string compare \\ [%W get insert-2c]]} {
::tk::console::MatchPair %W \[ \] promptEnd
}
}
bind PostConsole <Key-braceright> {
if {[string compare \\ [%W get insert-2c]]} {
::tk::console::MatchPair %W \{ \} promptEnd
}
}
bind PostConsole <Key-quotedbl> {
if {[string compare \\ [%W get insert-2c]]} {
::tk::console::MatchQuote %W promptEnd
}
}
bind PostConsole <KeyPress> {
if {"%A" != ""} {
::tk::console::TagProc %W
}
break
}
}
proc ::tk::ConsoleInsert {w s} {
if {[string equal $s ""]} {
return
}
catch {
if {[$w compare sel.first <= insert]
&& [$w compare sel.last >= insert]} {
$w tag remove sel sel.first promptEnd
$w delete sel.first sel.last
}
}
if {[$w compare insert < promptEnd]} {
$w mark set insert end
}
$w insert insert $s {input stdin}
$w see insert
}
proc ::tk::ConsoleOutput {dest string} {
set w .console
$w insert output $string $dest
::tk::console::ConstrainBuffer $w $::tk::console::maxLines
$w see insert
}
proc ::tk::ConsoleExit {} {
destroy .
}
proc ::tk::ConsoleAbout {} {
tk_messageBox -type ok -message "[mc {Tcl for Windows}]
Tcl $::tcl_patchLevel
Tk $::tk_patchLevel"
}
proc ::tk::console::TagProc w {
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}
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"
} else {
$w tag remove proc $i "insert-1c wordend"
}
if {[llength [EvalAttached [list info vars $c]]]} {
$w tag add var $i "insert-1c wordend"
} else {
$w tag remove var $i "insert-1c wordend"
}
}
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]]]} {
while {
[string match {\\} [$w get $ix-1c]] &&
[string compare {} [set ix [$w search -back $c1 $ix-1c $lim]]]
} {}
set i1 insert-1c
while {[string compare {} $ix]} {
set i0 $ix
set j 0
while {[string compare {} [set i0 [$w search $c2 $i0 $i1]]]} {
append i0 +1c
if {[string match {\\} [$w get $i0-2c]]} continue
incr j
}
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
incr j -1
}
}
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 {
Blink $w $ix $ix+1c [$w index insert-1c] [$w index insert]
}
}
proc ::tk::console::MatchQuote {w {lim 1.0}} {
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}
incr j
}
if {$j&1} {
if {$::tk::console::blinkRange} {
Blink $w $i0 [$w index insert]
} else {
Blink $w $i0 $i0+1c [$w index insert-1c] [$w index insert]
}
} else {
Blink $w [$w index insert-1c] [$w index insert]
}
}
proc ::tk::console::Blink {w args} {
eval [list $w tag add blink] $args
after $::tk::console::blinkTime [list $w] tag remove blink $args
}
proc ::tk::console::ConstrainBuffer {w size} {
if {[$w index end] > $size} {
$w delete 1.0 [expr {int([$w index end])-$size}].0
}
}
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 }
set str [$w get $tmp insert]
switch -glob $type {
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 }
}
}
}
set len [llength $res]
if {$len} {
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]} {
puts stdout [lsort [lreplace $res 0 0]]
}
} else { bell }
return [incr len -1]
}
proc ::tk::console::ExpandPathname str {
set pwd [EvalAttached pwd]
if {[catch {EvalAttached [list cd [file dirname $str]]} err]} {
return -code error $err
}
set dir [file tail $str]
if {[string match */ $str]} { append dir / }
if {[catch {lsort [EvalAttached [list glob $dir*]]} m]} {
set match {}
} else {
if {[llength $m] > 1} {
global tcl_platform
if {[string match windows $tcl_platform(platform)]} {
set tmp [ExpandBestMatch [string tolower $m] \
[string tolower $dir]]
if {[string length $dir]==[string length $tmp]} {
set tmp $dir
}
} else {
set tmp [ExpandBestMatch $m $dir]
}
if {[string match ?*/* $str]} {
set tmp [file dirname $str]/$tmp
} elseif {[string match /* $str]} {
set tmp /$tmp
}
regsub -all { } $tmp {\\ } tmp
set match [linsert $m 0 $tmp]
} else {
eval append match $m
if {[file isdir $match]} {append match /}
if {[string match ?*/* $str]} {
set match [file dirname $str]/$match
} elseif {[string match /* $str]} {
set match /$match
}
regsub -all { } $match {\\ } match
set match [list $match]
}
}
EvalAttached [list cd $pwd]
return $match
}
proc ::tk::console::ExpandProcname str {
set match [EvalAttached [list info commands $str*]]
if {[llength $match] == 0} {
set ns [EvalAttached \
"namespace children \[namespace current\] [list $str*]"]
if {[llength $ns]==1} {
set match [EvalAttached [list info commands ${ns}::*]]
} else {
set match $ns
}
}
if {[llength $match] > 1} {
regsub -all { } [ExpandBestMatch $match $str] {\\ } str
set match [linsert $match 0 $str]
} else {
regsub -all { } $match {\\ } match
}
return $match
}
proc ::tk::console::ExpandVariable str {
if {[regexp {([^\(]*)\((.*)} $str junk ary str]} {
| 
