Mercurial > repos > rliterman > csp2

comparison CSP2/CSP2_env/env-d9b9114564458d9d-741b3de822f2aaca6c6caa4325c4afce/lib/tcl8.6/history.tcl @ 68:5028fdace37b

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
planemo upload commit 2e9511a184a1ca667c7be0c6321a36dc4e3d116d
author jpayne
date Tue, 18 Mar 2025 16:23:26 -0400
parents
children
comparison
equal deleted inserted replaced
67:0e9998148a16 68:5028fdace37b
1 # history.tcl --
2 #
3 # Implementation of the history command.
4 #
5 # Copyright (c) 1997 Sun Microsystems, Inc.
6 #
7 # See the file "license.terms" for information on usage and redistribution of
8 # this file, and for a DISCLAIMER OF ALL WARRANTIES.
9 #
10
11 # The tcl::history array holds the history list and some additional
12 # bookkeeping variables.
13 #
14 # nextid the index used for the next history list item.
15 # keep the max size of the history list
16 # oldest the index of the oldest item in the history.
17
18 namespace eval ::tcl {
19 variable history
20 if {![info exists history]} {
21 array set history {
22 nextid 0
23 keep 20
24 oldest -20
25 }
26 }
27
28 namespace ensemble create -command ::tcl::history -map {
29 add ::tcl::HistAdd
30 change ::tcl::HistChange
31 clear ::tcl::HistClear
32 event ::tcl::HistEvent
33 info ::tcl::HistInfo
34 keep ::tcl::HistKeep
35 nextid ::tcl::HistNextID
36 redo ::tcl::HistRedo
37 }
38 }
39
40 # history --
41 #
42 # This is the main history command. See the man page for its interface.
43 # This does some argument checking and calls the helper ensemble in the
44 # tcl namespace.
45
46 proc ::history {args} {
47 # If no command given, we're doing 'history info'. Can't be done with an
48 # ensemble unknown handler, as those don't fire when no subcommand is
49 # given at all.
50
51 if {![llength $args]} {
52 set args info
53 }
54
55 # Tricky stuff needed to make stack and errors come out right!
56 tailcall apply {arglist {tailcall history {*}$arglist} ::tcl} $args
57 }
58
59 # (unnamed) --
60 #
61 # Callback when [::history] is destroyed. Destroys the implementation.
62 #
63 # Parameters:
64 # oldName what the command was called.
65 # newName what the command is now called (an empty string).
66 # op the operation (= delete).
67 #
68 # Results:
69 # none
70 #
71 # Side Effects:
72 # The implementation of the [::history] command ceases to exist.
73
74 trace add command ::history delete [list apply {{oldName newName op} {
75 variable history
76 unset -nocomplain history
77 foreach c [info procs ::tcl::Hist*] {
78 rename $c {}
79 }
80 rename ::tcl::history {}
81 } ::tcl}]
82
83 # tcl::HistAdd --
84 #
85 # Add an item to the history, and optionally eval it at the global scope
86 #
87 # Parameters:
88 # event the command to add
89 # exec (optional) a substring of "exec" causes the command to
90 # be evaled.
91 # Results:
92 # If executing, then the results of the command are returned
93 #
94 # Side Effects:
95 # Adds to the history list
96
97 proc ::tcl::HistAdd {event {exec {}}} {
98 variable history
99
100 if {
101 [prefix longest {exec {}} $exec] eq ""
102 && [llength [info level 0]] == 3
103 } then {
104 return -code error "bad argument \"$exec\": should be \"exec\""
105 }
106
107 # Do not add empty commands to the history
108 if {[string trim $event] eq ""} {
109 return ""
110 }
111
112 # Maintain the history
113 set history([incr history(nextid)]) $event
114 unset -nocomplain history([incr history(oldest)])
115
116 # Only execute if 'exec' (or non-empty prefix of it) given
117 if {$exec eq ""} {
118 return ""
119 }
120 tailcall eval $event
121 }
122
123 # tcl::HistKeep --
124 #
125 # Set or query the limit on the length of the history list
126 #
127 # Parameters:
128 # limit (optional) the length of the history list
129 #
130 # Results:
131 # If no limit is specified, the current limit is returned
132 #
133 # Side Effects:
134 # Updates history(keep) if a limit is specified
135
136 proc ::tcl::HistKeep {{count {}}} {
137 variable history
138 if {[llength [info level 0]] == 1} {
139 return $history(keep)
140 }
141 if {![string is integer -strict $count] || ($count < 0)} {
142 return -code error "illegal keep count \"$count\""
143 }
144 set oldold $history(oldest)
145 set history(oldest) [expr {$history(nextid) - $count}]
146 for {} {$oldold <= $history(oldest)} {incr oldold} {
147 unset -nocomplain history($oldold)
148 }
149 set history(keep) $count
150 }
151
152 # tcl::HistClear --
153 #
154 # Erase the history list
155 #
156 # Parameters:
157 # none
158 #
159 # Results:
160 # none
161 #
162 # Side Effects:
163 # Resets the history array, except for the keep limit
164
165 proc ::tcl::HistClear {} {
166 variable history
167 set keep $history(keep)
168 unset history
169 array set history [list \
170 nextid 0 \
171 keep $keep \
172 oldest -$keep \
173 ]
174 }
175
176 # tcl::HistInfo --
177 #
178 # Return a pretty-printed version of the history list
179 #
180 # Parameters:
181 # num (optional) the length of the history list to return
182 #
183 # Results:
184 # A formatted history list
185
186 proc ::tcl::HistInfo {{count {}}} {
187 variable history
188 if {[llength [info level 0]] == 1} {
189 set count [expr {$history(keep) + 1}]
190 } elseif {![string is integer -strict $count]} {
191 return -code error "bad integer \"$count\""
192 }
193 set result {}
194 set newline ""
195 for {set i [expr {$history(nextid) - $count + 1}]} \
196 {$i <= $history(nextid)} {incr i} {
197 if {![info exists history($i)]} {
198 continue
199 }
200 set cmd [string map [list \n \n\t] [string trimright $history($i) \ \n]]
201 append result $newline[format "%6d %s" $i $cmd]
202 set newline \n
203 }
204 return $result
205 }
206
207 # tcl::HistRedo --
208 #
209 # Fetch the previous or specified event, execute it, and then replace
210 # the current history item with that event.
211 #
212 # Parameters:
213 # event (optional) index of history item to redo. Defaults to -1,
214 # which means the previous event.
215 #
216 # Results:
217 # Those of the command being redone.
218 #
219 # Side Effects:
220 # Replaces the current history list item with the one being redone.
221
222 proc ::tcl::HistRedo {{event -1}} {
223 variable history
224
225 set i [HistIndex $event]
226 if {$i == $history(nextid)} {
227 return -code error "cannot redo the current event"
228 }
229 set cmd $history($i)
230 HistChange $cmd 0
231 tailcall eval $cmd
232 }
233
234 # tcl::HistIndex --
235 #
236 # Map from an event specifier to an index in the history list.
237 #
238 # Parameters:
239 # event index of history item to redo.
240 # If this is a positive number, it is used directly.
241 # If it is a negative number, then it counts back to a previous
242 # event, where -1 is the most recent event.
243 # A string can be matched, either by being the prefix of a
244 # command or by matching a command with string match.
245 #
246 # Results:
247 # The index into history, or an error if the index didn't match.
248
249 proc ::tcl::HistIndex {event} {
250 variable history
251 if {![string is integer -strict $event]} {
252 for {set i [expr {$history(nextid)-1}]} {[info exists history($i)]} \
253 {incr i -1} {
254 if {[string match $event* $history($i)]} {
255 return $i
256 }
257 if {[string match $event $history($i)]} {
258 return $i
259 }
260 }
261 return -code error "no event matches \"$event\""
262 } elseif {$event <= 0} {
263 set i [expr {$history(nextid) + $event}]
264 } else {
265 set i $event
266 }
267 if {$i <= $history(oldest)} {
268 return -code error "event \"$event\" is too far in the past"
269 }
270 if {$i > $history(nextid)} {
271 return -code error "event \"$event\" hasn't occured yet"
272 }
273 return $i
274 }
275
276 # tcl::HistEvent --
277 #
278 # Map from an event specifier to the value in the history list.
279 #
280 # Parameters:
281 # event index of history item to redo. See index for a description of
282 # possible event patterns.
283 #
284 # Results:
285 # The value from the history list.
286
287 proc ::tcl::HistEvent {{event -1}} {
288 variable history
289 set i [HistIndex $event]
290 if {![info exists history($i)]} {
291 return ""
292 }
293 return [string trimright $history($i) \ \n]
294 }
295
296 # tcl::HistChange --
297 #
298 # Replace a value in the history list.
299 #
300 # Parameters:
301 # newValue The new value to put into the history list.
302 # event (optional) index of history item to redo. See index for a
303 # description of possible event patterns. This defaults to 0,
304 # which specifies the current event.
305 #
306 # Side Effects:
307 # Changes the history list.
308
309 proc ::tcl::HistChange {newValue {event 0}} {
310 variable history
311 set i [HistIndex $event]
312 set history($i) $newValue
313 }
314
315 # tcl::HistNextID --
316 #
317 # Returns the number of the next history event.
318 #
319 # Parameters:
320 # None.
321 #
322 # Side Effects:
323 # None.
324
325 proc ::tcl::HistNextID {} {
326 variable history
327 return [expr {$history(nextid) + 1}]
328 }
329
330 return
331
332 # Local Variables:
333 # mode: tcl
334 # fill-column: 78
335 # End: