figenc

history.tcl (7900B)

---

 # 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: