Root/nanonote-files/base-files/root/.tclshrc

1global tcl_interactive
2if {[info exists tcl_interactive] && $tcl_interactive > 0} {
3
4# ripped from http://wiki.tcl.tk/16139
5
6foreach {var val} {
7    PROMPT {tclsh$::tcl_patchLevel> }
8    HISTORY ""
9    HISTORY_BUFFER 500
10    COMPLETION_MATCH ""
11} {
12    if {![info exists env($var)]} {
13        set env($var) $val
14    }
15}
16foreach {var val} {
17    CMDLINE ""
18    CMDLINE_CURSOR 0
19    CMDLINE_LINES 0
20    HISTORY_LEVEL -1
21} {
22    set env($var) $val
23}
24unset var val
25
26set forever 0
27
28# Resource & history files:
29set HISTFILE $env(HOME)/.tclsh_history
30
31proc ESC {} {
32    return "\033"
33}
34
35proc readbuf {txt} {
36    upvar 1 $txt STRING
37
38    set ret [string index $STRING 0]
39    set STRING [string range $STRING 1 end]
40    return $ret
41}
42
43proc goto {row {col 1}} {
44    switch -- $row {
45        "home" {set row 1}
46    }
47    print "[ESC]\[${row};${col}H" nowait
48}
49
50proc gotocol {col} {
51    print "\r" nowait
52    if {$col > 0} {
53        print "[ESC]\[${col}C" nowait
54    }
55}
56
57proc clear {} {
58    print "[ESC]\[2J" nowait
59    goto home
60}
61
62proc clearline {} {
63    print "[ESC]\[2K\r" nowait
64}
65
66proc getColumns {} {
67    set cols 0
68    if {![catch {exec stty -a} err]} {
69        regexp {rows \d+; columns (\d+)} $err -> cols
70    }
71    return $cols
72}
73
74proc prompt {{txt ""}} {
75    global env
76
77    set prompt [subst $env(PROMPT)]
78    set txt "$prompt$txt"
79    foreach {end mid} $env(CMDLINE_LINES) break
80
81    # Calculate how many extra lines we need to display.
82    # Also calculate cursor position:
83    set n -1
84    set totalLen 0
85    set cursorLen [expr {$env(CMDLINE_CURSOR)+[string length $prompt]}]
86    set row 0
87    set col 0
88
89    # Render output line-by-line to $out then copy back to $txt:
90    set found 0
91    set out [list]
92    foreach line [split $txt "\n"] {
93        set len [expr {[string length $line]+1}]
94        incr totalLen $len
95        if {$found == 0 && $totalLen >= $cursorLen} {
96            set cursorLen [expr {$cursorLen - ($totalLen - $len)}]
97            set col [expr {$cursorLen % $env(COLUMNS)}]
98            set row [expr {$n + ($cursorLen / $env(COLUMNS)) + 1}]
99
100            if {$cursorLen >= $len} {
101                set col 0
102                incr row
103            }
104            set found 1
105        }
106        incr n [expr {int(ceil(double($len)/$env(COLUMNS)))}]
107        while {$len > 0} {
108            lappend out [string range $line 0 [expr {$env(COLUMNS)-1}]]
109            set line [string range $line $env(COLUMNS) end]
110            set len [expr {$len-$env(COLUMNS)}]
111        }
112    }
113    set txt [join $out "\n"]
114    set row [expr {$n-$row}]
115
116    # Reserve spaces for display:
117    if {$end} {
118        if {$mid} {
119            print "[ESC]\[${mid}B" nowait
120        }
121        for {set x 0} {$x < $end} {incr x} {
122            clearline
123            print "[ESC]\[1A" nowait
124        }
125    }
126    clearline
127    set env(CMDLINE_LINES) $n
128
129    # Output line(s):
130    print "\r$txt"
131
132    if {$row} {
133        print "[ESC]\[${row}A" nowait
134    }
135    gotocol $col
136    lappend env(CMDLINE_LINES) $row
137}
138
139proc print {txt {wait wait}} {
140    # Sends output to stdout chunks at a time.
141    # This is to prevent the terminal from
142    # hanging if we output too much:
143    while {[string length $txt]} {
144        puts -nonewline [string range $txt 0 2047]
145        set txt [string range $txt 2048 end]
146        if {$wait == "wait"} {
147            after 1
148        }
149    }
150}
151
152################################
153# Key bindings
154################################
155proc handleEscapes {} {
156    global env
157    upvar 1 keybuffer keybuffer
158    set seq ""
159    set found 0
160    while {[set ch [readbuf keybuffer]] != ""} {
161        append seq $ch
162
163        switch -exact -- $seq {
164            "\[A" { ;# Cursor Up (cuu1,up)
165                handleHistory 1
166                set found 1; break
167            }
168            "\[B" { ;# Cursor Down
169                handleHistory -1
170                set found 1; break
171            }
172            "\[C" { ;# Cursor Right (cuf1,nd)
173                if {$env(CMDLINE_CURSOR) < [string length $env(CMDLINE)]} {
174                    incr env(CMDLINE_CURSOR)
175                }
176                set found 1; break
177            }
178            "\[D" { ;# Cursor Left
179                if {$env(CMDLINE_CURSOR) > 0} {
180                    incr env(CMDLINE_CURSOR) -1
181                }
182                set found 1; break
183            }
184            "\[H" -
185            "\[7~" -
186            "\[1~" { ;# home
187                set env(CMDLINE_CURSOR) 0
188                set found 1; break
189            }
190            "\[3~" { ;# delete
191                if {$env(CMDLINE_CURSOR) < [string length $env(CMDLINE)]} {
192                    set env(CMDLINE) [string replace $env(CMDLINE) \
193                        $env(CMDLINE_CURSOR) $env(CMDLINE_CURSOR)]
194                }
195                set found 1; break
196            }
197            "\[F" -
198            "\[K" -
199            "\[8~" -
200            "\[4~" { ;# end
201                set env(CMDLINE_CURSOR) [string length $env(CMDLINE)]
202                set found 1; break
203            }
204            "\[5~" { ;# Page Up }
205            "\[6~" { ;# Page Down }
206        }
207    }
208    return $found
209}
210
211proc handleControls {} {
212    global env
213    upvar 1 char char
214    upvar 1 keybuffer keybuffer
215
216    # Control chars start at a == \u0001 and count up.
217    switch -exact -- $char {
218        \u0004 { ;# ^d
219          if { $env(CMDLINE_CURSOR) <= 0 } {
220            print "exit\n" nowait
221            doExit
222          }
223        }
224        \u0003 { ;# ^c
225            print "^C\n" nowait
226            doExit
227        }
228        \u0008 -
229        \u007f { ;# ^h && backspace ?
230            if {$env(CMDLINE_CURSOR) > 0} {
231                incr env(CMDLINE_CURSOR) -1
232                set env(CMDLINE) [string replace $env(CMDLINE) \
233                    $env(CMDLINE_CURSOR) $env(CMDLINE_CURSOR)]
234            }
235        }
236        \u001b { ;# ESC - handle escape sequences
237            handleEscapes
238        }
239    }
240    # Rate limiter:
241    set keybuffer ""
242}
243
244proc shortMatch {maybe} {
245    # Find the shortest matching substring:
246    set maybe [lsort $maybe]
247    set shortest [lindex $maybe 0]
248    foreach x $maybe {
249        while {![string match $shortest* $x]} {
250            set shortest [string range $shortest 0 end-1]
251        }
252    }
253    return $shortest
254}
255
256proc handleCompletion {} {
257    global env
258    set vars ""
259    set cmds ""
260
261    # First find out what kind of word we need to complete:
262    set wordstart [string last " " $env(CMDLINE) \
263        [expr {$env(CMDLINE_CURSOR)-1}]]
264    incr wordstart
265    set wordend [string first " " $env(CMDLINE) $wordstart]
266    if {$wordend == -1} {
267        set wordend end
268    } else {
269        incr wordend -1
270    }
271    set word [string range $env(CMDLINE) $wordstart $wordend]
272
273    if {[string trim $word] == ""} return
274
275    set firstchar [string index $word 0]
276
277    # Check if word is a variable:
278    if {$firstchar == "\$"} {
279        set word [string range $word 1 end]
280        incr wordstart
281
282        # Check if it is an array key:
283        set x [string first "(" $word]
284        if {$x != -1} {
285            set v [string range $word 0 [expr {$x-1}]]
286            incr x
287            set word [string range $word $x end]
288            incr wordstart $x
289            if {[uplevel #0 "array exists $v"]} {
290                set vars [uplevel #0 "array names $v $word*"]
291            }
292        } else {
293            foreach x [uplevel #0 {info vars}] {
294                if {[string match $word* $x]} {
295                    lappend vars $x
296                }
297            }
298        }
299    } else {
300        if {$firstchar == "\[" || $wordstart == 0} {
301            if {$firstchar == "\["} {
302                set word [string range $word 1 end]
303                incr wordstart
304            }
305            # Check commands:
306            foreach x [info commands] {
307                if {[string match $word* $x]} {
308                    lappend cmds $x
309                }
310            }
311        } else {
312            # Check commands anyway:
313            foreach x [info commands] {
314                if {[string match $word* $x]} {
315                    lappend cmds $x
316                }
317            }
318        }
319        if {$wordstart != 0} {
320            # Check variables anyway:
321            set x [string first "(" $word]
322            if {$x != -1} {
323                set v [string range $word 0 [expr {$x-1}]]
324                incr x
325                set word [string range $word $x end]
326                incr wordstart $x
327                if {[uplevel #0 "array exists $v"]} {
328                    set vars [uplevel #0 "array names $v $word*"]
329                }
330            } else {
331                foreach x [uplevel #0 {info vars}] {
332                    if {[string match $word* $x]} {
333                        lappend vars $x
334                    }
335                }
336            }
337        }
338    }
339
340    set maybe [concat $vars $cmds]
341    set shortest [shortMatch $maybe]
342    if {"$word" == "$shortest"} {
343        if {[llength $maybe] > 1 && $env(COMPLETION_MATCH) != $maybe} {
344            set env(COMPLETION_MATCH) $maybe
345            clearline
346            set temp ""
347            foreach {match format} {
348                vars "35"
349                cmds "1;32"
350            } {
351                if {[llength $match]} {
352                    append temp "[ESC]\[${format}m"
353                    foreach x [set $match] {
354                        append temp "[file tail $x] "
355                    }
356                    append temp "[ESC]\[0m"
357                }
358            }
359            print "\n$temp\n"
360        }
361    }
362}
363
364proc handleHistory {x} {
365    global env
366
367    set hlen [llength $env(HISTORY)]
368    incr env(HISTORY_LEVEL) $x
369    if {$env(HISTORY_LEVEL) > -1} {
370        set env(CMDLINE) [lindex $env(HISTORY) end-$env(HISTORY_LEVEL)]
371        set env(CMDLINE_CURSOR) [string length $env(CMDLINE)]
372    }
373    if {$env(HISTORY_LEVEL) <= -1} {
374        set env(HISTORY_LEVEL) -1
375        set env(CMDLINE) ""
376        set env(CMDLINE_CURSOR) 0
377    } elseif {$env(HISTORY_LEVEL) > $hlen} {
378        set env(HISTORY_LEVEL) $hlen
379    }
380}
381
382################################
383# History handling functions
384################################
385
386proc getHistory {} {
387    global env
388    return $env(HISTORY)
389}
390
391proc setHistory {hlist} {
392    global env
393    set env(HISTORY) $hlist
394}
395
396proc appendHistory {cmdline} {
397    global env
398    set old [lsearch -exact $env(HISTORY) $cmdline]
399    if {$old != -1} {
400        set env(HISTORY) [lreplace $env(HISTORY) $old $old]
401    }
402    lappend env(HISTORY) $cmdline
403    set env(HISTORY) \
404        [lrange $env(HISTORY) end-$env(HISTORY_BUFFER) end]
405}
406
407################################
408# main()
409################################
410
411proc rawInput {} {
412    fconfigure stdin -buffering none -blocking 0
413    fconfigure stdout -buffering none -translation crlf
414    exec stty raw -echo
415}
416
417proc lineInput {} {
418    fconfigure stdin -buffering line -blocking 1
419    fconfigure stdout -buffering line
420    exec stty -raw echo
421}
422
423proc doExit {{code 0}} {
424    global env HISTFILE
425
426    # Reset terminal:
427# print "[ESC]c[ESC]\[2J" nowait
428    lineInput
429
430    set hlist [getHistory]
431    if {[llength $hlist] > 0} {
432        set f [open $HISTFILE w]
433        foreach x $hlist {
434            # Escape newlines:
435            puts $f [string map {
436                \n "\\n"
437                "\\" "\\b"
438            } $x]
439        }
440        close $f
441    }
442
443    ___exit $code
444}
445
446# Load history if available:
447if {[llength $env(HISTORY)] == 0} {
448    if {[file exists $HISTFILE]} {
449        set f [open $HISTFILE r]
450        set hlist [list]
451        foreach x [split [read $f] "\n"] {
452            if {$x != ""} {
453                # Undo newline escapes:
454                lappend hlist [string map {
455                    "\\n" \n
456                    "\\\\" "\\"
457                    "\\b" "\\"
458                } $x]
459            }
460        }
461        setHistory $hlist
462        unset hlist
463        close $f
464    }
465}
466
467rawInput
468
469rename exit ___exit
470proc exit args doExit
471
472proc tclline {} {
473    global env
474    set char ""
475    set keybuffer [read stdin]
476    set env(COLUMNS) [getColumns]
477
478    while {$keybuffer != ""} {
479        if {[eof stdin]} return
480        set char [readbuf keybuffer]
481        if {$char == ""} {
482            # Sleep for a bit to reduce CPU time:
483            after 40
484            continue
485        }
486
487        if {[string is print $char]} {
488            set x $env(CMDLINE_CURSOR)
489
490            if {$x < 1 && [string trim $char] == ""} continue
491
492            set trailing [string range $env(CMDLINE) $x end]
493            set env(CMDLINE) [string replace $env(CMDLINE) $x end]
494            append env(CMDLINE) $char
495            append env(CMDLINE) $trailing
496            incr env(CMDLINE_CURSOR)
497        } elseif {$char == "\t"} {
498            handleCompletion
499        } elseif {$char == "\n" || $char == "\r"} {
500            if {[info complete $env(CMDLINE)] &&
501                [string index $env(CMDLINE) end] != "\\"} {
502                lineInput
503                print "\n" nowait
504                uplevel #0 {
505                    global env
506
507                    # Run the command:
508                    if { [catch $env(CMDLINE) res] } {
509                      print "[ESC]\[1;31m\[[ESC]\[0;31mError[ESC]\[1;31m\][ESC]\[0m "
510                    }
511                    if {$res != ""} {
512                        print "$res\n"
513                    }
514
515                    # Append HISTORY:
516                    set env(HISTORY_LEVEL) -1
517                    appendHistory $env(CMDLINE)
518
519                    set env(CMDLINE) ""
520                    set env(CMDLINE_CURSOR) 0
521                    set env(CMDLINE_LINES) {0 0}
522                }
523                rawInput
524            } else {
525                set x $env(CMDLINE_CURSOR)
526
527                if {$x < 1 && [string trim $char] == ""} continue
528
529                set trailing [string range $env(CMDLINE) $x end]
530                set env(CMDLINE) [string replace $env(CMDLINE) $x end]
531                append env(CMDLINE) $char
532                append env(CMDLINE) $trailing
533                incr env(CMDLINE_CURSOR)
534            }
535        } else {
536            handleControls
537        }
538    }
539    prompt $env(CMDLINE)
540}
541tclline
542
543fileevent stdin readable tclline
544vwait forever
545doExit
546}
547

Archive Download this file

Branches:
backfire
master
release_2010-11-17
release_2010-12-14
release_2011-02-23
release_2011-05-28
release_2011-08-27
release_2011-11-13
release_2012-03-18
release_2012-04-09
release_2012-07-11
release_2012-10-11



interactive