# history.tcl --
#
# Implementation of the history command.
#
# RCS: @(#) $Id: history.tcl,v 1.2 2004/10/28 21:58:12 cgregg 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 <= $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 [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
}
