Jump to content
Sign in to follow this  
Guest

How to reset selected variables in TCL

Recommended Posts

Guest

Hie everybody

When I loop over several subcases to post treat the stresses, I need to reset variables otherwise, the results , I can obtain in the first loop, remain in the next loops : thus it is impossible to get the results I want.

I tried to use the command : "namespace delete varaible" but it deletes all

thanks for your replies

greg

Share this post


Link to post
Share on other sites
Guest

# console.tcl --

#

# This code constructs the console window for an application. It

# can be used by non-unix systems that do not have built-in support

# for shells.

#

# RCS: @(#) $Id: console.tcl,v 1.22.2.3 2005/05/31 04:58:00 hobbs Exp $

#

# Copyright © 1995-1997 Sun Microsystems, Inc.

# Copyright © 1998-2000 Ajuba Solutions.

#

# See the file "license.terms" for information on usage and redistribution

# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

#

# TODO: history - remember partially written command

namespace eval ::tk::console {

variable blinkTime 500 ; # msecs to blink braced range for

variable blinkRange 1 ; # enable blinking of the entire braced range

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 inPlugin [info exists embed_args]

variable defaultPrompt ; # default prompt if tcl_prompt1 isn't used

if {$inPlugin} {

set defaultPrompt {subst {[history nextid] % }}

} else {

set defaultPrompt {subst {([file tail [pwd]]) [history nextid] % }}

}

}

# simple compat function for tkcon code added for this console

interp alias {} EvalAttached {} consoleinterp eval

# ::tk::ConsoleInit --

# This procedure constructs and configures the console windows.

#

# Arguments:

# None.

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

}

}

}

#added for right click menu

if {[catch {menu .cutPasteMenu -tearoff 0 -type normal} err]} { bgerror "INIT: $err" }

# .cutPasteMenu add command -label [mc "Cut"] -underline 2 \

# -command { event generate .console <<Cut>> } -accel "$mod+X"

.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"

# .cutPasteMenu add command -label [mc "Clear"] -underline 2 \

# -command { event generate .console <<Clear>> }

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

# changed this so as not to leave a wish.exe left running

wm protocol . WM_DELETE_WINDOW {

if {[wm state .]=="normal"} {

# destroy .

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

# this is the binding that pops the menu

# and additionally enables/disables the copy function

# based on if you have selected any data

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]

}

# A variant of ConsolePrompt to avoid a 'puts' call

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"} {

# Subtle work-around to erase the '% ' that tclMain.c prints out

after idle [list $con delete 1.0 output]

}

}

# ::tk::ConsoleSource --

#

# Prompts the user for a file to source in the main interpreter.

#

# Arguments:

# None.

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"

}

}

}

# ::tk::ConsoleInvoke --

# Processes the command line input. If the command is complete it

# is evaled in the main interpreter. Otherwise, the continuation

# prompt is added and more input may be added.

#

# Arguments:

# None.

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

}

# ::tk::ConsoleHistory --

# This procedure implements command line history for the

# console. In general is evals the history command in the

# main interpreter to obtain the history. The variable

# ::tk::HistNum is used to store the current location in the history.

#

# Arguments:

# cmd - Which action to take: prev, next, reset.

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

}

}

}

# ::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

# prompt. Otherwise, a hard coded default prompt is printed.

#

# Arguments:

# partial - Flag to specify which prompt to print.

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

}

# ::tk::ConsoleBind --

# This procedure first ensures that the default bindings for the Text

# class have been defined. Then certain bindings are overridden for

# the class.

#

# Arguments:

# None.

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] }

## We really didn't want the newline insertion...

bind Console <Control-Key-o> {}

## ...or any Control-v binding (would block <<Paste>>)

bind Console <Control-Key-v> {}

# For the moment, transpose isn't enabled until the console

# gets and overhaul of how it handles input -- hobbs

bind Console <Control-Key-t> {}

# Ignore all Alt, Meta, and Control keypresses unless explicitly bound.

# Otherwise, if a widget binding for one of these is defined, the

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>> {

## Clear console display

%W delete 1.0 "promptEnd linestart"

}

bind Console <<Console_ClearLine>> {

## Clear command line (Unix shell staple)

%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>> {

# Same as the copy event

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

}

}

}

##

## Bindings for doing special things based on certain keys

##

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

}

}

# ::tk::ConsoleInsert --

# Insert a string into a text at the point of the insertion cursor.

# If there is a selection in the text, and it covers the point of the

# insertion cursor, then delete the selection before inserting. Insertion

# is restricted to the prompt area.

#

# Arguments:

# w - The text window in which to insert the string

# s - The string to insert (usually just a single character)

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

}

# ::tk::ConsoleOutput --

#

# This routine is called directly by ConsolePutsCmd to cause a string

# to be displayed in the console.

#

# Arguments:

# dest - The output tag to be used: either "stderr" or "stdout".

# string - The string to be displayed.

proc ::tk::ConsoleOutput {dest string} {

set w .console

$w insert output $string $dest

::tk::console::ConstrainBuffer $w $::tk::console::maxLines

$w see insert

}

# ::tk::ConsoleExit --

#

# This routine is called by ConsoleEventProc when the main window of

# the application is destroyed. Don't call exit - that probably already

# happened. Just delete our window.

#

# Arguments:

# None.

