projects / OpenSPARC-T2-DV / blame
| Commit | Line | Data |
|---|---|---|
| 86530b38 AT |
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 | } |