venv/tcl/tcl8.6/history.tcl

   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 \f
  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 \f
  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 \f
  59 # tcl::HistAdd --
  60 #
  61 #       Add an item to the history, and optionally eval it at the global scope
  62 #
  63 # Parameters:
  64 #       event           the command to add
  65 #       exec            (optional) a substring of "exec" causes the command to
  66 #                       be evaled.
  67 # Results:
  68 #       If executing, then the results of the command are returned
  69 #
  70 # Side Effects:
  71 #       Adds to the history list
  72
  73 proc ::tcl::HistAdd {event {exec {}}} {
  74     variable history
  75
  76     if {
  77         [prefix longest {exec {}} $exec] eq ""
  78         && [llength [info level 0]] == 3
  79     } then {
  80         return -code error "bad argument \"$exec\": should be \"exec\""
  81     }
  82
  83     # Do not add empty commands to the history
  84     if {[string trim $event] eq ""} {
  85         return ""
  86     }
  87
  88     # Maintain the history
  89     set history([incr history(nextid)]) $event
  90     unset -nocomplain history([incr history(oldest)])
  91
  92     # Only execute if 'exec' (or non-empty prefix of it) given
  93     if {$exec eq ""} {
  94         return ""
  95     }
  96     tailcall eval $event
  97 }
  98 \f
  99 # tcl::HistKeep --
 100 #
 101 #       Set or query the limit on the length of the history list
 102 #
 103 # Parameters:
 104 #       limit   (optional) the length of the history list
 105 #
 106 # Results:
 107 #       If no limit is specified, the current limit is returned
 108 #
 109 # Side Effects:
 110 #       Updates history(keep) if a limit is specified
 111
 112 proc ::tcl::HistKeep {{count {}}} {
 113     variable history
 114     if {[llength [info level 0]] == 1} {
 115         return $history(keep)
 116     }
 117     if {![string is integer -strict $count] || ($count < 0)} {
 118         return -code error "illegal keep count \"$count\""
 119     }
 120     set oldold $history(oldest)
 121     set history(oldest) [expr {$history(nextid) - $count}]
 122     for {} {$oldold <= $history(oldest)} {incr oldold} {
 123         unset -nocomplain history($oldold)
 124     }
 125     set history(keep) $count
 126 }
 127 \f
 128 # tcl::HistClear --
 129 #
 130 #       Erase the history list
 131 #
 132 # Parameters:
 133 #       none
 134 #
 135 # Results:
 136 #       none
 137 #
 138 # Side Effects:
 139 #       Resets the history array, except for the keep limit
 140
 141 proc ::tcl::HistClear {} {
 142     variable history
 143     set keep $history(keep)
 144     unset history
 145     array set history [list \
 146         nextid  0       \
 147         keep    $keep   \
 148         oldest  -$keep  \
 149     ]
 150 }
 151 \f
 152 # tcl::HistInfo --
 153 #
 154 #       Return a pretty-printed version of the history list
 155 #
 156 # Parameters:
 157 #       num     (optional) the length of the history list to return
 158 #
 159 # Results:
 160 #       A formatted history list
 161
 162 proc ::tcl::HistInfo {{count {}}} {
 163     variable history
 164     if {[llength [info level 0]] == 1} {
 165         set count [expr {$history(keep) + 1}]
 166     } elseif {![string is integer -strict $count]} {
 167         return -code error "bad integer \"$count\""
 168     }
 169     set result {}
 170     set newline ""
 171     for {set i [expr {$history(nextid) - $count + 1}]} \
 172             {$i <= $history(nextid)} {incr i} {
 173         if {![info exists history($i)]} {
 174             continue
 175         }
 176         set cmd [string map [list \n \n\t] [string trimright $history($i) \ \n]]
 177         append result $newline[format "%6d  %s" $i $cmd]
 178         set newline \n
 179     }
 180     return $result
 181 }
 182 \f
 183 # tcl::HistRedo --
 184 #
 185 #       Fetch the previous or specified event, execute it, and then replace
 186 #       the current history item with that event.
 187 #
 188 # Parameters:
 189 #       event   (optional) index of history item to redo.  Defaults to -1,
 190 #               which means the previous event.
 191 #
 192 # Results:
 193 #       Those of the command being redone.
 194 #
 195 # Side Effects:
 196 #       Replaces the current history list item with the one being redone.
 197
 198 proc ::tcl::HistRedo {{event -1}} {
 199     variable history
 200
 201     set i [HistIndex $event]
 202     if {$i == $history(nextid)} {
 203         return -code error "cannot redo the current event"
 204     }
 205     set cmd $history($i)
 206     HistChange $cmd 0
 207     tailcall eval $cmd
 208 }
 209 \f
 210 # tcl::HistIndex --
 211 #
 212 #       Map from an event specifier to an index in the history list.
 213 #
 214 # Parameters:
 215 #       event   index of history item to redo.
 216 #               If this is a positive number, it is used directly.
 217 #               If it is a negative number, then it counts back to a previous
 218 #               event, where -1 is the most recent event.
 219 #               A string can be matched, either by being the prefix of a
 220 #               command or by matching a command with string match.
 221 #
 222 # Results:
 223 #       The index into history, or an error if the index didn't match.
 224
 225 proc ::tcl::HistIndex {event} {
 226     variable history
 227     if {![string is integer -strict $event]} {
 228         for {set i [expr {$history(nextid)-1}]} {[info exists history($i)]} \
 229                 {incr i -1} {
 230             if {[string match $event* $history($i)]} {
 231                 return $i
 232             }
 233             if {[string match $event $history($i)]} {
 234                 return $i
 235             }
 236         }
 237         return -code error "no event matches \"$event\""
 238     } elseif {$event <= 0} {
 239         set i [expr {$history(nextid) + $event}]
 240     } else {
 241         set i $event
 242     }
 243     if {$i <= $history(oldest)} {
 244         return -code error "event \"$event\" is too far in the past"
 245     }
 246     if {$i > $history(nextid)} {
 247         return -code error "event \"$event\" hasn't occured yet"
 248     }
 249     return $i
 250 }
 251 \f
 252 # tcl::HistEvent --
 253 #
 254 #       Map from an event specifier to the value in the history list.
 255 #
 256 # Parameters:
 257 #       event   index of history item to redo.  See index for a description of
 258 #               possible event patterns.
 259 #
 260 # Results:
 261 #       The value from the history list.
 262
 263 proc ::tcl::HistEvent {{event -1}} {
 264     variable history
 265     set i [HistIndex $event]
 266     if {![info exists history($i)]} {
 267         return ""
 268     }
 269     return [string trimright $history($i) \ \n]
 270 }
 271 \f
 272 # tcl::HistChange --
 273 #
 274 #       Replace a value in the history list.
 275 #
 276 # Parameters:
 277 #       newValue  The new value to put into the history list.
 278 #       event     (optional) index of history item to redo.  See index for a
 279 #                 description of possible event patterns.  This defaults to 0,
 280 #                 which specifies the current event.
 281 #
 282 # Side Effects:
 283 #       Changes the history list.
 284
 285 proc ::tcl::HistChange {newValue {event 0}} {
 286     variable history
 287     set i [HistIndex $event]
 288     set history($i) $newValue
 289 }
 290 \f
 291 # tcl::HistNextID --
 292 #
 293 #       Returns the number of the next history event.
 294 #
 295 # Parameters:
 296 #       None.
 297 #
 298 # Side Effects:
 299 #       None.
 300
 301 proc ::tcl::HistNextID {} {
 302     variable history
 303     return [expr {$history(nextid) + 1}]
 304 }
 305 \f
 306 return
 307
 308 # Local Variables:
 309 # mode: tcl
 310 # fill-column: 78
 311 # End: