| 1 | # history.tcl -- |
|---|
| 2 | # |
|---|
| 3 | # Implementation of the history command. |
|---|
| 4 | # |
|---|
| 5 | # RCS: @(#) $Id: history.tcl,v 1.7 2005/07/23 04:12:49 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 | } |
|---|
