tcl-hacks

Check-in [65b27430fd]
Login

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

Overview
Comment:be conventional: member variables get Capitalised
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:65b27430fdef9364a4d5630b67860c083a41b8a0
User & Date: aspect 2018-05-15 08:30:43
Context
2018-05-15
08:31
sketch how the interface should look check-in: 4bf331f466 user: aspect tags: trunk
08:30
be conventional: member variables get Capitalised check-in: 65b27430fd user: aspect tags: trunk
2018-05-14
14:31
Add [getline]. This is mostly complete, and replaces the experimental mess that was lineedit with a better structured, more-capable almost-package. check-in: 625cf86df3 user: aspect tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to getline/getline.tcl.

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
...
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
...
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
...
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
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
    if {![regexp -indices -start $i {\M} $s ab]} {return $i}
    lassign $ab a b
    expr {$a - $i}
}

## class Getline is an "engine".  Methods on it may be addressed in the keymap.
# Getline is a single-line-only getter; Getlines extends on it with line continuation capability
## TOKENS:  these are defined in keymap

oo::class create Getline {

    # history traversal is permitted when:
    #  - histid is "" and [input::get] is ""
    #  - histid is not ""
    variable histid
    variable yank
    variable prompt

    constructor {pr} {  ;# input output history iscomplete accept? completer
        set histid ""
        set yank ""
        set prompt $pr
        input reset
        output reset $prompt
    }

    method get {} {
        input get
    }

    method sigpipe {} {
................................................................................
        if {[input get] ne ""}  { 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} {
        variable histid
        foreach c [split $s ""] {
            input insert $c
            output insert [rep $c]  ;# attr?
        }
        set histid ""
    }

    method goto {i} {
        if {$i < [input pos]} {
            my back  [expr {[input pos] - $i}]
        } else {
            my forth [expr {$i - [input pos]}]
................................................................................
    }
    method replace-input {s} {
        my clear
        my insert $s
    }

    method set-state {{s ""} {p 0}} {
        variable prompt
        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 yank-word-after {}  { my yank [my kill-word-after] }

    method home {}             { my back      [input pos] }
................................................................................
    }
}


oo::class create Getlines {
    superclass Getline

    variable lines
    variable lineidx
    variable prompts        ;# for getlines, there must be a list of prompts!

    constructor {pr} {
        set prompts [list $pr]
        set lines   [list ""]
        set lineidx 0
        next $pr
    }

    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!
................................................................................
                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} {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]} {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 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 {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 {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 {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 {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
        }
    }







<
>


<
<
<
|
|
<


<
|
|

|







 







<




<







 







<



|


|
|







 







|
|
|


|
|
|




|
|



|


|

|

|







 







|



|
|




|


|
|
|





|

|
|
|





|
|



|
|






|







|








|











|









|








|







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
...
188
189
190
191
192
193
194

195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
...
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
...
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
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
    if {![regexp -indices -start $i {\M} $s ab]} {return $i}
    lassign $ab a b
    expr {$a - $i}
}

## class Getline is an "engine".  Methods on it may be addressed in the keymap.
# Getline is a single-line-only getter; Getlines extends on it with line continuation capability

#
oo::class create Getline {




    variable Yank
    variable Prompt


    constructor {pr} {  ;# input output history iscomplete accept? completer

        set Yank ""
        set Prompt $pr
        input reset
        output reset $Prompt
    }

    method get {} {
        input get
    }

    method sigpipe {} {
................................................................................
        if {[input get] ne ""}  { 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} {

        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 replace-input {s} {
        my clear
        my insert $s
    }

    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 yank-word-after {}  { my yank [my kill-word-after] }

    method home {}             { my back      [input pos] }
................................................................................
    }
}


oo::class create Getlines {
    superclass Getline

    variable Lines
    variable Lineidx
    variable Prompts        ;# for getlines, there must be a list of prompts!

    constructor {pr} {
        set Prompts [list $pr]
        set Lines   [list ""]
        set Lineidx 0
        next $pr
    }

    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!
................................................................................
                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} {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]} {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 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 {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 {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 {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 {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
        }
    }