diff CSP2/CSP2_env/env-d9b9114564458d9d-741b3de822f2aaca6c6caa4325c4afce/lib/tcl8.6/history.tcl @ 69:33d812a61356

planemo upload commit 2e9511a184a1ca667c7be0c6321a36dc4e3d116d
author jpayne
date Tue, 18 Mar 2025 17:55:14 -0400
parents
children
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/CSP2/CSP2_env/env-d9b9114564458d9d-741b3de822f2aaca6c6caa4325c4afce/lib/tcl8.6/history.tcl	Tue Mar 18 17:55:14 2025 -0400
@@ -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: