3
# Implementation of the history command.
5
# SCCS: @(#) history.tcl 1.7 97/08/07 16:45:50
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 {}}} {
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]
182
# Set or query the limit on the length of the history list
185
# limit (optional) the length of the history list
188
# If no limit is specified, the current limit is returned
191
# Updates history(keep) if a limit is specified
193
proc tcl::HistKeep {{limit {}}} {
195
if {[string length $limit] == 0} {
196
return $history(keep)
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)}
203
set history(keep) $limit
209
# Erase the history list
218
# Resets the history array, except for the keep limit
220
proc tcl::HistClear {} {
222
set keep $history(keep)
224
array set history [list \
233
# Return a pretty-printed version of the history list
236
# num (optional) the length of the history list to return
239
# A formatted history list
241
proc tcl::HistInfo {{num {}}} {
244
set num [expr $history(keep) + 1]
248
for {set i [expr $history(nextid) - $num + 1]} \
249
{$i <= $history(nextid)} {incr i} {
250
if ![info exists history($i)] {
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]
263
# Fetch the previous or specified event, execute it, and then
264
# replace the current history item with that event.
267
# event (optional) index of history item to redo. Defaults to -1,
268
# which means the previous event.
271
# Those of the command being redone.
274
# Replaces the current history list item with the one being redone.
276
proc tcl::HistRedo {{event -1}} {
278
if {[string length $event] == 0} {
281
set i [HistIndex $event]
282
if {$i == $history(nextid)} {
283
return -code error "cannot redo the current event"
292
# Map from an event specifier to an index in the history list.
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.
303
# The index into history, or an error if the index didn't match.
305
proc tcl::HistIndex {event} {
307
if {[catch {expr $event}]} {
308
for {set i $history(nextid)} {[info exists history($i)]} {incr i -1} {
309
if {[string match $event* $history($i)]} {
312
if {[string match $event $history($i)]} {
316
return -code error "no event matches \"$event\""
317
} elseif {$event <= 0} {
318
set i [expr $history(nextid) + $event]
322
if {$i <= $history(oldest)} {
323
return -code error "event \"$event\" is too far in the past"
325
if {$i > $history(nextid)} {
326
return -code error "event \"$event\" hasn't occured yet"
333
# Map from an event specifier to the value in the history list.
336
# event index of history item to redo. See index for a
337
# description of possible event patterns.
340
# The value from the history list.
342
proc tcl::HistEvent {event} {
344
set i [HistIndex $event]
345
if {[info exists history($i)]} {
346
return [string trimright $history($i) \ \n]
354
# Replace a value in the history list.
357
# cmd The new value to put into the history list.
358
# event (optional) index of history item to redo. See index for a
359
# description of possible event patterns. This defaults
360
# to 0, which specifies the current event.
363
# Changes the history list.
365
proc tcl::HistChange {cmd {event 0}} {
367
set i [HistIndex $event]
added
removed
lib/tcl/history.tcl
