Ignore mingw-get's downloaded files

[msysgit.git] / mingw / lib / tk8.5 / console.tcl

# 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.37.2.3 2010/01/04 21:34:12 patthoyts Exp $
#
# Copyright (c) 1995-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-2000 Ajuba Solutions.
# Copyright (c) 2007 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 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
    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>>}

    . 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 {}
        }
    }
    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 <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 .]
        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]
        font configure TkConsoleFont -size [incr size]
    }
    bind Console <<Console_FontSizeDecr>> {
        set size [font configure TkConsoleFont -size]
        font configure TkConsoleFont -size [incr size -1]
    }

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