URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tix/] [library/] [Console.tcl] - Blame information for rev 1765

Details | Compare with Previous | View Log


# 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.
#
#       This file was distributed as a part of Tk 4.1 by Sun
#       Microsystems, Inc. and subsequently modified by Expert
#       Interface Techonoligies and included as a part of Tix.
#
#       Some of the functions in this file have been renamed from
#       using a "tk" prefix to a "tix" prefix to avoid namespace
#       conflict with the original file.
#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
# Copyright (c) 1996 Expert Interface Technologies.
#
# See the file "docs/license.tcltk" for information on usage and
# redistribution of the original file "console.tcl". These license
# terms do NOT apply to other files in the Tix distribution.
#
# See the file "license.terms" for information on usage and
# redistribution * of this file, and for a DISCLAIMER OF ALL
# WARRANTIES.
 
# tixConsoleInit --
# This procedure constructs and configures the console windows.
#
# Arguments:
#       None.
 
proc tixConsoleInit {} {
    global tcl_platform
 
    uplevel #0 set tixConsoleTextFont Courier
    uplevel #0 set tixConsoleTextSize 14
 
    set f [frame .f]
    set fontcb [tixComboBox $f.size -label "" -command "tixConsoleSetFont" \
        -variable tixConsoleTextFont \
        -options {
            entry.width    15
            listbox.height 5
        }]
    set sizecb [tixComboBox $f.font -label "" -command "tixConsoleSetFont" \
        -variable tixConsoleTextSize \
        -options {
            entry.width    4
            listbox.width  6
            listbox.height 5
        }]
    pack $fontcb $sizecb -side left
    pack $f -side top -fill x -padx 2 -pady 2
    foreach font {
        "Courier New"
        "Courier"
        "Helvetica"
        "Lucida"
        "Lucida Typewriter"
        "MS LineDraw"
        "System"
        "Times Roman"
    } {
        $fontcb subwidget listbox insert end $font
    }
 
    for {set s 6} {$s < 25} {incr s} {
        $sizecb subwidget listbox insert end $s
    }
 
    bind [$fontcb subwidget entry] <Escape> "focus .console"
    bind [$sizecb subwidget entry] <Escape> "focus .console"
 
    text .console  -yscrollcommand ".sb set" -setgrid true \
        -highlightcolor [. cget -bg] -highlightbackground [. cget -bg] \
        -cursor left_ptr
    scrollbar .sb -command ".console yview" -highlightcolor [. cget -bg] \
        -highlightbackground [. cget -bg]
    pack .sb -side right -fill both
    pack .console -fill both -expand 1 -side left
 
    tixConsoleBind .console
 
    .console tag configure stderr -foreground red
    .console tag configure stdin -foreground blue
 
    focus .console
 
    wm protocol . WM_DELETE_WINDOW { wm withdraw . }
    wm title . "Console"
    flush stdout
    .console mark set output [.console index "end - 1 char"]
    tkTextSetCursor .console end
    .console mark set promptEnd insert
    .console mark gravity promptEnd left
 
    tixConsoleSetFont
}
 
proc tixConsoleSetFont {args} {
    if ![winfo exists .console] tixConsoleInit
 
    global tixConsoleTextFont tixConsoleTextSize
 
    set font  -*-$tixConsoleTextFont-medium-r-normal-*-$tixConsoleTextSize-*-*-*-*-*-*-*
    .console config -font $font
}
 
# tixConsoleInvoke --
# 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 tixConsoleInvoke {args} {
    if ![winfo exists .console] tixConsoleInit
 
    if {[.console dlineinfo insert] != {}} {
        set setend 1
    } else {
        set setend 0
    }
    set ranges [.console tag ranges input]
    set cmd ""
    if {$ranges != ""} {
        set pos 0
        while {[lindex $ranges $pos] != ""} {
            set start [lindex $ranges $pos]
            set end [lindex $ranges [incr pos]]
            append cmd [.console get $start $end]
            incr pos
        }
    }
    if {$cmd == ""} {
        tixConsolePrompt
    } elseif [info complete $cmd] {
        .console mark set output end
        .console tag delete input
        set err [catch {
            set result [interp record $cmd]
        } result]
 
        if {$result != ""} {
            if {$err} {
                .console insert insert "$result\n" stderr
            } else {
                .console insert insert "$result\n"
            }
        }
        tixConsoleHistory reset
        tixConsolePrompt
    } else {
        tixConsolePrompt partial
    }
    if {$setend} {
        .console yview -pickplace insert
    }
}
 
