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