diff options
Diffstat (limited to 'contrib/tcl/library/history.tcl')
| -rw-r--r-- | contrib/tcl/library/history.tcl | 369 |
1 files changed, 0 insertions, 369 deletions
diff --git a/contrib/tcl/library/history.tcl b/contrib/tcl/library/history.tcl deleted file mode 100644 index a6beb438ca37..000000000000 --- a/contrib/tcl/library/history.tcl +++ /dev/null @@ -1,369 +0,0 @@ -# history.tcl -- -# -# Implementation of the history command. -# -# SCCS: @(#) history.tcl 1.7 97/08/07 16:45:50 -# -# 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 - 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 <= $history(oldest)} {incr 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 <= $history(nextid)} {incr 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 $history(nextid)} {[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} { - 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 -} |