tcl-hacks

Check-in [a68589d94a]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:add /lineedit: an experiment in TTY control
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:a68589d94aaca0e27e100184dc696c2fc79f1890
User & Date: aspect 2018-05-03 12:28:39
Context
2018-05-03
12:30
fixture: a WIP hierarchical test runner check-in: 795760bfe1 user: aspect tags: trunk
12:28
add /lineedit: an experiment in TTY control check-in: a68589d94a user: aspect tags: trunk
2018-04-24
16:36
add trees puzzle check-in: 6ceb872484 user: aspect tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Added lineedit/ascii.tcl.

cannot compute difference between binary files

Added lineedit/cat.tcl.















































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
#!/usr/bin/env tclsh
#
# Try to be faithful to readline control chars.
#
# Rely only on /bin/stty (raw, echo, query size or parseable -a)
#
# No signals, so ^L needs to substitute for SIGWINCH

oo::class create Tty {
    variable input
    variable moreinput  ;# everything to the right of the cursor
    variable pushbuf
    variable yank
    constructor {} {
        set input ""
        set moreinput ""
        set pushbuf ""
        set yank ""
        exec stty raw -echo
        interp bgerror {} [list [namespace which my] bgerror]
        chan configure stdin -blocking 0
        chan configure stdout -buffering none
        coroutine run my run
        chan event stdin readable [namespace which run]
    }
    destructor {
        chan event stdin readable ""
        chan configure stdin -blocking 1
        chan configure stdout -buffering line
        exec stty -raw echo
    }
    method bgerror {err opts} {
        puts "BGERROR: $err"
        array set {} $opts
        parray {}
        my destroy
    }
    method geom {} {
        try {
            exec stty size
        } on error {} {
            set out [exec stty -a]
            # Linux style
            if {![regexp {rows (= )?(\d+); columns (= )?(\d+)} $out -> rows cols]} {
                # BSD style
                if {![regexp { (\d+) rows; (\d+) columns;} $err - rows cols]} {
                    list 80 24
                }
            }
            list $rows $cols
        }
    }
    method wait {} {
        set run [namespace which -command run]
        if {$run ne ""} {
            set var [my varname Wait]
            trace add command run delete "[list incr $var];list"
            vwait $var
        }
        my destroy
    }
    method push {chars} {
        set pushbuf $chars$pushbuf
    }
    # getch might as well return special sequences as multiple chars
    # I'm not sure about it throwing signals
    method getch {} {
        if {$pushbuf ne ""} {
            regexp (.)(.*) $pushbuf -> c pushbuf
            return $c
        }
        yield
        set c [read stdin 1]
        switch $c {
            ""      { if {[eof stdin]} { throw SIGPIPE "EOF" } }
            \u3     { throw SIGINT "Control-C" }
            \u4     { if {$input eq ""} { throw SIGPIPE "Control-D" } }
            \x1b    {
                try {
                # escape!
                # [A up [B down [C right [D left
                set lb [my getch]
                if {$lb eq "\u7f"} {
                    set c \u07
                } elseif {$lb ne "\["} {
                    my push $lb
                } else {
                    set d [my getch]
                    switch -exact $d {
                        A  { set c \u10 }
                        B  { set c \u0e }
                        C  { set c \u06 }
                        D  { set c \u02 }
                        default { my push $lb$d }
                    }
                }
            } on error {e o} {puts ERR:$e; exit}
            }
        }
        return $c
    }
    method emit {chars {times 1}} {
        while {[incr times -1] >= 0} {
            foreach char [split $chars ""] {
                #after 20
                puts -nonewline $char
            }
        }
    }
    method run {} {
        try {
            while 1 {
                try {
                    set c [my getch]
                    switch -exact $c {
                        \r - \n {       ;# newline
                            # what happens in the middle of a command?
                            append input $c
                            my emit \n
                            if {[info complete $input]} {
                                # do something!
                                puts "> [binary encode hex $input]"
                                set input $moreinput
                                set moreinput ""
                                if {$input eq ""} break
                                my emit $input
                            }
                            # prompt!
                        }
                        \u0f {          ;# ^O submit without clearing
                        }
                        \u8 - \u7f {    ;# ^H backspace
                            if {$input ne ""} {
                                my emit \u8\ \u8    ;# FIXME: handle moreinput
                                set input [string range $input 0 end-1]
                            }
                        }
                        \u14 {          ;# ^T transpose
                        }
                        \u2 {           ;# ^B back
                            if {$input ne ""} {
                                my emit \u8
                                set moreinput [string index $input end]$moreinput
                                set input [string range $input 0 end-1]
                            }
                        }
                        \u6 {           ;# ^F forward
                            if {$moreinput ne ""} {
                                set i [string index $moreinput 0]
                                set moreinput [string range $moreinput 1 end]
                                my emit $i
                                append input $i
                            }
                        }
                        \u1 {           ;# ^A home
                            my emit \u8 [string length $input]
                            set moreinput $input$moreinput
                            set input ""
                        }
                        \u5 {           ;# ^E end
                            my emit $moreinput
                            set input $input$moreinput
                            set moreinput ""
                        }
                        \ub {           ;# ^K kill after
                            # \e[K
                            my emit " " [string length $moreinput]
                            my emit \u8 [string length $moreinput]
                            set yank $moreinput
                            set moreinput ""
                        }
                        \u15 {          ;# ^U kill before
                            # \e[1K
                            set yank $input
                            my emit \   [string length $moreinput]
                            my emit \u8 [string length $moreinput]
                            my emit \u8 [string length $input]
                            my emit \   [string length $input]
                            my emit \u8 [string length $input]
                            set input $moreinput
                            my emit $input
                        }
                        \u19 {          ;# ^Y paste
                            my push $yank
                            set yank ""
                        }
                        \uc {           ;# ^L redraw
                            my emit \u8 [string length $input]
                            my emit $input$moreinput
                            my emit \u8 [string length $moreinput]
                        }
                        \u07 {          ;# ^G softbreak
                            if {$input eq ""} {
                                my emit \   [string length $moreinput]
                                my emit \u8 [string length $moreinput]
                                set moreinput ""
                            } else {
                                my emit \   [string length $moreinput]
                                my emit \u8 [string length $moreinput]
                                my emit \u8 [string length $input]
                                my emit \   [string length $input]
                                my emit \u8 [string length $input]
                                my emit $moreinput
                                my emit \u8 [string length $moreinput]
                                set input ""
                            }
                        }
                        \u17 {          ;# ^W kill word
                        }
                        \u1a {          ;# ^Z suspend
                            # process control!
                        }
                        \u9 {           ;# ^I tab
                            # needs to interact with completion
                        }
                        \u10 {          ;# ^P prev
                            # needs to interact with history
                        }
                        \u0e {          ;# ^N next
                            # needs to interact with history
                        }
                        \u12 {          ;# ^R reverse-isearch
                            # needs to interact with history
                            # and abstractions for clear/redraw
                        }
                        \u13 {          ;# ^S scroll-lock
                        }
                        \u11 {          ;# ^Q scroll-lock
                        }
                        \u18 {          ;# ^X extended
                            # ^X^E -> $EDITOR
                        }
                        \u16 {          ;# ^V quote
                            set c [my getch]
                            append input $c
                            if {$moreinput ne ""} {my emit \x1b\[1@}    ;# insert space for 1 char
                            my emit $c
                        }
                        default {
                            append input $c
                            if {$moreinput ne ""} {my emit \x1b\[1@}    ;# insert space for 1 char
                            my emit $c
                        }
                    }
                } trap SIGINT {} {
                    puts {[INTR]}
                    if {$input eq ""} break
                    set input ""
                }
            }
        } trap SIGPIPE {} {
            puts {[EOF]}
            my destroy
        }
    }
}

#coroutine Main main {*}$::argv
#trace add command Main delete {incr ::forever;list}
#vwait forever
#exec stty -raw echo
Tty create tty
tty wait

Added lineedit/display.tcl.











































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
source util.tcl

namespace eval display {
    variable prompt
    variable output ""
    variable pos 0
    variable row 0
    variable col 0

    proc _def {name args body} {
        proc $name $args "
            variable prompt
            variable output
            variable row
            variable col
        "
    }

    _def init {{p "% "}} {
        set prompt $p
        set output ""
        set pos 0
        set row 0
        set col 0
    }

    _def prompt1 {} {
        puts -nonewline $prompt
    }

    _def prompt2 {} {
        regsub -all . $prompt . prompt2
        puts -nonewline $prompt2
    }

    # if no newlines
    _def _insert {s} {
        set l [string length $s]
        set output [sinsert $output $pos $s]
        incr pos $l
        incr col $l
        emit [tty::insert $l]
        emit $s
    }

    _def emit-more {} {
        set s [string range $output $pos end]
        set lines 0
        while {[regexp {^(.*?)\n(.*)$} $s -> line s]} {
            incr lines
            prompt2
            emit $line
            emit \n
        }
        prompt2
        emit $s
        # take the cursor back!
        emit [tty::up $lines]
        emit [tty::goto-col [expr {$col + [string length $prompt]}]]
    }

    _def insert {s} {
        # set p [string length $s]
        # while {[string last \n $s p] > -1} .. uhg
        while {[regexp {^(.*?)\n(.*)$} $s -> line s]} {
            _insert $line
            newline
        }
        _insert $s
    }

    _def newline {} {
        if {$pos eq [string length $output]} {
            append output \n
            incr pos
            incr row
            set col 0
            emit \n
            prompt2
        } else {
            set output [sinsert $output $pos \n]
            incr pos
            incr row
            set col 0
            emit [tty::erase-to-end]
            emit \n
            emit-more
        }
    }

    _def erase {{n 1}} {
        # FIXME: newlines!
        set n [expr {min($n, [string length $input] - $point)}]
        set input [string replace $input $pos [expr {$pos + $n - 1}]
        emit [tty::delete $n]
    }
    _def backspace {{n 1}} {
        # FIXME: newlines!
        set n [expr {min($n, $pos)}]
        incr pos -$n
        set input [string replace $input $pos [expr {$pos + $n - 1}]
        emit [tty::delete $n]
    }

    _def left {{n 1}} {
        # FIXME: newlines!
        set pos [expr {min($n, $pos)}]
        emit [tty::left $n]
        incr pos -$n
    }
    _def right {{n 1}} {
        # FIXME: newlines!
        set n [expr {min($n, [string length $input] - $point)}]
        emit [tty::right $n]
        incr pos $n
    }
}

Added lineedit/histdb.tcl.



































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
namespace eval histdb {
    proc init {sqliteconn} {
        variable lastid ""
        interp alias {} [namespace current]::db {} $sqliteconn
        db eval {
            create table if not exists "history" (
                rowid integer primary key autoincrement,
                timestamp int,
                entry text
            );
        }
    }

    proc add {entry} {
        variable lastid
        if {[regexp {^[[:space:]]} $entry]} {
            set rec 0
        } elseif {[db exists {select 1 from "history" where rowid=$lastid and entry=$entry}]} {
            set rec 0
        } else {
            set rec 1
        }
        if {$rec} {
            set now [clock seconds]
            db eval {
                insert into "history" (timestamp, entry) values ($now, $entry);
            }
            set lastid [db last_insert_rowid]
        }
        return $lastid  ;# yes, even if it's not true!
    }

    proc get {id} {
        variable lastid
        db onecolumn {
            select entry from "history" where rowid = $id limit 1
        }
    }
    proc next {id} {
        db onecolumn {
            select rowid from "history" where rowid > $id order by rowid limit 1
        }
    }
    proc prev {id} {
        if {$id eq ""} {
            db onecolumn {
                select rowid from "history" order by rowid desc limit 1
            }
        } else {
            db onecolumn {
                select rowid from "history" where rowid < $id order by rowid desc limit 1
            }
        }
    }
    proc lastid {} {
        variable lastid
        return $lastid
    }
    proc curr {} {
        variable lastid
        lindex [db onecolumn {select entry from history where rowid = $lastid}]
    }
}


Added lineedit/input.tcl.

























































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
source util.tcl

namespace eval input {
    # provides insert, delete, backspace
    # each of which returns a triple {operation replist extlist ?attr?}
    # representing the change in output+extents
    # suitable for feeding to a display system
    # a higher abstraction would be [replace p1 p2 newtext], either side of point
    variable point    0 ;#
    variable input   "" ;# a string - the "literal" input sequence
    variable output  "" ;# another string - physical characters represented on the terminal
    variable extents {} ;# a list, indexed by input.  0=part of previous grapheme; -1=newline.
    variable attr    {} ;# a list, indexed by input.  tty attributes of output extent.
    proc init {} {}

    # rep knows how to turn an input string
    # into a list of graphemes
    # it should probably do attr as well
    proc rep {chars} {
        lmap c [split $chars ""] {
            if {[string is print $c]} {
                set c
            } else {
                string cat < [binary encode hex $c] >
            }
        }
    }

    proc _def {name args body} {
        proc $name $args "
            variable point
            variable input
            variable output
            variable extents
            variable attr
            $body
        "
    }

    _def left {{n 1}} {
        set n [expr {min($n, $point)}]
        if {$n == 0} {return [list]}
        set to [expr {$point - $n}]
        set ext [lrange $extents $to $point-1]
        set point $to
        return [list left [sum $ext]]
    }

    _def right {{n 1}} {
        set n [expr {min($n, [string length $input] - $point)}]
        if {$n == 0} {return [list]}
        set to [expr {$point + $n}]
        set ext [lrange $extents $point $to-1]
        set point $to
        return [list right [sum $ext]]
    }

    # if you specify a rep, the sequence will be inserted all as one
    _def insert {chars {rep ""}} {
        # always occurs at point
        if {$rep ne ""} {
            # ""/0 is part-of-previous-graph
            set rep [lrepeat [string length $chars] ""]
            lset rep 0 $rep
        } else {
            set rep [rep $chars]
        }
        # -1 is newline
        set ext [lmap r $rep {expr {$r eq "\n" ? -1 : [string length $r]}}]
        set input   [sinsert $input   $point    $chars]
        set output  [linsert $output  $point {*}$rep]
        set extents [linsert $extents $point {*}$ext]
        incr point [string length $chars]
        return [list insert [join $rep ""] [sum $ext]]
    }

    _def delete {to} {
        # erase forward
        if {$to eq "end"} {
            set to [string length $input]
        } else {
            set to [expr {$point + abs($to)}]
        }
        set rep        [lrange $output  $point $to-1]
        set ext        [lrange $extents $point $to-1]
        set input    [sreplace $input   $point $to-1]
        set output   [lreplace $output  $point $to-1]
        set extents  [lreplace $extents $point $to-1]
        set point $point
        return [list delete [join $rep ""] [sum $ext]]
    }

    _def backspace {to} {
        # erase backward
        if {$to eq "start"} {
            set to 0
        } else {
            set to [expr {$point - abs($to)}]
        }
        set rep        [lrange $output  $to $point-1]
        set ext        [lrange $extents $to $point-1]
        set input    [sreplace $input   $to $point-1]
        set output   [lreplace $output  $to $point-1]
        set extents  [lreplace $extents $to $point-1]
        set point $to
        return [list backspace [join $rep ""] [sum $ext]]
    }
}

Added lineedit/keymap.tcl.

















































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
namespace eval keymap {

    variable map {
        ^A  home
        ^B  back
        ^C  sigint
        ^D  sigpipe
        ^E  end
        ^F  forth
        ^G  softbreak
        ^H  backspace
        ^I  tab
        ^J  newline
        ^K  kill-after
        ^L  redraw
        ^M  newline
        ^N  history-next
        ^O  stash
        ^P  history-prev
        ^Q  scroll-unlock
        ^R  history-search
        ^S  scroll-lock
        ^T  transpose
        ^U  kill-before
        ^V  quote
        ^W  yank-word
        ^Y  paste
        ^Z  suspend

        ^?  backspace
        ^_  undo

        ^X^E    editor
        ^X^U    undo
        ^X^X    swap-mark

        ^[[A    history-prev
        ^[[B    history-next
        ^[[C    forth
        ^[[D    back

        ^[[3~   delete
        ^[[5~   page-up
        ^[[6~   page-down
        ^[[7~   home
        ^[[8~   end

        ^[^?    kill-word-before
        ^[^[^?  kill-word-after
        ^[^[[C  forth-word
        ^[^[[D  back-word

        ^[b     back-word
        ^[f     forth-word
        ^[u     uppercase-word
        ^[l     lowercase-word
        ^[g     complete-filename
        ^[d     kill-to-end
        ^[p     ??
        ^[n     ??
    }

    # convert a string rep from keymap into a string of binary codes
    proc keycode {str} {
        set controls {
            ^A  0x01  ^B  0x02  ^C  0x03  ^D  0x04  ^E  0x05  ^F  0x06  ^G  0x07
            ^H  0x08  ^I  0x09  ^J  0x0a  ^K  0x0b  ^L  0x0c  ^M  0x0d  ^N  0x0e
            ^O  0x0f  ^P  0x10  ^Q  0x11  ^R  0x12  ^S  0x13  ^T  0x14  ^U  0x15
            ^V  0x16  ^W  0x17  ^X  0x18  ^Y  0x19  ^Z  0x1a

            ^3  0x1b  ^4  0x1c  ^5  0x1d  ^6  0x1e  ^7  0x1f
            ^[  0x1b  ^\\ 0x1c  ^]  0x1d  ^^  0x1e  ^_  0x1f

            ^2  0x00  ^8  0x7f
            ^@  0x00  ^?  0x7f
        }
        set controls [dict map {_ v} $controls {format %c $v}]
        set res {}
        set s $str
        while {$s ne ""} {
            if {[regexp {^(\^.)(.*)} $s -> code rest]} {
                append res [dict get $controls $code]
                set s $rest
            } elseif {[regexp {^(.[^^]*)(.*)} $s -> part rest]} {
                append res $part
                set s $rest
            }
        }
        return $res
    }

    # turn a list of lists into a trie, realised as a recursive dict
    # with leaves holding {}
    proc mktrie {items} {
        set res [dict create]
        foreach ks $items {
            if {![dict exists $res {*}$ks]} {
                dict set res {*}$ks {}
            }
        }
        return $res
    }

    proc init {} {
        variable map
        variable trie

        # turn keycodes into lists of bytes
        set map [dict map {k v} $map {
            set k [split [keycode $k] ""]
            set v
        }]

        # make a trie for gettok
        set trie [mktrie [dict keys $map]]
    }

    proc getch {} {
        yield
        read stdin 1
    }

    # called with an optional list of input chars to start with
    # returns either [list TOKEN $tokenname] or [list LITERAL [list $char...]]
    proc gettok {{chars ""}} {
        variable trie
        variable map

        # chars is a list of pre-buffered input
        if {$chars eq ""} {
            set state $trie
        } else {
            set state [dict get $trie {*}$chars]
        }

        while 1 {
            if {$state eq ""} {
                set tok [dict get $map $chars]
                if {$tok eq "quote"} {
                    return [list LITERAL [list [getch]]]
                } else {
                    return [list TOKEN $tok $chars]
                }
            }
            lappend chars [set c [getch]]
            if {![dict exists $state $c]} {
                return [list LITERAL $chars]
            }
            set state [dict get $state $c]
        }
    }
}

Added lineedit/map.

cannot compute difference between binary files

Added lineedit/map.tcl.

























































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
# This will be called [getline].
#
# TODO:
#  x char-wise navigation
#  x line-wise nagivation
#  x prompts
#  x history
#    - history-dump and history-edit
#    - search, rsearch
#  - word-wise nagivation
#  - handle navigation of multi-char [reps] (cursor, editing)
#  - handle navigation of newlines (history, fill, cursor, editing)
#    - these would be simpler if input was a list and we kept an index rather than moreinput
#    - with a parallel list of display-lengths. -1 for newline?
#     emit [rep] is broken.  I need [emit-rep chars ?rep?].  Which makes N:M ...
#    - note that this is going beyond readline or ipython!
#  - word navigation
#  - simple colour
#  - completion callback
#  - objectify so handlers can call one another (and take args!)

package require sqlite3
sqlite3 db {}

source keymap.tcl
keymap::init

source tty.tcl

source histdb.tcl
histdb::init ::db


proc init {} {
    variable input ""
    variable moreinput ""
    variable yank ""
    variable peek ""
    variable stash ""
    variable histid 0
}

proc _vars {} {
    join [lmap v {input moreinput yank peek stash histid} {
        string cat "variable $v;"
    }]
}

proc _def {name args body} {
    proc $name $args "[_vars]$body"
}

proc _tok {name body} {
    _def t:$name {} $body
}

# I need a group of functions for traversing (manipulating) the output string
# these talk to the tty and need to know the display width of each token
#
# The trick is putting the input modifications and output modifications in
# the right place to keep them in sync and the code reasonably tidy.
#

source util.tcl

# these procs are responsible for maintaining their own models ${(more)?(input|output)}
_def input:insert {c} {}
_def input:left {{n 1}} {}
_def input:right {{n 1}} {}
_def input:erase {{n 1}} {}
_def input:backspace {{n 1}} {}

# o:i can use [rep] if it gets a raw char from above.
_def output:insert {c} {}
_def output:left {{n 1}} {}
_def output:right {{n 1}} {}
_def output:erase {{n 1}} {}
_def output:backspace {{n 1}} {}

# output needs a redraw proc
_def output:redraw {} {}
# and some internal helpers
_def output:_prompt1 {} {}
_def output:_prompt2 {} {}
_def output:_newline {} {}

# input events: home/end, kill-home/end/line are like word-wise events
#  -> input is responsible for finding the target distance and driving primitive output events to match.

foreach {tok body} {
    sigpipe { if {"$input$moreinput" eq ""} {return -level 2 -code break} else bell }
    sigint  { return -level 2 "" }

    newline {
        emit \n
        set input $input$moreinput
        set moreinput ""
        if {[complete? $input\n]} {
            puts "Complete!"
            if {![string is space $input]} {
                histdb::add $input
                set histid ""
            }
            return -code return $input  ;# FIXME: invoke callback
        } else {
            append input \n
            # append input [getline $prompt1]   ;# won't transmit sigint!
            emit [prompt2 $prompt1]
        }
    }

    history-next {
        if {"$input$moreinput" ne ""} {
            set id [histdb::next $histid]
            set histid $id
            set s [histdb::get $histid]
            set n [string length $input]
            emit [tty::left $n]
            incr n [string length $moreinput]
            emit [tty::erase $n]
            emit $s
            set input $s
            set moreinput ""
        } else bell
    }

    history-prev {
        set id [histdb::prev $histid]
        if {$id ne ""} {
            set histid $id
            set s [histdb::get $histid]
            if {$s ne ""} {
                set n [string length $input]
                emit [tty::left $n]
                incr n [string length $moreinput]
                emit [tty::erase $n]
                emit $s
                set input $s
                set moreinput ""
            }
        } else bell
    }

    backspace {
        if {$input ne ""} {
            emit \u8[tty::delete 1]
            set input [string range $input 0 end-1]
        } else bell
    }

    delete {
        if {$moreinput ne ""} {
            emit [tty::delete 1]
            set moreinput [string range $moreinput 1 end]
        } else bell
    }

    back {
        if {$input ne ""} {
            emit \u8
            set moreinput [string index $input end]$moreinput
            set input [string range $input 0 end-1]
        } else bell
    }
    forth {
        if {$moreinput ne ""} {
            set i [string index $moreinput 0]
            set moreinput [string range $moreinput 1 end]
            emit $i
            append input $i
        } else bell
    }
    home {
        emit [tty::left [string length $input]]
        set moreinput $input$moreinput
        set input ""
    }
    end {
        emit $moreinput
        set input $input$moreinput
        set moreinput ""
    }
    swap-mark {
        if {$input eq ""} {
            emit $moreinput
            set input $moreinput
            set moreinput ""
        } else {
            emit [tty::left [string length $input]]
            set moreinput $input$moreinput
            set input ""
        }
    }

    kill-after {
        emit [tty::erase [string length $moreinput]]
        set yank $moreinput
        set moreinput ""
    }
    kill-before {
        set yank $input
        emit [tty::left [string length $input]]
        emit [tty::delete [string length $input]]
        set input ""
    }
    kill-line {
        set yank $input$moreinput
        set n [string length $input]
        emit [tty::left $n]
        incr n [string length $moreinput]
        emit [tty::erase $n]
        set input ""
        set moreinput ""
    }

    redraw {
        # prompt!
        emit [tty::left [string length $input]]
        emit $input$moreinput
        emit [tty::left [string length $moreinput]]
    }

    paste {
        append input $yank
        insert [lmap c $yank {rep $c}]  ;# FIXME: rep a string
    }
} {
    _def t:$tok {} $body
}

proc getline {} {
    variable input ""
    variable moreinput ""
    variable yank
    variable peek
    variable stash
    variable histid

    set prompt1 [prompt1]
    emit $prompt1

    if {$stash ne ""} {
        emit $stash
        set input $stash
        set stash ""
    }

    set cmds [info commands t:*]

    while 1 {
        lassign [keymap::gettok] kind tok chars
        switch $kind {
            TOKEN {
                set cmd t:$tok
                if {$cmd in $cmds} {
                    $cmd
                } else {
                    append input [join $chars ""]
                    insert [rep $tok]   ;# this is a rep covering N>1 input chars!
                }
            }
            LITERAL {
                append input [join $tok ""]
                foreach char $tok {
                    if {[string is print $char]} {
                        insert $char
                    } else {
                        insert [rep $char]
                    }
                }
            }
        }
    }
}

# There's already some repetition with general movement .. let's see if we can factor that decently.

# handling rep properly means consulting it for all cursor movement, including overdrawing
# this argues for storing both input and inputrep.
proc rep {char} {
    if {[string length $char] > 1} {
        return \[$char\]
    } elseif {[string is print $char]} {
        return $char
    } else {
        return <[binary encode hex $char]>
    }
}

proc insert {s} {
    variable moreinput
    if {$moreinput ne ""} {
        emit [tty::insert [string length $s]]
    }
    emit $s
}

proc emit {s {repeat 1}} {
    while {[incr repeat -1] >= 0} {
        foreach c [split $s ""] {
            after 10
            puts -nonewline $c
        }
    }
}

proc bell {} {
    puts -nonewline \x07
}

proc prompt1 {} {
    string cat \[ [file tail [info script]] \] " "
}

# takes prompt1 as argument, so it can copy its length
proc prompt2 {p} {
    set p [prompt1]
    regsub -all .   $p "."  p
    regsub -all ..$ $p ": " p
    return $p
}

proc complete? {input} {
    info complete $input
}

#proc trieverse {varName trie script {prefix ""}} {
#    upvar 1 $varName var
#    dict for {key subtrie} $trie {
#        if {$subtrie eq ""} {
#            set var [list {*}$prefix $key]
#            uplevel 1 $script
#        } else {
#            uplevel 1 [list trieverse $varName $subtrie $script [list {*}$prefix $key]]
#        }
#    }
#}

proc main {} {
    try {
        init
        exec stty raw -echo
        chan configure stdin -blocking no
        chan configure stdout -buffering none
        chan event stdin readable [info coroutine]
        while {![eof stdin]} {
            puts ">>[getline]<<"
        }
    } on error {e o} {
        puts "ERROR: $e"
        array set {} $o
        parray {}
    } finally {
        exec stty -raw echo
    }
    exit
}

coroutine MAIN main {*}$::argv
vwait forever

#trieverse keys $trie {
#    puts [lmap k $keys {binary encode hex $k}]
#}

Added lineedit/map0.tcl.

































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
# This will be called [getline].
#
# TODO:
#  x char-wise navigation
#  x line-wise nagivation
#  x prompts
#  x history
#    - history-dump and history-edit
#    - search, rsearch
#  - word-wise nagivation
#  - handle navigation of multi-char [reps] (cursor, editing)
#  - handle navigation of newlines (history, fill, cursor, editing)
#    - these would be simpler if input was a list and we kept an index rather than moreinput
#    - with a parallel list of display-lengths. -1 for newline?
#     emit [rep] is broken.  I need [emit-rep chars ?rep?].  Which makes N:M ...
#    - note that this is going beyond readline or ipython!
#  - word navigation
#  - simple colour
#  - completion callback
#  - objectify so handlers can call one another (and take args!)

package require sqlite3
sqlite3 db {}

source keymap.tcl
keymap::init

source tty.tcl

source histdb.tcl
histdb::init ::db


proc init {} {
    variable input ""
    variable moreinput ""
    variable yank ""
    variable peek ""
    variable stash ""
    variable histid 0
}

proc getline {} {
    variable input ""
    variable moreinput ""
    variable yank
    variable peek
    variable stash
    variable histid

    set prompt1 [prompt1]
    emit $prompt1

    if {$stash ne ""} {
        emit $stash
        set input $stash
        set stash ""
    }

    while 1 {
        lassign [keymap::gettok] kind tok chars
        switch $kind {
            TOKEN {
                switch $tok {

                    sigpipe { if {"$input$moreinput" eq ""} {return -code break} else bell }
                    sigint  { return "" }

                    newline {
                        emit \n
                        set input $input$moreinput
                        set moreinput ""
                        if {[complete? $input\n]} {
                            if {![string is space $input]} {
                                histdb::add $input
                                set histid ""
                            }
                            return $input
                        } else {
                            append input \n
                            # append input [getline $prompt1]   ;# won't transmit sigint!
                            emit [prompt2 $prompt1]
                        }
                    }

                    history-next {
                        if {"$input$moreinput" ne ""} {
                            set id [histdb::next $histid]
                            set histid $id
                            set s [histdb::get $histid]
                            set n [string length $input]
                            emit [tty::left $n]
                            incr n [string length $moreinput]
                            emit [tty::erase $n]
                            emit $s
                            set input $s
                            set moreinput ""
                        } else bell
                    }

                    history-prev {
                        set id [histdb::prev $histid]
                        if {$id ne ""} {
                            set histid $id
                            set s [histdb::get $histid]
                            if {$s ne ""} {
                                set n [string length $input]
                                emit [tty::left $n]
                                incr n [string length $moreinput]
                                emit [tty::erase $n]
                                emit $s
                                set input $s
                                set moreinput ""
                            }
                        } else bell
                    }

                    backspace {
                        if {$input ne ""} {
                            emit \u8[tty::delete 1]
                            set input [string range $input 0 end-1]
                        } else bell
                    }

                    delete {
                        if {$moreinput ne ""} {
                            emit [tty::delete 1]
                            set moreinput [string range $moreinput 1 end]
                        } else bell
                    }

                    back {
                        if {$input ne ""} {
                            emit \u8
                            set moreinput [string index $input end]$moreinput
                            set input [string range $input 0 end-1]
                        } else bell
                    }
                    forth {
                        if {$moreinput ne ""} {
                            set i [string index $moreinput 0]
                            set moreinput [string range $moreinput 1 end]
                            emit $i
                            append input $i
                        } else bell
                    }
                    home {
                        emit [tty::left [string length $input]]
                        set moreinput $input$moreinput
                        set input ""
                    }
                    end {
                        emit $moreinput
                        set input $input$moreinput
                        set moreinput ""
                    }
                    swap-mark {
                        if {$input eq ""} {
                            emit $moreinput
                            set input $moreinput
                            set moreinput ""
                        } else {
                            emit [tty::left [string length $input]]
                            set moreinput $input$moreinput
                            set input ""
                        }
                    }

                    kill-after {
                        emit [tty::erase [string length $moreinput]]
                        set yank $moreinput
                        set moreinput ""
                    }
                    kill-before {
                        set yank $input
                        emit [tty::left [string length $input]]
                        emit [tty::delete [string length $input]]
                        set input ""
                    }
                    kill-line {
                        set yank $input$moreinput
                        set n [string length $input]
                        emit [tty::left $n]
                        incr n [string length $moreinput]
                        emit [tty::erase $n]
                    }

                    redraw {
                        # prompt!
                        emit [tty::left [string length $input]]
                        emit $input$moreinput
                        emit [tty::left [string length $moreinput]]
                    }

                    paste {
                        append input $yank
                        insert [lmap c $yank {rep $c}]  ;# FIXME: rep a string
                    }

                    default {
                        append input [join $chars ""]
                        insert [rep $tok]   ;# this is a rep covering N>1 input chars!
                    }
                }
            }
            LITERAL {
                append input [join $tok ""]
                foreach char $tok {
                    if {[string is print $char]} {
                        insert $char
                    } else {
                        insert [rep $char]
                    }
                }
            }
        }
    }
}

# There's already some repetition with general movement .. let's see if we can factor that decently.

# handling rep properly means consulting it for all cursor movement, including overdrawing
# this argues for storing both input and inputrep.
proc rep {char} {
    if {[string length $char] > 1} {
        return \[$char\]
    } elseif {[string is print $char]} {
        return $char
    } else {
        return <[binary encode hex $char]>
    }
}

proc insert {s} {
    variable moreinput
    if {$moreinput ne ""} {
        emit [tty::insert [string length $s]]
    }
    emit $s
}

proc emit {s {repeat 1}} {
    while {[incr repeat -1] >= 0} {
        foreach c [split $s ""] {
            after 10
            puts -nonewline $c
        }
    }
}

proc bell {} {
    puts -nonewline \x07
}

proc prompt1 {} {
    string cat \[ [file tail [info script]] \] " "
}

# takes prompt1 as argument, so it can copy its length
proc prompt2 {p} {
    set p [prompt1]
    regsub -all .   $p "."  p
    regsub -all ..$ $p ": " p
    return $p
}

proc complete? {input} {
    info complete $input
}

#proc trieverse {varName trie script {prefix ""}} {
#    upvar 1 $varName var
#    dict for {key subtrie} $trie {
#        if {$subtrie eq ""} {
#            set var [list {*}$prefix $key]
#            uplevel 1 $script
#        } else {
#            uplevel 1 [list trieverse $varName $subtrie $script [list {*}$prefix $key]]
#        }
#    }
#}

proc main {} {
    try {
        init
        exec stty raw -echo
        chan configure stdin -blocking no
        chan configure stdout -buffering none
        chan event stdin readable [info coroutine]
        while {![eof stdin]} {
            puts ">> [getline] <<"
        }
    } finally {
        exec stty -raw echo
    }
    exit
}

coroutine MAIN main {*}$::argv
vwait forever

#trieverse keys $trie {
#    puts [lmap k $keys {binary encode hex $k}]
#}

Added lineedit/test-input.tcl.



























































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
source input.tcl
namespace path [list {*}[namespace path] ::input]

proc assert {cond} {
    if {![uplevel 1 [list ::expr $cond]]} {
        append          err "Assertion failed: [list $cond]"
        catch {append err "\n           subst: ([uplevel 1 [list ::subst -noc -nob $cond]])"}
        catch {append err "\n          result: [uplevel 1 [list ::subst -nob $cond]]"}
        return -code error $err
    }
}

assert {[sreplace "foo" 0 0 BOO]    eq "BOOoo"}
assert {[sreplace "foo" 0 -1 BOO]   eq "BOOfoo"}
assert {[sreplace "foo" 0 1 BOO]    eq "BOOo"}
assert {[sreplace "foo" 1 1 BOO]    eq "fBOOo"}
assert {[sreplace "foo" 2 2]        eq "fo"}
assert {[sreplace "foo" end+1 end+1 BOO]    eq "fooBOO"}
assert {[sreplace "foo" end+1 1 BOO]        eq "fooBOO"}

input::init

# basics, endpoints:
assert {[input::insert "foo"] eq [list insert foo 3]}
assert {$::input::input eq "foo"}
assert {$::input::point eq 3}
assert {[input::left 4] eq [list left 3]}
assert {$::input::input eq "foo"}
assert {$::input::point eq 0}
assert {[input::insert "bar"] eq [list insert bar 3]}
assert {$::input::input eq "barfoo"}
assert {$::input::point eq 3}
assert {[input::right 4] eq [list right 3]}
assert {[input::right 1] eq [list]}
assert {[input::insert "badge"] eq [list insert badge 5]}
assert {$::input::input eq "barfoobadge"}
assert {[input::left 4] eq [list left 4]}
# deletion:
assert {[input::delete 2] eq [list delete ad 2]}
assert {[input::backspace 2] eq [list backspace ob 2]}
assert {$::input::input eq "barfoge"}
# insert within, insert control:
assert {[input::insert \x03] eq [list insert <03> 4]}
assert {[input::left] eq [list left 4]}
assert {[input::delete 2] eq [list delete <03>g 5]}

Added lineedit/tty.tcl.











































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
namespace eval tty {
    # http://real-world-systems.com/docs/ANSIcode.html#Esc
    proc _def {name args result} {
        set CSI \x1b\[      ;# or \x9b ?
        proc $name $args "string cat [list $CSI] $result"
    }
    _def up {{n ""}}        {[if {$n==0} return] $n A}
    _def down {{n ""}}      {[if {$n==0} return] $n B}
    _def right {{n ""}}     {[if {$n==0} return] $n C}
    _def left {{n ""}}      {[if {$n==0} return] $n D}
    _def erase {{n ""}}     {[if {$n==0} return] $n X}
    _def delete {{n ""}}    {[if {$n==0} return] $n P}
    _def insert {{n ""}}    {[if {$n==0} return] $n @}
    _def mode-insert {}     {4h}
    _def mode-replace {}    {4l}
    _def goto-col {col}     {$col G}
    _def goto {row col}     {$row \; $col H}
    _def erase-to-end {}     {K}
    _def erase-from-start {} {1K}
    _def erase-line {}       {2K}
}

Added lineedit/util.tcl.





















































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26

proc sum ls {::tcl::mathop::+ {*}$ls}

proc sreplace {str i j {new ""}} {
    # handle indices
    set end [expr {1 + [string length $str]}]
    regsub end $i $end i
    regsub end $j $end j
    set i [expr $i]
    set j [expr $j]
    if {$j < $i} {set j [expr {$i - 1}]}
    set pre [string range $str 0 $i-1]
    set suf [string range $str $j+1 end]
    set str $pre$new$suf
}

proc sinsert {str i new} {
    if {$i eq "end+1"} {
        append str $new
    } else {
        set pre [string range $str 0 $i-1]
        set suf [string range $str $i end]
        set str $pre$new$suf
    }
}