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 20namespace 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 37proc 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} 376