hdf5.git - Mirror from: https://github.com/HDFGroup/hdf5.git

diff options

author	MuQun Yang <ymuqun@hdfgroup.org>	2006-10-25 20:11:29 (GMT)
committer	MuQun Yang <ymuqun@hdfgroup.org>	2006-10-25 20:11:29 (GMT)
commit	a88a102d5c05b97291b071e336472ce4da52439b (patch)
tree	7986f2f7970842819dca10edc8a7cf7f7b0de131
parent	84bd65e8fcfc28a6a15d062d9a3d36eff674aa9b (diff)
download	hdf5-a88a102d5c05b97291b071e336472ce4da52439b.zip hdf5-a88a102d5c05b97291b071e336472ce4da52439b.tar.gz hdf5-a88a102d5c05b97291b071e336472ce4da52439b.tar.bz2

[svn-r12812] Add h5copy tool tests for windows.

Diffstat

-rw-r--r--

windows/tools/copytest.BAT

193

-rwxr-xr-x

windows/tools/testhdf5tools.BAT

-rwxr-xr-x

windows/tools/tooltest.bat

3 files changed, 216 insertions, 4 deletions

# 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. # # Copyright (c) 1995-1997 Sun Microsystems, Inc. # Copyright (c) 1998-2000 Ajuba Solutions. # Copyright (c) 2007-2008 Daniel A. Steffen <das@users.sourceforge.net> # # 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 useFontchooser [llength [info command ::tk::fontchooser]] 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 {[tk windowingsystem] eq "aqua"} { set mod "Cmd" } else { set mod "Ctrl" } 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 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 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"} { AmpMenuArgs .menubar.edit add command -label [mc Cl&ear] \ -command {event generate .console <<Clear>>} } else { 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 AmpMenuArgs .menubar.help add command -label [mc &About...] \ -command tk::ConsoleAbout } AmpMenuArgs .menubar.edit add separator if {$::tk::console::useFontchooser} { if {[tk windowingsystem] eq "aqua"} { .menubar.edit add command -label tk_choose_font_marker set index [.menubar.edit index tk_choose_font_marker] .menubar.edit entryconfigure $index \ -label [mc "Show Fonts"]\ -accelerator "$mod-T"\ -command [list ::tk::console::FontchooserToggle] bind Console <<TkFontchooserVisibility>> \ [list ::tk::console::FontchooserVisibility $index] ::tk::console::FontchooserVisibility $index } else { AmpMenuArgs .menubar.edit add command -label [mc "&Font..."] \ -command [list ::tk::console::FontchooserToggle] } bind Console <FocusIn> [list ::tk::console::FontchooserFocus %W 1] bind Console <FocusOut> [list ::tk::console::FontchooserFocus %W 0] } 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>>} if {[tk windowingsystem] eq "aqua"} { .menubar add cascade -label [mc Window] -menu [menu .menubar.window] .menubar add cascade -label [mc Help] -menu [menu .menubar.help] } . configure -menu .menubar # 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 $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 # 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 $con mark set output [$con index "end - 1 char"] tk::TextSetCursor $con end $con mark set promptEnd insert $con mark gravity promptEnd left # 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 [subst -nocommand { if {[$con get 1.0 output] eq "% "} { $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 {$filename ne ""} { 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 {[lindex $ranges $pos] ne ""} { set start [lindex $ranges $pos] set end [lindex $ranges [incr pos]] append cmd [.console get $start $end] incr pos } } if {$cmd eq ""} { ConsolePrompt } elseif {[info complete $cmd]} { .console mark set output end .console tag delete input set result [consoleinterp record $cmd] if {$result ne ""} { 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 {$cmd ne ""} { 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 {$partial eq "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 } # 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 # 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 # <Keypress> class binding will also fire and insert the character # which is wrong. 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> <<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 {} } if {$::tk::console::useFontchooser} { bind Console <Command-Key-t> [list ::tk::console::FontchooserToggle] } } 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 {{} 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 %W see insert } } bind Console <BackSpace> { 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]} { %W delete insert-1c %W see insert } } bind Console <Control-h> [bind Console <BackSpace>] bind Console <<LineStart>> { if {[%W compare insert < promptEnd]} { tk::TextSetCursor %W {insert linestart} } else { tk::TextSetCursor %W promptEnd } } bind Console <<LineEnd>> { tk::TextSetCursor %W {insert lineend} } 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 .] source [file join $tk_library console.tcl] } if {[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] if {$size < 0} {set sign -1} else {set sign 1} set size [expr {(abs($size) + 1) * $sign}] font configure TkConsoleFont -size $size if {$::tk::console::useFontchooser} { tk fontchooser configure -font TkConsoleFont } } bind Console <<Console_FontSizeDecr>> { set size [font configure TkConsoleFont -size] if {abs($size) < 2} { return } if {$size < 0} {set sign -1} else {set sign 1} set size [expr {(abs($size) - 1) * $sign}] font configure TkConsoleFont -size $size if {$::tk::console::useFontchooser} { tk fontchooser configure -font TkConsoleFont } } ## ## Bindings for doing special things based on certain keys ## bind PostConsole <Key-parenright> { if {"\\" ne [%W get insert-2c]} { ::tk::console::MatchPair %W  promptEnd } } bind PostConsole <Key-bracketright> { if {"\\" ne [%W get insert-2c]} { ::tk::console::MatchPair %W \[ \] promptEnd } } bind PostConsole <Key-braceright> { if {"\\" ne [%W get insert-2c]} { ::tk::console::MatchPair %W \{ \} promptEnd } } bind PostConsole <Key-quotedbl> { if {"\\" ne [%W get insert-2c]} { ::tk::console::MatchQuote %W promptEnd } } bind PostConsole <KeyPress> { if {"%A" ne ""} { ::tk::console::TagProc %W } } } # ::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 {$s eq ""} { 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::Fontchooser* -- # Let the user select the console font (TIP 324). proc ::tk::console::FontchooserToggle {} { if {[tk fontchooser configure -visible]} { tk fontchooser hide } else { tk fontchooser show } } proc ::tk::console::FontchooserVisibility {index} { if {[tk fontchooser configure -visible]} { .menubar.edit entryconfigure $index -label [msgcat::mc "Hide Fonts"] } else { .menubar.edit entryconfigure $index -label [msgcat::mc "Show Fonts"] } } proc ::tk::console::FontchooserFocus {w isFocusIn} { if {$isFocusIn} { tk fontchooser configure -parent $w -font TkConsoleFont \ -command [namespace code [list FontchooserApply]] } else { tk fontchooser configure -parent $w -font {} -command {} } } proc ::tk::console::FontchooserApply {font args} { catch {font configure TkConsoleFont {*}[font actual $font]} } # ::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 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" } 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 {{} 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 i1 insert-1c while {$ix ne {}} { set i0 $ix set j 0 while {[set i0 [$w search $c2 $i0 $i1]] ne {}} { append i0 +1c if {[string match {\\} [$w get $i0-2c]]} { continue } incr j } 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 } 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 {[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} { 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 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] } default { set res {} foreach t {Pathname Procname Variable} { if {![catch {Expand$t $str} res] && ($res ne "")} { 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) && ($repl eq $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 -> 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 [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]] } } } return $ec } # now initialize the console ::tk::ConsoleInit


context:
space:
mode: