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