# Implementation of the history command.
# RCS: @(#) $Id: history.tcl,v 1.5 2001/05/17 08:18:56 hobbs Exp $
# Copyright (c) 1997 Sun Microsystems, Inc.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
# The tcl::history array holds the history list and
# some additional bookkeeping variables.
# nextid the index used for the next history list item.
# keep the max size of the history list
# oldest the index of the oldest item in the history.
if {![info exists
history]} {
# This is the main history command. See the man page for its interface.
# This does argument checking and calls helper procedures in the
set options "add, change, clear, event, info, keep, nextid, or redo"
return -code error "wrong # args: should be \"history add event ?exec?\""
if {![string match
$key* add
]} {
return -code error "bad option \"$key\": must be $options"
if {! ([string match e
* $arg] && [string match
$arg* exec])} {
return -code error "bad argument \"$arg\": should be \"exec\""
return [tcl
::HistAdd [lindex $args 1] [lindex $args 2]]
if {($len > 3) ||
($len < 2)} {
return -code error "wrong # args: should be \"history change newValue ?event?\""
if {![string match
$key* change
]} {
return -code error "bad option \"$key\": must be $options"
set event [lindex $args 2]
return [tcl
::HistChange [lindex $args 1] $event]
return -code error "wrong # args: should be \"history clear\""
if {![string match
$key* clear
]} {
return -code error "bad option \"$key\": must be $options"
return -code error "wrong # args: should be \"history event ?event?\""
if {![string match
$key* event]} {
return -code error "bad option \"$key\": must be $options"
set event [lindex $args 1]
return [tcl
::HistEvent $event]
return -code error "wrong # args: should be \"history info ?count?\""
if {![string match
$key* info]} {
return -code error "bad option \"$key\": must be $options"
return [tcl
::HistInfo [lindex $args 1]]
return -code error "wrong # args: should be \"history keep ?count?\""
set limit
[lindex $args 1]
if {[catch {expr {~
$limit}}] ||
($limit < 0)} {
return -code error "illegal keep count \"$limit\""
return [tcl
::HistKeep $limit]
return -code error "wrong # args: should be \"history nextid\""
if {![string match
$key* nextid
]} {
return -code error "bad option \"$key\": must be $options"
return [expr {$tcl::history(nextid
) + 1}]
return -code error "wrong # args: should be \"history redo ?event?\""
if {![string match
$key* redo
]} {
return -code error "bad option \"$key\": must be $options"
return [tcl
::HistRedo [lindex $args 1]]
return -code error "bad option \"$key\": must be $options"
# Add an item to the history, and optionally eval it at the global scope
# command the command to add
# exec (optional) a substring of "exec" causes the
# If executing, then the results of the command are returned
# Adds to the history list
proc tcl
::HistAdd {command
{exec {}}} {
# Do not add empty commands to the history
if {[string trim
$command] == ""} {
set i
[incr history(nextid
)]
set j
[incr history(oldest
)]
if {[info exists
history($j)]} {unset history($j)}
if {[string match e
* $exec]} {
return [uplevel #0 $command]
# Set or query the limit on the length of the history list
# limit (optional) the length of the history list
# If no limit is specified, the current limit is returned
# Updates history(keep) if a limit is specified
proc tcl
::HistKeep {{limit
{}}} {
if {[string length
$limit] == 0} {
set oldold
$history(oldest
)
set history(oldest
) [expr {$history(nextid
) - $limit}]
for {} {$oldold <= $history(oldest
)} {incr oldold
} {
if {[info exists
history($oldold)]} {unset history($oldold)}
# Resets the history array, except for the keep limit
array set history [list \
# Return a pretty-printed version of the history list
# num (optional) the length of the history list to return
# A formatted history list
proc tcl
::HistInfo {{num
{}}} {
set num
[expr {$history(keep
) + 1}]
for {set i
[expr {$history(nextid
) - $num + 1}]} \
{$i <= $history(nextid
)} {incr i
} {
if {![info exists
history($i)]} {
set cmd
[string trimright
$history($i) \ \n]
regsub -all \n $cmd "\n\t" cmd
append result
$newline[format "%6d %s" $i $cmd]
# Fetch the previous or specified event, execute it, and then
# replace the current history item with that event.
# event (optional) index of history item to redo. Defaults to -1,
# which means the previous event.
# Those of the command being redone.
# Replaces the current history list item with the one being redone.
proc tcl
::HistRedo {{event -1}} {
if {[string length
$event] == 0} {
if {$i == $history(nextid
)} {
return -code error "cannot redo the current event"
# Map from an event specifier to an index in the history list.
# event index of history item to redo.
# If this is a positive number, it is used directly.
# If it is a negative number, then it counts back to a previous
# event, where -1 is the most recent event.
# A string can be matched, either by being the prefix of
# a command or by matching a command with string match.
# The index into history, or an error if the index didn't match.
proc tcl
::HistIndex {event} {
if {[catch {expr {~
$event}}]} {
for {set i
[expr {$history(nextid
)-1}]} {[info exists
history($i)]} \
if {[string match
$event* $history($i)]} {
if {[string match
$event $history($i)]} {
return -code error "no event matches \"$event\""
set i
[expr {$history(nextid
) + $event}]
if {$i <= $history(oldest
)} {
return -code error "event \"$event\" is too far in the past"
if {$i > $history(nextid
)} {
return -code error "event \"$event\" hasn't occured yet"
# Map from an event specifier to the value in the history list.
# event index of history item to redo. See index for a
# description of possible event patterns.
# The value from the history list.
proc tcl
::HistEvent {event} {
if {[info exists
history($i)]} {
return [string trimright
$history($i) \ \n]
# Replace a value in the history list.
# cmd The new value to put into the history list.
# event (optional) index of history item to redo. See index for a
# description of possible event patterns. This defaults
# to 0, which specifies the current event.
# Changes the history list.
proc tcl
::HistChange {cmd
{event 0}} {