mingw/lib/tcl8.4/history.tcl

   1 # history.tcl --
   2 #
   3 # Implementation of the history command.
   4 #
   5 # RCS: @(#) $Id: history.tcl,v 1.5.14.1 2005/07/22 21:59:40 dgp 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] eq ""} {
 172         return ""
 173     }
 174
 175     set i [incr history(nextid)]
 176     set history($i) $command
 177     set j [incr history(oldest)]
 178     unset -nocomplain 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 {$limit eq ""} {
 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             unset -nocomplain 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 eq ""} {
 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 map [list \n \n\t] [string trimright $history($i) \ \n]]
 260         append result $newline[format "%6d  %s" $i $cmd]
 261         set newline \n
 262     }
 263     return $result
 264 }
 265
 266 # tcl::HistRedo --
 267 #
 268 #       Fetch the previous or specified event, execute it, and then
 269 #       replace the current history item with that event.
 270 #
 271 # Parameters:
 272 #       event   (optional) index of history item to redo.  Defaults to -1,
 273 #               which means the previous event.
 274 #
 275 # Results:
 276 #       Those of the command being redone.
 277 #
 278 # Side Effects:
 279 #       Replaces the current history list item with the one being redone.
 280
 281  proc tcl::HistRedo {{event -1}} {
 282     variable history
 283     if {$event eq ""} {
 284         set event -1
 285     }
 286     set i [HistIndex $event]
 287     if {$i == $history(nextid)} {
 288         return -code error "cannot redo the current event"
 289     }
 290     set cmd $history($i)
 291     HistChange $cmd 0
 292     uplevel #0 $cmd
 293 }
 294
 295 # tcl::HistIndex --
 296 #
 297 #       Map from an event specifier to an index in the history list.
 298 #
 299 # Parameters:
 300 #       event   index of history item to redo.
 301 #               If this is a positive number, it is used directly.
 302 #               If it is a negative number, then it counts back to a previous
 303 #               event, where -1 is the most recent event.
 304 #               A string can be matched, either by being the prefix of
 305 #               a command or by matching a command with string match.
 306 #
 307 # Results:
 308 #       The index into history, or an error if the index didn't match.
 309
 310  proc tcl::HistIndex {event} {
 311     variable history
 312     if {[catch {expr {~$event}}]} {
 313         for {set i [expr {$history(nextid)-1}]} {[info exists history($i)]} \
 314                 {incr i -1} {
 315             if {[string match $event* $history($i)]} {
 316                 return $i;
 317             }
 318             if {[string match $event $history($i)]} {
 319                 return $i;
 320             }
 321         }
 322         return -code error "no event matches \"$event\""
 323     } elseif {$event <= 0} {
 324         set i [expr {$history(nextid) + $event}]
 325     } else {
 326         set i $event
 327     }
 328     if {$i <= $history(oldest)} {
 329         return -code error "event \"$event\" is too far in the past"
 330     }
 331     if {$i > $history(nextid)} {
 332         return -code error "event \"$event\" hasn't occured yet"
 333     }
 334     return $i
 335 }
 336
 337 # tcl::HistEvent --
 338 #
 339 #       Map from an event specifier to the value in the history list.
 340 #
 341 # Parameters:
 342 #       event   index of history item to redo.  See index for a
 343 #               description of possible event patterns.
 344 #
 345 # Results:
 346 #       The value from the history list.
 347
 348  proc tcl::HistEvent {event} {
 349     variable history
 350     set i [HistIndex $event]
 351     if {[info exists history($i)]} {
 352         return [string trimright $history($i) \ \n]
 353     } else {
 354         return "";
 355     }
 356 }
 357
 358 # tcl::HistChange --
 359 #
 360 #       Replace a value in the history list.
 361 #
 362 # Parameters:
 363 #       cmd     The new value to put into the history list.
 364 #       event   (optional) index of history item to redo.  See index for a
 365 #               description of possible event patterns.  This defaults
 366 #               to 0, which specifies the current event.
 367 #
 368 # Side Effects:
 369 #       Changes the history list.
 370
 371  proc tcl::HistChange {cmd {event 0}} {
 372     variable history
 373     set i [HistIndex $event]
 374     set history($i) $cmd
 375 }