Planet
navi homePPSaboutscreenshotsdownloaddevelopmentforum

source: data/media/tcl8.5/history.tcl @ 5238

Last change on this file since 5238 was 5167, checked in by rgrieder, 16 years ago

added svn property svn:eol-style native to all tcl files

  • Property svn:eol-style set to native
File size: 8.8 KB
Line 
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}
Note: See TracBrowser for help on using the repository browser.