# history.tcl -- # # Implementation of the history command. # # RCS: @(#) $Id: history.tcl,v 1.5 2001/05/17 08:18:56 hobbs Exp $ # # 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 } } } # history -- # # This is the main history command. See the man page for its interface. # This does argument checking and calls helper procedures in the # history namespace. proc history {args} { set len [llength $args] if {$len == 0} { return [tcl::HistInfo] } set key [lindex $args 0] set options "add, change, clear, event, info, keep, nextid, or redo" switch -glob -- $key { a* { # history add if {$len > 3} { return -code error "wrong # args: should be \"history add event ?exec?\"" } if {![string match $key* add]} { return -code error "bad option \"$key\": must be $options" } if {$len == 3} { set arg [lindex $args 2] if {! ([string match e* $arg] && [string match $arg* exec])} { return -code error "bad argument \"$arg\": should be \"exec\"" } } return [tcl::HistAdd [lindex $args 1] [lindex $args 2]] } ch* { # history change if {($len > 3) || ($len < 2)} { return -code error "wrong # args: should be \"history change newValue ?event?\"" } if {![string match $key* change]} { return -code error "bad option \"$key\": must be $options" } if {$len == 2} { set event 0 } else { set event [lindex $args 2] } return [tcl::HistChange [lindex $args 1] $event] } cl* { # history clear if {($len > 1)} { return -code error "wrong # args: should be \"history clear\"" } if {![string match $key* clear]} { return -code error "bad option \"$key\": must be $options" } return [tcl::HistClear] } e* { # history event if {$len > 2} { return -code error "wrong # args: should be \"history event ?event?\"" } if {![string match $key* event]} { return -code error "bad option \"$key\": must be $options" } if {$len == 1} { set event -1 } else { set event [lindex $args 1] } return [tcl::HistEvent $event] } i* { # history info if {$len > 2} { return -code error "wrong # args: should be \"history info ?count?\"" } if {![string match $key* info]} { return -code error "bad option \"$key\": must be $options" } return [tcl::HistInfo [lindex $args 1]] } k* { # history keep if {$len > 2} { return -code error "wrong # args: should be \"history keep ?count?\"" } if {$len == 1} { return [tcl::HistKeep] } else { set limit [lindex $args 1] if {[catch {expr {~$limit}}] || ($limit < 0)} { return -code error "illegal keep count \"$limit\"" } return [tcl::HistKeep $limit] } } n* { # history nextid if {$len > 1} { return -code error "wrong # args: should be \"history nextid\"" } if {![string match $key* nextid]} { return -code error "bad option \"$key\": must be $options" } return [expr {$tcl::history(nextid) + 1}] } r* { # history redo if {$len > 2} { return -code error "wrong # args: should be \"history redo ?event?\"" } if {![string match $key* redo]} { return -code error "bad option \"$key\": must be $options" } return [tcl::HistRedo [lindex $args 1]] } default { return -code error "bad option \"$key\": must be $options" } } } # tcl::HistAdd -- # # Add an item to the history, and optionally eval it at the global scope # # Parameters: # command 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 {command {exec {}}} { variable history # Do not add empty commands to the history if {[string trim $command] == ""} { return "" } set i [incr history(nextid)] set history($i) $command set j [incr history(oldest)] if {[info exists history($j)]} {unset history($j)} if {[string match e* $exec]} { return [uplevel #0 $command] } else { return {} } } # 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 {{limit {}}} { variable history if {[string length $limit] == 0} { return $history(keep) } else { set oldold $history(oldest) set history(oldest) [expr {$history(nextid) - $limit}] for {} {$oldold if {[info exists history($oldold)]} {unset history($oldold)} } set history(keep) $limit } } # 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 {{num {}}} { variable history if {$num == {}} { set num [expr {$history(keep) + 1}] } set result {} set newline "" for {set i [expr {$history(nextid) - $num + 1}]} \ {$i if {![info exists history($i)]} { continue } set cmd [string trimright $history($i) \ \n] regsub -all \n $cmd "\n\t" cmd 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 if {[string length $event] == 0} { set event -1 } set i [HistIndex $event] if {$i == $history(nextid)} { return -code error "cannot redo the current event" } set cmd $history($i) HistChange $cmd 0 uplevel #0 $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 {[catch {expr {~$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 set i [expr {$history(nextid) + $event}] } else { set i $event } if {$i 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} { variable history set i [HistIndex $event] if {[info exists history($i)]} { return [string trimright $history($i) \ \n] } else { return ""; } } # tcl::HistChange -- # # Replace a value in the history list. # # Parameters: # cmd 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 {cmd {event 0}} { variable history set i [HistIndex $event] set history($i) $cmd }
