tcl-hacks

Check-in [6aa8964556]
Login

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

Overview
Comment:Multi-line input working, by putting it in [class Getline] rather than the failed separation through subclassing. Net code reduction and getline.tcl still <400loc, so it seems sound.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:6aa896455670a60c74adc61a4d4e2c36356dc89a
User & Date: aspect 2018-05-17 12:43:32
Context
2018-05-17
13:01
update readme. Nearly there check-in: ea0ae249f7 user: aspect tags: trunk
12:43
Multi-line input working, by putting it in [class Getline] rather than the failed separation through subclassing. Net code reduction and getline.tcl still <400loc, so it seems sound. check-in: 6aa8964556 user: aspect tags: trunk
2018-05-15
15:40
more tidy check-in: afa40a75e9 user: aspect tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to getline/README.multi-line.

1
2
3
4
5
6
7
8
9
10
** the prompt needs to be held in getline and fed to input,
** so input::reset can dtrt and so can getline::set-state

Multi-line input is just single-line input where:
 - newline when not Complete?, splits the line opens a new getline $prompt2
 - each line must be able to report its displayrows (including prompt)
 - change in displayrows must result in redraw of following lines
 - excessive back/forth transitions between getlines
 - up/down can cause transitions
 - delete/rubout within multilines kills the current line and transitions
<
<
<










1
2
3
4
5
6
7



Multi-line input is just single-line input where:
 - newline when not Complete?, splits the line opens a new getline $prompt2
 - each line must be able to report its displayrows (including prompt)
 - change in displayrows must result in redraw of following lines
 - excessive back/forth transitions between getlines
 - up/down can cause transitions
 - delete/rubout within multilines kills the current line and transitions

Changes to getline/getline.tcl.

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
..
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
...
184
185
186
187
188
189
190

191
192
193
194
195
196
197
...
218
219
220
221
222
223
224



225



