tcl/library/history.tcl

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