Commit | Line | Data |
---|---|---|
920dae64 AT |
1 | # history.tcl -- |
2 | # | |
3 | # Implementation of the history command. | |
4 | # | |
5 | # RCS: @(#) $Id: history.tcl,v 1.5 2001/05/17 08:18:56 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 | ||
20 | namespace 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 | ||
37 | proc 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 | ||
170 | # Do not add empty commands to the history | |
171 | if {[string trim $command] == ""} { | |
172 | return "" | |
173 | } | |
174 | ||
175 | set i [incr history(nextid)] | |
176 | set history($i) $command | |
177 | set j [incr history(oldest)] | |
178 | if {[info exists history($j)]} {unset history($j)} | |
179 | if {[string match e* $exec]} { | |
180 | return [uplevel #0 $command] | |
181 | } else { | |
182 | return {} | |
183 | } | |
184 | } | |
185 | ||
186 | # tcl::HistKeep -- | |
187 | # | |
188 | # Set or query the limit on the length of the history list | |
189 | # | |
190 | # Parameters: | |
191 | # limit (optional) the length of the history list | |
192 | # | |
193 | # Results: | |
194 | # If no limit is specified, the current limit is returned | |
195 | # | |
196 | # Side Effects: | |
197 | # Updates history(keep) if a limit is specified | |
198 | ||
199 | proc tcl::HistKeep {{limit {}}} { | |
200 | variable history | |
201 | if {[string length $limit] == 0} { | |
202 | return $history(keep) | |
203 | } else { | |
204 | set oldold $history(oldest) | |
205 | set history(oldest) [expr {$history(nextid) - $limit}] | |
206 | for {} {$oldold <= $history(oldest)} {incr oldold} { | |
207 | if {[info exists history($oldold)]} {unset history($oldold)} | |
208 | } | |
209 | set history(keep) $limit | |
210 | } | |
211 | } | |
212 | ||
213 | # tcl::HistClear -- | |
214 | # | |
215 | # Erase the history list | |
216 | # | |
217 | # Parameters: | |
218 | # none | |
219 | # | |
220 | # Results: | |
221 | # none | |
222 | # | |
223 | # Side Effects: | |
224 | # Resets the history array, except for the keep limit | |
225 | ||
226 | proc tcl::HistClear {} { | |
227 | variable history | |
228 | set keep $history(keep) | |
229 | unset history | |
230 | array set history [list \ | |
231 | nextid 0 \ | |
232 | keep $keep \ | |
233 | oldest -$keep \ | |
234 | ] | |
235 | } | |
236 | ||
237 | # tcl::HistInfo -- | |
238 | # | |
239 | # Return a pretty-printed version of the history list | |
240 | # | |
241 | # Parameters: | |
242 | # num (optional) the length of the history list to return | |
243 | # | |
244 | # Results: | |
245 | # A formatted history list | |
246 | ||
247 | proc tcl::HistInfo {{num {}}} { | |
248 | variable history | |
249 | if {$num == {}} { | |
250 | set num [expr {$history(keep) + 1}] | |
251 | } | |
252 | set result {} | |
253 | set newline "" | |
254 | for {set i [expr {$history(nextid) - $num + 1}]} \ | |
255 | {$i <= $history(nextid)} {incr i} { | |
256 | if {![info exists history($i)]} { | |
257 | continue | |
258 | } | |
259 | set cmd [string trimright $history($i) \ \n] | |
260 | regsub -all \n $cmd "\n\t" cmd | |
261 | append result $newline[format "%6d %s" $i $cmd] | |
262 | set newline \n | |
263 | } | |
264 | return $result | |
265 | } | |
266 | ||
267 | # tcl::HistRedo -- | |
268 | # | |
269 | # Fetch the previous or specified event, execute it, and then | |
270 | # replace the current history item with that event. | |
271 | # | |
272 | # Parameters: | |
273 | # event (optional) index of history item to redo. Defaults to -1, | |
274 | # which means the previous event. | |
275 | # | |
276 | # Results: | |
277 | # Those of the command being redone. | |
278 | # | |
279 | # Side Effects: | |
280 | # Replaces the current history list item with the one being redone. | |
281 | ||
282 | proc tcl::HistRedo {{event -1}} { | |
283 | variable history | |
284 | if {[string length $event] == 0} { | |
285 | set event -1 | |
286 | } | |
287 | set i [HistIndex $event] | |
288 | if {$i == $history(nextid)} { | |
289 | return -code error "cannot redo the current event" | |
290 | } | |
291 | set cmd $history($i) | |
292 | HistChange $cmd 0 | |
293 | uplevel #0 $cmd | |
294 | } | |
295 | ||
296 | # tcl::HistIndex -- | |
297 | # | |
298 | # Map from an event specifier to an index in the history list. | |
299 | # | |
300 | # Parameters: | |
301 | # event index of history item to redo. | |
302 | # If this is a positive number, it is used directly. | |
303 | # If it is a negative number, then it counts back to a previous | |
304 | # event, where -1 is the most recent event. | |
305 | # A string can be matched, either by being the prefix of | |
306 | # a command or by matching a command with string match. | |
307 | # | |
308 | # Results: | |
309 | # The index into history, or an error if the index didn't match. | |
310 | ||
311 | proc tcl::HistIndex {event} { | |
312 | variable history | |
313 | if {[catch {expr {~$event}}]} { | |
314 | for {set i [expr {$history(nextid)-1}]} {[info exists history($i)]} \ | |
315 | {incr i -1} { | |
316 | if {[string match $event* $history($i)]} { | |
317 | return $i; | |
318 | } | |
319 | if {[string match $event $history($i)]} { | |
320 | return $i; | |
321 | } | |
322 | } | |
323 | return -code error "no event matches \"$event\"" | |
324 | } elseif {$event <= 0} { | |
325 | set i [expr {$history(nextid) + $event}] | |
326 | } else { | |
327 | set i $event | |
328 | } | |
329 | if {$i <= $history(oldest)} { | |
330 | return -code error "event \"$event\" is too far in the past" | |
331 | } | |
332 | if {$i > $history(nextid)} { | |
333 | return -code error "event \"$event\" hasn't occured yet" | |
334 | } | |
335 | return $i | |
336 | } | |
337 | ||
338 | # tcl::HistEvent -- | |
339 | # | |
340 | # Map from an event specifier to the value in the history list. | |
341 | # | |
342 | # Parameters: | |
343 | # event index of history item to redo. See index for a | |
344 | # description of possible event patterns. | |
345 | # | |
346 | # Results: | |
347 | # The value from the history list. | |
348 | ||
349 | proc tcl::HistEvent {event} { | |
350 | variable history | |
351 | set i [HistIndex $event] | |
352 | if {[info exists history($i)]} { | |
353 | return [string trimright $history($i) \ \n] | |
354 | } else { | |
355 | return ""; | |
356 | } | |
357 | } | |
358 | ||
359 | # tcl::HistChange -- | |
360 | # | |
361 | # Replace a value in the history list. | |
362 | # | |
363 | # Parameters: | |
364 | # cmd The new value to put into the history list. | |
365 | # event (optional) index of history item to redo. See index for a | |
366 | # description of possible event patterns. This defaults | |
367 | # to 0, which specifies the current event. | |
368 | # | |
369 | # Side Effects: | |
370 | # Changes the history list. | |
371 | ||
372 | proc tcl::HistChange {cmd {event 0}} { | |
373 | variable history | |
374 | set i [HistIndex $event] | |
375 | set history($i) $cmd | |
376 | } |