tcl-hacks

Check-in [37c5eb27dc]
Login

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

Overview
Comment:tclish taking arguments: will require fixing boot.tcl's argv/0 handling
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | tclish-args
Files: files | file ages | folders
SHA1:37c5eb27dcde4c7d39bc8a1451589ccda7edc4aa
User & Date: aspect 2018-07-26 14:59:06
Context
2018-07-28
05:55
simpler isatty check-in: b4e24a23f3 user: aspect tags: tclish-args
2018-07-26
14:59
tclish taking arguments: will require fixing boot.tcl's argv/0 handling check-in: 37c5eb27dc user: aspect tags: tclish-args
2018-07-24
13:25
Note some teapot deficiencies while they're fresh check-in: 97b423d7fc user: aspect tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to bin/tclish.

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
    proc atexit {script args} {
        set ns [uplevel 1 {namespace current}]
        set script "$script $args"
        trace add execution exit enter [thunk $script $ns]
    }











    proc main {} {














        exec stty raw -echo <@ stdin
        finally {exec stty -raw echo <@ stdin}
        atexit  {exec stty -raw echo <@ stdin}  ;# finally might not be enough!

        set prompt "\[[info patch]\]% "

        Getline create getline \
                            -prompt $prompt \
                            -completer [callback complete-word] \
        ;#

        finally [callback getline destroy]













        while 1 {
            set input [getline getline]             ;# can return -code break/continue
            try {
                uplevel #0 $input
            } on ok {res opt} {
                if {$res eq ""} continue







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













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







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
    proc atexit {script args} {
        set ns [uplevel 1 {namespace current}]
        set script "$script $args"
        trace add execution exit enter [thunk $script $ns]
    }


    proc lshift {_list} {
        upvar 1 $_list list
        if {[llength $list] == 0} {
            throw {LSHIFT EMPTY} "Attempt to shift an empty list!"
        }
        set list [lassign $list r]
        return $r
    }

    proc main {args} {

        set cmds {}
        while {[string match -* [lindex $args 0]]} {
            set arg [lshift args]
            switch $arg {
                -c { lappend cmds [lshift args] }
                -m { lappend cmds "package require [lshift args]" }
                -- { break }
            }
        }
        foreach script $args {
            lappend cmds [list source $script]
        }

        exec stty raw -echo <@ stdin
        finally {exec stty -raw echo <@ stdin}
        atexit  {exec stty -raw echo <@ stdin}  ;# finally might not be enough!

        set prompt "\[[info patch]\]% "

        Getline create getline \
                            -prompt $prompt \
                            -completer [callback complete-word] \
        ;#

        finally [callback getline destroy]

        foreach cmd $cmds {
            getline insert $cmd\n
            try {
                uplevel #0 $cmd
            } on ok {res opt} {
                if {$res eq ""} continue
                puts [tty::attr bold]\ [list $res][tty::attr]
            } on error {res opt} {
                puts [tty::attr fg red bold]\ $res[tty::attr]
            }
        }

        while 1 {
            set input [getline getline]             ;# can return -code break/continue
            try {
                uplevel #0 $input
            } on ok {res opt} {
                if {$res eq ""} continue