Check-in [447ba8e3d1]
Not logged in
Overview
Comment: sources Removed Files: tclreadlineSetup.tcl
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:447ba8e3d1fe619ec7979f8bc12b4caf150c6fca
User & Date: johannes@zellner.org on 1999-08-20 11:32:20
Other Links: manifest | tags
Context
1999-08-20
11:35
config.guess config.sub install-sh mkinstalldirs tcltags vimtags check-in: 3aa896e85d user: johannes@zellner.org tags: trunk
11:32
sources Removed Files: tclreadlineSetup.tcl check-in: 447ba8e3d1 user: johannes@zellner.org tags: trunk
09:44
*** empty log message *** check-in: 90883b7fdb user: johannes@zellner.org tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Modified sources from [404a74ebf6] to [4bb0513a62].


1


2



3
4

5
6
7
8
9

    Makefile.in


    configure.in



    tclreadline.c
    tclreadline.h.in

    tclreadlineConfig.sh.in
    tclreadlineInit.tcl.in
    tclreadlineSetup.tcl.in
    tclreadline.n.in
    sample.tclshrc
>

>
>

>
>
>


>



<
<
1
2
3
4
5
6
7
8
9
10
11
12
13
14


    GPL
    Makefile.in
    README
    TODO
    configure.in
    pkgIndex.tcl
    sample.tclshrc
    sources
    tclreadline.c
    tclreadline.h.in
    tclreadline.n.in
    tclreadlineConfig.sh.in
    tclreadlineInit.tcl.in
    tclreadlineSetup.tcl.in


Deleted tclreadlineSetup.tcl version [ed16deb2b2].

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
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
322
323
324
325
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
#!/usr/local/bin/tclsh
# ==================================================================
# FILE: "/home/joze/tmp/tclreadline/tclreadlineSetup.tcl"
# LAST MODIFIED: "Mon Oct 05 15:15:42 1998 (joze)"
# (c) 1998 by Johannes Zellner
# Johannes.Zellner@physik.uni-karlsruhe.de
# $Id$
# ================================================================== 

package provide tclreadline 1.0

proc unknown args {

    global auto_noexec auto_noload env unknown_pending tcl_interactive
    global errorCode errorInfo

    # Save the values of errorCode and errorInfo variables, since they
    # may get modified if caught errors occur below.  The variables will
    # be restored just before re-executing the missing command.

    set savedErrorCode $errorCode
    set savedErrorInfo $errorInfo
    set name [lindex $args 0]
    if ![info exists auto_noload] {
        #
        # Make sure we're not trying to load the same proc twice.
        #
        if [info exists unknown_pending($name)] {
            return -code error "self-referential recursion in \"unknown\" for command \"$name\"";
        }
        set unknown_pending($name) pending;
        set ret [catch {auto_load $name [uplevel 1 {namespace current}]} msg]
        unset unknown_pending($name);
        if {$ret != 0} {
            return -code $ret -errorcode $errorCode \
                "error while autoloading \"$name\": $msg"
        }
        if ![array size unknown_pending] {
            unset unknown_pending
        }
        if $msg {
            set errorCode $savedErrorCode
            set errorInfo $savedErrorInfo
            set code [catch {uplevel 1 $args} msg]
            if {$code ==  1} {
                #
                # Strip the last five lines off the error stack (they're
                # from the "uplevel" command).
                #

                set new [split $errorInfo \n]
                set new [join [lrange $new 0 [expr [llength $new] - 6]] \n]
                return -code error -errorcode $errorCode \
                        -errorinfo $new $msg
            } else {
                return -code $code $msg
            }
        }
    }

    # REMOVED THE [info script] TEST (joze, SEP 98)
    if {([info level] == 1) \
            && [info exists tcl_interactive] && $tcl_interactive} {
        if ![info exists auto_noexec] {
            set new [auto_execok $name]
            if {$new != ""} {
                set errorCode $savedErrorCode
                set errorInfo $savedErrorInfo
                set redir ""
                if {[info commands console] == ""} {
                    set redir ">&@stdout <@stdin"
                }
                # LOOK FOR GLOB STUFF IN $ARGS (joze, SEP 98)
                return [uplevel eval exec $redir $new \
                    [::tclreadline::Glob [lrange $args 1 end]]]
            }
        }
        set errorCode $savedErrorCode
        set errorInfo $savedErrorInfo
        if {$name == "!!"} {
            set newcmd [history event]
        } elseif {[regexp {^!(.+)$} $name dummy event]} {
            set newcmd [history event $event]
        } elseif {[regexp {^\^([^^]*)\^([^^]*)\^?$} $name dummy old new]} {
            set newcmd [history event -1]
            catch {regsub -all -- $old $newcmd $new newcmd}
        }
        if [info exists newcmd] {
            tclLog $newcmd
            history change $newcmd 0
            return [uplevel $newcmd]
        }

        set ret [catch {set cmds [info commands $name*]} msg]
        if {[string compare $name "::"] == 0} {
            set name ""
        }
        if {$ret != 0} {
            return -code $ret -errorcode $errorCode \
                "error in unknown while checking if \"$name\" is a unique command abbreviation: $msg"
        }
        if {[llength $cmds] == 1} {
            return [uplevel [lreplace $args 0 0 $cmds]]
        }
        if {[llength $cmds] != 0} {
            if {$name == ""} {
                return -code error "empty command name \"\""
            } else {
                return -code error \
                        "ambiguous command name \"$name\": [lsort $cmds]"
            }
        }
    }
    return -code error "invalid command name \"$name\""
}

