tcl-hacks

Check-in [3256e23b42]
Login

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

Overview
Comment:make [exec stty] use a bit more portable
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:3256e23b4226d3d49be925f3272329979e2b1537
User & Date: aspect 2018-05-24 11:05:18
Context
2018-05-30
04:10
some todos in tclish, but it works for now check-in: 66c776ae7e user: aspect tags: trunk
2018-05-24
11:05
make [exec stty] use a bit more portable check-in: 3256e23b42 user: aspect tags: trunk
10:55
resolve callback check-in: 446ba418f4 user: aspect tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to modules/getline/output.tcl.

14
15
16
17
18
19
20
21
22
23
24
25
26
27

















28
29
30
31
32
33
34
..
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
...
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
    variable rows
    variable flashid

    constructor {Chan} {
        namespace path [list [namespace qualifiers [self class]] {*}[namespace path]]
        set pos 0
        set output ""
        lassign [exec stty size <@ stdin] rows cols
        set chan $Chan
    }

    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
................................................................................
    }
    method set-state {s p} {
        set output $s
        set pos $p
    }

    method redraw {} {
        lassign [exec stty size <@ stdin] rows cols     ;# because no SIGWINCH
        set dy [my wrap 0 [my pos]]
        if {$dy} {my emit [tty::up $dy]}
        my emit [tty::goto-col 0]
        my emit [tty::erase-to-end]
        my emit $output
        set dy [my wrap [my pos] [my rpos]]
        if {$dy} {my emit [tty::up $dy]}
................................................................................

    method beep {} {
        my emit \x07
    }
    method flash-message {msg} {
        catch {after cancel $flashid}
        my emit [tty::save]
        lassign [exec stty size] rows cols
        my emit [tty::goto 0 [expr {$cols - [string length $msg] - 2}]]
        my emit [tty::attr bold]
        my emit " $msg "
        my emit [tty::attr]
        my emit [tty::restore]
        if {[string is space $msg]} return
        regsub -all . $msg " " msg
        set flashid [after 1000 [list [self] flash-message $msg]]
    }
}







|






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







 







|







 







|










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
..
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
...
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
    variable rows
    variable flashid

    constructor {Chan} {
        namespace path [list [namespace qualifiers [self class]] {*}[namespace path]]
        set pos 0
        set output ""
        lassign [my size] rows cols
        set chan $Chan
    }

    destructor {
        catch {after cancel $flashid}
    }

    # we call this a lot because no SIGWINCH handler
    method size {} {
        try {
            lassign [exec stty size <@ stdin] rows cols
            return [list $rows $cols]
        } on error {} {
            set stty [exec stty -a <@ stdin]
            if {[regexp {rows (= )?(\d+); columns (= )?(\d+)} $err -> _ rows _ cols]} {
                return [list $rows $cols]
            }
            if {[regexp { (\d+) rows; (\d+) columns;} $err -> rows cols]} {
                return [list $rows $cols]
            }
            return [list 25 80]     ;# fallback .. provide something better please!
        }
    }

    method emit {s} {
        if {[string match \x1b* $s]} {
            puts -nonewline $chan $s
        } else {
            foreach c [split $s ""] {
                puts -nonewline $chan $c
................................................................................
    }
    method set-state {s p} {
        set output $s
        set pos $p
    }

    method redraw {} {
        lassign [my size] rows cols     ;# because no SIGWINCH
        set dy [my wrap 0 [my pos]]
        if {$dy} {my emit [tty::up $dy]}
        my emit [tty::goto-col 0]
        my emit [tty::erase-to-end]
        my emit $output
        set dy [my wrap [my pos] [my rpos]]
        if {$dy} {my emit [tty::up $dy]}
................................................................................

    method beep {} {
        my emit \x07
    }
    method flash-message {msg} {
        catch {after cancel $flashid}
        my emit [tty::save]
        lassign [my size] rows cols
        my emit [tty::goto 0 [expr {$cols - [string length $msg] - 2}]]
        my emit [tty::attr bold]
        my emit " $msg "
        my emit [tty::attr]
        my emit [tty::restore]
        if {[string is space $msg]} return
        regsub -all . $msg " " msg
        set flashid [after 1000 [list [self] flash-message $msg]]
    }
}