diff options
Diffstat (limited to 'systems/texlive/tlnet/tlpkg/tltcl/lib/tcl8.6/history.tcl')
| -rw-r--r-- | systems/texlive/tlnet/tlpkg/tltcl/lib/tcl8.6/history.tcl | 335 |
1 files changed, 335 insertions, 0 deletions
diff --git a/systems/texlive/tlnet/tlpkg/tltcl/lib/tcl8.6/history.tcl b/systems/texlive/tlnet/tlpkg/tltcl/lib/tcl8.6/history.tcl new file mode 100644 index 0000000000..ef9099be5b --- /dev/null +++ b/systems/texlive/tlnet/tlpkg/tltcl/lib/tcl8.6/history.tcl @@ -0,0 +1,335 @@ +# 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: |