Artifact
4d5a635c327fa29e9ddf9e6a2a44081c8db8aa5a
File
library/history.tcl
— part of check-in
[79367df0f0]
at
2011-03-02 16:06:41
on branch core-8-5-branch
— Now that we're no longer using SCM based on RCS, the RCS Keyword lines cause
more harm than good. Purged them.
(user:
dgp
size: 8965)
[more...]
0000: 23 20 68 69 73 74 6f 72 79 2e 74 63 6c 20 2d 2d # history.tcl --
0010: 0a 23 0a 23 20 49 6d 70 6c 65 6d 65 6e 74 61 74 .#.# Implementat
0020: 69 6f 6e 20 6f 66 20 74 68 65 20 68 69 73 74 6f ion of the histo
0030: 72 79 20 63 6f 6d 6d 61 6e 64 2e 0a 23 0a 23 20 ry command..#.#
0040: 43 6f 70 79 72 69 67 68 74 20 28 63 29 20 31 39 Copyright (c) 19
0050: 39 37 20 53 75 6e 20 4d 69 63 72 6f 73 79 73 74 97 Sun Microsyst
0060: 65 6d 73 2c 20 49 6e 63 2e 0a 23 0a 23 20 53 65 ems, Inc..#.# Se
0070: 65 20 74 68 65 20 66 69 6c 65 20 22 6c 69 63 65 e the file "lice
0080: 6e 73 65 2e 74 65 72 6d 73 22 20 66 6f 72 20 69 nse.terms" for i
0090: 6e 66 6f 72 6d 61 74 69 6f 6e 20 6f 6e 20 75 73 nformation on us
00a0: 61 67 65 20 61 6e 64 20 72 65 64 69 73 74 72 69 age and redistri
00b0: 62 75 74 69 6f 6e 0a 23 20 6f 66 20 74 68 69 73 bution.# of this
00c0: 20 66 69 6c 65 2c 20 61 6e 64 20 66 6f 72 20 61 file, and for a
00d0: 20 44 49 53 43 4c 41 49 4d 45 52 20 4f 46 20 41 DISCLAIMER OF A
00e0: 4c 4c 20 57 41 52 52 41 4e 54 49 45 53 2e 0a 23 LL WARRANTIES..#
00f0: 0a 0a 23 20 54 68 65 20 74 63 6c 3a 3a 68 69 73 ..# The tcl::his
0100: 74 6f 72 79 20 61 72 72 61 79 20 68 6f 6c 64 73 tory array holds
0110: 20 74 68 65 20 68 69 73 74 6f 72 79 20 6c 69 73 the history lis
0120: 74 20 61 6e 64 0a 23 20 73 6f 6d 65 20 61 64 64 t and.# some add
0130: 69 74 69 6f 6e 61 6c 20 62 6f 6f 6b 6b 65 65 70 itional bookkeep
0140: 69 6e 67 20 76 61 72 69 61 62 6c 65 73 2e 0a 23 ing variables..#
0150: 0a 23 20 6e 65 78 74 69 64 09 74 68 65 20 69 6e .# nextid.the in
0160: 64 65 78 20 75 73 65 64 20 66 6f 72 20 74 68 65 dex used for the
0170: 20 6e 65 78 74 20 68 69 73 74 6f 72 79 20 6c 69 next history li
0180: 73 74 20 69 74 65 6d 2e 0a 23 20 6b 65 65 70 09 st item..# keep.
0190: 09 74 68 65 20 6d 61 78 20 73 69 7a 65 20 6f 66 .the max size of
01a0: 20 74 68 65 20 68 69 73 74 6f 72 79 20 6c 69 73 the history lis
01b0: 74 0a 23 20 6f 6c 64 65 73 74 09 74 68 65 20 69 t.# oldest.the i
01c0: 6e 64 65 78 20 6f 66 20 74 68 65 20 6f 6c 64 65 ndex of the olde
01d0: 73 74 20 69 74 65 6d 20 69 6e 20 74 68 65 20 68 st item in the h
01e0: 69 73 74 6f 72 79 2e 0a 0a 6e 61 6d 65 73 70 61 istory...namespa
01f0: 63 65 20 65 76 61 6c 20 74 63 6c 20 7b 0a 20 20 ce eval tcl {.
0200: 20 20 76 61 72 69 61 62 6c 65 20 68 69 73 74 6f variable histo
0210: 72 79 0a 20 20 20 20 69 66 20 7b 21 5b 69 6e 66 ry. if {![inf
0220: 6f 20 65 78 69 73 74 73 20 68 69 73 74 6f 72 79 o exists history
0230: 5d 7d 20 7b 0a 09 61 72 72 61 79 20 73 65 74 20 ]} {..array set
0240: 68 69 73 74 6f 72 79 20 7b 0a 09 20 20 20 20 6e history {.. n
0250: 65 78 74 69 64 09 30 0a 09 20 20 20 20 6b 65 65 extid.0.. kee
0260: 70 09 32 30 0a 09 20 20 20 20 6f 6c 64 65 73 74 p.20.. oldest
0270: 09 2d 32 30 0a 09 7d 0a 20 20 20 20 7d 0a 7d 0a .-20..}. }.}.
0280: 0a 23 20 68 69 73 74 6f 72 79 20 2d 2d 0a 23 0a .# history --.#.
0290: 23 09 54 68 69 73 20 69 73 20 74 68 65 20 6d 61 #.This is the ma
02a0: 69 6e 20 68 69 73 74 6f 72 79 20 63 6f 6d 6d 61 in history comma
02b0: 6e 64 2e 20 20 53 65 65 20 74 68 65 20 6d 61 6e nd. See the man
02c0: 20 70 61 67 65 20 66 6f 72 20 69 74 73 20 69 6e page for its in
02d0: 74 65 72 66 61 63 65 2e 0a 23 09 54 68 69 73 20 terface..#.This
02e0: 64 6f 65 73 20 61 72 67 75 6d 65 6e 74 20 63 68 does argument ch
02f0: 65 63 6b 69 6e 67 20 61 6e 64 20 63 61 6c 6c 73 ecking and calls
0300: 20 68 65 6c 70 65 72 20 70 72 6f 63 65 64 75 72 helper procedur
0310: 65 73 20 69 6e 20 74 68 65 0a 23 09 68 69 73 74 es in the.#.hist
0320: 6f 72 79 20 6e 61 6d 65 73 70 61 63 65 2e 0a 0a ory namespace...
0330: 70 72 6f 63 20 68 69 73 74 6f 72 79 20 7b 61 72 proc history {ar
0340: 67 73 7d 20 7b 0a 20 20 20 20 73 65 74 20 6c 65 gs} {. set le
0350: 6e 20 5b 6c 6c 65 6e 67 74 68 20 24 61 72 67 73 n [llength $args
0360: 5d 0a 20 20 20 20 69 66 20 7b 24 6c 65 6e 20 3d ]. if {$len =
0370: 3d 20 30 7d 20 7b 0a 09 72 65 74 75 72 6e 20 5b = 0} {..return [
0380: 74 63 6c 3a 3a 48 69 73 74 49 6e 66 6f 5d 0a 20 tcl::HistInfo].
0390: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 6b 65 79 }. set key
03a0: 20 5b 6c 69 6e 64 65 78 20 24 61 72 67 73 20 30 [lindex $args 0
03b0: 5d 0a 20 20 20 20 73 65 74 20 6f 70 74 69 6f 6e ]. set option
03c0: 73 20 22 61 64 64 2c 20 63 68 61 6e 67 65 2c 20 s "add, change,
03d0: 63 6c 65 61 72 2c 20 65 76 65 6e 74 2c 20 69 6e clear, event, in
03e0: 66 6f 2c 20 6b 65 65 70 2c 20 6e 65 78 74 69 64 fo, keep, nextid
03f0: 2c 20 6f 72 20 72 65 64 6f 22 0a 20 20 20 20 73 , or redo". s
0400: 77 69 74 63 68 20 2d 67 6c 6f 62 20 2d 2d 20 24 witch -glob -- $
0410: 6b 65 79 20 7b 0a 09 61 2a 20 7b 20 23 20 68 69 key {..a* { # hi
0420: 73 74 6f 72 79 20 61 64 64 0a 0a 09 20 20 20 20 story add...
0430: 69 66 20 7b 24 6c 65 6e 20 3e 20 33 7d 20 7b 0a if {$len > 3} {.
0440: 09 09 72 65 74 75 72 6e 20 2d 63 6f 64 65 20 65 ..return -code e
0450: 72 72 6f 72 20 22 77 72 6f 6e 67 20 23 20 61 72 rror "wrong # ar
0460: 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 5c 22 gs: should be \"
0470: 68 69 73 74 6f 72 79 20 61 64 64 20 65 76 65 6e history add even
0480: 74 20 3f 65 78 65 63 3f 5c 22 22 0a 09 20 20 20 t ?exec?\""..
0490: 20 7d 0a 09 20 20 20 20 69 66 20 7b 21 5b 73 74 }.. if {![st
04a0: 72 69 6e 67 20 6d 61 74 63 68 20 24 6b 65 79 2a ring match $key*
04b0: 20 61 64 64 5d 7d 20 7b 0a 09 09 72 65 74 75 72 add]} {...retur
04c0: 6e 20 2d 63 6f 64 65 20 65 72 72 6f 72 20 22 62 n -code error "b
04d0: 61 64 20 6f 70 74 69 6f 6e 20 5c 22 24 6b 65 79 ad option \"$key
04e0: 5c 22 3a 20 6d 75 73 74 20 62 65 20 24 6f 70 74 \": must be $opt
04f0: 69 6f 6e 73 22 0a 09 20 20 20 20 7d 0a 09 20 20 ions".. }..
0500: 20 20 69 66 20 7b 24 6c 65 6e 20 3d 3d 20 33 7d if {$len == 3}
0510: 20 7b 0a 09 09 73 65 74 20 61 72 67 20 5b 6c 69 {...set arg [li
0520: 6e 64 65 78 20 24 61 72 67 73 20 32 5d 0a 09 09 ndex $args 2]...
0530: 69 66 20 7b 21 20 28 5b 73 74 72 69 6e 67 20 6d if {! ([string m
0540: 61 74 63 68 20 65 2a 20 24 61 72 67 5d 20 26 26 atch e* $arg] &&
0550: 20 5b 73 74 72 69 6e 67 20 6d 61 74 63 68 20 24 [string match $
0560: 61 72 67 2a 20 65 78 65 63 5d 29 7d 20 7b 0a 09 arg* exec])} {..
0570: 09 20 20 20 20 72 65 74 75 72 6e 20 2d 63 6f 64 . return -cod
0580: 65 20 65 72 72 6f 72 20 22 62 61 64 20 61 72 67 e error "bad arg
0590: 75 6d 65 6e 74 20 5c 22 24 61 72 67 5c 22 3a 20 ument \"$arg\":
05a0: 73 68 6f 75 6c 64 20 62 65 20 5c 22 65 78 65 63 should be \"exec
05b0: 5c 22 22 0a 09 09 7d 0a 09 20 20 20 20 7d 0a 09 \""...}.. }..
05c0: 20 20 20 20 72 65 74 75 72 6e 20 5b 74 63 6c 3a return [tcl:
05d0: 3a 48 69 73 74 41 64 64 20 5b 6c 69 6e 64 65 78 :HistAdd [lindex
05e0: 20 24 61 72 67 73 20 31 5d 20 5b 6c 69 6e 64 65 $args 1] [linde
05f0: 78 20 24 61 72 67 73 20 32 5d 5d 0a 09 7d 0a 09 x $args 2]]..}..
0600: 63 68 2a 20 7b 20 23 20 68 69 73 74 6f 72 79 20 ch* { # history
0610: 63 68 61 6e 67 65 0a 0a 09 20 20 20 20 69 66 20 change... if
0620: 7b 28 24 6c 65 6e 20 3e 20 33 29 20 7c 7c 20 28 {($len > 3) || (
0630: 24 6c 65 6e 20 3c 20 32 29 7d 20 7b 0a 09 09 72 $len < 2)} {...r
0640: 65 74 75 72 6e 20 2d 63 6f 64 65 20 65 72 72 6f eturn -code erro
0650: 72 20 22 77 72 6f 6e 67 20 23 20 61 72 67 73 3a r "wrong # args:
0660: 20 73 68 6f 75 6c 64 20 62 65 20 5c 22 68 69 73 should be \"his
0670: 74 6f 72 79 20 63 68 61 6e 67 65 20 6e 65 77 56 tory change newV
0680: 61 6c 75 65 20 3f 65 76 65 6e 74 3f 5c 22 22 0a alue ?event?\"".
0690: 09 20 20 20 20 7d 0a 09 20 20 20 20 69 66 20 7b . }.. if {
06a0: 21 5b 73 74 72 69 6e 67 20 6d 61 74 63 68 20 24 ![string match $
06b0: 6b 65 79 2a 20 63 68 61 6e 67 65 5d 7d 20 7b 0a key* change]} {.
06c0: 09 09 72 65 74 75 72 6e 20 2d 63 6f 64 65 20 65 ..return -code e
06d0: 72 72 6f 72 20 22 62 61 64 20 6f 70 74 69 6f 6e rror "bad option
06e0: 20 5c 22 24 6b 65 79 5c 22 3a 20 6d 75 73 74 20 \"$key\": must
06f0: 62 65 20 24 6f 70 74 69 6f 6e 73 22 0a 09 20 20 be $options"..
0700: 20 20 7d 0a 09 20 20 20 20 69 66 20 7b 24 6c 65 }.. if {$le
0710: 6e 20 3d 3d 20 32 7d 20 7b 0a 09 09 73 65 74 20 n == 2} {...set
0720: 65 76 65 6e 74 20 30 0a 09 20 20 20 20 7d 20 65 event 0.. } e
0730: 6c 73 65 20 7b 0a 09 09 73 65 74 20 65 76 65 6e lse {...set even
0740: 74 20 5b 6c 69 6e 64 65 78 20 24 61 72 67 73 20 t [lindex $args
0750: 32 5d 0a 09 20 20 20 20 7d 0a 0a 09 20 20 20 20 2].. }...
0760: 72 65 74 75 72 6e 20 5b 74 63 6c 3a 3a 48 69 73 return [tcl::His
0770: 74 43 68 61 6e 67 65 20 5b 6c 69 6e 64 65 78 20 tChange [lindex
0780: 24 61 72 67 73 20 31 5d 20 24 65 76 65 6e 74 5d $args 1] $event]
0790: 0a 09 7d 0a 09 63 6c 2a 20 7b 20 23 20 68 69 73 ..}..cl* { # his
07a0: 74 6f 72 79 20 63 6c 65 61 72 0a 0a 09 20 20 20 tory clear...
07b0: 20 69 66 20 7b 28 24 6c 65 6e 20 3e 20 31 29 7d if {($len > 1)}
07c0: 20 7b 0a 09 09 72 65 74 75 72 6e 20 2d 63 6f 64 {...return -cod
07d0: 65 20 65 72 72 6f 72 20 22 77 72 6f 6e 67 20 23 e error "wrong #
07e0: 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 args: should be
07f0: 20 5c 22 68 69 73 74 6f 72 79 20 63 6c 65 61 72 \"history clear
0800: 5c 22 22 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 \"".. }..
0810: 69 66 20 7b 21 5b 73 74 72 69 6e 67 20 6d 61 74 if {![string mat
0820: 63 68 20 24 6b 65 79 2a 20 63 6c 65 61 72 5d 7d ch $key* clear]}
0830: 20 7b 0a 09 09 72 65 74 75 72 6e 20 2d 63 6f 64 {...return -cod
0840: 65 20 65 72 72 6f 72 20 22 62 61 64 20 6f 70 74 e error "bad opt
0850: 69 6f 6e 20 5c 22 24 6b 65 79 5c 22 3a 20 6d 75 ion \"$key\": mu
0860: 73 74 20 62 65 20 24 6f 70 74 69 6f 6e 73 22 0a st be $options".
0870: 09 20 20 20 20 7d 0a 09 20 20 20 20 72 65 74 75 . }.. retu
0880: 72 6e 20 5b 74 63 6c 3a 3a 48 69 73 74 43 6c 65 rn [tcl::HistCle
0890: 61 72 5d 0a 09 7d 0a 09 65 2a 20 7b 20 23 20 68 ar]..}..e* { # h
08a0: 69 73 74 6f 72 79 20 65 76 65 6e 74 0a 0a 09 20 istory event...
08b0: 20 20 20 69 66 20 7b 24 6c 65 6e 20 3e 20 32 7d if {$len > 2}
08c0: 20 7b 0a 09 09 72 65 74 75 72 6e 20 2d 63 6f 64 {...return -cod
08d0: 65 20 65 72 72 6f 72 20 22 77 72 6f 6e 67 20 23 e error "wrong #
08e0: 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 args: should be
08f0: 20 5c 22 68 69 73 74 6f 72 79 20 65 76 65 6e 74 \"history event
0900: 20 3f 65 76 65 6e 74 3f 5c 22 22 0a 09 20 20 20 ?event?\""..
0910: 20 7d 0a 09 20 20 20 20 69 66 20 7b 21 5b 73 74 }.. if {![st
0920: 72 69 6e 67 20 6d 61 74 63 68 20 24 6b 65 79 2a ring match $key*
0930: 20 65 76 65 6e 74 5d 7d 20 7b 0a 09 09 72 65 74 event]} {...ret
0940: 75 72 6e 20 2d 63 6f 64 65 20 65 72 72 6f 72 20 urn -code error
0950: 22 62 61 64 20 6f 70 74 69 6f 6e 20 5c 22 24 6b "bad option \"$k
0960: 65 79 5c 22 3a 20 6d 75 73 74 20 62 65 20 24 6f ey\": must be $o
0970: 70 74 69 6f 6e 73 22 0a 09 20 20 20 20 7d 0a 09 ptions".. }..
0980: 20 20 20 20 69 66 20 7b 24 6c 65 6e 20 3d 3d 20 if {$len ==
0990: 31 7d 20 7b 0a 09 09 73 65 74 20 65 76 65 6e 74 1} {...set event
09a0: 20 2d 31 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 -1.. } else
09b0: 7b 0a 09 09 73 65 74 20 65 76 65 6e 74 20 5b 6c {...set event [l
09c0: 69 6e 64 65 78 20 24 61 72 67 73 20 31 5d 0a 09 index $args 1]..
09d0: 20 20 20 20 7d 0a 09 20 20 20 20 72 65 74 75 72 }.. retur
09e0: 6e 20 5b 74 63 6c 3a 3a 48 69 73 74 45 76 65 6e n [tcl::HistEven
09f0: 74 20 24 65 76 65 6e 74 5d 0a 09 7d 0a 09 69 2a t $event]..}..i*
0a00: 20 7b 20 23 20 68 69 73 74 6f 72 79 20 69 6e 66 { # history inf
0a10: 6f 0a 0a 09 20 20 20 20 69 66 20 7b 24 6c 65 6e o... if {$len
0a20: 20 3e 20 32 7d 20 7b 0a 09 09 72 65 74 75 72 6e > 2} {...return
0a30: 20 2d 63 6f 64 65 20 65 72 72 6f 72 20 22 77 72 -code error "wr
0a40: 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 ong # args: shou
0a50: 6c 64 20 62 65 20 5c 22 68 69 73 74 6f 72 79 20 ld be \"history
0a60: 69 6e 66 6f 20 3f 63 6f 75 6e 74 3f 5c 22 22 0a info ?count?\"".
0a70: 09 20 20 20 20 7d 0a 09 20 20 20 20 69 66 20 7b . }.. if {
0a80: 21 5b 73 74 72 69 6e 67 20 6d 61 74 63 68 20 24 ![string match $
0a90: 6b 65 79 2a 20 69 6e 66 6f 5d 7d 20 7b 0a 09 09 key* info]} {...
0aa0: 72 65 74 75 72 6e 20 2d 63 6f 64 65 20 65 72 72 return -code err
0ab0: 6f 72 20 22 62 61 64 20 6f 70 74 69 6f 6e 20 5c or "bad option \
0ac0: 22 24 6b 65 79 5c 22 3a 20 6d 75 73 74 20 62 65 "$key\": must be
0ad0: 20 24 6f 70 74 69 6f 6e 73 22 0a 09 20 20 20 20 $options"..
0ae0: 7d 0a 09 20 20 20 20 72 65 74 75 72 6e 20 5b 74 }.. return [t
0af0: 63 6c 3a 3a 48 69 73 74 49 6e 66 6f 20 5b 6c 69 cl::HistInfo [li
0b00: 6e 64 65 78 20 24 61 72 67 73 20 31 5d 5d 0a 09 ndex $args 1]]..
0b10: 7d 0a 09 6b 2a 20 7b 20 23 20 68 69 73 74 6f 72 }..k* { # histor
0b20: 79 20 6b 65 65 70 0a 0a 09 20 20 20 20 69 66 20 y keep... if
0b30: 7b 24 6c 65 6e 20 3e 20 32 7d 20 7b 0a 09 09 72 {$len > 2} {...r
0b40: 65 74 75 72 6e 20 2d 63 6f 64 65 20 65 72 72 6f eturn -code erro
0b50: 72 20 22 77 72 6f 6e 67 20 23 20 61 72 67 73 3a r "wrong # args:
0b60: 20 73 68 6f 75 6c 64 20 62 65 20 5c 22 68 69 73 should be \"his
0b70: 74 6f 72 79 20 6b 65 65 70 20 3f 63 6f 75 6e 74 tory keep ?count
0b80: 3f 5c 22 22 0a 09 20 20 20 20 7d 0a 09 20 20 20 ?\"".. }..
0b90: 20 69 66 20 7b 24 6c 65 6e 20 3d 3d 20 31 7d 20 if {$len == 1}
0ba0: 7b 0a 09 09 72 65 74 75 72 6e 20 5b 74 63 6c 3a {...return [tcl:
0bb0: 3a 48 69 73 74 4b 65 65 70 5d 0a 09 20 20 20 20 :HistKeep]..
0bc0: 7d 20 65 6c 73 65 20 7b 0a 09 09 73 65 74 20 6c } else {...set l
0bd0: 69 6d 69 74 20 5b 6c 69 6e 64 65 78 20 24 61 72 imit [lindex $ar
0be0: 67 73 20 31 5d 0a 09 09 69 66 20 7b 5b 63 61 74 gs 1]...if {[cat
0bf0: 63 68 20 7b 65 78 70 72 20 7b 7e 24 6c 69 6d 69 ch {expr {~$limi
0c00: 74 7d 7d 5d 20 7c 7c 20 28 24 6c 69 6d 69 74 20 t}}] || ($limit
0c10: 3c 20 30 29 7d 20 7b 0a 09 09 20 20 20 20 72 65 < 0)} {... re
0c20: 74 75 72 6e 20 2d 63 6f 64 65 20 65 72 72 6f 72 turn -code error
0c30: 20 22 69 6c 6c 65 67 61 6c 20 6b 65 65 70 20 63 "illegal keep c
0c40: 6f 75 6e 74 20 5c 22 24 6c 69 6d 69 74 5c 22 22 ount \"$limit\""
0c50: 0a 09 09 7d 0a 09 09 72 65 74 75 72 6e 20 5b 74 ...}...return [t
0c60: 63 6c 3a 3a 48 69 73 74 4b 65 65 70 20 24 6c 69 cl::HistKeep $li
0c70: 6d 69 74 5d 0a 09 20 20 20 20 7d 0a 09 7d 0a 09 mit].. }..}..
0c80: 6e 2a 20 7b 20 23 20 68 69 73 74 6f 72 79 20 6e n* { # history n
0c90: 65 78 74 69 64 0a 0a 09 20 20 20 20 69 66 20 7b extid... if {
0ca0: 24 6c 65 6e 20 3e 20 31 7d 20 7b 0a 09 09 72 65 $len > 1} {...re
0cb0: 74 75 72 6e 20 2d 63 6f 64 65 20 65 72 72 6f 72 turn -code error
0cc0: 20 22 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 "wrong # args:
0cd0: 73 68 6f 75 6c 64 20 62 65 20 5c 22 68 69 73 74 should be \"hist
0ce0: 6f 72 79 20 6e 65 78 74 69 64 5c 22 22 0a 09 20 ory nextid\""..
0cf0: 20 20 20 7d 0a 09 20 20 20 20 69 66 20 7b 21 5b }.. if {![
0d00: 73 74 72 69 6e 67 20 6d 61 74 63 68 20 24 6b 65 string match $ke
0d10: 79 2a 20 6e 65 78 74 69 64 5d 7d 20 7b 0a 09 09 y* nextid]} {...
0d20: 72 65 74 75 72 6e 20 2d 63 6f 64 65 20 65 72 72 return -code err
0d30: 6f 72 20 22 62 61 64 20 6f 70 74 69 6f 6e 20 5c or "bad option \
0d40: 22 24 6b 65 79 5c 22 3a 20 6d 75 73 74 20 62 65 "$key\": must be
0d50: 20 24 6f 70 74 69 6f 6e 73 22 0a 09 20 20 20 20 $options"..
0d60: 7d 0a 09 20 20 20 20 72 65 74 75 72 6e 20 5b 65 }.. return [e
0d70: 78 70 72 20 7b 24 74 63 6c 3a 3a 68 69 73 74 6f xpr {$tcl::histo
0d80: 72 79 28 6e 65 78 74 69 64 29 20 2b 20 31 7d 5d ry(nextid) + 1}]
0d90: 0a 09 7d 0a 09 72 2a 20 7b 20 23 20 68 69 73 74 ..}..r* { # hist
0da0: 6f 72 79 20 72 65 64 6f 0a 0a 09 20 20 20 20 69 ory redo... i
0db0: 66 20 7b 24 6c 65 6e 20 3e 20 32 7d 20 7b 0a 09 f {$len > 2} {..
0dc0: 09 72 65 74 75 72 6e 20 2d 63 6f 64 65 20 65 72 .return -code er
0dd0: 72 6f 72 20 22 77 72 6f 6e 67 20 23 20 61 72 67 ror "wrong # arg
0de0: 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 5c 22 68 s: should be \"h
0df0: 69 73 74 6f 72 79 20 72 65 64 6f 20 3f 65 76 65 istory redo ?eve
0e00: 6e 74 3f 5c 22 22 0a 09 20 20 20 20 7d 0a 09 20 nt?\"".. }..
0e10: 20 20 20 69 66 20 7b 21 5b 73 74 72 69 6e 67 20 if {![string
0e20: 6d 61 74 63 68 20 24 6b 65 79 2a 20 72 65 64 6f match $key* redo
0e30: 5d 7d 20 7b 0a 09 09 72 65 74 75 72 6e 20 2d 63 ]} {...return -c
0e40: 6f 64 65 20 65 72 72 6f 72 20 22 62 61 64 20 6f ode error "bad o
0e50: 70 74 69 6f 6e 20 5c 22 24 6b 65 79 5c 22 3a 20 ption \"$key\":
0e60: 6d 75 73 74 20 62 65 20 24 6f 70 74 69 6f 6e 73 must be $options
0e70: 22 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 72 65 ".. }.. re
0e80: 74 75 72 6e 20 5b 74 63 6c 3a 3a 48 69 73 74 52 turn [tcl::HistR
0e90: 65 64 6f 20 5b 6c 69 6e 64 65 78 20 24 61 72 67 edo [lindex $arg
0ea0: 73 20 31 5d 5d 0a 09 7d 0a 09 64 65 66 61 75 6c s 1]]..}..defaul
0eb0: 74 20 7b 0a 09 20 20 20 20 72 65 74 75 72 6e 20 t {.. return
0ec0: 2d 63 6f 64 65 20 65 72 72 6f 72 20 22 62 61 64 -code error "bad
0ed0: 20 6f 70 74 69 6f 6e 20 5c 22 24 6b 65 79 5c 22 option \"$key\"
0ee0: 3a 20 6d 75 73 74 20 62 65 20 24 6f 70 74 69 6f : must be $optio
0ef0: 6e 73 22 0a 09 7d 0a 20 20 20 20 7d 0a 7d 0a 0a ns"..}. }.}..
0f00: 23 20 74 63 6c 3a 3a 48 69 73 74 41 64 64 20 2d # tcl::HistAdd -
0f10: 2d 0a 23 0a 23 09 41 64 64 20 61 6e 20 69 74 65 -.#.#.Add an ite
0f20: 6d 20 74 6f 20 74 68 65 20 68 69 73 74 6f 72 79 m to the history
0f30: 2c 20 61 6e 64 20 6f 70 74 69 6f 6e 61 6c 6c 79 , and optionally
0f40: 20 65 76 61 6c 20 69 74 20 61 74 20 74 68 65 20 eval it at the
0f50: 67 6c 6f 62 61 6c 20 73 63 6f 70 65 0a 23 0a 23 global scope.#.#
0f60: 20 50 61 72 61 6d 65 74 65 72 73 3a 0a 23 09 63 Parameters:.#.c
0f70: 6f 6d 6d 61 6e 64 09 09 74 68 65 20 63 6f 6d 6d ommand..the comm
0f80: 61 6e 64 20 74 6f 20 61 64 64 0a 23 09 65 78 65 and to add.#.exe
0f90: 63 09 09 28 6f 70 74 69 6f 6e 61 6c 29 20 61 20 c..(optional) a
0fa0: 73 75 62 73 74 72 69 6e 67 20 6f 66 20 22 65 78 substring of "ex
0fb0: 65 63 22 20 63 61 75 73 65 73 20 74 68 65 0a 23 ec" causes the.#
0fc0: 09 09 09 63 6f 6d 6d 61 6e 64 20 74 6f 20 62 65 ...command to be
0fd0: 20 65 76 61 6c 65 64 2e 0a 23 20 52 65 73 75 6c evaled..# Resul
0fe0: 74 73 3a 0a 23 20 09 49 66 20 65 78 65 63 75 74 ts:.# .If execut
0ff0: 69 6e 67 2c 20 74 68 65 6e 20 74 68 65 20 72 65 ing, then the re
1000: 73 75 6c 74 73 20 6f 66 20 74 68 65 20 63 6f 6d sults of the com
1010: 6d 61 6e 64 20 61 72 65 20 72 65 74 75 72 6e 65 mand are returne
1020: 64 0a 23 0a 23 20 53 69 64 65 20 45 66 66 65 63 d.#.# Side Effec
1030: 74 73 3a 0a 23 09 41 64 64 73 20 74 6f 20 74 68 ts:.#.Adds to th
1040: 65 20 68 69 73 74 6f 72 79 20 6c 69 73 74 0a 0a e history list..
1050: 20 70 72 6f 63 20 74 63 6c 3a 3a 48 69 73 74 41 proc tcl::HistA
1060: 64 64 20 7b 63 6f 6d 6d 61 6e 64 20 7b 65 78 65 dd {command {exe
1070: 63 20 7b 7d 7d 7d 20 7b 0a 20 20 20 20 76 61 72 c {}}} {. var
1080: 69 61 62 6c 65 20 68 69 73 74 6f 72 79 0a 0a 20 iable history..
1090: 20 20 20 23 20 44 6f 20 6e 6f 74 20 61 64 64 20 # Do not add
10a0: 65 6d 70 74 79 20 63 6f 6d 6d 61 6e 64 73 20 74 empty commands t
10b0: 6f 20 74 68 65 20 68 69 73 74 6f 72 79 0a 20 20 o the history.
10c0: 20 20 69 66 20 7b 5b 73 74 72 69 6e 67 20 74 72 if {[string tr
10d0: 69 6d 20 24 63 6f 6d 6d 61 6e 64 5d 20 65 71 20 im $command] eq
10e0: 22 22 7d 20 7b 0a 09 72 65 74 75 72 6e 20 22 22 ""} {..return ""
10f0: 0a 20 20 20 20 7d 0a 0a 20 20 20 20 73 65 74 20 . }.. set
1100: 69 20 5b 69 6e 63 72 20 68 69 73 74 6f 72 79 28 i [incr history(
1110: 6e 65 78 74 69 64 29 5d 0a 20 20 20 20 73 65 74 nextid)]. set
1120: 20 68 69 73 74 6f 72 79 28 24 69 29 20 24 63 6f history($i) $co
1130: 6d 6d 61 6e 64 0a 20 20 20 20 73 65 74 20 6a 20 mmand. set j
1140: 5b 69 6e 63 72 20 68 69 73 74 6f 72 79 28 6f 6c [incr history(ol
1150: 64 65 73 74 29 5d 0a 20 20 20 20 75 6e 73 65 74 dest)]. unset
1160: 20 2d 6e 6f 63 6f 6d 70 6c 61 69 6e 20 68 69 73 -nocomplain his
1170: 74 6f 72 79 28 24 6a 29 0a 20 20 20 20 69 66 20 tory($j). if
1180: 7b 5b 73 74 72 69 6e 67 20 6d 61 74 63 68 20 65 {[string match e
1190: 2a 20 24 65 78 65 63 5d 7d 20 7b 0a 09 72 65 74 * $exec]} {..ret
11a0: 75 72 6e 20 5b 75 70 6c 65 76 65 6c 20 23 30 20 urn [uplevel #0
11b0: 24 63 6f 6d 6d 61 6e 64 5d 0a 20 20 20 20 7d 20 $command]. }
11c0: 65 6c 73 65 20 7b 0a 09 72 65 74 75 72 6e 20 7b else {..return {
11d0: 7d 0a 20 20 20 20 7d 0a 7d 0a 0a 23 20 74 63 6c }. }.}..# tcl
11e0: 3a 3a 48 69 73 74 4b 65 65 70 20 2d 2d 0a 23 0a ::HistKeep --.#.
11f0: 23 09 53 65 74 20 6f 72 20 71 75 65 72 79 20 74 #.Set or query t
1200: 68 65 20 6c 69 6d 69 74 20 6f 6e 20 74 68 65 20 he limit on the
1210: 6c 65 6e 67 74 68 20 6f 66 20 74 68 65 20 68 69 length of the hi
1220: 73 74 6f 72 79 20 6c 69 73 74 0a 23 0a 23 20 50 story list.#.# P
1230: 61 72 61 6d 65 74 65 72 73 3a 0a 23 09 6c 69 6d arameters:.#.lim
1240: 69 74 09 28 6f 70 74 69 6f 6e 61 6c 29 20 74 68 it.(optional) th
1250: 65 20 6c 65 6e 67 74 68 20 6f 66 20 74 68 65 20 e length of the
1260: 68 69 73 74 6f 72 79 20 6c 69 73 74 0a 23 0a 23 history list.#.#
1270: 20 52 65 73 75 6c 74 73 3a 0a 23 09 49 66 20 6e Results:.#.If n
1280: 6f 20 6c 69 6d 69 74 20 69 73 20 73 70 65 63 69 o limit is speci
1290: 66 69 65 64 2c 20 74 68 65 20 63 75 72 72 65 6e fied, the curren
12a0: 74 20 6c 69 6d 69 74 20 69 73 20 72 65 74 75 72 t limit is retur
12b0: 6e 65 64 0a 23 0a 23 20 53 69 64 65 20 45 66 66 ned.#.# Side Eff
12c0: 65 63 74 73 3a 0a 23 09 55 70 64 61 74 65 73 20 ects:.#.Updates
12d0: 68 69 73 74 6f 72 79 28 6b 65 65 70 29 20 69 66 history(keep) if
12e0: 20 61 20 6c 69 6d 69 74 20 69 73 20 73 70 65 63 a limit is spec
12f0: 69 66 69 65 64 0a 0a 20 70 72 6f 63 20 74 63 6c ified.. proc tcl
1300: 3a 3a 48 69 73 74 4b 65 65 70 20 7b 7b 6c 69 6d ::HistKeep {{lim
1310: 69 74 20 7b 7d 7d 7d 20 7b 0a 20 20 20 20 76 61 it {}}} {. va
1320: 72 69 61 62 6c 65 20 68 69 73 74 6f 72 79 0a 20 riable history.
1330: 20 20 20 69 66 20 7b 24 6c 69 6d 69 74 20 65 71 if {$limit eq
1340: 20 22 22 7d 20 7b 0a 09 72 65 74 75 72 6e 20 24 ""} {..return $
1350: 68 69 73 74 6f 72 79 28 6b 65 65 70 29 0a 20 20 history(keep).
1360: 20 20 7d 20 65 6c 73 65 20 7b 0a 09 73 65 74 20 } else {..set
1370: 6f 6c 64 6f 6c 64 20 24 68 69 73 74 6f 72 79 28 oldold $history(
1380: 6f 6c 64 65 73 74 29 0a 09 73 65 74 20 68 69 73 oldest)..set his
1390: 74 6f 72 79 28 6f 6c 64 65 73 74 29 20 5b 65 78 tory(oldest) [ex
13a0: 70 72 20 7b 24 68 69 73 74 6f 72 79 28 6e 65 78 pr {$history(nex
13b0: 74 69 64 29 20 2d 20 24 6c 69 6d 69 74 7d 5d 0a tid) - $limit}].
13c0: 09 66 6f 72 20 7b 7d 20 7b 24 6f 6c 64 6f 6c 64 .for {} {$oldold
13d0: 20 3c 3d 20 24 68 69 73 74 6f 72 79 28 6f 6c 64 <= $history(old
13e0: 65 73 74 29 7d 20 7b 69 6e 63 72 20 6f 6c 64 6f est)} {incr oldo
13f0: 6c 64 7d 20 7b 0a 09 20 20 20 20 75 6e 73 65 74 ld} {.. unset
1400: 20 2d 6e 6f 63 6f 6d 70 6c 61 69 6e 20 68 69 73 -nocomplain his
1410: 74 6f 72 79 28 24 6f 6c 64 6f 6c 64 29 0a 09 7d tory($oldold)..}
1420: 0a 09 73 65 74 20 68 69 73 74 6f 72 79 28 6b 65 ..set history(ke
1430: 65 70 29 20 24 6c 69 6d 69 74 0a 20 20 20 20 7d ep) $limit. }
1440: 0a 7d 0a 0a 23 20 74 63 6c 3a 3a 48 69 73 74 43 .}..# tcl::HistC
1450: 6c 65 61 72 20 2d 2d 0a 23 0a 23 09 45 72 61 73 lear --.#.#.Eras
1460: 65 20 74 68 65 20 68 69 73 74 6f 72 79 20 6c 69 e the history li
1470: 73 74 0a 23 0a 23 20 50 61 72 61 6d 65 74 65 72 st.#.# Parameter
1480: 73 3a 0a 23 09 6e 6f 6e 65 0a 23 0a 23 20 52 65 s:.#.none.#.# Re
1490: 73 75 6c 74 73 3a 0a 23 09 6e 6f 6e 65 0a 23 0a sults:.#.none.#.
14a0: 23 20 53 69 64 65 20 45 66 66 65 63 74 73 3a 0a # Side Effects:.
14b0: 23 09 52 65 73 65 74 73 20 74 68 65 20 68 69 73 #.Resets the his
14c0: 74 6f 72 79 20 61 72 72 61 79 2c 20 65 78 63 65 tory array, exce
14d0: 70 74 20 66 6f 72 20 74 68 65 20 6b 65 65 70 20 pt for the keep
14e0: 6c 69 6d 69 74 0a 0a 20 70 72 6f 63 20 74 63 6c limit.. proc tcl
14f0: 3a 3a 48 69 73 74 43 6c 65 61 72 20 7b 7d 20 7b ::HistClear {} {
1500: 0a 20 20 20 20 76 61 72 69 61 62 6c 65 20 68 69 . variable hi
1510: 73 74 6f 72 79 0a 20 20 20 20 73 65 74 20 6b 65 story. set ke
1520: 65 70 20 24 68 69 73 74 6f 72 79 28 6b 65 65 70 ep $history(keep
1530: 29 0a 20 20 20 20 75 6e 73 65 74 20 68 69 73 74 ). unset hist
1540: 6f 72 79 0a 20 20 20 20 61 72 72 61 79 20 73 65 ory. array se
1550: 74 20 68 69 73 74 6f 72 79 20 5b 6c 69 73 74 20 t history [list
1560: 5c 0a 09 6e 65 78 74 69 64 09 30 09 5c 0a 09 6b \..nextid.0.\..k
1570: 65 65 70 09 24 6b 65 65 70 09 5c 0a 09 6f 6c 64 eep.$keep.\..old
1580: 65 73 74 09 2d 24 6b 65 65 70 09 5c 0a 20 20 20 est.-$keep.\.
1590: 20 5d 0a 7d 0a 0a 23 20 74 63 6c 3a 3a 48 69 73 ].}..# tcl::His
15a0: 74 49 6e 66 6f 20 2d 2d 0a 23 0a 23 09 52 65 74 tInfo --.#.#.Ret
15b0: 75 72 6e 20 61 20 70 72 65 74 74 79 2d 70 72 69 urn a pretty-pri
15c0: 6e 74 65 64 20 76 65 72 73 69 6f 6e 20 6f 66 20 nted version of
15d0: 74 68 65 20 68 69 73 74 6f 72 79 20 6c 69 73 74 the history list
15e0: 0a 23 0a 23 20 50 61 72 61 6d 65 74 65 72 73 3a .#.# Parameters:
15f0: 0a 23 09 6e 75 6d 09 28 6f 70 74 69 6f 6e 61 6c .#.num.(optional
1600: 29 20 74 68 65 20 6c 65 6e 67 74 68 20 6f 66 20 ) the length of
1610: 74 68 65 20 68 69 73 74 6f 72 79 20 6c 69 73 74 the history list
1620: 20 74 6f 20 72 65 74 75 72 6e 0a 23 0a 23 20 52 to return.#.# R
1630: 65 73 75 6c 74 73 3a 0a 23 09 41 20 66 6f 72 6d esults:.#.A form
1640: 61 74 74 65 64 20 68 69 73 74 6f 72 79 20 6c 69 atted history li
1650: 73 74 0a 0a 20 70 72 6f 63 20 74 63 6c 3a 3a 48 st.. proc tcl::H
1660: 69 73 74 49 6e 66 6f 20 7b 7b 6e 75 6d 20 7b 7d istInfo {{num {}
1670: 7d 7d 20 7b 0a 20 20 20 20 76 61 72 69 61 62 6c }} {. variabl
1680: 65 20 68 69 73 74 6f 72 79 0a 20 20 20 20 69 66 e history. if
1690: 20 7b 24 6e 75 6d 20 65 71 20 22 22 7d 20 7b 0a {$num eq ""} {.
16a0: 09 73 65 74 20 6e 75 6d 20 5b 65 78 70 72 20 7b .set num [expr {
16b0: 24 68 69 73 74 6f 72 79 28 6b 65 65 70 29 20 2b $history(keep) +
16c0: 20 31 7d 5d 0a 20 20 20 20 7d 0a 20 20 20 20 73 1}]. }. s
16d0: 65 74 20 72 65 73 75 6c 74 20 7b 7d 0a 20 20 20 et result {}.
16e0: 20 73 65 74 20 6e 65 77 6c 69 6e 65 20 22 22 0a set newline "".
16f0: 20 20 20 20 66 6f 72 20 7b 73 65 74 20 69 20 5b for {set i [
1700: 65 78 70 72 20 7b 24 68 69 73 74 6f 72 79 28 6e expr {$history(n
1710: 65 78 74 69 64 29 20 2d 20 24 6e 75 6d 20 2b 20 extid) - $num +
1720: 31 7d 5d 7d 20 5c 0a 09 20 20 20 20 7b 24 69 20 1}]} \.. {$i
1730: 3c 3d 20 24 68 69 73 74 6f 72 79 28 6e 65 78 74 <= $history(next
1740: 69 64 29 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a id)} {incr i} {.
1750: 09 69 66 20 7b 21 5b 69 6e 66 6f 20 65 78 69 73 .if {![info exis
1760: 74 73 20 68 69 73 74 6f 72 79 28 24 69 29 5d 7d ts history($i)]}
1770: 20 7b 0a 09 20 20 20 20 63 6f 6e 74 69 6e 75 65 {.. continue
1780: 0a 09 7d 0a 20 20 20 20 20 20 20 20 73 65 74 20 ..}. set
1790: 63 6d 64 20 5b 73 74 72 69 6e 67 20 6d 61 70 20 cmd [string map
17a0: 5b 6c 69 73 74 20 5c 6e 20 5c 6e 5c 74 5d 20 5b [list \n \n\t] [
17b0: 73 74 72 69 6e 67 20 74 72 69 6d 72 69 67 68 74 string trimright
17c0: 20 24 68 69 73 74 6f 72 79 28 24 69 29 20 5c 20 $history($i) \
17d0: 5c 6e 5d 5d 0a 09 61 70 70 65 6e 64 20 72 65 73 \n]]..append res
17e0: 75 6c 74 20 24 6e 65 77 6c 69 6e 65 5b 66 6f 72 ult $newline[for
17f0: 6d 61 74 20 22 25 36 64 20 20 25 73 22 20 24 69 mat "%6d %s" $i
1800: 20 24 63 6d 64 5d 0a 09 73 65 74 20 6e 65 77 6c $cmd]..set newl
1810: 69 6e 65 20 5c 6e 0a 20 20 20 20 7d 0a 20 20 20 ine \n. }.
1820: 20 72 65 74 75 72 6e 20 24 72 65 73 75 6c 74 0a return $result.
1830: 7d 0a 0a 23 20 74 63 6c 3a 3a 48 69 73 74 52 65 }..# tcl::HistRe
1840: 64 6f 20 2d 2d 0a 23 0a 23 09 46 65 74 63 68 20 do --.#.#.Fetch
1850: 74 68 65 20 70 72 65 76 69 6f 75 73 20 6f 72 20 the previous or
1860: 73 70 65 63 69 66 69 65 64 20 65 76 65 6e 74 2c specified event,
1870: 20 65 78 65 63 75 74 65 20 69 74 2c 20 61 6e 64 execute it, and
1880: 20 74 68 65 6e 0a 23 09 72 65 70 6c 61 63 65 20 then.#.replace
1890: 74 68 65 20 63 75 72 72 65 6e 74 20 68 69 73 74 the current hist
18a0: 6f 72 79 20 69 74 65 6d 20 77 69 74 68 20 74 68 ory item with th
18b0: 61 74 20 65 76 65 6e 74 2e 0a 23 0a 23 20 50 61 at event..#.# Pa
18c0: 72 61 6d 65 74 65 72 73 3a 0a 23 09 65 76 65 6e rameters:.#.even
18d0: 74 09 28 6f 70 74 69 6f 6e 61 6c 29 20 69 6e 64 t.(optional) ind
18e0: 65 78 20 6f 66 20 68 69 73 74 6f 72 79 20 69 74 ex of history it
18f0: 65 6d 20 74 6f 20 72 65 64 6f 2e 20 20 44 65 66 em to redo. Def
1900: 61 75 6c 74 73 20 74 6f 20 2d 31 2c 0a 23 09 09 aults to -1,.#..
1910: 77 68 69 63 68 20 6d 65 61 6e 73 20 74 68 65 20 which means the
1920: 70 72 65 76 69 6f 75 73 20 65 76 65 6e 74 2e 0a previous event..
1930: 23 0a 23 20 52 65 73 75 6c 74 73 3a 0a 23 09 54 #.# Results:.#.T
1940: 68 6f 73 65 20 6f 66 20 74 68 65 20 63 6f 6d 6d hose of the comm
1950: 61 6e 64 20 62 65 69 6e 67 20 72 65 64 6f 6e 65 and being redone
1960: 2e 0a 23 0a 23 20 53 69 64 65 20 45 66 66 65 63 ..#.# Side Effec
1970: 74 73 3a 0a 23 09 52 65 70 6c 61 63 65 73 20 74 ts:.#.Replaces t
1980: 68 65 20 63 75 72 72 65 6e 74 20 68 69 73 74 6f he current histo
1990: 72 79 20 6c 69 73 74 20 69 74 65 6d 20 77 69 74 ry list item wit
19a0: 68 20 74 68 65 20 6f 6e 65 20 62 65 69 6e 67 20 h the one being
19b0: 72 65 64 6f 6e 65 2e 0a 0a 20 70 72 6f 63 20 74 redone... proc t
19c0: 63 6c 3a 3a 48 69 73 74 52 65 64 6f 20 7b 7b 65 cl::HistRedo {{e
19d0: 76 65 6e 74 20 2d 31 7d 7d 20 7b 0a 20 20 20 20 vent -1}} {.
19e0: 76 61 72 69 61 62 6c 65 20 68 69 73 74 6f 72 79 variable history
19f0: 0a 20 20 20 20 69 66 20 7b 24 65 76 65 6e 74 20 . if {$event
1a00: 65 71 20 22 22 7d 20 7b 0a 09 73 65 74 20 65 76 eq ""} {..set ev
1a10: 65 6e 74 20 2d 31 0a 20 20 20 20 7d 0a 20 20 20 ent -1. }.
1a20: 20 73 65 74 20 69 20 5b 48 69 73 74 49 6e 64 65 set i [HistInde
1a30: 78 20 24 65 76 65 6e 74 5d 0a 20 20 20 20 69 66 x $event]. if
1a40: 20 7b 24 69 20 3d 3d 20 24 68 69 73 74 6f 72 79 {$i == $history
1a50: 28 6e 65 78 74 69 64 29 7d 20 7b 0a 09 72 65 74 (nextid)} {..ret
1a60: 75 72 6e 20 2d 63 6f 64 65 20 65 72 72 6f 72 20 urn -code error
1a70: 22 63 61 6e 6e 6f 74 20 72 65 64 6f 20 74 68 65 "cannot redo the
1a80: 20 63 75 72 72 65 6e 74 20 65 76 65 6e 74 22 0a current event".
1a90: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 63 6d }. set cm
1aa0: 64 20 24 68 69 73 74 6f 72 79 28 24 69 29 0a 20 d $history($i).
1ab0: 20 20 20 48 69 73 74 43 68 61 6e 67 65 20 24 63 HistChange $c
1ac0: 6d 64 20 30 0a 20 20 20 20 75 70 6c 65 76 65 6c md 0. uplevel
1ad0: 20 23 30 20 24 63 6d 64 0a 7d 0a 0a 23 20 74 63 #0 $cmd.}..# tc
1ae0: 6c 3a 3a 48 69 73 74 49 6e 64 65 78 20 2d 2d 0a l::HistIndex --.
1af0: 23 0a 23 09 4d 61 70 20 66 72 6f 6d 20 61 6e 20 #.#.Map from an
1b00: 65 76 65 6e 74 20 73 70 65 63 69 66 69 65 72 20 event specifier
1b10: 74 6f 20 61 6e 20 69 6e 64 65 78 20 69 6e 20 74 to an index in t
1b20: 68 65 20 68 69 73 74 6f 72 79 20 6c 69 73 74 2e he history list.
1b30: 0a 23 0a 23 20 50 61 72 61 6d 65 74 65 72 73 3a .#.# Parameters:
1b40: 0a 23 09 65 76 65 6e 74 09 69 6e 64 65 78 20 6f .#.event.index o
1b50: 66 20 68 69 73 74 6f 72 79 20 69 74 65 6d 20 74 f history item t
1b60: 6f 20 72 65 64 6f 2e 0a 23 09 09 49 66 20 74 68 o redo..#..If th
1b70: 69 73 20 69 73 20 61 20 70 6f 73 69 74 69 76 65 is is a positive
1b80: 20 6e 75 6d 62 65 72 2c 20 69 74 20 69 73 20 75 number, it is u
1b90: 73 65 64 20 64 69 72 65 63 74 6c 79 2e 0a 23 09 sed directly..#.
1ba0: 09 49 66 20 69 74 20 69 73 20 61 20 6e 65 67 61 .If it is a nega
1bb0: 74 69 76 65 20 6e 75 6d 62 65 72 2c 20 74 68 65 tive number, the
1bc0: 6e 20 69 74 20 63 6f 75 6e 74 73 20 62 61 63 6b n it counts back
1bd0: 20 74 6f 20 61 20 70 72 65 76 69 6f 75 73 0a 23 to a previous.#
1be0: 09 09 65 76 65 6e 74 2c 20 77 68 65 72 65 20 2d ..event, where -
1bf0: 31 20 69 73 20 74 68 65 20 6d 6f 73 74 20 72 65 1 is the most re
1c00: 63 65 6e 74 20 65 76 65 6e 74 2e 0a 23 09 09 41 cent event..#..A
1c10: 20 73 74 72 69 6e 67 20 63 61 6e 20 62 65 20 6d string can be m
1c20: 61 74 63 68 65 64 2c 20 65 69 74 68 65 72 20 62 atched, either b
1c30: 79 20 62 65 69 6e 67 20 74 68 65 20 70 72 65 66 y being the pref
1c40: 69 78 20 6f 66 0a 23 09 09 61 20 63 6f 6d 6d 61 ix of.#..a comma
1c50: 6e 64 20 6f 72 20 62 79 20 6d 61 74 63 68 69 6e nd or by matchin
1c60: 67 20 61 20 63 6f 6d 6d 61 6e 64 20 77 69 74 68 g a command with
1c70: 20 73 74 72 69 6e 67 20 6d 61 74 63 68 2e 0a 23 string match..#
1c80: 0a 23 20 52 65 73 75 6c 74 73 3a 0a 23 09 54 68 .# Results:.#.Th
1c90: 65 20 69 6e 64 65 78 20 69 6e 74 6f 20 68 69 73 e index into his
1ca0: 74 6f 72 79 2c 20 6f 72 20 61 6e 20 65 72 72 6f tory, or an erro
1cb0: 72 20 69 66 20 74 68 65 20 69 6e 64 65 78 20 64 r if the index d
1cc0: 69 64 6e 27 74 20 6d 61 74 63 68 2e 0a 0a 20 70 idn't match... p
1cd0: 72 6f 63 20 74 63 6c 3a 3a 48 69 73 74 49 6e 64 roc tcl::HistInd
1ce0: 65 78 20 7b 65 76 65 6e 74 7d 20 7b 0a 20 20 20 ex {event} {.
1cf0: 20 76 61 72 69 61 62 6c 65 20 68 69 73 74 6f 72 variable histor
1d00: 79 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 y. if {[catch
1d10: 20 7b 65 78 70 72 20 7b 7e 24 65 76 65 6e 74 7d {expr {~$event}
1d20: 7d 5d 7d 20 7b 0a 09 66 6f 72 20 7b 73 65 74 20 }]} {..for {set
1d30: 69 20 5b 65 78 70 72 20 7b 24 68 69 73 74 6f 72 i [expr {$histor
1d40: 79 28 6e 65 78 74 69 64 29 2d 31 7d 5d 7d 20 7b y(nextid)-1}]} {
1d50: 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 68 69 73 [info exists his
1d60: 74 6f 72 79 28 24 69 29 5d 7d 20 5c 0a 09 09 7b tory($i)]} \...{
1d70: 69 6e 63 72 20 69 20 2d 31 7d 20 7b 0a 09 20 20 incr i -1} {..
1d80: 20 20 69 66 20 7b 5b 73 74 72 69 6e 67 20 6d 61 if {[string ma
1d90: 74 63 68 20 24 65 76 65 6e 74 2a 20 24 68 69 73 tch $event* $his
1da0: 74 6f 72 79 28 24 69 29 5d 7d 20 7b 0a 09 09 72 tory($i)]} {...r
1db0: 65 74 75 72 6e 20 24 69 3b 0a 09 20 20 20 20 7d eturn $i;.. }
1dc0: 0a 09 20 20 20 20 69 66 20 7b 5b 73 74 72 69 6e .. if {[strin
1dd0: 67 20 6d 61 74 63 68 20 24 65 76 65 6e 74 20 24 g match $event $
1de0: 68 69 73 74 6f 72 79 28 24 69 29 5d 7d 20 7b 0a history($i)]} {.
1df0: 09 09 72 65 74 75 72 6e 20 24 69 3b 0a 09 20 20 ..return $i;..
1e00: 20 20 7d 0a 09 7d 0a 09 72 65 74 75 72 6e 20 2d }..}..return -
1e10: 63 6f 64 65 20 65 72 72 6f 72 20 22 6e 6f 20 65 code error "no e
1e20: 76 65 6e 74 20 6d 61 74 63 68 65 73 20 5c 22 24 vent matches \"$
1e30: 65 76 65 6e 74 5c 22 22 0a 20 20 20 20 7d 20 65 event\"". } e
1e40: 6c 73 65 69 66 20 7b 24 65 76 65 6e 74 20 3c 3d lseif {$event <=
1e50: 20 30 7d 20 7b 0a 09 73 65 74 20 69 20 5b 65 78 0} {..set i [ex
1e60: 70 72 20 7b 24 68 69 73 74 6f 72 79 28 6e 65 78 pr {$history(nex
1e70: 74 69 64 29 20 2b 20 24 65 76 65 6e 74 7d 5d 0a tid) + $event}].
1e80: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 73 65 } else {..se
1e90: 74 20 69 20 24 65 76 65 6e 74 0a 20 20 20 20 7d t i $event. }
1ea0: 0a 20 20 20 20 69 66 20 7b 24 69 20 3c 3d 20 24 . if {$i <= $
1eb0: 68 69 73 74 6f 72 79 28 6f 6c 64 65 73 74 29 7d history(oldest)}
1ec0: 20 7b 0a 09 72 65 74 75 72 6e 20 2d 63 6f 64 65 {..return -code
1ed0: 20 65 72 72 6f 72 20 22 65 76 65 6e 74 20 5c 22 error "event \"
1ee0: 24 65 76 65 6e 74 5c 22 20 69 73 20 74 6f 6f 20 $event\" is too
1ef0: 66 61 72 20 69 6e 20 74 68 65 20 70 61 73 74 22 far in the past"
1f00: 0a 20 20 20 20 7d 0a 20 20 20 20 69 66 20 7b 24 . }. if {$
1f10: 69 20 3e 20 24 68 69 73 74 6f 72 79 28 6e 65 78 i > $history(nex
1f20: 74 69 64 29 7d 20 7b 0a 09 72 65 74 75 72 6e 20 tid)} {..return
1f30: 2d 63 6f 64 65 20 65 72 72 6f 72 20 22 65 76 65 -code error "eve
1f40: 6e 74 20 5c 22 24 65 76 65 6e 74 5c 22 20 68 61 nt \"$event\" ha
1f50: 73 6e 27 74 20 6f 63 63 75 72 65 64 20 79 65 74 sn't occured yet
1f60: 22 0a 20 20 20 20 7d 0a 20 20 20 20 72 65 74 75 ". }. retu
1f70: 72 6e 20 24 69 0a 7d 0a 0a 23 20 74 63 6c 3a 3a rn $i.}..# tcl::
1f80: 48 69 73 74 45 76 65 6e 74 20 2d 2d 0a 23 0a 23 HistEvent --.#.#
1f90: 09 4d 61 70 20 66 72 6f 6d 20 61 6e 20 65 76 65 .Map from an eve
1fa0: 6e 74 20 73 70 65 63 69 66 69 65 72 20 74 6f 20 nt specifier to
1fb0: 74 68 65 20 76 61 6c 75 65 20 69 6e 20 74 68 65 the value in the
1fc0: 20 68 69 73 74 6f 72 79 20 6c 69 73 74 2e 0a 23 history list..#
1fd0: 0a 23 20 50 61 72 61 6d 65 74 65 72 73 3a 0a 23 .# Parameters:.#
1fe0: 09 65 76 65 6e 74 09 69 6e 64 65 78 20 6f 66 20 .event.index of
1ff0: 68 69 73 74 6f 72 79 20 69 74 65 6d 20 74 6f 20 history item to
2000: 72 65 64 6f 2e 20 20 53 65 65 20 69 6e 64 65 78 redo. See index
2010: 20 66 6f 72 20 61 0a 23 09 09 64 65 73 63 72 69 for a.#..descri
2020: 70 74 69 6f 6e 20 6f 66 20 70 6f 73 73 69 62 6c ption of possibl
2030: 65 20 65 76 65 6e 74 20 70 61 74 74 65 72 6e 73 e event patterns
2040: 2e 0a 23 0a 23 20 52 65 73 75 6c 74 73 3a 0a 23 ..#.# Results:.#
2050: 09 54 68 65 20 76 61 6c 75 65 20 66 72 6f 6d 20 .The value from
2060: 74 68 65 20 68 69 73 74 6f 72 79 20 6c 69 73 74 the history list
2070: 2e 0a 0a 20 70 72 6f 63 20 74 63 6c 3a 3a 48 69 ... proc tcl::Hi
2080: 73 74 45 76 65 6e 74 20 7b 65 76 65 6e 74 7d 20 stEvent {event}
2090: 7b 0a 20 20 20 20 76 61 72 69 61 62 6c 65 20 68 {. variable h
20a0: 69 73 74 6f 72 79 0a 20 20 20 20 73 65 74 20 69 istory. set i
20b0: 20 5b 48 69 73 74 49 6e 64 65 78 20 24 65 76 65 [HistIndex $eve
20c0: 6e 74 5d 0a 20 20 20 20 69 66 20 7b 5b 69 6e 66 nt]. if {[inf
20d0: 6f 20 65 78 69 73 74 73 20 68 69 73 74 6f 72 79 o exists history
20e0: 28 24 69 29 5d 7d 20 7b 0a 09 72 65 74 75 72 6e ($i)]} {..return
20f0: 20 5b 73 74 72 69 6e 67 20 74 72 69 6d 72 69 67 [string trimrig
2100: 68 74 20 24 68 69 73 74 6f 72 79 28 24 69 29 20 ht $history($i)
2110: 5c 20 5c 6e 5d 0a 20 20 20 20 7d 20 65 6c 73 65 \ \n]. } else
2120: 20 7b 0a 09 72 65 74 75 72 6e 20 22 22 3b 0a 20 {..return "";.
2130: 20 20 20 7d 0a 7d 0a 0a 23 20 74 63 6c 3a 3a 48 }.}..# tcl::H
2140: 69 73 74 43 68 61 6e 67 65 20 2d 2d 0a 23 0a 23 istChange --.#.#
2150: 09 52 65 70 6c 61 63 65 20 61 20 76 61 6c 75 65 .Replace a value
2160: 20 69 6e 20 74 68 65 20 68 69 73 74 6f 72 79 20 in the history
2170: 6c 69 73 74 2e 0a 23 0a 23 20 50 61 72 61 6d 65 list..#.# Parame
2180: 74 65 72 73 3a 0a 23 09 63 6d 64 09 54 68 65 20 ters:.#.cmd.The
2190: 6e 65 77 20 76 61 6c 75 65 20 74 6f 20 70 75 74 new value to put
21a0: 20 69 6e 74 6f 20 74 68 65 20 68 69 73 74 6f 72 into the histor
21b0: 79 20 6c 69 73 74 2e 0a 23 09 65 76 65 6e 74 09 y list..#.event.
21c0: 28 6f 70 74 69 6f 6e 61 6c 29 20 69 6e 64 65 78 (optional) index
21d0: 20 6f 66 20 68 69 73 74 6f 72 79 20 69 74 65 6d of history item
21e0: 20 74 6f 20 72 65 64 6f 2e 20 20 53 65 65 20 69 to redo. See i
21f0: 6e 64 65 78 20 66 6f 72 20 61 0a 23 09 09 64 65 ndex for a.#..de
2200: 73 63 72 69 70 74 69 6f 6e 20 6f 66 20 70 6f 73 scription of pos
2210: 73 69 62 6c 65 20 65 76 65 6e 74 20 70 61 74 74 sible event patt
2220: 65 72 6e 73 2e 20 20 54 68 69 73 20 64 65 66 61 erns. This defa
2230: 75 6c 74 73 0a 23 09 09 74 6f 20 30 2c 20 77 68 ults.#..to 0, wh
2240: 69 63 68 20 73 70 65 63 69 66 69 65 73 20 74 68 ich specifies th
2250: 65 20 63 75 72 72 65 6e 74 20 65 76 65 6e 74 2e e current event.
2260: 0a 23 0a 23 20 53 69 64 65 20 45 66 66 65 63 74 .#.# Side Effect
2270: 73 3a 0a 23 09 43 68 61 6e 67 65 73 20 74 68 65 s:.#.Changes the
2280: 20 68 69 73 74 6f 72 79 20 6c 69 73 74 2e 0a 0a history list...
2290: 20 70 72 6f 63 20 74 63 6c 3a 3a 48 69 73 74 43 proc tcl::HistC
22a0: 68 61 6e 67 65 20 7b 63 6d 64 20 7b 65 76 65 6e hange {cmd {even
22b0: 74 20 30 7d 7d 20 7b 0a 20 20 20 20 76 61 72 69 t 0}} {. vari
22c0: 61 62 6c 65 20 68 69 73 74 6f 72 79 0a 20 20 20 able history.
22d0: 20 73 65 74 20 69 20 5b 48 69 73 74 49 6e 64 65 set i [HistInde
22e0: 78 20 24 65 76 65 6e 74 5d 0a 20 20 20 20 73 65 x $event]. se
22f0: 74 20 68 69 73 74 6f 72 79 28 24 69 29 20 24 63 t history($i) $c
2300: 6d 64 0a 7d 0a md.}.