namespace eval tclreadline:: {
    namespace export Setup Glob Loop InitCmds InitTclCmds InitTkCmds
}

proc ::tclreadline::Setup {} {

    uplevel #0 {


        if {[info exists tk_version]} {
            set readlinePrompt "\[0;94mwish$tk_version\[0m"
        } else {
            set readlinePrompt "\[0;91mtclsh$tcl_version\[0m"
        }

        proc ls {args} {
            if {[exec uname -s] == "Linux"} {
                eval exec ls --color -FC [::tclreadline::Glob $args]
            } else {
                eval exec ls -FC [::tclreadline::Glob $args]
            }
        }

        if {[info procs cd] == ""} {
            catch {rename ::tclreadline::Cd ""}
            rename cd ::tclreadline::Cd
            proc cd {args} {
                if {[catch {eval ::tclreadline::Cd $args} message]} {
                    puts stderr "$message"
                }
                ls
            }
        }

        if {[info procs exit] == ""} {

            catch {rename ::tclreadline::Exit ""}
            rename exit ::tclreadline::Exit

            proc exit {args} {

                catch {::tclreadline::readline write 
                    [::tclreadline::HistoryFileGet]}

                if [catch "eval ::tclreadline::Exit $args" message] {
                    puts stderr "error:"
                    puts stderr "$message"
                }
                # NOTREACHED
            }
        }



        global pi
        set pi 3.1415926535897931
        set tcl_precision 17


        global env
        variable historyfile

        if {[info exists env(HOME)]} {
            set historyfile  $env(HOME)/.tclsh-history
            set env(INPUTRC) $env(HOME)/.tclsh-inputrc
        } else {
            set historyfile  .tclsh-history
        }
        set msg [::tclreadline::readline initialize $historyfile]
        if {$msg != ""} {
            puts stderr "$msg"
        }

        ::tclreadline::InitCmds
    }

    rename ::tclreadline::Setup ""
}

proc ::tclreadline::HistoryFileGet {} {
    variable historyfile
    puts stderr "::tclreadline::HistoryFileGet: entered"
    return $historyfile
}

