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