"Fossies" - the Fresh Open Source Software Archive

Member "install-tl-20200916/tlpkg/tltcl/lib/tcl8.6/history.tcl" (17 Mar 2020, 7900 Bytes) of package /windows/misc/install-tl.zip:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Tcl/Tk source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file.

    1 # history.tcl --
    2 #
    3 # Implementation of the history command.
    4 #
    5 # Copyright (c) 1997 Sun Microsystems, Inc.
    6 #
    7 # See the file "license.terms" for information on usage and redistribution of
    8 # this file, and for a DISCLAIMER OF ALL WARRANTIES.
    9 #
   10 
   11 # The tcl::history array holds the history list and some additional
   12 # bookkeeping variables.
   13 #
   14 # nextid    the index used for the next history list item.
   15 # keep      the max size of the history list
   16 # oldest    the index of the oldest item in the history.
   17 
   18 namespace eval ::tcl {
   19     variable history
   20     if {![info exists history]} {
   21     array set history {
   22         nextid  0
   23         keep    20
   24         oldest  -20
   25     }
   26     }
   27 
   28     namespace ensemble create -command ::tcl::history -map {
   29     add ::tcl::HistAdd
   30     change  ::tcl::HistChange
   31     clear   ::tcl::HistClear
   32     event   ::tcl::HistEvent
   33     info    ::tcl::HistInfo
   34     keep    ::tcl::HistKeep
   35     nextid  ::tcl::HistNextID
   36     redo    ::tcl::HistRedo
   37     }
   38 }
   39 
   40 # history --
   41 #
   42 #   This is the main history command.  See the man page for its interface.
   43 #   This does some argument checking and calls the helper ensemble in the
   44 #   tcl namespace.
   45 
   46 proc ::history {args} {
   47     # If no command given, we're doing 'history info'. Can't be done with an
   48     # ensemble unknown handler, as those don't fire when no subcommand is
   49     # given at all.
   50 
   51     if {![llength $args]} {
   52     set args info
   53     }
   54 
   55     # Tricky stuff needed to make stack and errors come out right!
   56     tailcall apply {arglist {tailcall history {*}$arglist} ::tcl} $args
   57 }
   58 
   59 # (unnamed) --
   60 #
   61 #   Callback when [::history] is destroyed. Destroys the implementation.
   62 #
   63 # Parameters:
   64 #   oldName    what the command was called.
   65 #   newName    what the command is now called (an empty string).
   66 #   op     the operation (= delete).
   67 #
   68 # Results:
   69 #   none
   70 #
   71 # Side Effects:
   72 #   The implementation of the [::history] command ceases to exist.
   73 
   74 trace add command ::history delete [list apply {{oldName newName op} {
   75     variable history
   76     unset -nocomplain history
   77     foreach c [info procs ::tcl::Hist*] {
   78     rename $c {}
   79     }
   80     rename ::tcl::history {}
   81 } ::tcl}]
   82 
   83 # tcl::HistAdd --
   84 #
   85 #   Add an item to the history, and optionally eval it at the global scope
   86 #
   87 # Parameters:
   88 #   event       the command to add
   89 #   exec        (optional) a substring of "exec" causes the command to
   90 #           be evaled.
   91 # Results:
   92 #   If executing, then the results of the command are returned
   93 #
   94 # Side Effects:
   95 #   Adds to the history list
   96 
   97 proc ::tcl::HistAdd {event {exec {}}} {
   98     variable history
   99 
  100     if {
  101     [prefix longest {exec {}} $exec] eq ""
  102     && [llength [info level 0]] == 3
  103     } then {
  104     return -code error "bad argument \"$exec\": should be \"exec\""
  105     }
  106 
  107     # Do not add empty commands to the history
  108     if {[string trim $event] eq ""} {
  109     return ""
  110     }
  111 
  112     # Maintain the history
  113     set history([incr history(nextid)]) $event
  114     unset -nocomplain history([incr history(oldest)])
  115 
  116     # Only execute if 'exec' (or non-empty prefix of it) given
  117     if {$exec eq ""} {
  118     return ""
  119     }
  120     tailcall eval $event
  121 }
  122 
  123 # tcl::HistKeep --
  124 #
  125 #   Set or query the limit on the length of the history list
  126 #
  127 # Parameters:
  128 #   limit   (optional) the length of the history list
  129 #
  130 # Results:
  131 #   If no limit is specified, the current limit is returned
  132 #
  133 # Side Effects:
  134 #   Updates history(keep) if a limit is specified
  135 
  136 proc ::tcl::HistKeep {{count {}}} {
  137     variable history
  138     if {[llength [info level 0]] == 1} {
  139     return $history(keep)
  140     }
  141     if {![string is integer -strict $count] || ($count < 0)} {
  142     return -code error "illegal keep count \"$count\""
  143     }
  144     set oldold $history(oldest)
  145     set history(oldest) [expr {$history(nextid) - $count}]
  146     for {} {$oldold <= $history(oldest)} {incr oldold} {
  147     unset -nocomplain history($oldold)
  148     }
  149     set history(keep) $count
  150 }
  151 
  152 # tcl::HistClear --
  153 #
  154 #   Erase the history list
  155 #
  156 # Parameters:
  157 #   none
  158 #
  159 # Results:
  160 #   none
  161 #
  162 # Side Effects:
  163 #   Resets the history array, except for the keep limit
  164 
  165 proc ::tcl::HistClear {} {
  166     variable history
  167     set keep $history(keep)
  168     unset history
  169     array set history [list \
  170     nextid  0   \
  171     keep    $keep   \
  172     oldest  -$keep  \
  173     ]
  174 }
  175 
  176 # tcl::HistInfo --
  177 #
  178 #   Return a pretty-printed version of the history list
  179 #
  180 # Parameters:
  181 #   num (optional) the length of the history list to return
  182 #
  183 # Results:
  184 #   A formatted history list
  185 
  186 proc ::tcl::HistInfo {{count {}}} {
  187     variable history
  188     if {[llength [info level 0]] == 1} {
  189     set count [expr {$history(keep) + 1}]
  190     } elseif {![string is integer -strict $count]} {
  191     return -code error "bad integer \"$count\""
  192     }
  193     set result {}
  194     set newline ""
  195     for {set i [expr {$history(nextid) - $count + 1}]} \
  196         {$i <= $history(nextid)} {incr i} {
  197     if {![info exists history($i)]} {
  198         continue
  199     }
  200         set cmd [string map [list \n \n\t] [string trimright $history($i) \ \n]]
  201     append result $newline[format "%6d  %s" $i $cmd]
  202     set newline \n
  203     }
  204     return $result
  205 }
  206 
  207 # tcl::HistRedo --
  208 #
  209 #   Fetch the previous or specified event, execute it, and then replace
  210 #   the current history item with that event.
  211 #
  212 # Parameters:
  213 #   event   (optional) index of history item to redo.  Defaults to -1,
  214 #       which means the previous event.
  215 #
  216 # Results:
  217 #   Those of the command being redone.
  218 #
  219 # Side Effects:
  220 #   Replaces the current history list item with the one being redone.
  221 
  222 proc ::tcl::HistRedo {{event -1}} {
  223     variable history
  224 
  225     set i [HistIndex $event]
  226     if {$i == $history(nextid)} {
  227     return -code error "cannot redo the current event"
  228     }
  229     set cmd $history($i)
  230     HistChange $cmd 0
  231     tailcall eval $cmd
  232 }
  233 
  234 # tcl::HistIndex --
  235 #
  236 #   Map from an event specifier to an index in the history list.
  237 #
  238 # Parameters:
  239 #   event   index of history item to redo.
  240 #       If this is a positive number, it is used directly.
  241 #       If it is a negative number, then it counts back to a previous
  242 #       event, where -1 is the most recent event.
  243 #       A string can be matched, either by being the prefix of a
  244 #       command or by matching a command with string match.
  245 #
  246 # Results:
  247 #   The index into history, or an error if the index didn't match.
  248 
  249 proc ::tcl::HistIndex {event} {
  250     variable history
  251     if {![string is integer -strict $event]} {
  252     for {set i [expr {$history(nextid)-1}]} {[info exists history($i)]} \
  253         {incr i -1} {
  254         if {[string match $event* $history($i)]} {
  255         return $i
  256         }
  257         if {[string match $event $history($i)]} {
  258         return $i
  259         }
  260     }
  261     return -code error "no event matches \"$event\""
  262     } elseif {$event <= 0} {
  263     set i [expr {$history(nextid) + $event}]
  264     } else {
  265     set i $event
  266     }
  267     if {$i <= $history(oldest)} {
  268     return -code error "event \"$event\" is too far in the past"
  269     }
  270     if {$i > $history(nextid)} {
  271     return -code error "event \"$event\" hasn't occured yet"
  272     }
  273     return $i
  274 }
  275 
  276 # tcl::HistEvent --
  277 #
  278 #   Map from an event specifier to the value in the history list.
  279 #
  280 # Parameters:
  281 #   event   index of history item to redo.  See index for a description of
  282 #       possible event patterns.
  283 #
  284 # Results:
  285 #   The value from the history list.
  286 
  287 proc ::tcl::HistEvent {{event -1}} {
  288     variable history
  289     set i [HistIndex $event]
  290     if {![info exists history($i)]} {
  291     return ""
  292     }
  293     return [string trimright $history($i) \ \n]
  294 }
  295 
  296 # tcl::HistChange --
  297 #
  298 #   Replace a value in the history list.
  299 #
  300 # Parameters:
  301 #   newValue  The new value to put into the history list.
  302 #   event     (optional) index of history item to redo.  See index for a
  303 #         description of possible event patterns.  This defaults to 0,
  304 #         which specifies the current event.
  305 #
  306 # Side Effects:
  307 #   Changes the history list.
  308 
  309 proc ::tcl::HistChange {newValue {event 0}} {
  310     variable history
  311     set i [HistIndex $event]
  312     set history($i) $newValue
  313 }
  314 
  315 # tcl::HistNextID --
  316 #
  317 #   Returns the number of the next history event.
  318 #
  319 # Parameters:
  320 #   None.
  321 #
  322 # Side Effects:
  323 #   None.
  324 
  325 proc ::tcl::HistNextID {} {
  326     variable history
  327     return [expr {$history(nextid) + 1}]
  328 }
  329 
  330 return
  331 
  332 # Local Variables:
  333 # mode: tcl
  334 # fill-column: 78
  335 # End: