jpayne@68: # history.tcl --
jpayne@68: #
jpayne@68: # Implementation of the history command.
jpayne@68: #
jpayne@68: # Copyright (c) 1997 Sun Microsystems, Inc.
jpayne@68: #
jpayne@68: # See the file "license.terms" for information on usage and redistribution of
jpayne@68: # this file, and for a DISCLAIMER OF ALL WARRANTIES.
jpayne@68: #
jpayne@68: 
jpayne@68: # The tcl::history array holds the history list and some additional
jpayne@68: # bookkeeping variables.
jpayne@68: #
jpayne@68: # nextid	the index used for the next history list item.
jpayne@68: # keep		the max size of the history list
jpayne@68: # oldest	the index of the oldest item in the history.
jpayne@68: 
jpayne@68: namespace eval ::tcl {
jpayne@68:     variable history
jpayne@68:     if {![info exists history]} {
jpayne@68: 	array set history {
jpayne@68: 	    nextid	0
jpayne@68: 	    keep	20
jpayne@68: 	    oldest	-20
jpayne@68: 	}
jpayne@68:     }
jpayne@68: 
jpayne@68:     namespace ensemble create -command ::tcl::history -map {
jpayne@68: 	add	::tcl::HistAdd
jpayne@68: 	change	::tcl::HistChange
jpayne@68: 	clear	::tcl::HistClear
jpayne@68: 	event	::tcl::HistEvent
jpayne@68: 	info	::tcl::HistInfo
jpayne@68: 	keep	::tcl::HistKeep
jpayne@68: 	nextid	::tcl::HistNextID
jpayne@68: 	redo	::tcl::HistRedo
jpayne@68:     }
jpayne@68: }
jpayne@68: 
jpayne@68: # history --
jpayne@68: #
jpayne@68: #	This is the main history command.  See the man page for its interface.
jpayne@68: #	This does some argument checking and calls the helper ensemble in the
jpayne@68: #	tcl namespace.
jpayne@68: 
jpayne@68: proc ::history {args} {
jpayne@68:     # If no command given, we're doing 'history info'. Can't be done with an
jpayne@68:     # ensemble unknown handler, as those don't fire when no subcommand is
jpayne@68:     # given at all.
jpayne@68: 
jpayne@68:     if {![llength $args]} {
jpayne@68: 	set args info
jpayne@68:     }
jpayne@68: 
jpayne@68:     # Tricky stuff needed to make stack and errors come out right!
jpayne@68:     tailcall apply {arglist {tailcall history {*}$arglist} ::tcl} $args
jpayne@68: }
jpayne@68: 
jpayne@68: # (unnamed) --
jpayne@68: #
jpayne@68: #	Callback when [::history] is destroyed. Destroys the implementation.
jpayne@68: #
jpayne@68: # Parameters:
jpayne@68: #	oldName    what the command was called.
jpayne@68: #	newName    what the command is now called (an empty string).
jpayne@68: #	op	   the operation (= delete).
jpayne@68: #
jpayne@68: # Results:
jpayne@68: #	none
jpayne@68: #
jpayne@68: # Side Effects:
jpayne@68: #	The implementation of the [::history] command ceases to exist.
jpayne@68: 
jpayne@68: trace add command ::history delete [list apply {{oldName newName op} {
jpayne@68:     variable history
jpayne@68:     unset -nocomplain history
jpayne@68:     foreach c [info procs ::tcl::Hist*] {
jpayne@68: 	rename $c {}
jpayne@68:     }
jpayne@68:     rename ::tcl::history {}
jpayne@68: } ::tcl}]
jpayne@68: 
jpayne@68: # tcl::HistAdd --
jpayne@68: #
jpayne@68: #	Add an item to the history, and optionally eval it at the global scope
jpayne@68: #
jpayne@68: # Parameters:
jpayne@68: #	event		the command to add
jpayne@68: #	exec		(optional) a substring of "exec" causes the command to
jpayne@68: #			be evaled.
jpayne@68: # Results:
jpayne@68: # 	If executing, then the results of the command are returned
jpayne@68: #
jpayne@68: # Side Effects:
jpayne@68: #	Adds to the history list
jpayne@68: 
jpayne@68: proc ::tcl::HistAdd {event {exec {}}} {
jpayne@68:     variable history
jpayne@68: 
jpayne@68:     if {
jpayne@68: 	[prefix longest {exec {}} $exec] eq ""
jpayne@68: 	&& [llength [info level 0]] == 3
jpayne@68:     } then {
jpayne@68: 	return -code error "bad argument \"$exec\": should be \"exec\""
jpayne@68:     }
jpayne@68: 
jpayne@68:     # Do not add empty commands to the history
jpayne@68:     if {[string trim $event] eq ""} {
jpayne@68: 	return ""
jpayne@68:     }
jpayne@68: 
jpayne@68:     # Maintain the history
jpayne@68:     set history([incr history(nextid)]) $event
jpayne@68:     unset -nocomplain history([incr history(oldest)])
jpayne@68: 
jpayne@68:     # Only execute if 'exec' (or non-empty prefix of it) given
jpayne@68:     if {$exec eq ""} {
jpayne@68: 	return ""
jpayne@68:     }
jpayne@68:     tailcall eval $event
jpayne@68: }
jpayne@68: 
jpayne@68: # tcl::HistKeep --
jpayne@68: #
jpayne@68: #	Set or query the limit on the length of the history list
jpayne@68: #
jpayne@68: # Parameters:
jpayne@68: #	limit	(optional) the length of the history list
jpayne@68: #
jpayne@68: # Results:
jpayne@68: #	If no limit is specified, the current limit is returned
jpayne@68: #
jpayne@68: # Side Effects:
jpayne@68: #	Updates history(keep) if a limit is specified
jpayne@68: 
jpayne@68: proc ::tcl::HistKeep {{count {}}} {
jpayne@68:     variable history
jpayne@68:     if {[llength [info level 0]] == 1} {
jpayne@68: 	return $history(keep)
jpayne@68:     }
jpayne@68:     if {![string is integer -strict $count] || ($count < 0)} {
jpayne@68: 	return -code error "illegal keep count \"$count\""
jpayne@68:     }
jpayne@68:     set oldold $history(oldest)
jpayne@68:     set history(oldest) [expr {$history(nextid) - $count}]
jpayne@68:     for {} {$oldold <= $history(oldest)} {incr oldold} {
jpayne@68: 	unset -nocomplain history($oldold)
jpayne@68:     }
jpayne@68:     set history(keep) $count
jpayne@68: }
jpayne@68: 
jpayne@68: # tcl::HistClear --
jpayne@68: #
jpayne@68: #	Erase the history list
jpayne@68: #
jpayne@68: # Parameters:
jpayne@68: #	none
jpayne@68: #
jpayne@68: # Results:
jpayne@68: #	none
jpayne@68: #
jpayne@68: # Side Effects:
jpayne@68: #	Resets the history array, except for the keep limit
jpayne@68: 
jpayne@68: proc ::tcl::HistClear {} {
jpayne@68:     variable history
jpayne@68:     set keep $history(keep)
jpayne@68:     unset history
jpayne@68:     array set history [list \
jpayne@68: 	nextid	0	\
jpayne@68: 	keep	$keep	\
jpayne@68: 	oldest	-$keep	\
jpayne@68:     ]
jpayne@68: }
jpayne@68: 
jpayne@68: # tcl::HistInfo --
jpayne@68: #
jpayne@68: #	Return a pretty-printed version of the history list
jpayne@68: #
jpayne@68: # Parameters:
jpayne@68: #	num	(optional) the length of the history list to return
jpayne@68: #
jpayne@68: # Results:
jpayne@68: #	A formatted history list
jpayne@68: 
jpayne@68: proc ::tcl::HistInfo {{count {}}} {
jpayne@68:     variable history
jpayne@68:     if {[llength [info level 0]] == 1} {
jpayne@68: 	set count [expr {$history(keep) + 1}]
jpayne@68:     } elseif {![string is integer -strict $count]} {
jpayne@68: 	return -code error "bad integer \"$count\""
jpayne@68:     }
jpayne@68:     set result {}
jpayne@68:     set newline ""
jpayne@68:     for {set i [expr {$history(nextid) - $count + 1}]} \
jpayne@68: 	    {$i <= $history(nextid)} {incr i} {
jpayne@68: 	if {![info exists history($i)]} {
jpayne@68: 	    continue
jpayne@68: 	}
jpayne@68:         set cmd [string map [list \n \n\t] [string trimright $history($i) \ \n]]
jpayne@68: 	append result $newline[format "%6d  %s" $i $cmd]
jpayne@68: 	set newline \n
jpayne@68:     }
jpayne@68:     return $result
jpayne@68: }
jpayne@68: 
jpayne@68: # tcl::HistRedo --
jpayne@68: #
jpayne@68: #	Fetch the previous or specified event, execute it, and then replace
jpayne@68: #	the current history item with that event.
jpayne@68: #
jpayne@68: # Parameters:
jpayne@68: #	event	(optional) index of history item to redo.  Defaults to -1,
jpayne@68: #		which means the previous event.
jpayne@68: #
jpayne@68: # Results:
jpayne@68: #	Those of the command being redone.
jpayne@68: #
jpayne@68: # Side Effects:
jpayne@68: #	Replaces the current history list item with the one being redone.
jpayne@68: 
jpayne@68: proc ::tcl::HistRedo {{event -1}} {
jpayne@68:     variable history
jpayne@68: 
jpayne@68:     set i [HistIndex $event]
jpayne@68:     if {$i == $history(nextid)} {
jpayne@68: 	return -code error "cannot redo the current event"
jpayne@68:     }
jpayne@68:     set cmd $history($i)
jpayne@68:     HistChange $cmd 0
jpayne@68:     tailcall eval $cmd
jpayne@68: }
jpayne@68: 
jpayne@68: # tcl::HistIndex --
jpayne@68: #
jpayne@68: #	Map from an event specifier to an index in the history list.
jpayne@68: #
jpayne@68: # Parameters:
jpayne@68: #	event	index of history item to redo.
jpayne@68: #		If this is a positive number, it is used directly.
jpayne@68: #		If it is a negative number, then it counts back to a previous
jpayne@68: #		event, where -1 is the most recent event.
jpayne@68: #		A string can be matched, either by being the prefix of a
jpayne@68: #		command or by matching a command with string match.
jpayne@68: #
jpayne@68: # Results:
jpayne@68: #	The index into history, or an error if the index didn't match.
jpayne@68: 
jpayne@68: proc ::tcl::HistIndex {event} {
jpayne@68:     variable history
jpayne@68:     if {![string is integer -strict $event]} {
jpayne@68: 	for {set i [expr {$history(nextid)-1}]} {[info exists history($i)]} \
jpayne@68: 		{incr i -1} {
jpayne@68: 	    if {[string match $event* $history($i)]} {
jpayne@68: 		return $i
jpayne@68: 	    }
jpayne@68: 	    if {[string match $event $history($i)]} {
jpayne@68: 		return $i
jpayne@68: 	    }
jpayne@68: 	}
jpayne@68: 	return -code error "no event matches \"$event\""
jpayne@68:     } elseif {$event <= 0} {
jpayne@68: 	set i [expr {$history(nextid) + $event}]
jpayne@68:     } else {
jpayne@68: 	set i $event
jpayne@68:     }
jpayne@68:     if {$i <= $history(oldest)} {
jpayne@68: 	return -code error "event \"$event\" is too far in the past"
jpayne@68:     }
jpayne@68:     if {$i > $history(nextid)} {
jpayne@68: 	return -code error "event \"$event\" hasn't occured yet"
jpayne@68:     }
jpayne@68:     return $i
jpayne@68: }
jpayne@68: 
jpayne@68: # tcl::HistEvent --
jpayne@68: #
jpayne@68: #	Map from an event specifier to the value in the history list.
jpayne@68: #
jpayne@68: # Parameters:
jpayne@68: #	event	index of history item to redo.  See index for a description of
jpayne@68: #		possible event patterns.
jpayne@68: #
jpayne@68: # Results:
jpayne@68: #	The value from the history list.
jpayne@68: 
jpayne@68: proc ::tcl::HistEvent {{event -1}} {
jpayne@68:     variable history
jpayne@68:     set i [HistIndex $event]
jpayne@68:     if {![info exists history($i)]} {
jpayne@68: 	return ""
jpayne@68:     }
jpayne@68:     return [string trimright $history($i) \ \n]
jpayne@68: }
jpayne@68: 
jpayne@68: # tcl::HistChange --
jpayne@68: #
jpayne@68: #	Replace a value in the history list.
jpayne@68: #
jpayne@68: # Parameters:
jpayne@68: #	newValue  The new value to put into the history list.
jpayne@68: #	event	  (optional) index of history item to redo.  See index for a
jpayne@68: #		  description of possible event patterns.  This defaults to 0,
jpayne@68: #		  which specifies the current event.
jpayne@68: #
jpayne@68: # Side Effects:
jpayne@68: #	Changes the history list.
jpayne@68: 
jpayne@68: proc ::tcl::HistChange {newValue {event 0}} {
jpayne@68:     variable history
jpayne@68:     set i [HistIndex $event]
jpayne@68:     set history($i) $newValue
jpayne@68: }
jpayne@68: 
jpayne@68: # tcl::HistNextID --
jpayne@68: #
jpayne@68: #	Returns the number of the next history event.
jpayne@68: #
jpayne@68: # Parameters:
jpayne@68: #	None.
jpayne@68: #
jpayne@68: # Side Effects:
jpayne@68: #	None.
jpayne@68: 
jpayne@68: proc ::tcl::HistNextID {} {
jpayne@68:     variable history
jpayne@68:     return [expr {$history(nextid) + 1}]
jpayne@68: }
jpayne@68: 
jpayne@68: return
jpayne@68: 
jpayne@68: # Local Variables:
jpayne@68: # mode: tcl
jpayne@68: # fill-column: 78
jpayne@68: # End: