Made changes to tkcon.tcl to ensure compatibility with Tcl version 9.
This commit is contained in:
Tim Edwards
parent
1d286f9973
commit
021dfa6e8a
203
tcltk/tkcon.tcl
203
tcltk/tkcon.tcl
|
|
@ -36,7 +36,7 @@ exec ${NETGEN_WISH:=wish} "$0" ${1+"$@"}
|
|||
#
|
||||
# set ::tkcon::PRIV(proxy) {wwwproxy:8080 1}
|
||||
#
|
||||
# Or you can set the above variable from within tkcon by calling
|
||||
# Or you can set the above variable from within tkcon by calling
|
||||
#
|
||||
# tkcon master set ::tkcon:PRIV(proxy) wwwproxy:8080
|
||||
#
|
||||
|
|
@ -44,6 +44,8 @@ exec ${NETGEN_WISH:=wish} "$0" ${1+"$@"}
|
|||
if {$tcl_version < 8.0} {
|
||||
return -code error "tkcon requires at least Tcl/Tk8"
|
||||
} else {
|
||||
# Prevent breaking on version 8.5.2
|
||||
# package require -exact Tk $tcl_version
|
||||
package require Tk $tcl_version
|
||||
}
|
||||
|
||||
|
|
@ -59,18 +61,6 @@ foreach pkg [info loaded {}] {
|
|||
}
|
||||
catch {unset pkg file name version}
|
||||
|
||||
# Tk 8.4 makes previously exposed stuff private.
|
||||
# FIX: Update tkcon to not rely on the private Tk code.
|
||||
#
|
||||
if {![llength [info globals tkPriv]]} {
|
||||
::tk::unsupported::ExposePrivateVariable tkPriv
|
||||
}
|
||||
foreach cmd {SetCursor UpDownLine Transpose ScrollPages} {
|
||||
if {![llength [info commands tkText$cmd]]} {
|
||||
::tk::unsupported::ExposePrivateCommand tkText$cmd
|
||||
}
|
||||
}
|
||||
|
||||
# Initialize the ::tkcon namespace
|
||||
#
|
||||
namespace eval ::tkcon {
|
||||
|
|
@ -196,7 +186,7 @@ proc ::tkcon::Init {} {
|
|||
tkcon_puts tkcon_gets observe observe_var unalias which what
|
||||
}
|
||||
version 2.3
|
||||
RCS {RCS: @(#) $Id: tkcon.tcl,v 1.2 2008/05/23 00:20:17 tim Exp $}
|
||||
RCS {RCS: @(#) $Id: tkcon.tcl,v 1.2 2008/04/18 16:28:13 tim Exp $}
|
||||
HEADURL {http://cvs.sourceforge.net/cgi-bin/viewcvs.cgi/tkcon/tkcon/tkcon.tcl?rev=HEAD}
|
||||
docs "http://tkcon.sourceforge.net/"
|
||||
email {jeff@hobbs.org}
|
||||
|
|
@ -654,7 +644,7 @@ proc ::tkcon::GarbageCollect {} {
|
|||
## ::tkcon::EvalCmd) in turn. Any uncompleted command will not be eval'ed.
|
||||
# ARGS: w - console text widget
|
||||
# Calls: ::tkcon::CmdGet, ::tkcon::CmdSep, ::tkcon::EvalCmd
|
||||
##
|
||||
##
|
||||
proc ::tkcon::Eval {w} {
|
||||
set incomplete [CmdSep [CmdGet $w] cmds last]
|
||||
$w mark set insert end-1c
|
||||
|
|
@ -674,7 +664,7 @@ proc ::tkcon::Eval {w} {
|
|||
# Calls: ::tkcon::Prompt
|
||||
# Outputs: result of command to stdout (or stderr if error occured)
|
||||
# Returns: next event number
|
||||
##
|
||||
##
|
||||
proc ::tkcon::EvalCmd {w cmd} {
|
||||
variable OPT
|
||||
variable PRIV
|
||||
|
|
@ -745,7 +735,7 @@ proc ::tkcon::EvalCmd {w cmd} {
|
|||
$w tag bind $tag <Leave> \
|
||||
[list $w tag configure $tag -underline 0]
|
||||
$w tag bind $tag <ButtonRelease-1> \
|
||||
"if {!\[info exists tkPriv(mouseMoved)\] || !\$tkPriv(mouseMoved)} \
|
||||
"if {!\[info exists ::tk::Priv(mouseMoved)\] || !\$::tk::Priv(mouseMoved)} \
|
||||
{[list edit -attach [Attach] -type error -- $PRIV(errorInfo)]}"
|
||||
} else {
|
||||
$w insert output $res\n stderr
|
||||
|
|
@ -905,7 +895,7 @@ proc ::tkcon::EvalSocketClosed {} {
|
|||
## ::tkcon::EvalNamespace - evaluates the args in a particular namespace
|
||||
## This is an override for ::tkcon::EvalAttached for when the user wants
|
||||
## to attach to a particular namespace of the attached interp
|
||||
# ARGS: attached
|
||||
# ARGS: attached
|
||||
# namespace the namespace to evaluate in
|
||||
# args the args to evaluate
|
||||
# RETURNS: the result of the command
|
||||
|
|
@ -933,7 +923,7 @@ proc ::tkcon::Namespaces {{ns ::} {l {}}} {
|
|||
## ::tkcon::CmdGet - gets the current command from the console widget
|
||||
# ARGS: w - console text widget
|
||||
# Returns: text which compromises current command line
|
||||
##
|
||||
##
|
||||
proc ::tkcon::CmdGet w {
|
||||
if {![llength [$w tag nextrange prompt limit end]]} {
|
||||
$w tag add stdin limit end-1c
|
||||
|
|
@ -947,7 +937,7 @@ proc ::tkcon::CmdGet w {
|
|||
# last - varname of any remainder (like an incomplete final command).
|
||||
# If there is only one command, it's placed in this var.
|
||||
# Returns: constituent command info in varnames specified by list & rmd.
|
||||
##
|
||||
##
|
||||
proc ::tkcon::CmdSep {cmd list last} {
|
||||
upvar 1 $list cmds $last inc
|
||||
set inc {}
|
||||
|
|
@ -974,7 +964,7 @@ proc ::tkcon::CmdSep {cmd list last} {
|
|||
## ::tkcon::CmdSplit - splits multiple commands into a list
|
||||
# ARGS: cmd - (possible) multiple command to separate
|
||||
# Returns: constituent commands in a list
|
||||
##
|
||||
##
|
||||
proc ::tkcon::CmdSplit {cmd} {
|
||||
set inc {}
|
||||
set cmds {}
|
||||
|
|
@ -998,7 +988,7 @@ proc ::tkcon::CmdSplit {cmd} {
|
|||
## Called by ::tkcon::EvalCmd
|
||||
# ARGS: w - text widget
|
||||
# Outputs: tag name guaranteed unique in the widget
|
||||
##
|
||||
##
|
||||
proc ::tkcon::UniqueTag {w} {
|
||||
set tags [$w tag names]
|
||||
set idx 0
|
||||
|
|
@ -1011,7 +1001,7 @@ proc ::tkcon::UniqueTag {w} {
|
|||
# ARGS: w - console text widget
|
||||
# size - # of lines to constrain to
|
||||
# Outputs: may delete data in console widget
|
||||
##
|
||||
##
|
||||
proc ::tkcon::ConstrainBuffer {w size} {
|
||||
if {[$w index end] > $size} {
|
||||
$w delete 1.0 [expr {int([$w index end])-$size}].0
|
||||
|
|
@ -1021,7 +1011,7 @@ proc ::tkcon::ConstrainBuffer {w size} {
|
|||
## ::tkcon::Prompt - displays the prompt in the console widget
|
||||
# ARGS: w - console text widget
|
||||
# Outputs: prompt (specified in ::tkcon::OPT(prompt1)) to console
|
||||
##
|
||||
##
|
||||
proc ::tkcon::Prompt {{pre {}} {post {}} {prompt {}}} {
|
||||
variable OPT
|
||||
variable PRIV
|
||||
|
|
@ -1053,7 +1043,7 @@ proc ::tkcon::Prompt {{pre {}} {post {}} {prompt {}}} {
|
|||
}
|
||||
|
||||
## ::tkcon::About - gives about info for tkcon
|
||||
##
|
||||
##
|
||||
proc ::tkcon::About {} {
|
||||
variable OPT
|
||||
variable PRIV
|
||||
|
|
@ -1088,7 +1078,7 @@ proc ::tkcon::About {} {
|
|||
|
||||
## ::tkcon::InitMenus - inits the menubar and popup for the console
|
||||
# ARGS: w - console text widget
|
||||
##
|
||||
##
|
||||
proc ::tkcon::InitMenus {w title} {
|
||||
variable OPT
|
||||
variable PRIV
|
||||
|
|
@ -1521,7 +1511,7 @@ proc ::tkcon::NamespaceMenu m {
|
|||
}
|
||||
}
|
||||
|
||||
## Namepaces List
|
||||
## Namepaces List
|
||||
##
|
||||
proc ::tkcon::NamespacesList {names} {
|
||||
variable PRIV
|
||||
|
|
@ -1894,7 +1884,7 @@ proc ::tkcon::NewSocket {} {
|
|||
## The file is actually sourced in the currently attached's interp
|
||||
# ARGS: fn - (optional) filename to source in
|
||||
# Returns: selected filename ({} if nothing was selected)
|
||||
##
|
||||
##
|
||||
proc ::tkcon::Load { {fn ""} } {
|
||||
set types {
|
||||
{{Tcl Files} {.tcl .tk}}
|
||||
|
|
@ -1913,7 +1903,7 @@ proc ::tkcon::Load { {fn ""} } {
|
|||
## This does not eval in a slave because it's not necessary
|
||||
# ARGS: w - console text widget
|
||||
# fn - (optional) filename to save to
|
||||
##
|
||||
##
|
||||
proc ::tkcon::Save { {fn ""} {type ""} {opt ""} {mode w} } {
|
||||
variable PRIV
|
||||
|
||||
|
|
@ -1983,7 +1973,7 @@ proc ::tkcon::MainInit {} {
|
|||
## Creates a slave interpreter and sources in this script.
|
||||
## All other interpreters also get a command to eval function in the
|
||||
## new interpreter.
|
||||
##
|
||||
##
|
||||
proc ::tkcon::New {} {
|
||||
variable PRIV
|
||||
global argv0 argc argv
|
||||
|
|
@ -2020,7 +2010,7 @@ proc ::tkcon::MainInit {} {
|
|||
## ::tkcon::Exit - full exit OR destroy slave console
|
||||
## This proc should only be called in the main interpreter from a slave.
|
||||
## The master determines whether we do a full exit or just kill the slave.
|
||||
##
|
||||
##
|
||||
proc ::tkcon::Exit {slave args} {
|
||||
variable PRIV
|
||||
variable OPT
|
||||
|
|
@ -2043,7 +2033,7 @@ proc ::tkcon::MainInit {} {
|
|||
## This proc should only be called by the main interpreter. If it is
|
||||
## called from there, it will ask before exiting tkcon. All others
|
||||
## (slaves) will just have their slave interpreter deleted, closing them.
|
||||
##
|
||||
##
|
||||
proc ::tkcon::Destroy {{slave {}}} {
|
||||
variable PRIV
|
||||
|
||||
|
|
@ -2474,7 +2464,7 @@ proc ::tkcon::ErrorHighlight w {
|
|||
$w tag configure $tag -foreground $COLOR(stdout)
|
||||
$w tag bind $tag <Enter> [list $w tag configure $tag -underline 1]
|
||||
$w tag bind $tag <Leave> [list $w tag configure $tag -underline 0]
|
||||
$w tag bind $tag <ButtonRelease-1> "if {!\$tkPriv(mouseMoved)} \
|
||||
$w tag bind $tag <ButtonRelease-1> "if {!\$::tk::Priv(mouseMoved)} \
|
||||
{[list edit -attach $app -type proc -find $what -- $cmd]}"
|
||||
}
|
||||
set info [string range $info $c1 end]
|
||||
|
|
@ -2503,7 +2493,7 @@ proc ::tkcon::ErrorHighlight w {
|
|||
$w tag configure $tag -foreground $COLOR(proc)
|
||||
$w tag bind $tag <Enter> [list $w tag configure $tag -underline 1]
|
||||
$w tag bind $tag <Leave> [list $w tag configure $tag -underline 0]
|
||||
$w tag bind $tag <ButtonRelease-1> "if {!\$tkPriv(mouseMoved)} \
|
||||
$w tag bind $tag <ButtonRelease-1> "if {!\$::tk::Priv(mouseMoved)} \
|
||||
{[list edit -attach $app -type proc -- $cmd]}"
|
||||
}
|
||||
}
|
||||
|
|
@ -2513,7 +2503,7 @@ proc ::tkcon::ErrorHighlight w {
|
|||
## This always exists in the main interpreter, and is aliased into
|
||||
## other connected interpreters
|
||||
# ARGS: totally variable, see internal comments
|
||||
##
|
||||
##
|
||||
proc tkcon {cmd args} {
|
||||
global errorInfo
|
||||
|
||||
|
|
@ -2552,8 +2542,8 @@ proc tkcon {cmd args} {
|
|||
## 'congets' a replacement for [gets stdin]
|
||||
# Use the 'gets' alias of 'tkcon_gets' command instead of
|
||||
# calling the *get* methods directly for best compatability
|
||||
if {[llength $args]} {
|
||||
return -code error "wrong # args: must be \"tkcon congets\""
|
||||
if {[llength $args] > 1} {
|
||||
return -code error "wrong # args: must be \"tkcon congets [pfix]\""
|
||||
}
|
||||
tkcon show
|
||||
set old [bind TkConsole <<TkCon_Eval>>]
|
||||
|
|
@ -2561,7 +2551,12 @@ proc tkcon {cmd args} {
|
|||
set w $::tkcon::PRIV(console)
|
||||
# Make sure to move the limit to get the right data
|
||||
$w mark set insert end
|
||||
$w mark set limit insert
|
||||
if {[llength $args]} {
|
||||
$w mark set limit insert
|
||||
$w insert end $args
|
||||
} else {
|
||||
$w mark set limit insert
|
||||
}
|
||||
$w see end
|
||||
vwait ::tkcon::PRIV(wait)
|
||||
set line [::tkcon::CmdGet $w]
|
||||
|
|
@ -2790,21 +2785,27 @@ proc tkcon {cmd args} {
|
|||
## This allows me to capture all stdout/stderr to the console window
|
||||
## This will be renamed to 'puts' at the appropriate time during init
|
||||
##
|
||||
# ARGS: same as usual
|
||||
# ARGS: same as usual
|
||||
# Outputs: the string with a color-coded text tag
|
||||
##
|
||||
##
|
||||
proc tkcon_puts args {
|
||||
set len [llength $args]
|
||||
foreach {arg1 arg2 arg3} $args { break }
|
||||
|
||||
if {$len == 1} {
|
||||
tkcon console insert output "$arg1\n" stdout
|
||||
set sarg $arg1
|
||||
set nl 1
|
||||
set farg stdout
|
||||
} elseif {$len == 2} {
|
||||
if {![string compare $arg1 -nonewline]} {
|
||||
tkcon console insert output $arg2 stdout
|
||||
set sarg $arg2
|
||||
set farg stdout
|
||||
set nl 0
|
||||
} elseif {![string compare $arg1 stdout] \
|
||||
|| ![string compare $arg1 stderr]} {
|
||||
tkcon console insert output "$arg2\n" $arg1
|
||||
set sarg $arg2
|
||||
set farg $arg1
|
||||
set nl 1
|
||||
} else {
|
||||
set len 0
|
||||
}
|
||||
|
|
@ -2812,11 +2813,15 @@ proc tkcon_puts args {
|
|||
if {![string compare $arg1 -nonewline] \
|
||||
&& (![string compare $arg2 stdout] \
|
||||
|| ![string compare $arg2 stderr])} {
|
||||
tkcon console insert output $arg3 $arg2
|
||||
set sarg $arg3
|
||||
set farg $arg2
|
||||
set nl 0
|
||||
} elseif {(![string compare $arg1 stdout] \
|
||||
|| ![string compare $arg1 stderr]) \
|
||||
&& ![string compare $arg3 nonewline]} {
|
||||
tkcon console insert output $arg2 $arg1
|
||||
set sarg $arg2
|
||||
set farg $arg1
|
||||
set nl 0
|
||||
} else {
|
||||
set len 0
|
||||
}
|
||||
|
|
@ -2826,7 +2831,42 @@ proc tkcon_puts args {
|
|||
|
||||
## $len == 0 means it wasn't handled by tkcon above.
|
||||
##
|
||||
if {$len == 0} {
|
||||
|
||||
if {$len != 0} {
|
||||
|
||||
## "poor man's" \r substitution---erase everything on the output
|
||||
## line and print from character after the \r
|
||||
|
||||
set rpt [string last \r $sarg]
|
||||
if {$rpt >= 0} {
|
||||
tkcon console delete "insert linestart" "insert lineend"
|
||||
set sarg [string range $sarg [expr {$rpt + 1}] end]
|
||||
}
|
||||
|
||||
set bpt [string first \b $sarg]
|
||||
if {$bpt >= 0} {
|
||||
set narg [string range $sarg [expr {$bpt + 1}] end]
|
||||
set sarg [string range $sarg 0 [expr {$bpt - 1}]]
|
||||
set nl 0
|
||||
}
|
||||
|
||||
|
||||
if {$nl == 0} {
|
||||
tkcon console insert output $sarg $farg
|
||||
} else {
|
||||
tkcon console insert output "$sarg\n" $farg
|
||||
}
|
||||
|
||||
if {$bpt >= 0} {
|
||||
tkcon console delete "insert -1 char" insert
|
||||
if {$nl == 0} {
|
||||
tkcon_puts $farg $narg nonewline
|
||||
} else {
|
||||
tkcon_puts $farg $narg
|
||||
}
|
||||
}
|
||||
|
||||
} else {
|
||||
global errorCode errorInfo
|
||||
if {[catch "tkcon_tcl_puts $args" msg]} {
|
||||
regsub tkcon_tcl_puts $msg puts msg
|
||||
|
|
@ -2849,7 +2889,7 @@ proc tkcon_puts args {
|
|||
## This allows me to capture all stdin input without needing to stdin
|
||||
## This will be renamed to 'gets' at the appropriate time during init
|
||||
##
|
||||
# ARGS: same as gets
|
||||
# ARGS: same as gets
|
||||
# Outputs: same as gets
|
||||
##
|
||||
proc tkcon_gets args {
|
||||
|
|
@ -2873,12 +2913,12 @@ proc tkcon_gets args {
|
|||
}
|
||||
|
||||
## edit - opens a file/proc/var for reading/editing
|
||||
##
|
||||
##
|
||||
# Arguments:
|
||||
# type proc/file/var
|
||||
# what the actual name of the item
|
||||
# Returns: nothing
|
||||
##
|
||||
##
|
||||
proc edit {args} {
|
||||
array set opts {-find {} -type {} -attach {}}
|
||||
while {[string match -* [lindex $args 0]]} {
|
||||
|
|
@ -3030,7 +3070,7 @@ proc echo args { puts [concat $args] }
|
|||
|
||||
## clear - clears the buffer of the console (not the history though)
|
||||
## This is executed in the parent interpreter
|
||||
##
|
||||
##
|
||||
proc clear {{pcnt 100}} {
|
||||
if {![regexp {^[0-9]*$} $pcnt] || $pcnt < 1 || $pcnt > 100} {
|
||||
return -code error \
|
||||
|
|
@ -3048,7 +3088,7 @@ proc clear {{pcnt 100}} {
|
|||
## If called with one arg, returns the alias of that arg (or {} if none)
|
||||
# ARGS: newcmd - (optional) command to bind alias to
|
||||
# args - command and args being aliased
|
||||
##
|
||||
##
|
||||
proc alias {{newcmd {}} args} {
|
||||
if {[string match {} $newcmd]} {
|
||||
set res {}
|
||||
|
|
@ -3065,7 +3105,7 @@ proc alias {{newcmd {}} args} {
|
|||
|
||||
## unalias - unaliases an alias'ed command
|
||||
# ARGS: cmd - command to unbind as an alias
|
||||
##
|
||||
##
|
||||
proc unalias {cmd} {
|
||||
interp alias {} $cmd {}
|
||||
}
|
||||
|
|
@ -3085,7 +3125,7 @@ proc unalias {cmd} {
|
|||
# -- forcibly ends options recognition
|
||||
#
|
||||
# Returns: the values of the requested items in a 'source'able form
|
||||
##
|
||||
##
|
||||
proc dump {type args} {
|
||||
set whine 1
|
||||
set code ok
|
||||
|
|
@ -3637,13 +3677,13 @@ proc observe_var {name el op} {
|
|||
## which - tells you where a command is found
|
||||
# ARGS: cmd - command name
|
||||
# Returns: where command is found (internal / external / unknown)
|
||||
##
|
||||
##
|
||||
proc which cmd {
|
||||
## This tries to auto-load a command if not recognized
|
||||
set types [uplevel 1 [list what $cmd 1]]
|
||||
if {[llength $types]} {
|
||||
set out {}
|
||||
|
||||
|
||||
foreach type $types {
|
||||
switch -- $type {
|
||||
alias { set res "$cmd: aliased to [alias $cmd]" }
|
||||
|
|
@ -3674,7 +3714,7 @@ proc which cmd {
|
|||
## what - tells you what a string is recognized as
|
||||
# ARGS: str - string to id
|
||||
# Returns: id types of command as list
|
||||
##
|
||||
##
|
||||
proc what {str {autoload 0}} {
|
||||
set types {}
|
||||
if {[llength [info commands $str]] || ($autoload && \
|
||||
|
|
@ -3721,7 +3761,7 @@ proc what {str {autoload 0}} {
|
|||
# -long - list in full format "permissions size date filename"
|
||||
# -full - displays / after directories and link paths for links
|
||||
# Returns: a directory listing
|
||||
##
|
||||
##
|
||||
proc dir {args} {
|
||||
array set s {
|
||||
all 0 full 0 long 0
|
||||
|
|
@ -4106,7 +4146,7 @@ proc ::tkcon::Bindings {} {
|
|||
global tcl_platform tk_version
|
||||
|
||||
#-----------------------------------------------------------------------
|
||||
# Elements of tkPriv that are used in this file:
|
||||
# Elements of ::tk::Priv that are used in this file:
|
||||
#
|
||||
# char - Character position on the line; kept in order
|
||||
# to allow moving up or down past short lines while
|
||||
|
|
@ -4131,9 +4171,12 @@ proc ::tkcon::Bindings {} {
|
|||
}
|
||||
|
||||
## Get all Text bindings into TkConsole
|
||||
foreach ev [bind Text] { bind TkConsole $ev [bind Text $ev] }
|
||||
foreach ev [bind Text] { bind TkConsole $ev [bind Text $ev] }
|
||||
## We really didn't want the newline insertion
|
||||
bind TkConsole <Control-Key-o> {}
|
||||
|
||||
## in 8.6b3, the virtual events <<NextLine>> and <<PrevLine>>
|
||||
# mess up our history feature
|
||||
bind TkConsole <<NextLine>> {}
|
||||
bind TkConsole <<PrevLine>> {}
|
||||
|
||||
|
|
@ -4342,9 +4385,9 @@ proc ::tkcon::Bindings {} {
|
|||
|
||||
bind TkConsole <Control-a> {
|
||||
if {[%W compare {limit linestart} == {insert linestart}]} {
|
||||
tkTextSetCursor %W limit
|
||||
::tk::TextSetCursor %W limit
|
||||
} else {
|
||||
tkTextSetCursor %W {insert linestart}
|
||||
::tk::TextSetCursor %W {insert linestart}
|
||||
}
|
||||
}
|
||||
bind TkConsole <Key-Home> [bind TkConsole <Control-a>]
|
||||
|
|
@ -4368,14 +4411,14 @@ proc ::tkcon::Bindings {} {
|
|||
}
|
||||
bind TkConsole <<TkCon_Previous>> {
|
||||
if {[%W compare {insert linestart} != {limit linestart}]} {
|
||||
tkTextSetCursor %W [tkTextUpDownLine %W -1]
|
||||
::tk::TextSetCursor %W [::tk::TextUpDownLine %W -1]
|
||||
} else {
|
||||
::tkcon::Event -1
|
||||
}
|
||||
}
|
||||
bind TkConsole <<TkCon_Next>> {
|
||||
if {[%W compare {insert linestart} != {end-1c linestart}]} {
|
||||
tkTextSetCursor %W [tkTextUpDownLine %W 1]
|
||||
::tk::TextSetCursor %W [::tk::TextUpDownLine %W 1]
|
||||
} else {
|
||||
::tkcon::Event 1
|
||||
}
|
||||
|
|
@ -4390,7 +4433,7 @@ proc ::tkcon::Bindings {} {
|
|||
}
|
||||
bind TkConsole <<TkCon_Transpose>> {
|
||||
## Transpose current and previous chars
|
||||
if {[%W compare insert > "limit+1c"]} { tkTextTranspose %W }
|
||||
if {[%W compare insert > "limit+1c"]} { ::tk::TextTranspose %W }
|
||||
}
|
||||
bind TkConsole <<TkCon_ClearLine>> {
|
||||
## Clear command line (Unix shell staple)
|
||||
|
|
@ -4408,10 +4451,10 @@ proc ::tkcon::Bindings {} {
|
|||
::tkcon::Insert %W $::tkcon::PRIV(tmp)
|
||||
%W see end
|
||||
}
|
||||
catch {bind TkConsole <Key-Page_Up> { tkTextScrollPages %W -1 }}
|
||||
catch {bind TkConsole <Key-Prior> { tkTextScrollPages %W -1 }}
|
||||
catch {bind TkConsole <Key-Page_Down> { tkTextScrollPages %W 1 }}
|
||||
catch {bind TkConsole <Key-Next> { tkTextScrollPages %W 1 }}
|
||||
catch {bind TkConsole <Key-Page_Up> { ::tk::TextScrollPages %W -1 }}
|
||||
catch {bind TkConsole <Key-Prior> { ::tk::TextScrollPages %W -1 }}
|
||||
catch {bind TkConsole <Key-Page_Down> { ::tk::TextScrollPages %W 1 }}
|
||||
catch {bind TkConsole <Key-Next> { ::tk::TextScrollPages %W 1 }}
|
||||
bind TkConsole <$PRIV(meta)-d> {
|
||||
if {[%W compare insert >= limit]} {
|
||||
%W delete insert {insert wordend}
|
||||
|
|
@ -4429,7 +4472,7 @@ proc ::tkcon::Bindings {} {
|
|||
}
|
||||
bind TkConsole <ButtonRelease-2> {
|
||||
if {
|
||||
(!$tkPriv(mouseMoved) || $tk_strictMotif) &&
|
||||
(!$::tk::Priv(mouseMoved) || $tk_strictMotif) &&
|
||||
![catch {::tkcon::GetSelection %W} ::tkcon::PRIV(tmp)]
|
||||
} {
|
||||
if {[%W compare @%x,%y < limit]} {
|
||||
|
|
@ -4600,7 +4643,7 @@ proc ::tkcon::TagProc w {
|
|||
# c1 - first char of pair
|
||||
# c2 - second char of pair
|
||||
# Calls: ::tkcon::Blink
|
||||
##
|
||||
##
|
||||
proc ::tkcon::MatchPair {w c1 c2 {lim 1.0}} {
|
||||
if {[string compare {} [set ix [$w search -back $c1 insert $lim]]]} {
|
||||
while {
|
||||
|
|
@ -4638,7 +4681,7 @@ proc ::tkcon::MatchPair {w c1 c2 {lim 1.0}} {
|
|||
## The quote to match is assumed to be at the text index 'insert'.
|
||||
# ARGS: w - console text widget
|
||||
# Calls: ::tkcon::Blink
|
||||
##
|
||||
##
|
||||
proc ::tkcon::MatchQuote {w {lim 1.0}} {
|
||||
set i insert-1c
|
||||
set j 0
|
||||
|
|
@ -4664,7 +4707,7 @@ proc ::tkcon::MatchQuote {w {lim 1.0}} {
|
|||
# i2 - end index of blink region
|
||||
# dur - duration in usecs to blink for
|
||||
# Outputs: blinks selected characters in $w
|
||||
##
|
||||
##
|
||||
proc ::tkcon::Blink {w args} {
|
||||
eval [list $w tag add blink] $args
|
||||
after $::tkcon::OPT(blinktime) [list $w] tag remove blink $args
|
||||
|
|
@ -4679,7 +4722,7 @@ proc ::tkcon::Blink {w args} {
|
|||
# ARGS: w - text window in which to insert the string
|
||||
# s - string to insert (usually just a single char)
|
||||
# Outputs: $s to text widget
|
||||
##
|
||||
##
|
||||
proc ::tkcon::Insert {w s} {
|
||||
if {[string match {} $s] || [string match disabled [$w cget -state]]} {
|
||||
return
|
||||
|
|
@ -4695,7 +4738,7 @@ proc ::tkcon::Insert {w s} {
|
|||
$w see insert
|
||||
}
|
||||
|
||||
## ::tkcon::Expand -
|
||||
## ::tkcon::Expand -
|
||||
# ARGS: w - text widget in which to expand str
|
||||
# type - type of expansion (path / proc / variable)
|
||||
# Calls: ::tkcon::Expand(Pathname|Procname|Variable)
|
||||
|
|
@ -4704,7 +4747,7 @@ proc ::tkcon::Insert {w s} {
|
|||
# match equaled the string to expand, then all possible matches
|
||||
# are output to stdout. Triggers bell if no matches are found.
|
||||
# Returns: number of matches found
|
||||
##
|
||||
##
|
||||
proc ::tkcon::Expand {w {type ""}} {
|
||||
set exp "\[^\\\\\]\[\[ \t\n\r\\\{\"$\]"
|
||||
set tmp [$w search -backwards -regexp $exp insert-1c limit-1c]
|
||||
|
|
@ -4743,7 +4786,7 @@ proc ::tkcon::Expand {w {type ""}} {
|
|||
# Calls: ::tkcon::ExpandBestMatch
|
||||
# Returns: list containing longest unique match followed by all the
|
||||
# possible further matches
|
||||
##
|
||||
##
|
||||
proc ::tkcon::ExpandPathname str {
|
||||
set pwd [EvalAttached pwd]
|
||||
# Cause a string like {C:/Program\ Files/} to become "C:/Program Files/"
|
||||
|
|
@ -4825,7 +4868,7 @@ proc ::tkcon::ExpandProcname str {
|
|||
# Calls: ::tkcon::ExpandBestMatch
|
||||
# Returns: list containing longest unique match followed by all the
|
||||
# possible further matches
|
||||
##
|
||||
##
|
||||
proc ::tkcon::ExpandVariable str {
|
||||
if {[regexp {([^\(]*)\((.*)} $str junk ary str]} {
|
||||
## Looks like they're trying to expand an array.
|
||||
|
|
@ -4853,7 +4896,7 @@ proc ::tkcon::ExpandVariable str {
|
|||
## or $e is {}. $e is extra for compatibility with proc below.
|
||||
# ARGS: l - list to find best unique match in
|
||||
# Returns: longest unique match in the list
|
||||
##
|
||||
##
|
||||
proc ::tkcon::ExpandBestMatch2 {l {e {}}} {
|
||||
set s [lindex $l 0]
|
||||
if {[llength $l]>1} {
|
||||
|
|
@ -4873,7 +4916,7 @@ proc ::tkcon::ExpandBestMatch2 {l {e {}}} {
|
|||
# ARGS: l - list to find best unique match in
|
||||
# e - currently best known unique match
|
||||
# Returns: longest unique match in the list
|
||||
##
|
||||
##
|
||||
proc ::tkcon::ExpandBestMatch {l {e {}}} {
|
||||
set ec [lindex $l 0]
|
||||
if {[llength $l]>1} {
|
||||
|
|
@ -5237,7 +5280,7 @@ proc ::tkcon::Retrieve {} {
|
|||
## ::tkcon::Resource - re'source's this script into current console
|
||||
## Meant primarily for my development of this program. It follows
|
||||
## links until the ultimate source is found.
|
||||
##
|
||||
##
|
||||
set ::tkcon::PRIV(SCRIPT) [info script]
|
||||
if {!$::tkcon::PRIV(WWW) && [string compare $::tkcon::PRIV(SCRIPT) {}]} {
|
||||
# we use a catch here because some wrap apps choke on 'file type'
|
||||
|
|
|
|||
Loading…
Reference in New Issue