# tixConsoleHistory --
# 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 global variable
# histNum is used to store the current location in the history.
#
# Arguments:
# cmd - Which action to take: prev, next, reset.
 
set histNum 1
proc tixConsoleHistory {cmd} {
    if ![winfo exists .console] tixConsoleInit
 
    global 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 {interp 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 != ""} {
                catch {interp eval $cmd} cmd
            }
            .console delete promptEnd end
            .console insert promptEnd $cmd {input stdin}
        }
        reset {
            set histNum 1
        }
    }
}
 
# tixConsolePrompt --
# 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 tixConsolePrompt {{partial normal}} {
    if ![winfo exists .console] tixConsoleInit
 
    if {$partial == "normal"} {
        set temp [.console index "end - 1 char"]
        .console mark set output end
        if [interp eval "info exists tcl_prompt1"] {
            interp eval "eval \[set tcl_prompt1\]"
        } else {
            puts -nonewline "% "
        }
    } else {
        set temp [.console index output]
        .console mark set output end
        if [interp eval "info exists tcl_prompt2"] {
            interp eval "eval \[set tcl_prompt2\]"
        } else {
            puts -nonewline "> "
        }
    }
 
    flush stdout
    .console mark set output $temp
    tkTextSetCursor .console end
    .console mark set promptEnd insert
    .console mark gravity promptEnd left
}
 
