Mercurial > repos > rliterman > csp2

annotate CSP2/CSP2_env/env-d9b9114564458d9d-741b3de822f2aaca6c6caa4325c4afce/lib/tcl8.6/history.tcl @ 68:5028fdace37b

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