3 # Implementation of the history command.
5 # RCS: @(#) $Id: history.tcl,v 1.7 2005/07/23 04:12:49 dgp Exp $
7 # Copyright (c) 1997 Sun Microsystems, Inc.
9 # See the file "license.terms" for information on usage and redistribution
10 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
13 # The tcl::history array holds the history list and
14 # some additional bookkeeping variables.
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.
22 if {![info exists
history]} {
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
38 set len
[llength $args]
40 return [tcl
::HistInfo]
42 set key
[lindex $args 0]
43 set options "add, change, clear, event, info, keep, nextid, or redo"
44 switch -glob -- $key {
48 return -code error "wrong # args: should be \"history add event ?exec?\""
50 if {![string match
$key* add
]} {
51 return -code error "bad option \"$key\": must be $options"
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\""
59 return [tcl
::HistAdd [lindex $args 1] [lindex $args 2]]
61 ch
* { # history change
63 if {($len > 3) ||
($len < 2)} {
64 return -code error "wrong # args: should be \"history change newValue ?event?\""
66 if {![string match
$key* change
]} {
67 return -code error "bad option \"$key\": must be $options"
72 set event [lindex $args 2]
75 return [tcl
::HistChange [lindex $args 1] $event]
80 return -code error "wrong # args: should be \"history clear\""
82 if {![string match
$key* clear
]} {
83 return -code error "bad option \"$key\": must be $options"
85 return [tcl
::HistClear]
90 return -code error "wrong # args: should be \"history event ?event?\""
92 if {![string match
$key* event]} {
93 return -code error "bad option \"$key\": must be $options"
98 set event [lindex $args 1]
100 return [tcl
::HistEvent $event]
105 return -code error "wrong # args: should be \"history info ?count?\""
107 if {![string match
$key* info]} {
108 return -code error "bad option \"$key\": must be $options"
110 return [tcl
::HistInfo [lindex $args 1]]
115 return -code error "wrong # args: should be \"history keep ?count?\""
118 return [tcl
::HistKeep]
120 set limit
[lindex $args 1]
121 if {[catch {expr {~
$limit}}] ||
($limit < 0)} {
122 return -code error "illegal keep count \"$limit\""
124 return [tcl
::HistKeep $limit]
127 n
* { # history nextid
130 return -code error "wrong # args: should be \"history nextid\""
132 if {![string match
$key* nextid
]} {
133 return -code error "bad option \"$key\": must be $options"
135 return [expr {$tcl::history(nextid
) + 1}]
140 return -code error "wrong # args: should be \"history redo ?event?\""
142 if {![string match
$key* redo
]} {
143 return -code error "bad option \"$key\": must be $options"
145 return [tcl
::HistRedo [lindex $args 1]]
148 return -code error "bad option \"$key\": must be $options"
155 # Add an item to the history, and optionally eval it at the global scope
158 # command the command to add
159 # exec (optional) a substring of "exec" causes the
160 # command to be evaled.
162 # If executing, then the results of the command are returned
165 # Adds to the history list
167 proc tcl
::HistAdd {command
{exec {}}} {
170 # Do not add empty commands to the history
171 if {[string trim
$command] eq
""} {
175 set i
[incr history(nextid
)]
176 set history($i) $command
177 set j
[incr history(oldest
)]
178 unset -nocomplain history($j)
179 if {[string match e
* $exec]} {
180 return [uplevel #0 $command]
188 # Set or query the limit on the length of the history list
191 # limit (optional) the length of the history list
194 # If no limit is specified, the current limit is returned
197 # Updates history(keep) if a limit is specified
199 proc tcl
::HistKeep {{limit
{}}} {
202 return $history(keep
)
204 set oldold
$history(oldest
)
205 set history(oldest
) [expr {$history(nextid
) - $limit}]
206 for {} {$oldold <= $history(oldest
)} {incr oldold
} {
207 unset -nocomplain history($oldold)
209 set history(keep
) $limit
215 # Erase the history list
224 # Resets the history array, except for the keep limit
226 proc tcl
::HistClear {} {
228 set keep
$history(keep
)
230 array set history [list \
239 # Return a pretty-printed version of the history list
242 # num (optional) the length of the history list to return
245 # A formatted history list
247 proc tcl
::HistInfo {{num
{}}} {
250 set num
[expr {$history(keep
) + 1}]
254 for {set i
[expr {$history(nextid
) - $num + 1}]} \
255 {$i <= $history(nextid
)} {incr i
} {
256 if {![info exists
history($i)]} {
259 set cmd
[string map
[list \n \n\t] [string trimright
$history($i) \ \n]]
260 append result
$newline[format "%6d %s" $i $cmd]
268 # Fetch the previous or specified event, execute it, and then
269 # replace the current history item with that event.
272 # event (optional) index of history item to redo. Defaults to -1,
273 # which means the previous event.
276 # Those of the command being redone.
279 # Replaces the current history list item with the one being redone.
281 proc tcl
::HistRedo {{event -1}} {
286 set i
[HistIndex
$event]
287 if {$i == $history(nextid
)} {
288 return -code error "cannot redo the current event"
297 # Map from an event specifier to an index in the history list.
300 # event index of history item to redo.
301 # If this is a positive number, it is used directly.
302 # If it is a negative number, then it counts back to a previous
303 # event, where -1 is the most recent event.
304 # A string can be matched, either by being the prefix of
305 # a command or by matching a command with string match.
308 # The index into history, or an error if the index didn't match.
310 proc tcl
::HistIndex {event} {
312 if {[catch {expr {~
$event}}]} {
313 for {set i
[expr {$history(nextid
)-1}]} {[info exists
history($i)]} \
315 if {[string match
$event* $history($i)]} {
318 if {[string match
$event $history($i)]} {
322 return -code error "no event matches \"$event\""
323 } elseif
{$event <= 0} {
324 set i
[expr {$history(nextid
) + $event}]
328 if {$i <= $history(oldest
)} {
329 return -code error "event \"$event\" is too far in the past"
331 if {$i > $history(nextid
)} {
332 return -code error "event \"$event\" hasn't occured yet"
339 # Map from an event specifier to the value in the history list.
342 # event index of history item to redo. See index for a
343 # description of possible event patterns.
346 # The value from the history list.
348 proc tcl
::HistEvent {event} {
350 set i
[HistIndex
$event]
351 if {[info exists
history($i)]} {
352 return [string trimright
$history($i) \ \n]
360 # Replace a value in the history list.
363 # cmd The new value to put into the history list.
364 # event (optional) index of history item to redo. See index for a
365 # description of possible event patterns. This defaults
366 # to 0, which specifies the current event.
369 # Changes the history list.
371 proc tcl
::HistChange {cmd
{event 0}} {
373 set i
[HistIndex
$event]