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