proc ::tk::ConsoleExit {} {

destroy .

}

# ::tk::ConsoleAbout --

#

# This routine displays an About box to show Tcl/Tk version info.

#

# Arguments:

# None.

proc ::tk::ConsoleAbout {} {

tk_messageBox -type ok -message "[mc {Tcl for Windows}]

Tcl $::tcl_patchLevel

Tk $::tk_patchLevel"

}

# ::tk::console::TagProc --

#

# Tags a procedure in the console if it's recognized

# This procedure is not perfect. However, making it perfect wastes

# too much CPU time...

#

# Arguments:

# w - console text widget

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"

}

}

# ::tk::console::MatchPair --

#

# Blinks a matching pair of characters

# c2 is assumed to be at the text index 'insert'.

# This proc is really loopy and took me an hour to figure out given

# all possible combinations with escaping except for escaped \'s.

# It doesn't take into account possible commenting... Oh well. If

# anyone has something better, I'd like to see/use it. This is really

# only efficient for small contexts.

#

# Arguments:

# w - console text widget

# c1 - first char of pair

# c2 - second char of pair

#

# 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]]]} {

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]

}

}

# ::tk::console::MatchQuote --

#

# Blinks between matching quotes.

# Blinks just the quote if it's unmatched, otherwise blinks quoted string

# The quote to match is assumed to be at the text index 'insert'.

#

# Arguments:

# w - console text widget

#

# Calls: ::tk::console::Blink

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]

}

}

# ::tk::console::Blink --

#

# Blinks between n index pairs for a specified duration.

#

# Arguments:

# w - console text widget

# i1 - start index to blink region

# i2 - end index of blink region

# dur - duration in usecs to blink for

#

# Outputs:

# blinks selected characters in $w

proc ::tk::console::Blink {w args} {

eval [list $w tag add blink] $args

after $::tk::console::blinkTime [list $w] tag remove blink $args

}

# ::tk::console::ConstrainBuffer --

#

# This limits the amount of data in the text widget

# Called by Prompt and ConsoleOutput

#

# Arguments:

# w - console text widget

# size - # of lines to constrain to

#

# Outputs:

# may delete data in console widget

proc ::tk::console::ConstrainBuffer {w size} {

if {[$w index end] > $size} {

$w delete 1.0 [expr {int([$w index end])-$size}].0

}

}

# ::tk::console::Expand --

#

# Arguments:

# ARGS: w - text widget in which to expand str

# type - type of expansion (path / proc / variable)

#

# Calls: ::tk::console::Expand(Pathname|Procname|Variable)

#

# Outputs: The string to match is expanded to the longest possible match.

# If ::tk::console::showMatches is non-zero and the longest 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 ::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]

}

# ::tk::console::ExpandPathname --

#

# Expand a file pathname based on $str

# This is based on UNIX file name conventions

#

# Arguments:

# str - partial file pathname to expand

#

# Calls: ::tk::console::ExpandBestMatch

#

# 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

}

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 {[catch {lsort [EvalAttached [list glob $dir*]]} m]} {

set match {}

} else {

if {[llength $m] > 1} {

global tcl_platform

if {[string match windows $tcl_platform(platform)]} {

## Windows is screwy because it's case insensitive

set tmp [ExpandBestMatch [string tolower $m] \

[string tolower $dir]]

## Don't change case if we haven't changed the word

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 {

## This may look goofy, but it handles spaces in path names

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

## Why is this one needed and the ones below aren't!!

set match [list $match]

}

}

EvalAttached [list cd $pwd]

return $match

}

# ::tk::console::ExpandProcname --

#

# Expand a tcl proc name based on $str

#

# Arguments:

# str - partial proc name to expand

#

# Calls: ::tk::console::ExpandBestMatch

#

# Returns: list containing longest unique match followed by all the

# possible further matches

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

}

# ::tk::console::ExpandVariable --

#

# Expand a tcl variable name based on $str

#

# Arguments:

# str - partial tcl var name to expand

#

# Calls: ::tk::console::ExpandBestMatch

#

# Returns: list containing longest unique match followed by all the

# possible further matches

proc ::tk::console::ExpandVariable str {

if {[regexp {([^\(]*)\((.*)} $str junk 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\)}

return $vars

} elseif {[llength $match] == 1} {

set match $ary\($match\)

}

## Space transformation avoided for array names.

} else {

set match [EvalAttached [list info vars $str*]]

if {[llength $match] > 1} {

regsub -all { } [ExpandBestMatch $match $str] {\\ } str

set match [linsert $match 0 $str]

} else {

regsub -all { } $match {\\ } match

}

}

return $match

}

# ::tk::console::ExpandBestMatch --

#

# Finds the best unique match in a list of names.

# The extra $e in this argument allows us to limit the innermost loop a little

# further. This improves speed as $l becomes large or $e becomes long.

#

# Arguments:

# l - list to find best unique match in

# e - currently best known unique match

#

# Returns: longest unique match in the list

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

foreach l $l {

while {$ei>=$e && [string first $ec $l]} {

set ec [string range $ec 0 [incr ei -1]]

}

}

}

return $ec

}

# now initialize the console

::tk::ConsoleInit

Share this post


Link to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
You are posting as a guest. If you have an account, please sign in.
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Sign in to follow this  

×
×
  • Create New...