tcl-hacks

Check-in [7f6388e856]
Login

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

Overview
Comment:fix history cursor next-matching
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:7f6388e8568809b5d374aa2159236a3a04f3889b
User & Date: aspect 2018-05-15 11:51:57
Context
2018-05-15
15:40
more tidy check-in: afa40a75e9 user: aspect tags: trunk
11:51
fix history cursor next-matching check-in: 7f6388e856 user: aspect tags: trunk
11:31
split out the classes. Now use main.tcl check-in: fafcde2df6 user: aspect tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to getline/getline.tcl.

75
76
77
78
79
80
81

82
83
84
85
86
87
88
..
92
93
94
95
96
97
98

99
100
101
102
103
104
105

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

    method reset {} {

        input reset
        output reset $Prompt
    }

    # action methods:
    method get {} {
        input get
................................................................................
        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} {

        foreach c [split $s ""] {
            input insert $c
            output insert [rep $c]  ;# attr?
        }
    }

    method goto {i} {







>







 







>







75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
..
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107

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

Changes to getline/history.tcl.

42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
...
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
        set hit [lsearch -inline -sorted -bisect -integer $hits [expr {$Index-1}]]
        if {$hit eq ""} {return}
        set Index $hit
        lindex $Items $Index
    }
    method next-matching {glob {curr ""}} {
        if {$curr ne ""} {lset Items $Index $curr}
        set hit [lsearch -start $Index -glob $glob $Items]
        if {$hit == -1} {return}
        set Index $hit
        lindex $Items $Index
    }
}

oo::class create History {
................................................................................
    puts [history cursor items]
    while 1 {
        set s [history prev x[history cursor get]]
        puts <[history cursor index]:$s
        if {$s eq ""} break
    }
    puts [history cursor items]
    history add [history cursor get]<<
    while 1 {
        set s [history next y[history cursor get]]
        puts >[history cursor index]:$s
        if {$s eq ""} break
    }
    puts [history cursor items]
    while 1 {







|







 







<







42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
...
113
114
115
116
117
118
119

120
121
122
123
124
125
126
        set hit [lsearch -inline -sorted -bisect -integer $hits [expr {$Index-1}]]
        if {$hit eq ""} {return}
        set Index $hit
        lindex $Items $Index
    }
    method next-matching {glob {curr ""}} {
        if {$curr ne ""} {lset Items $Index $curr}
        set hit [lsearch -start [expr {1 + $Index}] -glob $Items $glob]
        if {$hit == -1} {return}
        set Index $hit
        lindex $Items $Index
    }
}

oo::class create History {
................................................................................
    puts [history cursor items]
    while 1 {
        set s [history prev x[history cursor get]]
        puts <[history cursor index]:$s
        if {$s eq ""} break
    }
    puts [history cursor items]

    while 1 {
        set s [history next y[history cursor get]]
        puts >[history cursor index]:$s
        if {$s eq ""} break
    }
    puts [history cursor items]
    while 1 {

Changes to getline/main.tcl.

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
    lassign $ab a b
    expr {$a - $i}
}

source getline.tcl
source getlines.tcl


proc _getline {{prompt "> "}} {

    # prompt history inchan outchan
    Getline create engine -prompt \[[info patchlevel]\]%\ 
    finally engine destroy
    try {
        return [engine getline]
    } on break {} {
        return -code break
    } on continue {} {
        return -code continue
    }
    error "Must not get here!  [input reset]"
}

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]}"
    }
}








<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







|







65
66
67
68
69
70
71
















72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
    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]\]% "
    Getline create getline -prompt $prompt
    finally getline destroy
    while 1 {
        set input [getline getline]             ;# can return -code break/continue
        puts " -> {[srep $input]}"
    }
}

Changes to getline/output.tcl.

18
19
20
21
22
23
24

25
26
27
28
29
30
31
32
33
34
35
36
37
..
41
42
43
44
45
46
47

48
49
50
51
52
53
54
55
56
57
58
59
..
76
77
78
79
80
81
82

83
84
85
86
87
88
89
    }

    destructor {
        catch {after cancel $flashid}
    }

    method emit {s} {

        if {[string match \x1b* $s]} {
            puts -nonewline $chan $s
        } else {
            foreach c [split $s ""] {
                puts -nonewline $chan $c
                after 10
            }
        }
    }

    method wrap {i j} {
        set j [expr {($i + $j) / $cols}]
        set i [expr {$i / $cols}]
................................................................................

    method get {} {return $output}
    method len {} {string length $output}
    method pos {}  {return $pos}
    method rpos {} {expr {[string length $output]-$pos}}

    method reset {prompt} {

        set r [my get]
        set output ""
        set pos 0
        my insert $prompt
        my redraw
        return $r
    }
    method set-state {s p} {
        set output $s
        set pos $p
    }

................................................................................
        }
        my emit [tty::erase-to-end]
        if {$dy} {my emit [tty::up $dy]}
        my emit [tty::goto-col [expr {1 + $pos % $cols}]]
    }

    method insert {s} {

        # update state
        set n [string length $s]
        set output [sinsert $output $pos $s]
        set dy [my wrap $pos [my rpos]]
        incr pos $n
        # draw
        if {[my rpos]} {my emit [tty::insert $n]}







>





|







 







>




|







 







>







18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
..
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
..
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
    }

    destructor {
        catch {after cancel $flashid}
    }

    method emit {s} {
        #if {[string match "*% " $s]} {my flash-message [list [self] emit from [info level -1] from [info level -2]]}
        if {[string match \x1b* $s]} {
            puts -nonewline $chan $s
        } else {
            foreach c [split $s ""] {
                puts -nonewline $chan $c
                after 20
            }
        }
    }

    method wrap {i j} {
        set j [expr {($i + $j) / $cols}]
        set i [expr {$i / $cols}]
................................................................................

    method get {} {return $output}
    method len {} {string length $output}
    method pos {}  {return $pos}
    method rpos {} {expr {[string length $output]-$pos}}

    method reset {prompt} {
        #my flash-message [list [self] reset from [info level -1] from [info level -2]]
        set r [my get]
        set output ""
        set pos 0
        my insert $prompt
        #my redraw
        return $r
    }
    method set-state {s p} {
        set output $s
        set pos $p
    }

................................................................................
        }
        my emit [tty::erase-to-end]
        if {$dy} {my emit [tty::up $dy]}
        my emit [tty::goto-col [expr {1 + $pos % $cols}]]
    }

    method insert {s} {
        #if {[string match "*% " $s]} {my flash-message [list [self] insert from [info level -1] from [info level -2]]}
        # update state
        set n [string length $s]
        set output [sinsert $output $pos $s]
        set dy [my wrap $pos [my rpos]]
        incr pos $n
        # draw
        if {[my rpos]} {my emit [tty::insert $n]}