proc ::tclreadline::Glob {string} {

    set commandstring ""
    foreach name $string {
        set replace [glob -nocomplain -- $name]
        if {$replace == ""} {
            lappend commandstring $name
        } else {
            lappend commandstring $replace
        }
    }
    return $commandstring
}



proc ::tclreadline::Loop {} {

    ::tclreadline::Setup

    uplevel #0 {
        while {1} {
            if {[catch {
                if {[info exists tk_version]} {
                    update
                }
                regsub $env(HOME) [pwd] "" prompt2
                set line [::tclreadline::readline read "$readlinePrompt \[$prompt2\]"]
                set result [eval $line]
                if {$result != ""} {
                    puts $result
                }
                set result ""
            } msg]} {
#                puts stderr $msg
            }
        }
    }
}


proc ::tclreadline::InitCmds {} {
    global tcl_version tk_version
    if {[info exists tcl_version]} {
        ::tclreadline::InitTclCmds
    }
    if {[info exists tk_version]} {
        ::tclreadline::InitTkCmds
    }
    rename tclreadline::InitCmds ""
}

proc ::tclreadline::InitTclCmds {} {
::tclreadline::readline add "after option ?arg arg ...?"
::tclreadline::readline add "append varName ?value value ...?"
::tclreadline::readline add "array option arrayName ?arg ...?"
::tclreadline::readline add "binary option ?arg arg ...?"
::tclreadline::readline add "catch command ?varName?"
::tclreadline::readline add "clock option ?arg ...?"
::tclreadline::readline add "close channelId"
::tclreadline::readline add "eof channelId"
::tclreadline::readline add "error message ?errorInfo? ?errorCode?"
::tclreadline::readline add "eval arg ?arg ...?"
::tclreadline::readline add "exec ?switches? arg ?arg ...?"
::tclreadline::readline add "expr arg ?arg ...?"
::tclreadline::readline add "fblocked channelId"
::tclreadline::readline add "fconfigure channelId ?optionName? ?value? ?optionName value?..."
::tclreadline::readline add "fcopy input output ?-size size? ?-command callback?"
::tclreadline::readline add "file option ?arg ...?"
::tclreadline::readline add "fileevent channelId event ?script?"
::tclreadline::readline add "flush channelId"
::tclreadline::readline add "for start test next command"
::tclreadline::readline add "foreach varList list ?varList list ...? command"
::tclreadline::readline add "format formatString ?arg arg ...?"
::tclreadline::readline add "gets channelId ?varName?"
::tclreadline::readline add "glob ?switches? name ?name ...?"
::tclreadline::readline add "global varName ?varName ...?"
::tclreadline::readline add "incr varName ?increment?"
::tclreadline::readline add "info option ?arg arg ...?"
::tclreadline::readline add "interp cmd ?arg ...?"
::tclreadline::readline add "join list ?joinString?"
::tclreadline::readline add "lappend varName ?value value ...?"
::tclreadline::readline add "lindex list index"
::tclreadline::readline add "linsert list index element ?element ...?"
::tclreadline::readline add "llength list"
::tclreadline::readline add "load fileName ?packageName? ?interp?"
::tclreadline::readline add "lrange list first last"
::tclreadline::readline add "lreplace list first last ?element element ...?"
::tclreadline::readline add "lsearch ?mode? list pattern"
::tclreadline::readline add "lsort ?options? list"
::tclreadline::readline add "namespace subcommand ?arg ...?"
::tclreadline::readline add "open fileName ?access? ?permissions?"
::tclreadline::readline add "package option ?arg arg ...?"
::tclreadline::readline add "proc name args body"
::tclreadline::readline add "puts ?-nonewline? ?channelId? string"
::tclreadline::readline add "read ?-nonewline? channelId"
::tclreadline::readline add "regexp ?switches? exp string ?matchVar? ?subMatchVar subMatchVar ...?"
::tclreadline::readline add "regsub ?switches? exp string subSpec varName"
::tclreadline::readline add "rename oldName newName"
::tclreadline::readline add "scan string format ?varName varName ...?"
::tclreadline::readline add "seek channelId offset ?origin?"
::tclreadline::readline add "set varName ?newValue?"
::tclreadline::readline add "socket ?-myaddr addr? ?-myport myport? ?-async? host port"
::tclreadline::readline add "socket -server command ?-myaddr addr? port"
::tclreadline::readline add "source fileName"
::tclreadline::readline add "split string ?splitChars?"
::tclreadline::readline add "string option arg ?arg ...?"
::tclreadline::readline add "subst ?-nobackslashes? ?-nocommands? ?-novariables? string"
::tclreadline::readline add "switch ?switches? string pattern body ... ?default body?"
::tclreadline::readline add "tell channelId"
::tclreadline::readline add "time command ?count?"
::tclreadline::readline add "trace option \[arg arg ...\]"
::tclreadline::readline add "unset varName ?varName ...?"
::tclreadline::readline add "uplevel ?level? command ?arg ...?"
::tclreadline::readline add "upvar ?level? otherVar localVar ?otherVar localVar ...?"
::tclreadline::readline add "vwait name"
::tclreadline::readline add "while test command"
rename tclreadline::InitTclCmds ""

}

