--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/python-2.5.2/win32/tcl/tcl8.4/history.tcl Fri Apr 03 17:19:34 2009 +0100
@@ -0,0 +1,375 @@
+# history.tcl --
+#
+# Implementation of the history command.
+#
+# RCS: @(#) $Id: history.tcl,v 1.5.14.1 2005/07/22 21:59:40 dgp 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] eq ""} {
+ return ""
+ }
+
+ set i [incr history(nextid)]
+ set history($i) $command
+ set j [incr history(oldest)]
+ unset -nocomplain 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 {$limit eq ""} {
+ return $history(keep)
+ } else {
+ set oldold $history(oldest)
+ set history(oldest) [expr {$history(nextid) - $limit}]
+ for {} {$oldold <= $history(oldest)} {incr oldold} {
+ unset -nocomplain 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 eq ""} {
+ 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 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
+ if {$event eq ""} {
+ 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 <= 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
+}