summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tltcl/lib/tcl8.6/history.tcl
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tltcl/lib/tcl8.6/history.tcl')
-rw-r--r--Master/tlpkg/tltcl/lib/tcl8.6/history.tcl335
1 files changed, 335 insertions, 0 deletions
diff --git a/Master/tlpkg/tltcl/lib/tcl8.6/history.tcl b/Master/tlpkg/tltcl/lib/tcl8.6/history.tcl
new file mode 100644
index 00000000000..ef9099be5b6
--- /dev/null
+++ b/Master/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: