tk/library/console.tcl

   1 # console.tcl --
   2 #
   3 # This code constructs the console window for an application.  It
   4 # can be used by non-unix systems that do not have built-in support
   5 # for shells.
   6 #
   7 # RCS: @(#) $Id$
   8 #
   9 # Copyright (c) 1995-1997 Sun Microsystems, Inc.
  10 # Copyright (c) 1998-2000 Ajuba Solutions.
  11 #
  12 # See the file "license.terms" for information on usage and redistribution
  13 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  14 #
  15
  16 # TODO: history - remember partially written command
  17
  18 namespace eval ::tk::console {
  19     variable blinkTime   500 ; # msecs to blink braced range for
  20     variable blinkRange  1   ; # enable blinking of the entire braced range
  21     variable magicKeys   1   ; # enable brace matching and proc/var recognition
  22     variable maxLines    600 ; # maximum # of lines buffered in console
  23     variable showMatches 1   ; # show multiple expand matches
  24
  25     variable inPlugin [info exists embed_args]
  26     variable defaultPrompt  ; # default prompt if tcl_prompt1 isn't used
  27
  28
  29     if {$inPlugin} {
  30         set defaultPrompt {subst {[history nextid] % }}
  31     } else {
  32         set defaultPrompt {subst {([file tail [pwd]]) [history nextid] % }}
  33     }
  34 }
  35
  36 # simple compat function for tkcon code added for this console
  37 interp alias {} EvalAttached {} consoleinterp eval
  38
  39 # ::tk::ConsoleInit --
  40 # This procedure constructs and configures the console windows.
  41 #
  42 # Arguments:
  43 #       None.
  44
  45 proc ::tk::ConsoleInit {} {
  46     global tcl_platform
  47
  48     if {![consoleinterp eval {set tcl_interactive}]} {
  49         wm withdraw .
  50     }
  51
  52     if {[string equal $tcl_platform(platform) "macintosh"]
  53             || [string equal [tk windowingsystem] "aqua"]} {
  54         set mod "Cmd"
  55     } else {
  56         set mod "Ctrl"
  57     }
  58
  59     if {[catch {menu .menubar} err]} { bgerror "INIT: $err" }
  60     .menubar add cascade -label File -menu .menubar.file -underline 0
  61     .menubar add cascade -label Edit -menu .menubar.edit -underline 0
  62
  63     menu .menubar.file -tearoff 0
  64     .menubar.file add command -label [mc "Source..."] \
  65             -underline 0 -command tk::ConsoleSource
  66     .menubar.file add command -label [mc "Hide Console"] \
  67             -underline 0 -command {wm withdraw .}
  68     .menubar.file add command -label [mc "Clear Console"] \
  69             -underline 0 -command {.console delete 1.0 "promptEnd linestart"}
  70    if {[string equal $tcl_platform(platform) "macintosh"]
  71            || [string equal [tk windowingsystem] "aqua"]} {
  72         .menubar.file add command -label [mc "Quit"] \
  73                 -command exit -accel Cmd-Q
  74     } else {
  75         .menubar.file add command -label [mc "Exit"] \
  76                 -underline 1 -command exit
  77     }
  78
  79     menu .menubar.edit -tearoff 0
  80     .menubar.edit add command -label [mc "Cut"] -underline 2 \
  81             -command { event generate .console <<Cut>> } -accel "$mod+X"
  82     .menubar.edit add command -label [mc "Copy"] -underline 0 \
  83             -command { event generate .console <<Copy>> } -accel "$mod+C"
  84     .menubar.edit add command -label [mc "Paste"] -underline 1 \
  85             -command { event generate .console <<Paste>> } -accel "$mod+V"
  86
  87     if {[string compare $tcl_platform(platform) "windows"]} {
  88         .menubar.edit add command -label [mc "Clear"] -underline 2 \
  89                 -command { event generate .console <<Clear>> }
  90     } else {
  91         .menubar.edit add command -label [mc "Delete"] -underline 0 \
  92                 -command { event generate .console <<Clear>> } -accel "Del"
  93
  94         .menubar add cascade -label Help -menu .menubar.help -underline 0
  95         menu .menubar.help -tearoff 0
  96         .menubar.help add command -label [mc "About..."] \
  97                 -underline 0 -command tk::ConsoleAbout
  98     }
  99
 100     . configure -menu .menubar
 101
 102     set con [text .console  -yscrollcommand [list .sb set] -setgrid true]
 103     scrollbar .sb -command [list $con yview]
 104     pack .sb -side right -fill both
 105     pack $con -fill both -expand 1 -side left
 106     switch -exact $tcl_platform(platform) {
 107         "macintosh" {
 108             $con configure -font {Monaco 9 normal} -highlightthickness 0
 109         }
 110         "windows" {
 111             $con configure -font systemfixed
 112         }
 113         "unix" {
 114             if {[string equal [tk windowingsystem] "aqua"]} {
 115                 $con configure -font {Monaco 9 normal} -highlightthickness 0
 116             }
 117         }
 118     }
 119
 120     ConsoleBind $con
 121
 122     $con tag configure stderr   -foreground red
 123     $con tag configure stdin    -foreground blue
 124     $con tag configure prompt   -foreground \#8F4433
 125     $con tag configure proc     -foreground \#008800
 126     $con tag configure var      -background \#FFC0D0
 127     $con tag raise sel
 128     $con tag configure blink    -background \#FFFF00
 129     $con tag configure find     -background \#FFFF00
 130
 131     focus $con
 132
 133     wm protocol . WM_DELETE_WINDOW { wm withdraw . }
 134     wm title . [mc "Console"]
 135     flush stdout
 136     $con mark set output [$con index "end - 1 char"]
 137     tk::TextSetCursor $con end
 138     $con mark set promptEnd insert
 139     $con mark gravity promptEnd left
 140 }
 141
 142 # ::tk::ConsoleSource --
 143 #
 144 # Prompts the user for a file to source in the main interpreter.
 145 #
 146 # Arguments:
 147 # None.
 148
 149 proc ::tk::ConsoleSource {} {
 150     set filename [tk_getOpenFile -defaultextension .tcl -parent . \
 151             -title [mc "Select a file to source"] \
 152             -filetypes [list \
 153             [list [mc "Tcl Scripts"] .tcl] \
 154             [list [mc "All Files"] *]]]
 155     if {[string compare $filename ""]} {
 156         set cmd [list source $filename]
 157         if {[catch {consoleinterp eval $cmd} result]} {
 158             ConsoleOutput stderr "$result\n"
 159         }
 160     }
 161 }
 162
 163 # ::tk::ConsoleInvoke --
 164 # Processes the command line input.  If the command is complete it
 165 # is evaled in the main interpreter.  Otherwise, the continuation
 166 # prompt is added and more input may be added.
 167 #
 168 # Arguments:
 169 # None.
 170
 171 proc ::tk::ConsoleInvoke {args} {
 172     set ranges [.console tag ranges input]
 173     set cmd ""
 174     if {[llength $ranges]} {
 175         set pos 0
 176         while {[string compare [lindex $ranges $pos] ""]} {
 177             set start [lindex $ranges $pos]
 178             set end [lindex $ranges [incr pos]]
 179             append cmd [.console get $start $end]
 180             incr pos
 181         }
 182     }
 183     if {[string equal $cmd ""]} {
 184         ConsolePrompt
 185     } elseif {[info complete $cmd]} {
 186         .console mark set output end
 187         .console tag delete input
 188         set result [consoleinterp record $cmd]
 189         if {[string compare $result ""]} {
 190             puts $result
 191         }
 192         ConsoleHistory reset
 193         ConsolePrompt
 194     } else {
 195         ConsolePrompt partial
 196     }
 197     .console yview -pickplace insert
 198 }
 199
 200 # ::tk::ConsoleHistory --
 201 # This procedure implements command line history for the
 202 # console.  In general is evals the history command in the
 203 # main interpreter to obtain the history.  The variable
 204 # ::tk::HistNum is used to store the current location in the history.
 205 #
 206 # Arguments:
 207 # cmd - Which action to take: prev, next, reset.
 208
 209 set ::tk::HistNum 1
 210 proc ::tk::ConsoleHistory {cmd} {
 211     variable HistNum
 212
 213     switch $cmd {
 214         prev {
 215             incr HistNum -1
 216             if {$HistNum == 0} {
 217                 set cmd {history event [expr {[history nextid] -1}]}
 218             } else {
 219                 set cmd "history event $HistNum"
 220             }
 221             if {[catch {consoleinterp eval $cmd} cmd]} {
 222                 incr HistNum
 223                 return
 224             }
 225             .console delete promptEnd end
 226             .console insert promptEnd $cmd {input stdin}
 227         }
 228         next {
 229             incr HistNum
 230             if {$HistNum == 0} {
 231                 set cmd {history event [expr {[history nextid] -1}]}
 232             } elseif {$HistNum > 0} {
 233                 set cmd ""
 234                 set HistNum 1
 235             } else {
 236                 set cmd "history event $HistNum"
 237             }
 238             if {[string compare $cmd ""]} {
 239                 catch {consoleinterp eval $cmd} cmd
 240             }
 241             .console delete promptEnd end
 242             .console insert promptEnd $cmd {input stdin}
 243         }
 244         reset {
 245             set HistNum 1
 246         }
 247     }
 248 }
 249
 250 # ::tk::ConsolePrompt --
 251 # This procedure draws the prompt.  If tcl_prompt1 or tcl_prompt2
 252 # exists in the main interpreter it will be called to generate the
 253 # prompt.  Otherwise, a hard coded default prompt is printed.
 254 #
 255 # Arguments:
 256 # partial -     Flag to specify which prompt to print.
 257
 258 proc ::tk::ConsolePrompt {{partial normal}} {
 259     set w .console
 260     if {[string equal $partial "normal"]} {
 261         set temp [$w index "end - 1 char"]
 262         $w mark set output end
 263         if {[consoleinterp eval "info exists tcl_prompt1"]} {
 264             consoleinterp eval "eval \[set tcl_prompt1\]"
 265         } else {
 266             puts -nonewline [EvalAttached $::tk::console::defaultPrompt]
 267         }
 268     } else {
 269         set temp [$w index output]
 270         $w mark set output end
 271         if {[consoleinterp eval "info exists tcl_prompt2"]} {
 272             consoleinterp eval "eval \[set tcl_prompt2\]"
 273         } else {
 274             puts -nonewline "> "
 275         }
 276     }
 277     flush stdout
 278     $w mark set output $temp
 279     ::tk::TextSetCursor $w end
 280     $w mark set promptEnd insert
 281     $w mark gravity promptEnd left
 282     ::tk::console::ConstrainBuffer $w $::tk::console::maxLines
 283     $w see end
 284 }
 285
 286 # ::tk::ConsoleBind --
 287 # This procedure first ensures that the default bindings for the Text
 288 # class have been defined.  Then certain bindings are overridden for
 289 # the class.
 290 #
 291 # Arguments:
 292 # None.
 293
 294 proc ::tk::ConsoleBind {w} {
 295     bindtags $w [list $w Console PostConsole [winfo toplevel $w] all]
 296
 297     ## Get all Text bindings into Console
 298     foreach ev [bind Text] { bind Console $ev [bind Text $ev] }
 299     ## We really didn't want the newline insertion...
 300     bind Console <Control-Key-o> {}
 301     ## ...or any Control-v binding (would block <<Paste>>)
 302     bind Console <Control-Key-v> {}
 303
 304     # For the moment, transpose isn't enabled until the console
 305     # gets and overhaul of how it handles input -- hobbs
 306     bind Console <Control-Key-t> {}
 307
 308     # Ignore all Alt, Meta, and Control keypresses unless explicitly bound.
 309     # Otherwise, if a widget binding for one of these is defined, the
 310
 311     bind Console <Alt-KeyPress> {# nothing }
 312     bind Console <Meta-KeyPress> {# nothing}
 313     bind Console <Control-KeyPress> {# nothing}
 314
 315     foreach {ev key} {
 316         <<Console_Prev>>                <Key-Up>
 317         <<Console_Next>>                <Key-Down>
 318         <<Console_NextImmediate>>       <Control-Key-n>
 319         <<Console_PrevImmediate>>       <Control-Key-p>
 320         <<Console_PrevSearch>>          <Control-Key-r>
 321         <<Console_NextSearch>>          <Control-Key-s>
 322
 323         <<Console_Expand>>              <Key-Tab>
 324         <<Console_Expand>>              <Key-Escape>
 325         <<Console_ExpandFile>>          <Control-Shift-Key-F>
 326         <<Console_ExpandProc>>          <Control-Shift-Key-P>
 327         <<Console_ExpandVar>>           <Control-Shift-Key-V>
 328         <<Console_Tab>>                 <Control-Key-i>
 329         <<Console_Tab>>                 <Meta-Key-i>
 330         <<Console_Eval>>                <Key-Return>
 331         <<Console_Eval>>                <Key-KP_Enter>
 332
 333         <<Console_Clear>>               <Control-Key-l>
 334         <<Console_KillLine>>            <Control-Key-k>
 335         <<Console_Transpose>>           <Control-Key-t>
 336         <<Console_ClearLine>>           <Control-Key-u>
 337         <<Console_SaveCommand>>         <Control-Key-z>
 338     } {
 339         event add $ev $key
 340         bind Console $key {}
 341     }
 342
 343     bind Console <<Console_Expand>> {
 344         if {[%W compare insert > promptEnd]} {::tk::console::Expand %W}
 345     }
 346     bind Console <<Console_ExpandFile>> {
 347         if {[%W compare insert > promptEnd]} {::tk::console::Expand %W path}
 348     }
 349     bind Console <<Console_ExpandProc>> {
 350         if {[%W compare insert > promptEnd]} {::tk::console::Expand %W proc}
 351     }
 352     bind Console <<Console_ExpandVar>> {
 353         if {[%W compare insert > promptEnd]} {::tk::console::Expand %W var}
 354     }
 355     bind Console <<Console_Eval>> {
 356         %W mark set insert {end - 1c}
 357         tk::ConsoleInsert %W "\n"
 358         tk::ConsoleInvoke
 359         break
 360     }
 361     bind Console <Delete> {
 362         if {[string compare {} [%W tag nextrange sel 1.0 end]] \
 363                 && [%W compare sel.first >= promptEnd]} {
 364             %W delete sel.first sel.last
 365         } elseif {[%W compare insert >= promptEnd]} {
 366             %W delete insert
 367             %W see insert
 368         }
 369     }
 370     bind Console <BackSpace> {
 371         if {[string compare {} [%W tag nextrange sel 1.0 end]] \
 372                 && [%W compare sel.first >= promptEnd]} {
 373             %W delete sel.first sel.last
 374         } elseif {[%W compare insert != 1.0] && \
 375                 [%W compare insert > promptEnd]} {
 376             %W delete insert-1c
 377             %W see insert
 378         }
 379     }
 380     bind Console <Control-h> [bind Console <BackSpace>]
 381
 382     bind Console <Home> {
 383         if {[%W compare insert < promptEnd]} {
 384             tk::TextSetCursor %W {insert linestart}
 385         } else {
 386             tk::TextSetCursor %W promptEnd
 387         }
 388     }
 389     bind Console <Control-a> [bind Console <Home>]
 390     bind Console <End> {
 391         tk::TextSetCursor %W {insert lineend}
 392     }
 393     bind Console <Control-e> [bind Console <End>]
 394     bind Console <Control-d> {
 395         if {[%W compare insert < promptEnd]} break
 396         %W delete insert
 397     }
 398     bind Console <<Console_KillLine>> {
 399         if {[%W compare insert < promptEnd]} break
 400         if {[%W compare insert == {insert lineend}]} {
 401             %W delete insert
 402         } else {
 403             %W delete insert {insert lineend}
 404         }
 405     }
 406     bind Console <<Console_Clear>> {
 407         ## Clear console display
 408         %W delete 1.0 "promptEnd linestart"
 409     }
 410     bind Console <<Console_ClearLine>> {
 411         ## Clear command line (Unix shell staple)
 412         %W delete promptEnd end
 413     }
 414     bind Console <Meta-d> {
 415         if {[%W compare insert >= promptEnd]} {
 416             %W delete insert {insert wordend}
 417         }
 418     }
 419     bind Console <Meta-BackSpace> {
 420         if {[%W compare {insert -1c wordstart} >= promptEnd]} {
 421             %W delete {insert -1c wordstart} insert
 422         }
 423     }
 424     bind Console <Meta-d> {
 425         if {[%W compare insert >= promptEnd]} {
 426             %W delete insert {insert wordend}
 427         }
 428     }
 429     bind Console <Meta-BackSpace> {
 430         if {[%W compare {insert -1c wordstart} >= promptEnd]} {
 431             %W delete {insert -1c wordstart} insert
 432         }
 433     }
 434     bind Console <Meta-Delete> {
 435         if {[%W compare insert >= promptEnd]} {
 436             %W delete insert {insert wordend}
 437         }
 438     }
 439     bind Console <<Console_Prev>> {
 440         tk::ConsoleHistory prev
 441     }
 442     bind Console <<Console_Next>> {
 443         tk::ConsoleHistory next
 444     }
 445     bind Console <Insert> {
 446         catch {tk::ConsoleInsert %W [::tk::GetSelection %W PRIMARY]}
 447     }
 448     bind Console <KeyPress> {
 449         tk::ConsoleInsert %W %A
 450     }
 451     bind Console <F9> {
 452         eval destroy [winfo child .]
 453         if {[string equal $tcl_platform(platform) "macintosh"]} {
 454             if {[catch {source [file join $tk_library console.tcl]}]} {source -rsrc console}
 455         } else {
 456             source [file join $tk_library console.tcl]
 457         }
 458     }
 459     bind Console <<Cut>> {
 460         # Same as the copy event
 461         if {![catch {set data [%W get sel.first sel.last]}]} {
 462             clipboard clear -displayof %W
 463             clipboard append -displayof %W $data
 464         }
 465     }
 466     bind Console <<Copy>> {
 467         if {![catch {set data [%W get sel.first sel.last]}]} {
 468             clipboard clear -displayof %W
 469             clipboard append -displayof %W $data
 470         }
 471     }
 472     bind Console <<Paste>> {
 473         catch {
 474             set clip [::tk::GetSelection %W CLIPBOARD]
 475             set list [split $clip \n\r]
 476             tk::ConsoleInsert %W [lindex $list 0]
 477             foreach x [lrange $list 1 end] {
 478                 %W mark set insert {end - 1c}
 479                 tk::ConsoleInsert %W "\n"
 480                 tk::ConsoleInvoke
 481                 tk::ConsoleInsert %W $x
 482             }
 483         }
 484     }
 485
 486     ##
 487     ## Bindings for doing special things based on certain keys
 488     ##
 489     bind PostConsole <Key-parenright> {
 490         if {[string compare \\ [%W get insert-2c]]} {
 491             ::tk::console::MatchPair %W \( \) promptEnd
 492         }
 493     }
 494     bind PostConsole <Key-bracketright> {
 495         if {[string compare \\ [%W get insert-2c]]} {
 496             ::tk::console::MatchPair %W \[ \] promptEnd
 497         }
 498     }
 499     bind PostConsole <Key-braceright> {
 500         if {[string compare \\ [%W get insert-2c]]} {
 501             ::tk::console::MatchPair %W \{ \} promptEnd
 502         }
 503     }
 504     bind PostConsole <Key-quotedbl> {
 505         if {[string compare \\ [%W get insert-2c]]} {
 506             ::tk::console::MatchQuote %W promptEnd
 507         }
 508     }
 509
 510     bind PostConsole <KeyPress> {
 511         if {"%A" != ""} {
 512             ::tk::console::TagProc %W
 513         }
 514         break
 515     }
 516 }
 517
 518 # ::tk::ConsoleInsert --
 519 # Insert a string into a text at the point of the insertion cursor.
 520 # If there is a selection in the text, and it covers the point of the
 521 # insertion cursor, then delete the selection before inserting.  Insertion
 522 # is restricted to the prompt area.
 523 #
 524 # Arguments:
 525 # w -           The text window in which to insert the string
 526 # s -           The string to insert (usually just a single character)
 527
 528 proc ::tk::ConsoleInsert {w s} {
 529     if {[string equal $s ""]} {
 530         return
 531     }
 532     catch {
 533         if {[$w compare sel.first <= insert]
 534                 && [$w compare sel.last >= insert]} {
 535             $w tag remove sel sel.first promptEnd
 536             $w delete sel.first sel.last
 537         }
 538     }
 539     if {[$w compare insert < promptEnd]} {
 540         $w mark set insert end
 541     }
 542     $w insert insert $s {input stdin}
 543     $w see insert
 544 }
 545
 546 # ::tk::ConsoleOutput --
 547 #
 548 # This routine is called directly by ConsolePutsCmd to cause a string
 549 # to be displayed in the console.
 550 #
 551 # Arguments:
 552 # dest -        The output tag to be used: either "stderr" or "stdout".
 553 # string -      The string to be displayed.
 554
 555 proc ::tk::ConsoleOutput {dest string} {
 556     set w .console
 557     $w insert output $string $dest
 558     ::tk::console::ConstrainBuffer $w $::tk::console::maxLines
 559     $w see insert
 560 }
 561
 562 # ::tk::ConsoleExit --
 563 #
 564 # This routine is called by ConsoleEventProc when the main window of
 565 # the application is destroyed.  Don't call exit - that probably already
 566 # happened.  Just delete our window.
 567 #
 568 # Arguments:
 569 # None.
 570
 571 proc ::tk::ConsoleExit {} {
 572     destroy .
 573 }
 574
 575 # ::tk::ConsoleAbout --
 576 #
 577 # This routine displays an About box to show Tcl/Tk version info.
 578 #
 579 # Arguments:
 580 # None.
 581
 582 proc ::tk::ConsoleAbout {} {
 583     tk_messageBox -type ok -message "[mc {Tcl for Windows}]
 584
 585 Tcl $::tcl_patchLevel
 586 Tk $::tk_patchLevel"
 587 }
 588
 589 # ::tk::console::TagProc --
 590 #
 591 # Tags a procedure in the console if it's recognized
 592 # This procedure is not perfect.  However, making it perfect wastes
 593 # too much CPU time...
 594 #
 595 # Arguments:
 596 #       w       - console text widget
 597
 598 proc ::tk::console::TagProc w {
 599     if {!$::tk::console::magicKeys} { return }
 600     set exp "\[^\\\\\]\[\[ \t\n\r\;{}\"\$\]"
 601     set i [$w search -backwards -regexp $exp insert-1c promptEnd-1c]
 602     if {$i == ""} {set i promptEnd} else {append i +2c}
 603     regsub -all "\[\[\\\\\\?\\*\]" [$w get $i "insert-1c wordend"] {\\\0} c
 604     if {[llength [EvalAttached [list info commands $c]]]} {
 605         $w tag add proc $i "insert-1c wordend"
 606     } else {
 607         $w tag remove proc $i "insert-1c wordend"
 608     }
 609     if {[llength [EvalAttached [list info vars $c]]]} {
 610         $w tag add var $i "insert-1c wordend"
 611     } else {
 612         $w tag remove var $i "insert-1c wordend"
 613     }
 614 }
 615
 616 # ::tk::console::MatchPair --
 617 #
 618 # Blinks a matching pair of characters
 619 # c2 is assumed to be at the text index 'insert'.
 620 # This proc is really loopy and took me an hour to figure out given
 621 # all possible combinations with escaping except for escaped \'s.
 622 # It doesn't take into account possible commenting... Oh well.  If
 623 # anyone has something better, I'd like to see/use it.  This is really
 624 # only efficient for small contexts.
 625 #
 626 # Arguments:
 627 #       w       - console text widget
 628 #       c1      - first char of pair
 629 #       c2      - second char of pair
 630 #
 631 # Calls:        ::tk::console::Blink
 632
 633 proc ::tk::console::MatchPair {w c1 c2 {lim 1.0}} {
 634     if {!$::tk::console::magicKeys} { return }
 635     if {[string compare {} [set ix [$w search -back $c1 insert $lim]]]} {
 636         while {
 637             [string match {\\} [$w get $ix-1c]] &&
 638             [string compare {} [set ix [$w search -back $c1 $ix-1c $lim]]]
 639         } {}
 640         set i1 insert-1c
 641         while {[string compare {} $ix]} {
 642             set i0 $ix
 643             set j 0
 644             while {[string compare {} [set i0 [$w search $c2 $i0 $i1]]]} {
 645                 append i0 +1c
 646                 if {[string match {\\} [$w get $i0-2c]]} continue
 647                 incr j
 648             }
 649             if {!$j} break
 650             set i1 $ix
 651             while {$j && [string compare {} \
 652                     [set ix [$w search -back $c1 $ix $lim]]]} {
 653                 if {[string match {\\} [$w get $ix-1c]]} continue
 654                 incr j -1
 655             }
 656         }
 657         if {[string match {} $ix]} { set ix [$w index $lim] }
 658     } else { set ix [$w index $lim] }
 659     if {$::tk::console::blinkRange} {
 660         Blink $w $ix [$w index insert]
 661     } else {
 662         Blink $w $ix $ix+1c [$w index insert-1c] [$w index insert]
 663     }
 664 }
 665
 666 # ::tk::console::MatchQuote --
 667 #
 668 # Blinks between matching quotes.
 669 # Blinks just the quote if it's unmatched, otherwise blinks quoted string
 670 # The quote to match is assumed to be at the text index 'insert'.
 671 #
 672 # Arguments:
 673 #       w       - console text widget
 674 #
 675 # Calls:        ::tk::console::Blink
 676
 677 proc ::tk::console::MatchQuote {w {lim 1.0}} {
 678     if {!$::tk::console::magicKeys} { return }
 679     set i insert-1c
 680     set j 0
 681     while {[string compare [set i [$w search -back \" $i $lim]] {}]} {
 682         if {[string match {\\} [$w get $i-1c]]} continue
 683         if {!$j} {set i0 $i}
 684         incr j
 685     }
 686     if {$j&1} {
 687         if {$::tk::console::blinkRange} {
 688             Blink $w $i0 [$w index insert]
 689         } else {
 690             Blink $w $i0 $i0+1c [$w index insert-1c] [$w index insert]
 691         }
 692     } else {
 693         Blink $w [$w index insert-1c] [$w index insert]
 694     }
 695 }
 696
 697 # ::tk::console::Blink --
 698 #
 699 # Blinks between n index pairs for a specified duration.
 700 #
 701 # Arguments:
 702 #       w       - console text widget
 703 #       i1      - start index to blink region
 704 #       i2      - end index of blink region
 705 #       dur     - duration in usecs to blink for
 706 #
 707 # Outputs:
 708 #       blinks selected characters in $w
 709
 710 proc ::tk::console::Blink {w args} {
 711     eval [list $w tag add blink] $args
 712     after $::tk::console::blinkTime [list $w] tag remove blink $args
 713 }
 714
 715 # ::tk::console::ConstrainBuffer --
 716 #
 717 # This limits the amount of data in the text widget
 718 # Called by Prompt and ConsoleOutput
 719 #
 720 # Arguments:
 721 #       w       - console text widget
 722 #       size    - # of lines to constrain to
 723 #
 724 # Outputs:
 725 #       may delete data in console widget
 726
 727 proc ::tk::console::ConstrainBuffer {w size} {
 728     if {[$w index end] > $size} {
 729         $w delete 1.0 [expr {int([$w index end])-$size}].0
 730     }
 731 }
 732
 733 # ::tk::console::Expand --
 734 #
 735 # Arguments:
 736 # ARGS: w       - text widget in which to expand str
 737 #       type    - type of expansion (path / proc / variable)
 738 #
 739 # Calls:        ::tk::console::Expand(Pathname|Procname|Variable)
 740 #
 741 # Outputs:      The string to match is expanded to the longest possible match.
 742 #               If ::tk::console::showMatches is non-zero and the longest match
 743 #               equaled the string to expand, then all possible matches are
 744 #               output to stdout.  Triggers bell if no matches are found.
 745 #
 746 # Returns:      number of matches found
 747
 748 proc ::tk::console::Expand {w {type ""}} {
 749     set exp "\[^\\\\\]\[\[ \t\n\r\\\{\"\\\\\$\]"
 750     set tmp [$w search -backwards -regexp $exp insert-1c promptEnd-1c]
 751     if {$tmp == ""} {set tmp promptEnd} else {append tmp +2c}
 752     if {[$w compare $tmp >= insert]} { return }
 753     set str [$w get $tmp insert]
 754     switch -glob $type {
 755         path* { set res [ExpandPathname $str] }
 756         proc* { set res [ExpandProcname $str] }
 757         var*  { set res [ExpandVariable $str] }
 758         default {
 759             set res {}
 760             foreach t {Pathname Procname Variable} {
 761                 if {![catch {Expand$t $str} res] && ($res != "")} { break }
 762             }
 763         }
 764     }
 765     set len [llength $res]
 766     if {$len} {
 767         set repl [lindex $res 0]
 768         $w delete $tmp insert
 769         $w insert $tmp $repl {input stdin}
 770         if {($len > 1) && $::tk::console::showMatches \
 771                 && [string equal $repl $str]} {
 772             puts stdout [lsort [lreplace $res 0 0]]
 773         }
 774     } else { bell }
 775     return [incr len -1]
 776 }
 777
 778 # ::tk::console::ExpandPathname --
 779 #
 780 # Expand a file pathname based on $str
 781 # This is based on UNIX file name conventions
 782 #
 783 # Arguments:
 784 #       str     - partial file pathname to expand
 785 #
 786 # Calls:        ::tk::console::ExpandBestMatch
 787 #
 788 # Returns:      list containing longest unique match followed by all the
 789 #               possible further matches
 790
 791 proc ::tk::console::ExpandPathname str {
 792     set pwd [EvalAttached pwd]
 793     if {[catch {EvalAttached [list cd [file dirname $str]]} err]} {
 794         return -code error $err
 795     }
 796     set dir [file tail $str]
 797     ## Check to see if it was known to be a directory and keep the trailing
 798     ## slash if so (file tail cuts it off)
 799     if {[string match */ $str]} { append dir / }
 800     if {[catch {lsort [EvalAttached [list glob $dir*]]} m]} {
 801         set match {}
 802     } else {
 803         if {[llength $m] > 1} {
 804             global tcl_platform
 805             if {[string match windows $tcl_platform(platform)]} {
 806                 ## Windows is screwy because it's case insensitive
 807                 set tmp [ExpandBestMatch [string tolower $m] \
 808                         [string tolower $dir]]
 809                 ## Don't change case if we haven't changed the word
 810                 if {[string length $dir]==[string length $tmp]} {
 811                     set tmp $dir
 812                 }
 813             } else {
 814                 set tmp [ExpandBestMatch $m $dir]
 815             }
 816             if {[string match ?*/* $str]} {
 817                 set tmp [file dirname $str]/$tmp
 818             } elseif {[string match /* $str]} {
 819                 set tmp /$tmp
 820             }
 821             regsub -all { } $tmp {\\ } tmp
 822             set match [linsert $m 0 $tmp]
 823         } else {
 824             ## This may look goofy, but it handles spaces in path names
 825             eval append match $m
 826             if {[file isdir $match]} {append match /}
 827             if {[string match ?*/* $str]} {
 828                 set match [file dirname $str]/$match
 829             } elseif {[string match /* $str]} {
 830                 set match /$match
 831             }
 832             regsub -all { } $match {\\ } match
 833             ## Why is this one needed and the ones below aren't!!
 834             set match [list $match]
 835         }
 836     }
 837     EvalAttached [list cd $pwd]
 838     return $match
 839 }
 840
 841 # ::tk::console::ExpandProcname --
 842 #
 843 # Expand a tcl proc name based on $str
 844 #
 845 # Arguments:
 846 #       str     - partial proc name to expand
 847 #
 848 # Calls:        ::tk::console::ExpandBestMatch
 849 #
 850 # Returns:      list containing longest unique match followed by all the
 851 #               possible further matches
 852
 853 proc ::tk::console::ExpandProcname str {
 854     set match [EvalAttached [list info commands $str*]]
 855     if {[llength $match] == 0} {
 856         set ns [EvalAttached \
 857                 "namespace children \[namespace current\] [list $str*]"]
 858         if {[llength $ns]==1} {
 859             set match [EvalAttached [list info commands ${ns}::*]]
 860         } else {
 861             set match $ns
 862         }
 863     }
 864     if {[llength $match] > 1} {
 865         regsub -all { } [ExpandBestMatch $match $str] {\\ } str
 866         set match [linsert $match 0 $str]
 867     } else {
 868         regsub -all { } $match {\\ } match
 869     }
 870     return $match
 871 }
 872
 873 # ::tk::console::ExpandVariable --
 874 #
 875 # Expand a tcl variable name based on $str
 876 #
 877 # Arguments:
 878 #       str     - partial tcl var name to expand
 879 #
 880 # Calls:        ::tk::console::ExpandBestMatch
 881 #
 882 # Returns:      list containing longest unique match followed by all the
 883 #               possible further matches
 884
 885 proc ::tk::console::ExpandVariable str {
 886     if {[regexp {([^\(]*)\((.*)} $str junk ary str]} {
 887         ## Looks like they're trying to expand an array.
 888         set match [EvalAttached [list array names $ary $str*]]
 889         if {[llength $match] > 1} {
 890             set vars $ary\([ExpandBestMatch $match $str]
 891             foreach var $match {lappend vars $ary\($var\)}
 892             return $vars
 893         } else {set match $ary\($match\)}
 894         ## Space transformation avoided for array names.
 895     } else {
 896         set match [EvalAttached [list info vars $str*]]
 897         if {[llength $match] > 1} {
 898             regsub -all { } [ExpandBestMatch $match $str] {\\ } str
 899             set match [linsert $match 0 $str]
 900         } else {
 901             regsub -all { } $match {\\ } match
 902         }
 903     }
 904     return $match
 905 }
 906
 907 # ::tk::console::ExpandBestMatch --
 908 #
 909 # Finds the best unique match in a list of names.
 910 # The extra $e in this argument allows us to limit the innermost loop a little
 911 # further.  This improves speed as $l becomes large or $e becomes long.
 912 #
 913 # Arguments:
 914 #       l       - list to find best unique match in
 915 #       e       - currently best known unique match
 916 #
 917 # Returns:      longest unique match in the list
 918
 919 proc ::tk::console::ExpandBestMatch {l {e {}}} {
 920     set ec [lindex $l 0]
 921     if {[llength $l]>1} {
 922         set e  [string length $e]; incr e -1
 923         set ei [string length $ec]; incr ei -1
 924         foreach l $l {
 925             while {$ei>=$e && [string first $ec $l]} {
 926                 set ec [string range $ec 0 [incr ei -1]]
 927             }
 928         }
 929     }
 930     return $ec
 931 }
 932
 933 # now initialize the console
 934 ::tk::ConsoleInit