# tixConsoleBind --
# 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 tixConsoleBind {win} {
    if ![winfo exists .console] tixConsoleInit
 
    bindtags $win "$win Text . all"
 
    # 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.  Ditto for <Escape>.
 
    bind $win <Alt-KeyPress> {# nothing }
    bind $win <Meta-KeyPress> {# nothing}
    bind $win <Control-KeyPress> {# nothing}
    bind $win <Escape> {# nothing}
    bind $win <KP_Enter> {# nothing}
 
    bind $win <Tab> {
        tixConsoleInsert %W \t
        focus %W
        break
    }
    bind $win <Return> {
        %W mark set insert {end - 1c}
        tixConsoleInsert %W "\n"
        tixConsoleInvoke
        break
    }
    bind $win <Delete> {
        if {[%W tag nextrange sel 1.0 end] != ""} {
            %W tag remove sel sel.first promptEnd
        } else {
            if [%W compare insert < promptEnd] {
                break
            }
        }
    }
    bind $win <BackSpace> {
        if {[%W tag nextrange sel 1.0 end] != ""} {
            %W tag remove sel sel.first promptEnd
        } else {
            if [%W compare insert <= promptEnd] {
                break
            }
        }
    }
    foreach left {Control-a Home} {
        bind $win <$left> {
            if [%W compare insert < promptEnd] {
                tkTextSetCursor %W {insert linestart}
            } else {
                tkTextSetCursor %W promptEnd
            }
            break
        }
    }
    foreach right {Control-e End} {
        bind $win <$right> {
            tkTextSetCursor %W {insert lineend}
            break
        }
    }
    bind $win <Control-d> {
        if [%W compare insert < promptEnd] {
            break
        }
    }
    bind $win <Control-k> {
        if [%W compare insert < promptEnd] {
            %W mark set insert promptEnd
        }
    }
    bind $win <Control-t> {
        if [%W compare insert < promptEnd] {
            break
        }
    }
    bind $win <Meta-d> {
        if [%W compare insert < promptEnd] {
            break
        }
    }
    bind $win <Meta-BackSpace> {
        if [%W compare insert <= promptEnd] {
            break
        }
    }
    bind $win <Control-h> {
        if [%W compare insert <= promptEnd] {
            break
        }
    }
    foreach prev {Control-p Up} {
        bind $win <$prev> {
            tixConsoleHistory prev
            break
        }
    }
    foreach prev {Control-n Down} {
        bind $win <$prev> {
            tixConsoleHistory next
            break
        }
    }
    bind $win <Control-v> {
        if [%W compare insert > promptEnd] {
            catch {
                %W insert insert [selection get -displayof %W] {input stdin}
                %W see insert
            }
        }
        break
    }
    bind $win <Insert> {
        catch {tixConsoleInsert %W [selection get -displayof %W]}
        break
    }
    bind $win <KeyPress> {
        tixConsoleInsert %W %A
        break
    }
    foreach left {Control-b Left} {
        bind $win <$left> {
            if [%W compare insert == promptEnd] {
                break
            }
            tkTextSetCursor %W insert-1c
            break
        }
    }
    foreach right {Control-f Right} {
        bind $win <$right> {
            tkTextSetCursor %W insert+1c
            break
        }
    }
    bind $win <Control-Up> {
        %W yview scroll -1 unit
        break;
    }
    bind $win <Control-Down> {
        %W yview scroll 1 unit
        break;
    }
    bind $win <Prior> {
        %W yview scroll -1 pages
    }
    bind $win <Next> {
        %W yview scroll  1 pages
    }
    bind $win <F9> {
        eval destroy [winfo child .]
        source $tix_library/Console.tcl
    }
    foreach copy {F16 Meta-w Control-i} {
        bind $win <$copy> {
            if {[selection own -displayof %W] == "%W"} {
                clipboard clear -displayof %W
                catch {
                    clipboard append -displayof %W [selection get -displayof %W]
                }
            }
            break
        }
    }
    foreach paste {F18 Control-y} {
        bind $win <$paste> {
            catch {
                set clip [selection get -displayof %W -selection CLIPBOARD]
                set list [split $clip \n\r]
                tixConsoleInsert %W [lindex $list 0]
                foreach x [lrange $list 1 end] {
                    %W mark set insert {end - 1c}
                    tixConsoleInsert %W "\n"
                    tixConsoleInvoke
                    tixConsoleInsert %W $x
                }
            }
            break
        }
    }
}
 
# tixConsoleInsert --
# 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 tixConsoleInsert {w s} {
    if ![winfo exists .console] tixConsoleInit
 
    if {[.console dlineinfo insert] != {}} {
        set setend 1
    } else {
        set setend 0
    }
    if {$s == ""} {
        return
    }
    catch {
        if {[$w compare sel.first <= insert]
                && [$w compare sel.last >= insert]} {
            $w tag remove sel sel.first promptEnd
            $w delete sel.first sel.last
        }
    }
    if {[$w compare insert < promptEnd]} {
        $w mark set insert end
    }
    $w insert insert $s {input stdin}
    if $setend {
        .console see insert
    }
}
 
 
 
# tixConsoleOutput --
#
# 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 tixConsoleOutput {dest string} {
    if ![winfo exists .console] tixConsoleInit
 
    if {[.console dlineinfo insert] != {}} {
        set setend 1
    } else {
        set setend 0
    }
    .console insert output $string $dest
    if $setend {
        .console see insert
    }
}
 
# tixConsoleExit --
#
# This routine is called by ConsoleEventProc when the main window of
# the application is destroyed.
#
# Arguments:
# None.
 
proc tixConsoleExit {} {
    if ![winfo exists .console] tixConsoleInit
 
    exit
}
 

Browse

Tools

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tix/] [library/] [Console.tcl] - Blame information for rev 1765

Line No.	Rev	Author	Line
1	578	markom	`# Console.tcl --`
2			`#`
3			`# This code constructs the console window for an application.`
4			`# It can be used by non-unix systems that do not have built-in`
5			`# support for shells.`
6			`#`
7			`# This file was distributed as a part of Tk 4.1 by Sun`
8			`# Microsystems, Inc. and subsequently modified by Expert`
9			`# Interface Techonoligies and included as a part of Tix.`
10			`#`
11			`# Some of the functions in this file have been renamed from`
12			`# using a "tk" prefix to a "tix" prefix to avoid namespace`
13			`# conflict with the original file.`
14			`#`
15			`# Copyright (c) 1995-1996 Sun Microsystems, Inc.`
16			`# Copyright (c) 1996 Expert Interface Technologies.`
17			`#`
18			`# See the file "docs/license.tcltk" for information on usage and`
19			`# redistribution of the original file "console.tcl". These license`
20			`# terms do NOT apply to other files in the Tix distribution.`
21			`#`
22			`# See the file "license.terms" for information on usage and`
23			`# redistribution * of this file, and for a DISCLAIMER OF ALL`
24			`# WARRANTIES.`
25
26			`# tixConsoleInit --`
27			`# This procedure constructs and configures the console windows.`
28			`#`
29			`# Arguments:`
30			`# None.`
31
32			`proc tixConsoleInit {} {`
33			`global tcl_platform`
34
35			`uplevel #0 set tixConsoleTextFont Courier`
36			`uplevel #0 set tixConsoleTextSize 14`
37
38			`set f [frame .f]`
39			`set fontcb [tixComboBox $f.size -label "" -command "tixConsoleSetFont" \`
40			`-variable tixConsoleTextFont \`
41			`-options {`
42			`entry.width 15`
43			`listbox.height 5`
44			`}]`
45			`set sizecb [tixComboBox $f.font -label "" -command "tixConsoleSetFont" \`
46			`-variable tixConsoleTextSize \`
47			`-options {`
48			`entry.width 4`
49			`listbox.width 6`
50			`listbox.height 5`
51			`}]`
52			`pack $fontcb $sizecb -side left`
53			`pack $f -side top -fill x -padx 2 -pady 2`
54			`foreach font {`
55			`"Courier New"`
56			`"Courier"`
57			`"Helvetica"`
58			`"Lucida"`
59			`"Lucida Typewriter"`
60			`"MS LineDraw"`
61			`"System"`
62			`"Times Roman"`
63			`} {`
64			`$fontcb subwidget listbox insert end $font`
65			`}`
66
67			`for {set s 6} {$s < 25} {incr s} {`
68			`$sizecb subwidget listbox insert end $s`
69			`}`
70
71			`bind [$fontcb subwidget entry] <Escape> "focus .console"`
72			`bind [$sizecb subwidget entry] <Escape> "focus .console"`
73
74			`text .console -yscrollcommand ".sb set" -setgrid true \`
75			`-highlightcolor [. cget -bg] -highlightbackground [. cget -bg] \`
76			`-cursor left_ptr`
77			`scrollbar .sb -command ".console yview" -highlightcolor [. cget -bg] \`
78			`-highlightbackground [. cget -bg]`
79			`pack .sb -side right -fill both`
80			`pack .console -fill both -expand 1 -side left`
81
82			`tixConsoleBind .console`
83
84			`.console tag configure stderr -foreground red`
85			`.console tag configure stdin -foreground blue`
86
87			`focus .console`
88
89			`wm protocol . WM_DELETE_WINDOW { wm withdraw . }`
90			`wm title . "Console"`
91			`flush stdout`
92			`.console mark set output [.console index "end - 1 char"]`
93			`tkTextSetCursor .console end`
94			`.console mark set promptEnd insert`
95			`.console mark gravity promptEnd left`
96
97			`tixConsoleSetFont`
98			`}`
99
100			`proc tixConsoleSetFont {args} {`
101			`if ![winfo exists .console] tixConsoleInit`
102
103			`global tixConsoleTextFont tixConsoleTextSize`
104
105			`set font --$tixConsoleTextFont-medium-r-normal--$tixConsoleTextSize-------*`
106			`.console config -font $font`
107			`}`
108
109			`# tixConsoleInvoke --`
110			`# Processes the command line input. If the command is complete it`
111			`# is evaled in the main interpreter. Otherwise, the continuation`
112			`# prompt is added and more input may be added.`
113			`#`
114			`# Arguments:`
115			`# None.`
116
117			`proc tixConsoleInvoke {args} {`
118			`if ![winfo exists .console] tixConsoleInit`
119
120			`if {[.console dlineinfo insert] != {}} {`
121			`set setend 1`
122			`} else {`
123			`set setend 0`
124			`}`
125			`set ranges [.console tag ranges input]`
126			`set cmd ""`
127			`if {$ranges != ""} {`
128			`set pos 0`
129			`while {[lindex $ranges $pos] != ""} {`
130			`set start [lindex $ranges $pos]`
131			`set end [lindex $ranges [incr pos]]`
132			`append cmd [.console get $start $end]`
133			`incr pos`
134			`}`
135			`}`
136			`if {$cmd == ""} {`
137			`tixConsolePrompt`
138			`} elseif [info complete $cmd] {`
139			`.console mark set output end`
140			`.console tag delete input`
141			`set err [catch {`
142			`set result [interp record $cmd]`
143			`} result]`
144
145			`if {$result != ""} {`
146			`if {$err} {`
147			`.console insert insert "$result\n" stderr`
148			`} else {`
149			`.console insert insert "$result\n"`
150			`}`
151			`}`
152			`tixConsoleHistory reset`
153			`tixConsolePrompt`
154			`} else {`
155			`tixConsolePrompt partial`
156			`}`
157			`if {$setend} {`
158			`.console yview -pickplace insert`
159			`}`
160			`}`
161
162			`# tixConsoleHistory --`
163			`# This procedure implements command line history for the`
164			`# console. In general is evals the history command in the`
165			`# main interpreter to obtain the history. The global variable`
166			`# histNum is used to store the current location in the history.`
167			`#`
168			`# Arguments:`
169			`# cmd - Which action to take: prev, next, reset.`
170
171			`set histNum 1`
172			`proc tixConsoleHistory {cmd} {`
173			`if ![winfo exists .console] tixConsoleInit`
174
175			`global histNum`
176
177			`switch $cmd {`
178			`prev {`
179			`incr histNum -1`
180			`if {$histNum == 0} {`
181			`set cmd {history event [expr [history nextid] -1]}`
182			`} else {`
183			`set cmd "history event $histNum"`
184			`}`
185			`if {[catch {interp eval $cmd} cmd]} {`
186			`incr histNum`
187			`return`
188			`}`
189			`.console delete promptEnd end`
190			`.console insert promptEnd $cmd {input stdin}`
191			`}`
192			`next {`
193			`incr histNum`
194			`if {$histNum == 0} {`
195			`set cmd {history event [expr [history nextid] -1]}`
196			`} elseif {$histNum > 0} {`
197			`set cmd ""`
198			`set histNum 1`
199			`} else {`
200			`set cmd "history event $histNum"`
201			`}`
202			`if {$cmd != ""} {`
203			`catch {interp eval $cmd} cmd`
204			`}`
205			`.console delete promptEnd end`
206			`.console insert promptEnd $cmd {input stdin}`
207			`}`
208			`reset {`
209			`set histNum 1`
210			`}`
211			`}`
212			`}`
213
214			`# tixConsolePrompt --`
215			`# This procedure draws the prompt. If tcl_prompt1 or tcl_prompt2`
216			`# exists in the main interpreter it will be called to generate the`
217			`# prompt. Otherwise, a hard coded default prompt is printed.`
218			`#`
219			`# Arguments:`
220			`# partial - Flag to specify which prompt to print.`
221
222			`proc tixConsolePrompt {{partial normal}} {`
223			`if ![winfo exists .console] tixConsoleInit`
224
225			`if {$partial == "normal"} {`
226			`set temp [.console index "end - 1 char"]`
227			`.console mark set output end`
228			`if [interp eval "info exists tcl_prompt1"] {`
229			`interp eval "eval \[set tcl_prompt1\]"`
230			`} else {`
231			`puts -nonewline "% "`
232			`}`
233			`} else {`
234			`set temp [.console index output]`
235			`.console mark set output end`
236			`if [interp eval "info exists tcl_prompt2"] {`
237			`interp eval "eval \[set tcl_prompt2\]"`
238			`} else {`
239			`puts -nonewline "> "`
240			`}`
241			`}`
242
243			`flush stdout`
244			`.console mark set output $temp`
245			`tkTextSetCursor .console end`
246			`.console mark set promptEnd insert`
247			`.console mark gravity promptEnd left`
248			`}`
249
250			`# tixConsoleBind --`
251			`# This procedure first ensures that the default bindings for the Text`
252			`# class have been defined. Then certain bindings are overridden for`
253			`# the class.`
254			`#`
255			`# Arguments:`
256			`# None.`
257
258			`proc tixConsoleBind {win} {`
259			`if ![winfo exists .console] tixConsoleInit`
260
261			`bindtags $win "$win Text . all"`
262
263			`# Ignore all Alt, Meta, and Control keypresses unless explicitly bound.`
264			`# Otherwise, if a widget binding for one of these is defined, the`
265			`# <KeyPress> class binding will also fire and insert the character,`
266			`# which is wrong. Ditto for <Escape>.`
267
268			`bind $win <Alt-KeyPress> {# nothing }`
269			`bind $win <Meta-KeyPress> {# nothing}`
270			`bind $win <Control-KeyPress> {# nothing}`
271			`bind $win <Escape> {# nothing}`
272			`bind $win <KP_Enter> {# nothing}`
273
274			`bind $win <Tab> {`
275			`tixConsoleInsert %W \t`
276			`focus %W`
277			`break`
278			`}`
279			`bind $win <Return> {`
280			`%W mark set insert {end - 1c}`
281			`tixConsoleInsert %W "\n"`
282			`tixConsoleInvoke`
283			`break`
284			`}`
285			`bind $win <Delete> {`
286			`if {[%W tag nextrange sel 1.0 end] != ""} {`
287			`%W tag remove sel sel.first promptEnd`
288			`} else {`
289			`if [%W compare insert < promptEnd] {`
290			`break`
291			`}`
292			`}`
293			`}`
294			`bind $win <BackSpace> {`
295			`if {[%W tag nextrange sel 1.0 end] != ""} {`
296			`%W tag remove sel sel.first promptEnd`
297			`} else {`
298			`if [%W compare insert <= promptEnd] {`
299			`break`
300			`}`
301			`}`
302			`}`
303			`foreach left {Control-a Home} {`
304			`bind $win <$left> {`
305			`if [%W compare insert < promptEnd] {`
306			`tkTextSetCursor %W {insert linestart}`
307			`} else {`
308			`tkTextSetCursor %W promptEnd`
309			`}`
310			`break`
311			`}`
312			`}`
313			`foreach right {Control-e End} {`
314			`bind $win <$right> {`
315			`tkTextSetCursor %W {insert lineend}`
316			`break`
317			`}`
318			`}`
319			`bind $win <Control-d> {`
320			`if [%W compare insert < promptEnd] {`
321			`break`
322			`}`
323			`}`
324			`bind $win <Control-k> {`
325			`if [%W compare insert < promptEnd] {`
326			`%W mark set insert promptEnd`
327			`}`
328			`}`
329			`bind $win <Control-t> {`
330			`if [%W compare insert < promptEnd] {`
331			`break`
332			`}`
333			`}`
334			`bind $win <Meta-d> {`
335			`if [%W compare insert < promptEnd] {`
336			`break`
337			`}`
338			`}`
339			`bind $win <Meta-BackSpace> {`
340			`if [%W compare insert <= promptEnd] {`
341			`break`
342			`}`
343			`}`
344			`bind $win <Control-h> {`
345			`if [%W compare insert <= promptEnd] {`
346			`break`
347			`}`
348			`}`
349			`foreach prev {Control-p Up} {`
350			`bind $win <$prev> {`
351			`tixConsoleHistory prev`
352			`break`
353			`}`
354			`}`
355			`foreach prev {Control-n Down} {`
356			`bind $win <$prev> {`
357			`tixConsoleHistory next`
358			`break`
359			`}`
360			`}`
361			`bind $win <Control-v> {`
362			`if [%W compare insert > promptEnd] {`
363			`catch {`
364			`%W insert insert [selection get -displayof %W] {input stdin}`
365			`%W see insert`
366			`}`
367			`}`
368			`break`
369			`}`
370			`bind $win <Insert> {`
371			`catch {tixConsoleInsert %W [selection get -displayof %W]}`
372			`break`
373			`}`
374			`bind $win <KeyPress> {`
375			`tixConsoleInsert %W %A`
376			`break`
377			`}`
378			`foreach left {Control-b Left} {`
379			`bind $win <$left> {`
380			`if [%W compare insert == promptEnd] {`
381			`break`
382			`}`
383			`tkTextSetCursor %W insert-1c`
384			`break`
385			`}`
386			`}`
387			`foreach right {Control-f Right} {`
388			`bind $win <$right> {`
389			`tkTextSetCursor %W insert+1c`
390			`break`
391			`}`
392			`}`
393			`bind $win <Control-Up> {`
394			`%W yview scroll -1 unit`
395			`break;`
396			`}`
397			`bind $win <Control-Down> {`
398			`%W yview scroll 1 unit`
399			`break;`
400			`}`
401			`bind $win <Prior> {`
402			`%W yview scroll -1 pages`
403			`}`
404			`bind $win <Next> {`
405			`%W yview scroll 1 pages`
406			`}`
407			`bind $win <F9> {`
408			`eval destroy [winfo child .]`
409			`source $tix_library/Console.tcl`
410			`}`
411			`foreach copy {F16 Meta-w Control-i} {`
412			`bind $win <$copy> {`
413			`if {[selection own -displayof %W] == "%W"} {`
414			`clipboard clear -displayof %W`
415			`catch {`
416			`clipboard append -displayof %W [selection get -displayof %W]`
417			`}`
418			`}`
419			`break`
420			`}`
421			`}`
422			`foreach paste {F18 Control-y} {`
423			`bind $win <$paste> {`
424			`catch {`
425			`set clip [selection get -displayof %W -selection CLIPBOARD]`
426			`set list [split $clip \n\r]`
427			`tixConsoleInsert %W [lindex $list 0]`
428			`foreach x [lrange $list 1 end] {`
429			`%W mark set insert {end - 1c}`
430			`tixConsoleInsert %W "\n"`
431			`tixConsoleInvoke`
432			`tixConsoleInsert %W $x`
433			`}`
434			`}`
435			`break`
436			`}`
437			`}`
438			`}`
439
440			`# tixConsoleInsert --`
441			`# Insert a string into a text at the point of the insertion cursor.`
442			`# If there is a selection in the text, and it covers the point of the`
443			`# insertion cursor, then delete the selection before inserting. Insertion`
444			`# is restricted to the prompt area.`
445			`#`
446			`# Arguments:`
447			`# w - The text window in which to insert the string`
448			`# s - The string to insert (usually just a single character)`
449
450			`proc tixConsoleInsert {w s} {`
451			`if ![winfo exists .console] tixConsoleInit`
452
453			`if {[.console dlineinfo insert] != {}} {`
454			`set setend 1`
455			`} else {`
456			`set setend 0`
457			`}`
458			`if {$s == ""} {`
459			`return`
460			`}`
461			`catch {`
462			`if {[$w compare sel.first <= insert]`
463			`&& [$w compare sel.last >= insert]} {`
464			`$w tag remove sel sel.first promptEnd`
465			`$w delete sel.first sel.last`
466			`}`
467			`}`
468			`if {[$w compare insert < promptEnd]} {`
469			`$w mark set insert end`
470			`}`
471			`$w insert insert $s {input stdin}`
472			`if $setend {`
473			`.console see insert`
474			`}`
475			`}`
476
477
478
479			`# tixConsoleOutput --`
480			`#`
481			`# This routine is called directly by ConsolePutsCmd to cause a string`
482			`# to be displayed in the console.`
483			`#`
484			`# Arguments:`
485			`# dest - The output tag to be used: either "stderr" or "stdout".`
486			`# string - The string to be displayed.`
487
488			`proc tixConsoleOutput {dest string} {`
489			`if ![winfo exists .console] tixConsoleInit`
490
491			`if {[.console dlineinfo insert] != {}} {`
492			`set setend 1`
493			`} else {`
494			`set setend 0`
495			`}`
496			`.console insert output $string $dest`
497			`if $setend {`
498			`.console see insert`
499			`}`
500			`}`
501
502			`# tixConsoleExit --`
503			`#`
504			`# This routine is called by ConsoleEventProc when the main window of`
505			`# the application is destroyed.`
506			`#`
507			`# Arguments:`
508			`# None.`
509
510			`proc tixConsoleExit {} {`
511			`if ![winfo exists .console] tixConsoleInit`
512
513			`exit`
514			`}`
515