This repository has been archived on 2024-08-20. You can view files and clone it, but cannot push or open issues or pull requests.
BiblioMxWeb/windowsAgent/dist/tcl/history.tcl
2021-06-17 01:31:27 +02:00

336 lines
7.7 KiB
Tcl
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

# history.tcl --
#
# Implementation of the history command.
#
# 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
}
}
namespace ensemble create -command ::tcl::history -map {
add ::tcl::HistAdd
change ::tcl::HistChange
clear ::tcl::HistClear
event ::tcl::HistEvent
info ::tcl::HistInfo
keep ::tcl::HistKeep
nextid ::tcl::HistNextID
redo ::tcl::HistRedo
}
}
# history --
#
# This is the main history command. See the man page for its interface.
# This does some argument checking and calls the helper ensemble in the
# tcl namespace.
proc ::history {args} {
# If no command given, we're doing 'history info'. Can't be done with an
# ensemble unknown handler, as those don't fire when no subcommand is
# given at all.
if {![llength $args]} {
set args info
}
# Tricky stuff needed to make stack and errors come out right!
tailcall apply {arglist {tailcall history {*}$arglist} ::tcl} $args
}
# (unnamed) --
#
# Callback when [::history] is destroyed. Destroys the implementation.
#
# Parameters:
# oldName what the command was called.
# newName what the command is now called (an empty string).
# op the operation (= delete).
#
# Results:
# none
#
# Side Effects:
# The implementation of the [::history] command ceases to exist.
trace add command ::history delete [list apply {{oldName newName op} {
variable history
unset -nocomplain history
foreach c [info procs ::tcl::Hist*] {
rename $c {}
}
rename ::tcl::history {}
} ::tcl}]
# tcl::HistAdd --
#
# Add an item to the history, and optionally eval it at the global scope
#
# Parameters:
# event 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 {event {exec {}}} {
variable history
if {
[prefix longest {exec {}} $exec] eq ""
&& [llength [info level 0]] == 3
} then {
return -code error "bad argument \"$exec\": should be \"exec\""
}
# Do not add empty commands to the history
if {[string trim $event] eq ""} {
return ""
}
# Maintain the history
set history([incr history(nextid)]) $event
unset -nocomplain history([incr history(oldest)])
# Only execute if 'exec' (or non-empty prefix of it) given
if {$exec eq ""} {
return ""
}
tailcall eval $event
}
# 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 {{count {}}} {
variable history
if {[llength [info level 0]] == 1} {
return $history(keep)
}
if {![string is integer -strict $count] || ($count < 0)} {
return -code error "illegal keep count \"$count\""
}
set oldold $history(oldest)
set history(oldest) [expr {$history(nextid) - $count}]
for {} {$oldold <= $history(oldest)} {incr oldold} {
unset -nocomplain history($oldold)
}
set history(keep) $count
}
# 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 {{count {}}} {
variable history
if {[llength [info level 0]] == 1} {
set count [expr {$history(keep) + 1}]
} elseif {![string is integer -strict $count]} {
return -code error "bad integer \"$count\""
}
set result {}
set newline ""
for {set i [expr {$history(nextid) - $count + 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
set i [HistIndex $event]
if {$i == $history(nextid)} {
return -code error "cannot redo the current event"
}
set cmd $history($i)
HistChange $cmd 0
tailcall eval $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 {![string is integer -strict $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 -1}} {
variable history
set i [HistIndex $event]
if {![info exists history($i)]} {
return ""
}
return [string trimright $history($i) \ \n]
}
# tcl::HistChange --
#
# Replace a value in the history list.
#
# Parameters:
# newValue 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 {newValue {event 0}} {
variable history
set i [HistIndex $event]
set history($i) $newValue
}
# tcl::HistNextID --
#
# Returns the number of the next history event.
#
# Parameters:
# None.
#
# Side Effects:
# None.
proc ::tcl::HistNextID {} {
variable history
return [expr {$history(nextid) + 1}]
}
return
# Local Variables:
# mode: tcl
# fill-column: 78
# End: