history.tcl –

Implementation of the history command.

RCS: @(#) $Id: history.tcl,v 1.5.14.1 2005/07/22 21:59:40 dgp 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.

namespace eval tcl {
variable history
if {![info exists history]} {
array set history {
nextid 0
keep 20
oldest -20
}
}
}

history –

This is the main history command. See the man page for its interface.

This does argument checking and calls helper procedures in the

history namespace.

proc history {args} {
set len [llength args] if {len == 0} {
return [tcl::HistInfo]
}
set key [lindex $args 0]
set options “add, change, clear, event, info, keep, nextid, or redo”
switch -glob – $key {
a* { # history add

    if {$len > 3} {
	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 {$len == 3} {
	set arg [lindex $args 2]
	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]]
}
ch* { # history change

    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"
    }
    if {$len == 2} {
	set event 0
    } else {
	set event [lindex $args 2]
    }

    return [tcl::HistChange [lindex $args 1] $event]
}
cl* { # history clear

    if {($len > 1)} {
	return -code error "wrong # args: should be \"history clear\""
    }
    if {![string match $key* clear]} {
	return -code error "bad option \"$key\": must be $options"
    }
    return [tcl::HistClear]
}
e* { # history event

    if {$len > 2} {
	return -code error "wrong # args: should be \"history event ?event?\""
    }
    if {![string match $key* event]} {
	return -code error "bad option \"$key\": must be $options"
    }
    if {$len == 1} {
	set event -1
    } else {
	set event [lindex $args 1]
    }
    return [tcl::HistEvent $event]
}
i* { # history info

    if {$len > 2} {
	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]]
}
k* { # history keep

    if {$len > 2} {
	return -code error "wrong # args: should be \"history keep ?count?\""
    }
    if {$len == 1} {
	return [tcl::HistKeep]
    } else {
	set limit [lindex $args 1]
	if {[catch {expr {~$limit}}] || ($limit < 0)} {
	    return -code error "illegal keep count \"$limit\""
	}
	return [tcl::HistKeep $limit]
    }
}
n* { # history nextid

    if {$len > 1} {
	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}]
}
r* { # history redo

    if {$len > 2} {
	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]]
}
default {
    return -code error "bad option \"$key\": must be $options"
}
}

}

tcl::HistAdd –

Add an item to the history, and optionally eval it at the global scope

Parameters:

command the command to add

exec (optional) a substring of “exec” causes the

command to be evaled.

Results:

If executing, then the results of the command are returned

Side Effects:

Adds to the history list

proc tcl::HistAdd {command {exec {}}} {
variable history

# Do not add empty commands to the history
if {[string trim $command] eq ""} {
return ""
}

set i [incr history(nextid)]
set history($i) $command
set j [incr history(oldest)]
unset -nocomplain history($j)
if {[string match e* $exec]} {
return [uplevel #0 $command]
} else {
return {}
}

}

tcl::HistKeep –

Set or query the limit on the length of the history list

Parameters:

limit (optional) the length of the history list

Results:

If no limit is specified, the current limit is returned

Side Effects:

Updates history(keep) if a limit is specified

proc tcl::HistKeep {{limit {}}} {
variable history
if {$limit eq “”} {
return $history(keep)
} else {
set oldold history(oldest) set history(oldest) [expr {history(nextid) - limit}] for {} {oldold <= history(oldest)} {incr oldold} { unset -nocomplain history(oldold)
}
set history(keep) $limit
}
}

tcl::HistClear –

Erase the history list

Parameters:

none

Results:

none

Side Effects:

Resets the history array, except for the keep limit

proc tcl::HistClear {} {
variable history
set keep $history(keep)
unset history
array set history [list
nextid 0
keep keep \ oldest -keep
]
}

tcl::HistInfo –

Return a pretty-printed version of the history list

Parameters:

num (optional) the length of the history list to return

Results:

A formatted history list

proc tcl::HistInfo {{num {}}} {
variable history
if {num eq ""} { set num [expr {history(keep) + 1}]
}
set result {}
set newline “”
for {set i [expr {$history(nextid) - num + 1}]} \ {i <= history(nextid)} {incr i} { if {![info exists history(i)]} {
continue
}
set cmd [string map [list \n \n\t] [string trimright history(i) \ \n]]
append result $newline[format “%6d %s” $i $cmd]
set newline \n
}
return $result
}

tcl::HistRedo –

Fetch the previous or specified event, execute it, and then

replace the current history item with that event.

Parameters:

event (optional) index of history item to redo. Defaults to -1,

which means the previous event.

Results:

Those of the command being redone.

Side Effects:

Replaces the current history list item with the one being redone.

proc tcl::HistRedo {{event -1}} {
variable history
if {$event eq “”} {
set event -1
}
set i [HistIndex event] if {i == $history(nextid)} {
return -code error “cannot redo the current event”
}
set cmd history(i)
HistChange $cmd 0
uplevel #0 $cmd
}

tcl::HistIndex –

Map from an event specifier to an index in the history list.

Parameters:

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.

Results:

The index into history, or an error if the index didn’t match.

proc tcl::HistIndex {event} {
variable history
if {[catch {expr {~event}}]} { for {set i [expr {history(nextid)-1}]} {[info exists history($i)]}
{incr i -1} {
if {[string match $event* history(i)]} {
return $i;
}
if {[string match $event history(i)]} {
return i; } } return -code error "no event matches \"event"”
} elseif {event <= 0} { set i [expr {history(nextid) + $event}]
} else {
set i 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”
}
return $i
}

tcl::HistEvent –

Map from an event specifier to the value in the history list.

Parameters:

event index of history item to redo. See index for a

description of possible event patterns.

Results:

The value from the history list.

proc tcl::HistEvent {event} {
variable history
set i [HistIndex event] if {[info exists history(i)]} {
return [string trimright history(i) \ \n]
} else {
return “”;
}
}

tcl::HistChange –

Replace a value in the history list.

Parameters:

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.

Side Effects:

Changes the history list.

proc tcl::HistChange {cmd {event 0}} {
variable history
set i [HistIndex event] set history(i) $cmd
}