I386LINUX/util/I386LINUX/lib/tcl8.4/history.tcl

   1 # history.tcl --
   2 #
   3 # Implementation of the history command.
   4 #
   5 # RCS: @(#) $Id: history.tcl,v 1.5 2001/05/17 08:18:56 hobbs Exp $
   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
 170     # Do not add empty commands to the history
 171     if {[string trim $command] == ""} {
 172         return ""
 173     }
 174
 175     set i [incr history(nextid)]
 176     set history($i) $command
 177     set j [incr history(oldest)]
 178     if {[info exists history($j)]} {unset history($j)}
 179     if {[string match e* $exec]} {
 180         return [uplevel #0 $command]
 181     } else {
 182         return {}
 183     }
 184 }
 185
 186 # tcl::HistKeep --
 187 #
 188 #       Set or query the limit on the length of the history list
 189 #
 190 # Parameters:
 191 #       limit   (optional) the length of the history list
 192 #
 193 # Results:
 194 #       If no limit is specified, the current limit is returned
 195 #
 196 # Side Effects:
 197 #       Updates history(keep) if a limit is specified
 198
 199  proc tcl::HistKeep {{limit {}}} {
 200     variable history
 201     if {[string length $limit] == 0} {
 202         return $history(keep)
 203     } else {
 204         set oldold $history(oldest)
 205         set history(oldest) [expr {$history(nextid) - $limit}]
 206         for {} {$oldold <= $history(oldest)} {incr oldold} {
 207             if {[info exists history($oldold)]} {unset history($oldold)}
 208         }
 209         set history(keep) $limit
 210     }
 211 }
 212
 213 # tcl::HistClear --
 214 #
 215 #       Erase the history list
 216 #
 217 # Parameters:
 218 #       none
 219 #
 220 # Results:
 221 #       none
 222 #
 223 # Side Effects:
 224 #       Resets the history array, except for the keep limit
 225
 226  proc tcl::HistClear {} {
 227     variable history
 228     set keep $history(keep)
 229     unset history
 230     array set history [list \
 231         nextid  0       \
 232         keep    $keep   \
 233         oldest  -$keep  \
 234     ]
 235 }
 236
 237 # tcl::HistInfo --
 238 #
 239 #       Return a pretty-printed version of the history list
 240 #
 241 # Parameters:
 242 #       num     (optional) the length of the history list to return
 243 #
 244 # Results:
 245 #       A formatted history list
 246
 247  proc tcl::HistInfo {{num {}}} {
 248     variable history
 249     if {$num == {}} {
 250         set num [expr {$history(keep) + 1}]
 251     }
 252     set result {}
 253     set newline ""
 254     for {set i [expr {$history(nextid) - $num + 1}]} \
 255             {$i <= $history(nextid)} {incr i} {
 256         if {![info exists history($i)]} {
 257             continue
 258         }
 259         set cmd [string trimright $history($i) \ \n]
 260         regsub -all \n $cmd "\n\t" cmd
 261         append result $newline[format "%6d  %s" $i $cmd]
 262         set newline \n
 263     }
 264     return $result
 265 }
 266
 267 # tcl::HistRedo --
 268 #
 269 #       Fetch the previous or specified event, execute it, and then
 270 #       replace the current history item with that event.
 271 #
 272 # Parameters:
 273 #       event   (optional) index of history item to redo.  Defaults to -1,
 274 #               which means the previous event.
 275 #
 276 # Results:
 277 #       Those of the command being redone.
 278 #
 279 # Side Effects:
 280 #       Replaces the current history list item with the one being redone.
 281
 282  proc tcl::HistRedo {{event -1}} {
 283     variable history
 284     if {[string length $event] == 0} {
 285         set event -1
 286     }
 287     set i [HistIndex $event]
 288     if {$i == $history(nextid)} {
 289         return -code error "cannot redo the current event"
 290     }
 291     set cmd $history($i)
 292     HistChange $cmd 0
 293     uplevel #0 $cmd
 294 }
 295
 296 # tcl::HistIndex --
 297 #
 298 #       Map from an event specifier to an index in the history list.
 299 #
 300 # Parameters:
 301 #       event   index of history item to redo.
 302 #               If this is a positive number, it is used directly.
 303 #               If it is a negative number, then it counts back to a previous
 304 #               event, where -1 is the most recent event.
 305 #               A string can be matched, either by being the prefix of
 306 #               a command or by matching a command with string match.
 307 #
 308 # Results:
 309 #       The index into history, or an error if the index didn't match.
 310
 311  proc tcl::HistIndex {event} {
 312     variable history
 313     if {[catch {expr {~$event}}]} {
 314         for {set i [expr {$history(nextid)-1}]} {[info exists history($i)]} \
 315                 {incr i -1} {
 316             if {[string match $event* $history($i)]} {
 317                 return $i;
 318             }
 319             if {[string match $event $history($i)]} {
 320                 return $i;
 321             }
 322         }
 323         return -code error "no event matches \"$event\""
 324     } elseif {$event <= 0} {
 325         set i [expr {$history(nextid) + $event}]
 326     } else {
 327         set i $event
 328     }
 329     if {$i <= $history(oldest)} {
 330         return -code error "event \"$event\" is too far in the past"
 331     }
 332     if {$i > $history(nextid)} {
 333         return -code error "event \"$event\" hasn't occured yet"
 334     }
 335     return $i
 336 }
 337
 338 # tcl::HistEvent --
 339 #
 340 #       Map from an event specifier to the value in the history list.
 341 #
 342 # Parameters:
 343 #       event   index of history item to redo.  See index for a
 344 #               description of possible event patterns.
 345 #
 346 # Results:
 347 #       The value from the history list.
 348
 349  proc tcl::HistEvent {event} {
 350     variable history
 351     set i [HistIndex $event]
 352     if {[info exists history($i)]} {
 353         return [string trimright $history($i) \ \n]
 354     } else {
 355         return "";
 356     }
 357 }
 358
 359 # tcl::HistChange --
 360 #
 361 #       Replace a value in the history list.
 362 #
 363 # Parameters:
 364 #       cmd     The new value to put into the history list.
 365 #       event   (optional) index of history item to redo.  See index for a
 366 #               description of possible event patterns.  This defaults
 367 #               to 0, which specifies the current event.
 368 #
 369 # Side Effects:
 370 #       Changes the history list.
 371
 372  proc tcl::HistChange {cmd {event 0}} {
 373     variable history
 374     set i [HistIndex $event]
 375     set history($i) $cmd
 376 }