226
227
228
229
230
231
232
# Getline is a single-line-only getter; Getlines extends on it with line continuation capability
#
oo::class create Getline {

    # state:
    variable Yank






    # options:
    variable Prompt
    variable Chan
    method Complete? {input} { info complete $input\n }
    method Completions {s}   { return "" }
    method History {args} {
        History create History
        oo::objdefine [self] forward History History
        tailcall my History {*}$args
    }

    constructor {args} {
        set Yank ""


        set Prompt "getline> "
        set Chan stdout

        my Configure {*}$args



        Input create             input
        Output create            output $Chan
        keymap::KeyMapper create keymap [expr {$Chan eq "stdout" ? "stdin" : $Chan}]
    }

    method Configure {args} {
................................................................................

    method beep {msg} {
        output beep
        if {$msg ne ""} {tailcall output flash-message $msg}
    }

    method reset {} {
        #output flash-message [list [self] reset from [info level -1] from [info level -2]]

        input reset
        output reset $Prompt
    }

    # action methods:
    method get {} {

        input get
    }


    method sigpipe {} {
        if {[input get] ne ""}  { my beep "sigpipe with [string length [input get]] chars"; return }
        return -level 2 -code break
    }
    method sigint {}      { return -level 2 -code continue }

    method redraw {}      { output redraw }


























    method insert {s} {
        #if {[string match "*% " $s]} {output flash-message [list [self] insert from [info level -1] from [info level -2]]}
        foreach c [split $s ""] {



            input insert $c
            output insert [rep $c]  ;# attr?
        }
    }










    method goto {i} {
        if {$i < [input pos]} {
            my back  [expr {[input pos] - $i}]
        } else {
            my forth [expr {$i - [input pos]}]
        }
    }

    method back {{n 1}} {
        if {$n == 0} return






        if {[input pos] < 1} {my beep "back at BOL"; return}
        set n [expr {min($n, [input pos])}]
        if {$n == 0} return
        output back [string length [srep [input back $n]]]
    }
    method forth {{n 1}} {
        if {$n == 0} return






        if {[input rpos] < 1} {my beep "forth at EOL"; return}
        set n [expr {min($n, [input rpos])}]
        if {$n == 0} return
        output forth [string length [srep [input forth $n]]]
    }

    method backspace {{n 1}} {
        if {$n == 0} return










        if {[input pos] < 1} {my beep "backspace at BOL"; return}
        set n [expr {min($n, [input pos])}]
        if {$n == 0} return
        set in [input backspace $n]
        output backspace [string length [srep $in]]
        return $in
    }
    method delete {{n 1}} {
        if {$n == 0} return








        if {[input rpos] < 1} {my beep "delete at EOL"; return}
        set n [expr {min($n, [input rpos])}]
        if {$n == 0} return
        set in [input delete $n]
        output delete [string length [srep $in]]
        return $in
    }

    method clear {} {
        set r [input get]
        if {[input rpos]} {my kill-after}
        if {[input pos]} {my kill-before}


        return $r
    }
    method replace-input {s {pos 0}} {
        my clear
        my insert $s

        my goto $pos
    }

    method set-state {{s ""} {p 0}} {
        input set-state $s $p
        ssplit $s $p -> a b
        set a [srep $a]; set b [srep $b]    ;# attrs? :(
        output set-state $Prompt$a$b [string length $Prompt$a]
    }





































































    method yank {s} { variable Yank ; set Yank $s }
    method paste {} { variable Yank ; my insert $Yank }

    method yank-before {}      { my yank [my kill-before] }
    method yank-after {}       { my yank [my kill-after] }
    method yank-word-before {} { my yank [my kill-word-before] }
................................................................................
    method kill-word-after {}  { my delete    [word-length-after  [input get] [input pos]] }
    # softbreak tab

    method history-prev {} {
        set s [my History prev [my get]]
        if {$s eq ""}   { my beep "no more history!"; return }
        my replace-input $s

    }
    method history-next {} {
        set s [my History next [my get]]
        if {$s eq ""}   { my beep "no more history!"; return }
        my replace-input $s
    }
    method history-prev-starting {} {
................................................................................
        if {![string is space $input]}  { my History add $input }
        my end
        output emit \n
        return -code return $input  ;# FIXME: forcing [tailcall accept] is terrible
    }

    method newline {} {



        tailcall my accept



    }

    method editor {} {
        set fd [file tempfile fn]
        puts $fd [input get]
        close $fd
        exec $::env(VISUAL) $fn <@ stdin >@ stdout 2>@ stderr







>
>
>
>
>













>
>




>
>







 







|
>




<

>
|


>





>
|
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

<

>
>
>
|
|
|
|
>
>
>
>
>
>
>
>
>











>
>
>
>
>
>







>
>
>
>
>
>








>
>
>
>
>
>
>
>
>
>









>
>
>
>
>
>
>
>












>
>





>


<






>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







>







 







>
>
>
|
>
>
>







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
..
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
...
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
...
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
# Getline is a single-line-only getter; Getlines extends on it with line continuation capability
#
oo::class create Getline {

    # state:
    variable Yank

    # multi-line state:
    variable Lines
    variable Lineidx
    variable Prompts

    # options:
    variable Prompt
    variable Chan
    method Complete? {input} { info complete $input\n }
    method Completions {s}   { return "" }
    method History {args} {
        History create History
        oo::objdefine [self] forward History History
        tailcall my History {*}$args
    }

    constructor {args} {
        set Yank ""
        set Lines {""}
        set Lineidx 0
        set Prompt "getline> "
        set Chan stdout

        my Configure {*}$args

        set Prompts [list $Prompt]

        Input create             input
        Output create            output $Chan
        keymap::KeyMapper create keymap [expr {$Chan eq "stdout" ? "stdin" : $Chan}]
    }

    method Configure {args} {
................................................................................

    method beep {msg} {
        output beep
        if {$msg ne ""} {tailcall output flash-message $msg}
    }

    method reset {} {
        set Lines {""}
        set Lineidx 0
        input reset
        output reset $Prompt
    }


    method get {} {
        lset Lines $Lineidx [input get]
        join $Lines \n
    }

    # action methods:
    method sigpipe {} {
        if {[input get] ne ""}  { my beep "sigpipe with [string length [input get]] chars"; return }
        return -level 2 -code break
    }
    method sigint {}      { return -level 2 -code continue }

    method redraw {} {
        my redraw-preceding
        my redraw-following
        my redraw-line
    }

    method redraw-line {} { output redraw }
    method redraw-preceding {} {
        set pos [input pos]
        lset Lines $Lineidx [input get]
        set idx $Lineidx
        while {![my is-first-line]} { my prior-line }
        while {$Lineidx > $idx}      { my next-line }
        my goto $pos
    }
    method redraw-following {} {
        set pos [input pos]
        lset Lines $Lineidx [input get]
        set idx $Lineidx
        while {![my is-last-line]} { my next-line }
        output emit [tty::down]
        output emit [tty::erase-line]
        output emit [tty::up]
        while {$Lineidx > $idx}   { my prior-line }
        my goto $pos
    }

    method insert {s} {

        foreach c [split $s ""] {
            if {$c eq "\n"} {
                my insert-newline
            } else {
                input insert $c
                output insert [rep $c]  ;# attr?
            }
        }
    }

    method insert-newline {} {
        set rest [my kill-after]
        lset Lines $Lineidx [my get]
        set Lines [linsert $Lines $Lineidx+1 $rest]
        output emit \n
        my next-line
    }

    method goto {i} {
        if {$i < [input pos]} {
            my back  [expr {[input pos] - $i}]
        } else {
            my forth [expr {$i - [input pos]}]
        }
    }

    method back {{n 1}} {
        if {$n == 0} return
        while {$n > [input pos] && ![my is-first-line]} {
            incr n -[input pos]
            incr n -1
            my prior-line
            my end
        }
        if {[input pos] < 1} {my beep "back at BOL"; return}
        set n [expr {min($n, [input pos])}]
        if {$n == 0} return
        output back [string length [srep [input back $n]]]
    }
    method forth {{n 1}} {
        if {$n == 0} return
        while {$n > [input rpos] && ![my is-last-line]} {
            incr n -[input rpos]
            incr n -1
            my next-line
            my home
        }
        if {[input rpos] < 1} {my beep "forth at EOL"; return}
        set n [expr {min($n, [input rpos])}]
        if {$n == 0} return
        output forth [string length [srep [input forth $n]]]
    }

    method backspace {{n 1}} {
        if {$n == 0} return
        while {$n > [input pos] && ![my is-first-line]} {
            incr n -[input pos]
            incr n -1
            my kill-before
            my prior-line
            my end
            set s [my kill-next-line]
            my insert $s
            my redraw-following
        }
        if {[input pos] < 1} {my beep "backspace at BOL"; return}
        set n [expr {min($n, [input pos])}]
        if {$n == 0} return
        set in [input backspace $n]
        output backspace [string length [srep $in]]
        return $in
    }
    method delete {{n 1}} {
        if {$n == 0} return
        while {$n > [input rpos] && ![my is-last-line]} {
            incr n -[input rpos]
            incr n -1
            set rest [my kill-next-line]
            my insert $rest
            my back [string length $rest]
            my redraw-following
        }
        if {[input rpos] < 1} {my beep "delete at EOL"; return}
        set n [expr {min($n, [input rpos])}]
        if {$n == 0} return
        set in [input delete $n]
        output delete [string length [srep $in]]
        return $in
    }

    method clear {} {
        set r [input get]
        if {[input rpos]} {my kill-after}
        if {[input pos]} {my kill-before}
        while {![my is-last-line]} {my kill-next-line}
        while {![my is-first-line]} {my kill-prior-line}
        return $r
    }
    method replace-input {s {pos 0}} {
        my clear
        my insert $s
        if {[my get] ne $s} {error "didn't work!: [my get] [list $Lines]"}
        my goto $pos
    }

    method set-state {{s ""} {p 0}} {
        input set-state $s $p
        ssplit $s $p -> a b
        set a [srep $a]; set b [srep $b]    ;# attrs? :(
        output set-state $Prompt$a$b [string length $Prompt$a]
    }

    # multi-line helpers
    method is-first-line {}     { expr {$Lineidx == 0} }
    method is-last-line {}      { expr {$Lineidx == [llength $Lines]-1} }

    method prior-line {} {
        if {[my is-first-line]} {my beep "No prior line"; return}
        my home
        lset Lines $Lineidx [input get]
        incr Lineidx -1
        my set-state [lindex $Lines $Lineidx]
        set  nrows [output wrap 0 [output len]]  ;# hmmm
        incr nrows 1
        output emit [tty::up $nrows]
        my redraw-line
    }
    method next-line {} {
        if {[my is-last-line]} {my beep "No next line"; return}
        my end
        lset Lines $Lineidx [input get]
        incr Lineidx 1
        my set-state [lindex $Lines $Lineidx]
        set  nrows [output wrap 0 [output len]]  ;# hmmm
        incr nrows 1
        output emit [tty::down $nrows]
        my redraw-line
    }

    method kill-next-line {} {
        set r [lindex $Lines $Lineidx+1]
        set Lines [lreplace $Lines $Lineidx+1 $Lineidx+1]
        return $r
    }
    method kill-prior-line {} {
        set r [lindex $Lines $Lineidx-1]
        set Lines [lreplace $Lines $Lineidx-1 $Lineidx-1]
        return $r
    }

    method up {{n 1}} {
        if {$n == 0} {return}
        if {[my is-first-line]} {my beep "No more lines!"; return}
        set pos [input pos]
        while {$n > 0 && ![my is-first-line]} {
            my prior-line
            my goto [expr {min($pos,[input rpos])}]
            incr n -1
        }
    }
    method down {{n 1}} {
        if {$n == 0} {return}
        if {[my is-last-line]} {my beep "No more lines!"; return}
        set pos [input pos]
        while {$n > 0 && ![my is-first-line]} {
            my prior-line
            my goto [expr {min($pos,[input rpos])}]
            incr n 1
        }
    }

    method very-home {} {
        my home
        while {![my is-first-line]} { my back 1 ; my home }
    }
    method very-end {} {
        my end
        while {![my is-last-line]} { my forth 1 ; my end }
    }

    method yank {s} { variable Yank ; set Yank $s }
    method paste {} { variable Yank ; my insert $Yank }

    method yank-before {}      { my yank [my kill-before] }
    method yank-after {}       { my yank [my kill-after] }
    method yank-word-before {} { my yank [my kill-word-before] }
................................................................................
    method kill-word-after {}  { my delete    [word-length-after  [input get] [input pos]] }
    # softbreak tab

    method history-prev {} {
        set s [my History prev [my get]]
        if {$s eq ""}   { my beep "no more history!"; return }
        my replace-input $s
        my redraw
    }
    method history-next {} {
        set s [my History next [my get]]
        if {$s eq ""}   { my beep "no more history!"; return }
        my replace-input $s
    }
    method history-prev-starting {} {
................................................................................
        if {![string is space $input]}  { my History add $input }
        my end
        output emit \n
        return -code return $input  ;# FIXME: forcing [tailcall accept] is terrible
    }

    method newline {} {
        set input [my get]
        if {[my Complete? $input]} {
            my very-end
            tailcall my accept
        } else {
            my insert \n
        }
    }

    method editor {} {
        set fd [file tempfile fn]
        puts $fd [input get]
        close $fd
        exec $::env(VISUAL) $fn <@ stdin >@ stdout 2>@ stderr

Deleted getline/getlines.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
# a wrapper around Getline that enhances it for multi-line input
oo::class create Getlines {
    superclass Getline

    variable Lines
    variable Lineidx
    variable Prompts        ;# for getlines, there must be a list of prompts!
    variable Prompt         ;# actually belongs to Getline

    constructor {args} {
        set Lines   [list ""]
        set Lineidx 0
        next {*}$args
        set Prompts [list $Prompt]
    }

    method reset {} {
        set Lines [list ""]
        set Lineidx 0
        next
    }

    # method goto .. count lines

    method clear {} {
        my reset
    }

    method getline {} {
        try {
            next
        } on break {} {
            return -code break
        } on continue {} {
            return -code continue
        }
        # FIXME: if [my display-rows] has changed, redraw-following
    }

    method get {} {
        lset Lines $Lineidx [input get]
        join $Lines \n
    }

    method redraw-following {} {
        set line [lindex $Lines $Lineidx]
        set pos [input pos]
        my end
        set idx $Lineidx
        incr idx
        while {$idx < [llength $Lines]} {
            output emit \n
            set l [lindex $Lines $idx]
            my set-state $l [string length $l]
            my redraw
        }
        my set-state $line $pos
    }

    # [insert \n] might create a new line!
    method newline {} {
        set input [my get]
        if {[my Complete? $input]} {
            # FIXME: go down
            tailcall my accept
        }
        my insert \n
    }

    method insert {s} {
        foreach c [split $s ""] {
            if {$c ne "\n"} {
                next $c
            } elseif {[info complete [my get]\n]} {
                tailcall my accept
            } else {
                my insert-newline
            }
        }
    }

    method insert-newline {} {
        set rest [my kill-after]
        set Lines [linsert $Lines $Lineidx+1 $rest]
        set rows [output wrap [output pos] [output rpos]]
        output emit [tty::down $rows]           ;# hmmm
        output emit \n
        incr Lineidx
        my set-state [lindex $Lines $Lineidx]
        my redraw
    }

    method prior-line {} {
        if {$Lineidx == 0} {my beep "no prev line"; return}
        my home
        output emit [tty::up 1]
        lset Lines $Lineidx [input get]
        incr Lineidx -1
        my set-state [lindex $Lines $Lineidx]
        set nrows [output wrap 0 [output len]]  ;# hmmm
        output emit [tty::up $nrows]            ;# hmmm
        my redraw
    }
    method next-line {} {
        if {$Lineidx + 1 == [llength $Lines]} {my beep "no next line"; return}
        my end
        lset Lines $Lineidx [input get]
        incr Lineidx 1
        my set-state [lindex $Lines $Lineidx]
        output emit [tty::down 1]               ;# hmmm
        my flash-message [my get]
        my redraw
    }

    method kill-next-line {} {
        set r [lindex $Lines $Lineidx+1]
        set Lines [lreplace $Lines $Lineidx+1 $Lineidx+1]
        return $r
    }
    method kill-prev-line {} {
        set r [lindex $Lines $Lineidx-1]
        set Lines [lreplace $Lines $Lineidx-1 $Lineidx-1]
        return $r
    }

    method back {{n 1}} {
        if {$n <= [input pos]} {
            next $n
        } elseif {$Lineidx > 0} {
            my prior-line
            my end
        } else {my beep "back at beginning of input"}
    }
    method forth {{n 1}} {
        if {$n <= [input rpos]} {
            next $n
        } elseif {$Lineidx+1 < [llength $Lines]} {
            my next-line
            my home
        } else {my beep "forth at end of input"}
    }

    method backspace {{n 1}} {
        if {$n <= [input pos]} {
            next $n
        } elseif {$Lineidx > 0} {
            my prior-line
            my end
            set s [my kill-next-line]
            my insert $s
            my redraw
            my redraw-following
        } else {my beep "backspace at beginning of input"}
    }
    method delete {{n 1}} {
        if {$n <= [input rpos]} {
            next $n
        } elseif {$Lineidx+1 < [llength $Lines]} {
            set rest [my kill-next-line]
            my insert $rest
            my back [string length $rest]
            my redraw
            my redraw-following
        } else {my beep "delete at end of input"}
    }

    method up {{n 1}} {
        if {$Lineidx > 0} {
            set pos [input pos]
            my prior-line
            my home
            set pos [expr {min($pos,[input rpos])}]
            my forth $pos
        }
    }
    method down {{n 1}} {
        if {$Lineidx + 1 < [llength $Lines]} {
            set pos [input pos]
            my next-line
            my home
            set pos [expr {min($pos,[input rpos])}]
            my forth $pos
        }
    }

}
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<




















































































































































































































































































































































































Changes to getline/main.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
..
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
...
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
#
# The sticky point right now is the relationship between Getline and Getlines:
# as a subclass, Getlines wants to redefine some of its parent's methods to
# provide whole-input behaviour, while other methods it wants to preserve as
# single-line actions.  This, in an inheritance scenario, leads to some odd
# conflicts.
#
# I think the solution is (of course) composition:
#  - Getlines has-a Getline
#  - Getlines getline tries to dispatch on its own methods first
#  - those explicitly call down to Getline where appropriate
#  - whole-input-replacing actions (history-*) need to "call up"

# TODO:
#  x char-wise nav
#  x line-wise nav
#  x wrap handling
#  x word-wise nav
#  x history (basic)
#  x history-search
................................................................................
#  x basic yank
#  x C-x C-e EDITOR (get smarter)
#  x flash message
#  x tcloo'ify
#  x multi-line input (debug further)
#   x fix line joinage: too much redraw by far
#   - continuation prompts
#   - multi-line redraw (just a keymap / action naming thing?)
#  x fix up history
#  x objectify keymap
#  x -options to Getline, move history etc into components
#  x chan independence
#  - use throw for accept .. and beep?
#  ? prefix keymaps (eg: ^L=redraw-line; ^L^L=redraw-all-lines)
#  - history-incremental-search .. this is a mode!
................................................................................
proc word-length-after {s i} {
    if {![regexp -indices -start $i {\M} $s ab]} {return $i}
    lassign $ab a b
    expr {$a - $i}
}

source getline.tcl
source getlines.tcl

proc main {args} {
    exec stty raw -echo <@ stdin
    trace add variable args unset {apply {args {exec stty -raw echo <@ stdin}}}

    chan configure stdin -blocking 0
    chan configure stdout -buffering none
    chan event stdin readable [info coroutine]

    set prompt "\[[info patch]\]% "
    Getlines create getline -prompt $prompt

    finally getline destroy

    while 1 {
        set input [getline getline]             ;# can return -code break/continue
        puts " -> {[srep $input]}"
    }
................................................................................
if 0 {
    proc complete? {s} {info complete $s\n}
    proc complete-tcl-command {s} {
        # .. use procmap
        # return list of possible completions
    }
    # complete modes: first, cycle, showbelow, ..
    Getlines create getline \
                    -chan stdin \
                    -prompt "\[[info patchlevel]\]% " \
                    -history % \
                    -iscomplete complete? \
                    -complete-mode cycle \
                    -completer complete-tcl-command
    getline add-maps [read $mapsfile]
<
<
<
<
<
<
<
<
<
<
<
<
<







 







|







 







<










|







 







|




















1
2
3
4
5
6
7
.
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
..
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
..
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102













# TODO:
#  x char-wise nav
#  x line-wise nav
#  x wrap handling
#  x word-wise nav
#  x history (basic)
#  x history-search
................................................................................
#  x basic yank
#  x C-x C-e EDITOR (get smarter)
#  x flash message
#  x tcloo'ify
#  x multi-line input (debug further)
#   x fix line joinage: too much redraw by far
#   - continuation prompts
#   x multi-line redraw (just a keymap / action naming thing?)
#  x fix up history
#  x objectify keymap
#  x -options to Getline, move history etc into components
#  x chan independence
#  - use throw for accept .. and beep?
#  ? prefix keymaps (eg: ^L=redraw-line; ^L^L=redraw-all-lines)
#  - history-incremental-search .. this is a mode!
................................................................................
proc word-length-after {s i} {
    if {![regexp -indices -start $i {\M} $s ab]} {return $i}
    lassign $ab a b
    expr {$a - $i}
}

source getline.tcl


proc main {args} {
    exec stty raw -echo <@ stdin
    trace add variable args unset {apply {args {exec stty -raw echo <@ stdin}}}

    chan configure stdin -blocking 0
    chan configure stdout -buffering none
    chan event stdin readable [info coroutine]

    set prompt "\[[info patch]\]% "
    Getline create getline -prompt $prompt

    finally getline destroy

    while 1 {
        set input [getline getline]             ;# can return -code break/continue
        puts " -> {[srep $input]}"
    }
................................................................................
if 0 {
    proc complete? {s} {info complete $s\n}
    proc complete-tcl-command {s} {
        # .. use procmap
        # return list of possible completions
    }
    # complete modes: first, cycle, showbelow, ..
    Getline create getline \
                    -chan stdin \
                    -prompt "\[[info patchlevel]\]% " \
                    -history % \
                    -iscomplete complete? \
                    -complete-mode cycle \
                    -completer complete-tcl-command
    getline add-maps [read $mapsfile]