source: proiecte/pmake3d/make3d_original/Make3dSingleImageStanford_version0.1/third_party/vrippack-0.31/src/vrip/lib/tcl/history.tcl @ 37

Last change on this file since 37 was 37, checked in by (none), 14 years ago

Added original make3d
File size: 8.8 KB
Line 
1# history.tcl --
2#
3# Implementation of the history command.
4#
5# RCS: @(#) $Id: history.tcl,v 1.3.18.1 2000/08/07 21:31:47 hobbs Exp $
6#
7# Copyright (c) 1997 Sun Microsystems, Inc.
8#
9# See the file "license.terms" for information on usage and redistribution
10# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
11#
12
13# The tcl::history array holds the history list and
14# some additional bookkeeping variables.
15#
16# nextid        the index used for the next history list item.
17# keep          the max size of the history list
18# oldest        the index of the oldest item in the history.
19
20namespace eval tcl {
21    variable history
22    if {![info exists history]} {
23        array set history {
24            nextid      0
25            keep        20
26            oldest      -20
27        }
28    }
29}
30
31# history --
32#
33#       This is the main history command.  See the man page for its interface.
34#       This does argument checking and calls helper procedures in the
35#       history namespace.
36
37proc history {args} {
38    set len [llength $args]
39    if {$len == 0} {
40        return [tcl::HistInfo]
41    }
42    set key [lindex $args 0]
43    set options "add, change, clear, event, info, keep, nextid, or redo"
44    switch -glob -- $key {
45        a* { # history add
46
47            if {$len > 3} {
48                return -code error "wrong # args: should be \"history add event ?exec?\""
49            }
50            if {![string match $key* add]} {
51                return -code error "bad option \"$key\": must be $options"
52            }
53            if {$len == 3} {
54                set arg [lindex $args 2]
55                if {! ([string match e* $arg] && [string match $arg* exec])} {
56                    return -code error "bad argument \"$arg\": should be \"exec\""
57                }
58            }
59            return [tcl::HistAdd [lindex $args 1] [lindex $args 2]]
60        }
61        ch* { # history change
62
63            if {($len > 3) || ($len < 2)} {
64                return -code error "wrong # args: should be \"history change newValue ?event?\""
65            }
66            if {![string match $key* change]} {
67                return -code error "bad option \"$key\": must be $options"
68            }
69            if {$len == 2} {
70                set event 0
71            } else {
72                set event [lindex $args 2]
73            }
74
75            return [tcl::HistChange [lindex $args 1] $event]
76        }
77        cl* { # history clear
78
79            if {($len > 1)} {
80                return -code error "wrong # args: should be \"history clear\""
81            }
82            if {![string match $key* clear]} {
83                return -code error "bad option \"$key\": must be $options"
84            }
85            return [tcl::HistClear]
86        }
87        e* { # history event
88
89            if {$len > 2} {
90                return -code error "wrong # args: should be \"history event ?event?\""
91            }
92            if {![string match $key* event]} {
93                return -code error "bad option \"$key\": must be $options"
94            }
95            if {$len == 1} {
96                set event -1
97            } else {
98                set event [lindex $args 1]
99            }
100            return [tcl::HistEvent $event]
101        }
102        i* { # history info
103
104            if {$len > 2} {
105                return -code error "wrong # args: should be \"history info ?count?\""
106            }
107            if {![string match $key* info]} {
108                return -code error "bad option \"$key\": must be $options"
109            }
110            return [tcl::HistInfo [lindex $args 1]]
111        }
112        k* { # history keep
113
114            if {$len > 2} {
115                return -code error "wrong # args: should be \"history keep ?count?\""
116            }
117            if {$len == 1} {
118                return [tcl::HistKeep]
119            } else {
120                set limit [lindex $args 1]
121                if {[catch {expr {~$limit}}] || ($limit < 0)} {
122                    return -code error "illegal keep count \"$limit\""
123                }
124                return [tcl::HistKeep $limit]
125            }
126        }
127        n* { # history nextid
128
129            if {$len > 1} {
130                return -code error "wrong # args: should be \"history nextid\""
131            }
132            if {![string match $key* nextid]} {
133                return -code error "bad option \"$key\": must be $options"
134            }
135            return [expr {$tcl::history(nextid) + 1}]
136        }
137        r* { # history redo
138
139            if {$len > 2} {
140                return -code error "wrong # args: should be \"history redo ?event?\""
141            }
142            if {![string match $key* redo]} {
143                return -code error "bad option \"$key\": must be $options"
144            }
145            return [tcl::HistRedo [lindex $args 1]]
146        }
147        default {
148            return -code error "bad option \"$key\": must be $options"
149        }
150    }
151}
152
153# tcl::HistAdd --
154#
155#       Add an item to the history, and optionally eval it at the global scope
156#
157# Parameters:
158#       command         the command to add
159#       exec            (optional) a substring of "exec" causes the
160#                       command to be evaled.
161# Results:
162#       If executing, then the results of the command are returned
163#
164# Side Effects:
165#       Adds to the history list
166
167 proc tcl::HistAdd {command {exec {}}} {
168    variable history
169    set i [incr history(nextid)]
170    set history($i) $command
171    set j [incr history(oldest)]
172    if {[info exists history($j)]} {unset history($j)}
173    if {[string match e* $exec]} {
174        return [uplevel #0 $command]
175    } else {
176        return {}
177    }
178}
179
180# tcl::HistKeep --
181#
182#       Set or query the limit on the length of the history list
183#
184# Parameters:
185#       limit   (optional) the length of the history list
186#
187# Results:
188#       If no limit is specified, the current limit is returned
189#
190# Side Effects:
191#       Updates history(keep) if a limit is specified
192
193 proc tcl::HistKeep {{limit {}}} {
194    variable history
195    if {[string length $limit] == 0} {
196        return $history(keep)
197    } else {
198        set oldold $history(oldest)
199        set history(oldest) [expr {$history(nextid) - $limit}]
200        for {} {$oldold <= $history(oldest)} {incr oldold} {
201            if {[info exists history($oldold)]} {unset history($oldold)}
202        }
203        set history(keep) $limit
204    }
205}
206
207# tcl::HistClear --
208#
209#       Erase the history list
210#
211# Parameters:
212#       none
213#
214# Results:
215#       none
216#
217# Side Effects:
218#       Resets the history array, except for the keep limit
219
220 proc tcl::HistClear {} {
221    variable history
222    set keep $history(keep)
223    unset history
224    array set history [list \
225        nextid  0       \
226        keep    $keep   \
227        oldest  -$keep  \
228    ]
229}
230
231# tcl::HistInfo --
232#
233#       Return a pretty-printed version of the history list
234#
235# Parameters:
236#       num     (optional) the length of the history list to return
237#
238# Results:
239#       A formatted history list
240
241 proc tcl::HistInfo {{num {}}} {
242    variable history
243    if {$num == {}} {
244        set num [expr {$history(keep) + 1}]
245    }
246    set result {}
247    set newline ""
248    for {set i [expr {$history(nextid) - $num + 1}]} \
249            {$i <= $history(nextid)} {incr i} {
250        if {![info exists history($i)]} {
251            continue
252        }
253        set cmd [string trimright $history($i) \ \n]
254        regsub -all \n $cmd "\n\t" cmd
255        append result $newline[format "%6d  %s" $i $cmd]
256        set newline \n
257    }
258    return $result
259}
260
261# tcl::HistRedo --
262#
263#       Fetch the previous or specified event, execute it, and then
264#       replace the current history item with that event.
265#
266# Parameters:
267#       event   (optional) index of history item to redo.  Defaults to -1,
268#               which means the previous event.
269#
270# Results:
271#       Those of the command being redone.
272#
273# Side Effects:
274#       Replaces the current history list item with the one being redone.
275
276 proc tcl::HistRedo {{event -1}} {
277    variable history
278    if {[string length $event] == 0} {
279        set event -1
280    }
281    set i [HistIndex $event]
282    if {$i == $history(nextid)} {
283        return -code error "cannot redo the current event"
284    }
285    set cmd $history($i)
286    HistChange $cmd 0
287    uplevel #0 $cmd
288}
289
290# tcl::HistIndex --
291#
292#       Map from an event specifier to an index in the history list.
293#
294# Parameters:
295#       event   index of history item to redo.
296#               If this is a positive number, it is used directly.
297#               If it is a negative number, then it counts back to a previous
298#               event, where -1 is the most recent event.
299#               A string can be matched, either by being the prefix of
300#               a command or by matching a command with string match.
301#
302# Results:
303#       The index into history, or an error if the index didn't match.
304
305 proc tcl::HistIndex {event} {
306    variable history
307    if {[catch {expr {~$event}}]} {
308        for {set i [expr {$history(nextid)-1}]} {[info exists history($i)]} \
309                {incr i -1} {
310            if {[string match $event* $history($i)]} {
311                return $i;
312            }
313            if {[string match $event $history($i)]} {
314                return $i;
315            }
316        }
317        return -code error "no event matches \"$event\""
318    } elseif {$event <= 0} {
319        set i [expr {$history(nextid) + $event}]
320    } else {
321        set i $event
322    }
323    if {$i <= $history(oldest)} {
324        return -code error "event \"$event\" is too far in the past"
325    }
326    if {$i > $history(nextid)} {
327        return -code error "event \"$event\" hasn't occured yet"
328    }
329    return $i
330}
331
332# tcl::HistEvent --
333#
334#       Map from an event specifier to the value in the history list.
335#
336# Parameters:
337#       event   index of history item to redo.  See index for a
338#               description of possible event patterns.
339#
340# Results:
341#       The value from the history list.
342
343 proc tcl::HistEvent {event} {
344    variable history
345    set i [HistIndex $event]
346    if {[info exists history($i)]} {
347        return [string trimright $history($i) \ \n]
348    } else {
349        return "";
350    }
351}
352
353# tcl::HistChange --
354#
355#       Replace a value in the history list.
356#
357# Parameters:
358#       cmd     The new value to put into the history list.
359#       event   (optional) index of history item to redo.  See index for a
360#               description of possible event patterns.  This defaults
361#               to 0, which specifies the current event.
362#
363# Side Effects:
364#       Changes the history list.
365
366 proc tcl::HistChange {cmd {event 0}} {
367    variable history
368    set i [HistIndex $event]
369    set history($i) $cmd
370}
Note: See TracBrowser for help on using the repository browser.