proc ::tclreadline::InitTkCmds {} {
::tclreadline::readline add "bind window ?pattern? ?command?"
::tclreadline::readline add "bindtags window ?tags?"
::tclreadline::readline add "button pathName ?options?"
::tclreadline::readline add "canvas pathName ?options?"
::tclreadline::readline add "checkbutton pathName ?options?"
::tclreadline::readline add "clipboard option ?arg arg ...?"
::tclreadline::readline add "entry pathName ?options?"
::tclreadline::readline add "event option ?arg1?"
::tclreadline::readline add "font option ?arg?"
::tclreadline::readline add "frame pathName ?options?"
::tclreadline::readline add "grab option ?arg arg ...?"
::tclreadline::readline add "grid option arg ?arg ...?"
::tclreadline::readline add "image option ?args?"
::tclreadline::readline add "label pathName ?options?"
::tclreadline::readline add "listbox pathName ?options?"
::tclreadline::readline add "lower window ?belowThis?"
::tclreadline::readline add "menu pathName ?options?"
::tclreadline::readline add "menubutton pathName ?options?"
::tclreadline::readline add "message pathName ?options?"
::tclreadline::readline add "option cmd arg ?arg ...?"
::tclreadline::readline add "pack option arg ?arg ...?"
::tclreadline::readline add "radiobutton pathName ?options?"
::tclreadline::readline add "raise window ?aboveThis?"
::tclreadline::readline add "scale pathName ?options?"
::tclreadline::readline add "scrollbar pathName ?options?"
::tclreadline::readline add "selection option ?arg arg ...?"
::tclreadline::readline add "send ?options? interpName arg ?arg ...?"
::tclreadline::readline add "text pathName ?options?"
::tclreadline::readline add "tk option ?arg?"
::tclreadline::readline add "tkwait variable|visibility|window name"
::tclreadline::readline add "toplevel pathName ?options?"
::tclreadline::readline add "winfo option ?arg?"
::tclreadline::readline add "wm option window ?arg ...?"
rename tclreadline::InitTkCmds ""
}




# ***** invalid command name "Tcl"
# ***** invalid command name "bgerror"
# ***** invalid command name "contents"
# ***** invalid command name "filename"
# ***** invalid command name "http"
# ***** wrong # args: no expression after "if" argument
# ***** invalid command name "library"
# ***** 4940
# ***** invalid command name "pkgMkIndex"
# ***** /home/joze
# ***** invalid command name "registry"
# ***** invalid command name "resource"
# ***** invalid command name "safe"
# ***** wrong # args: should be either:
# ***** invalid command name "tclvars"
# ***** invalid command name ""
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<