Mercurial > repos > rliterman > csp2

annotate CSP2/CSP2_env/env-d9b9114564458d9d-741b3de822f2aaca6c6caa4325c4afce/lib/tcl8.6/history.tcl @ 69:33d812a61356

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
planemo upload commit 2e9511a184a1ca667c7be0c6321a36dc4e3d116d
author jpayne
date Tue, 18 Mar 2025 17:55:14 -0400
parents
children
rev   line source
jpayne@69 1 # history.tcl --
jpayne@69 2 #
jpayne@69 3 # Implementation of the history command.
jpayne@69 4 #
jpayne@69 5 # Copyright (c) 1997 Sun Microsystems, Inc.
jpayne@69 6 #
jpayne@69 7 # See the file "license.terms" for information on usage and redistribution of
jpayne@69 8 # this file, and for a DISCLAIMER OF ALL WARRANTIES.
jpayne@69 9 #
jpayne@69 10
jpayne@69 11 # The tcl::history array holds the history list and some additional
jpayne@69 12 # bookkeeping variables.
jpayne@69 13 #
jpayne@69 14 # nextid the index used for the next history list item.
jpayne@69 15 # keep the max size of the history list
jpayne@69 16 # oldest the index of the oldest item in the history.
jpayne@69 17
jpayne@69 18 namespace eval ::tcl {
jpayne@69 19 variable history
jpayne@69 20 if {![info exists history]} {
jpayne@69 21 array set history {
jpayne@69 22 nextid 0
jpayne@69 23 keep 20
jpayne@69 24 oldest -20
jpayne@69 25 }
jpayne@69 26 }
jpayne@69 27
jpayne@69 28 namespace ensemble create -command ::tcl::history -map {
jpayne@69 29 add ::tcl::HistAdd
jpayne@69 30 change ::tcl::HistChange
jpayne@69 31 clear ::tcl::HistClear
jpayne@69 32 event ::tcl::HistEvent
jpayne@69 33 info ::tcl::HistInfo
jpayne@69 34 keep ::tcl::HistKeep
jpayne@69 35 nextid ::tcl::HistNextID
jpayne@69 36 redo ::tcl::HistRedo
jpayne@69 37 }
jpayne@69 38 }
jpayne@69 39
jpayne@69 40 # history --
jpayne@69 41 #
jpayne@69 42 # This is the main history command. See the man page for its interface.
jpayne@69 43 # This does some argument checking and calls the helper ensemble in the
jpayne@69 44 # tcl namespace.
jpayne@69 45
jpayne@69 46 proc ::history {args} {
jpayne@69 47 # If no command given, we're doing 'history info'. Can't be done with an
jpayne@69 48 # ensemble unknown handler, as those don't fire when no subcommand is
jpayne@69 49 # given at all.
jpayne@69 50
jpayne@69 51 if {![llength $args]} {
jpayne@69 52 set args info
jpayne@69 53 }
jpayne@69 54
jpayne@69 55 # Tricky stuff needed to make stack and errors come out right!
jpayne@69 56 tailcall apply {arglist {tailcall history {*}$arglist} ::tcl} $args
jpayne@69 57 }
jpayne@69 58
jpayne@69 59 # (unnamed) --
jpayne@69 60 #
jpayne@69 61 # Callback when [::history] is destroyed. Destroys the implementation.
jpayne@69 62 #
jpayne@69 63 # Parameters:
jpayne@69 64 # oldName what the command was called.
jpayne@69 65 # newName what the command is now called (an empty string).
jpayne@69 66 # op the operation (= delete).
jpayne@69 67 #
jpayne@69 68 # Results:
jpayne@69 69 # none
jpayne@69 70 #
jpayne@69 71 # Side Effects:
jpayne@69 72 # The implementation of the [::history] command ceases to exist.
jpayne@69 73
jpayne@69 74 trace add command ::history delete [list apply {{oldName newName op} {
jpayne@69 75 variable history
jpayne@69 76 unset -nocomplain history
jpayne@69 77 foreach c [info procs ::tcl::Hist*] {
jpayne@69 78 rename $c {}
jpayne@69 79 }
jpayne@69 80 rename ::tcl::history {}
jpayne@69 81 } ::tcl}]
jpayne@69 82
jpayne@69 83 # tcl::HistAdd --
jpayne@69 84 #
jpayne@69 85 # Add an item to the history, and optionally eval it at the global scope
jpayne@69 86 #
jpayne@69 87 # Parameters:
jpayne@69 88 # event the command to add
jpayne@69 89 # exec (optional) a substring of "exec" causes the command to
jpayne@69 90 # be evaled.
jpayne@69 91 # Results:
jpayne@69 92 # If executing, then the results of the command are returned
jpayne@69 93 #
jpayne@69 94 # Side Effects:
jpayne@69 95 # Adds to the history list
jpayne@69 96
jpayne@69 97 proc ::tcl::HistAdd {event {exec {}}} {
jpayne@69 98 variable history
jpayne@69 99
jpayne@69 100 if {
jpayne@69 101 [prefix longest {exec {}} $exec] eq ""
jpayne@69 102 && [llength [info level 0]] == 3
jpayne@69 103 } then {
jpayne@69 104 return -code error "bad argument \"$exec\": should be \"exec\""
jpayne@69 105 }
jpayne@69 106
jpayne@69 107 # Do not add empty commands to the history
jpayne@69 108 if {[string trim $event] eq ""} {
jpayne@69 109 return ""
jpayne@69 110 }
jpayne@69 111
jpayne@69 112 # Maintain the history
jpayne@69 113 set history([incr history(nextid)]) $event
jpayne@69 114 unset -nocomplain history([incr history(oldest)])
jpayne@69 115
jpayne@69 116 # Only execute if 'exec' (or non-empty prefix of it) given
jpayne@69 117 if {$exec eq ""} {
jpayne@69 118 return ""
jpayne@69 119 }
jpayne@69 120 tailcall eval $event
jpayne@69 121 }
jpayne@69 122
jpayne@69 123 # tcl::HistKeep --
jpayne@69 124 #
jpayne@69 125 # Set or query the limit on the length of the history list
jpayne@69 126 #
jpayne@69 127 # Parameters:
jpayne@69 128 # limit (optional) the length of the history list
jpayne@69 129 #
jpayne@69 130 # Results:
jpayne@69 131 # If no limit is specified, the current limit is returned
jpayne@69 132 #
jpayne@69 133 # Side Effects:
jpayne@69 134 # Updates history(keep) if a limit is specified
jpayne@69 135
jpayne@69 136 proc ::tcl::HistKeep {{count {}}} {
jpayne@69 137 variable history
jpayne@69 138 if {[llength [info level 0]] == 1} {
jpayne@69 139 return $history(keep)
jpayne@69 140 }
jpayne@69 141 if {![string is integer -strict $count] || ($count < 0)} {
jpayne@69 142 return -code error "illegal keep count \"$count\""
jpayne@69 143 }
jpayne@69 144 set oldold $history(oldest)
jpayne@69 145 set history(oldest) [expr {$history(nextid) - $count}]
jpayne@69 146 for {} {$oldold <= $history(oldest)} {incr oldold} {
jpayne@69 147 unset -nocomplain history($oldold)
jpayne@69 148 }
jpayne@69 149 set history(keep) $count
jpayne@69 150 }
jpayne@69 151
jpayne@69 152 # tcl::HistClear --
jpayne@69 153 #
jpayne@69 154 # Erase the history list
jpayne@69 155 #
jpayne@69 156 # Parameters:
jpayne@69 157 # none
jpayne@69 158 #
jpayne@69 159 # Results:
jpayne@69 160 # none
jpayne@69 161 #
jpayne@69 162 # Side Effects:
jpayne@69 163 # Resets the history array, except for the keep limit
jpayne@69 164
jpayne@69 165 proc ::tcl::HistClear {} {
jpayne@69 166 variable history
jpayne@69 167 set keep $history(keep)
jpayne@69 168 unset history
jpayne@69 169 array set history [list \
jpayne@69 170 nextid 0 \
jpayne@69 171 keep $keep \
jpayne@69 172 oldest -$keep \
jpayne@69 173 ]
jpayne@69 174 }
jpayne@69 175
jpayne@69 176 # tcl::HistInfo --
jpayne@69 177 #
jpayne@69 178 # Return a pretty-printed version of the history list
jpayne@69 179 #
jpayne@69 180 # Parameters:
jpayne@69 181 # num (optional) the length of the history list to return
jpayne@69 182 #
jpayne@69 183 # Results:
jpayne@69 184 # A formatted history list
jpayne@69 185
jpayne@69 186 proc ::tcl::HistInfo {{count {}}} {
jpayne@69 187 variable history
jpayne@69 188 if {[llength [info level 0]] == 1} {
jpayne@69 189 set count [expr {$history(keep) + 1}]
jpayne@69 190 } elseif {![string is integer -strict $count]} {
jpayne@69 191 return -code error "bad integer \"$count\""
jpayne@69 192 }
jpayne@69 193 set result {}
jpayne@69 194 set newline ""
jpayne@69 195 for {set i [expr {$history(nextid) - $count + 1}]} \
jpayne@69 196 {$i <= $history(nextid)} {incr i} {
jpayne@69 197 if {![info exists history($i)]} {
jpayne@69 198 continue
jpayne@69 199 }
jpayne@69 200 set cmd [string map [list \n \n\t] [string trimright $history($i) \ \n]]
jpayne@69 201 append result $newline[format "%6d %s" $i $cmd]
jpayne@69 202 set newline \n
jpayne@69 203 }
jpayne@69 204 return $result
jpayne@69 205 }
jpayne@69 206
jpayne@69 207 # tcl::HistRedo --
jpayne@69 208 #
jpayne@69 209 # Fetch the previous or specified event, execute it, and then replace
jpayne@69 210 # the current history item with that event.
jpayne@69 211 #
jpayne@69 212 # Parameters:
jpayne@69 213 # event (optional) index of history item to redo. Defaults to -1,
jpayne@69 214 # which means the previous event.
jpayne@69 215 #
jpayne@69 216 # Results:
jpayne@69 217 # Those of the command being redone.
jpayne@69 218 #
jpayne@69 219 # Side Effects:
jpayne@69 220 # Replaces the current history list item with the one being redone.
jpayne@69 221
jpayne@69 222 proc ::tcl::HistRedo {{event -1}} {
jpayne@69 223 variable history
jpayne@69 224
jpayne@69 225 set i [HistIndex $event]
jpayne@69 226 if {$i == $history(nextid)} {
jpayne@69 227 return -code error "cannot redo the current event"
jpayne@69 228 }
jpayne@69 229 set cmd $history($i)
jpayne@69 230 HistChange $cmd 0
jpayne@69 231 tailcall eval $cmd
jpayne@69 232 }
jpayne@69 233
jpayne@69 234 # tcl::HistIndex --
jpayne@69 235 #
jpayne@69 236 # Map from an event specifier to an index in the history list.
jpayne@69 237 #
jpayne@69 238 # Parameters:
jpayne@69 239 # event index of history item to redo.
jpayne@69 240 # If this is a positive number, it is used directly.
jpayne@69 241 # If it is a negative number, then it counts back to a previous
jpayne@69 242 # event, where -1 is the most recent event.
jpayne@69 243 # A string can be matched, either by being the prefix of a
jpayne@69 244 # command or by matching a command with string match.
jpayne@69 245 #
jpayne@69 246 # Results:
jpayne@69 247 # The index into history, or an error if the index didn't match.
jpayne@69 248
jpayne@69 249 proc ::tcl::HistIndex {event} {
jpayne@69 250 variable history
jpayne@69 251 if {![string is integer -strict $event]} {
jpayne@69 252 for {set i [expr {$history(nextid)-1}]} {[info exists history($i)]} \
jpayne@69 253 {incr i -1} {
jpayne@69 254 if {[string match $event* $history($i)]} {
jpayne@69 255 return $i
jpayne@69 256 }
jpayne@69 257 if {[string match $event $history($i)]} {
jpayne@69 258 return $i
jpayne@69 259 }
jpayne@69 260 }
jpayne@69 261 return -code error "no event matches \"$event\""
jpayne@69 262 } elseif {$event <= 0} {
jpayne@69 263 set i [expr {$history(nextid) + $event}]
jpayne@69 264 } else {
jpayne@69 265 set i $event
jpayne@69 266 }
jpayne@69 267 if {$i <= $history(oldest)} {
jpayne@69 268 return -code error "event \"$event\" is too far in the past"
jpayne@69 269 }
jpayne@69 270 if {$i > $history(nextid)} {
jpayne@69 271 return -code error "event \"$event\" hasn't occured yet"
jpayne@69 272 }
jpayne@69 273 return $i
jpayne@69 274 }
jpayne@69 275
jpayne@69 276 # tcl::HistEvent --
jpayne@69 277 #
jpayne@69 278 # Map from an event specifier to the value in the history list.
jpayne@69 279 #
jpayne@69 280 # Parameters:
jpayne@69 281 # event index of history item to redo. See index for a description of
jpayne@69 282 # possible event patterns.
jpayne@69 283 #
jpayne@69 284 # Results:
jpayne@69 285 # The value from the history list.
jpayne@69 286
jpayne@69 287 proc ::tcl::HistEvent {{event -1}} {
jpayne@69 288 variable history
jpayne@69 289 set i [HistIndex $event]
jpayne@69 290 if {![info exists history($i)]} {
jpayne@69 291 return ""
jpayne@69 292 }
jpayne@69 293 return [string trimright $history($i) \ \n]
jpayne@69 294 }
jpayne@69 295
jpayne@69 296 # tcl::HistChange --
jpayne@69 297 #
jpayne@69 298 # Replace a value in the history list.
jpayne@69 299 #
jpayne@69 300 # Parameters:
jpayne@69 301 # newValue The new value to put into the history list.
jpayne@69 302 # event (optional) index of history item to redo. See index for a
jpayne@69 303 # description of possible event patterns. This defaults to 0,
jpayne@69 304 # which specifies the current event.
jpayne@69 305 #
jpayne@69 306 # Side Effects:
jpayne@69 307 # Changes the history list.
jpayne@69 308
jpayne@69 309 proc ::tcl::HistChange {newValue {event 0}} {
jpayne@69 310 variable history
jpayne@69 311 set i [HistIndex $event]
jpayne@69 312 set history($i) $newValue
jpayne@69 313 }
jpayne@69 314
jpayne@69 315 # tcl::HistNextID --
jpayne@69 316 #
jpayne@69 317 # Returns the number of the next history event.
jpayne@69 318 #
jpayne@69 319 # Parameters:
jpayne@69 320 # None.
jpayne@69 321 #
jpayne@69 322 # Side Effects:
jpayne@69 323 # None.
jpayne@69 324
jpayne@69 325 proc ::tcl::HistNextID {} {
jpayne@69 326 variable history
jpayne@69 327 return [expr {$history(nextid) + 1}]
jpayne@69 328 }
jpayne@69 329
jpayne@69 330 return
jpayne@69 331
jpayne@69 332 # Local Variables:
jpayne@69 333 # mode: tcl
jpayne@69 334 # fill-column: 78
jpayne@69 335 # End: