![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to history.l CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSDReno / pgrm / lisp / pearl|
Return to history.l CVS log | Up to [CSRG BSD Unix] / 43BSDReno / pgrm / lisp / pearl |
1.1 root 1: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; history.l ;;;;;;;;;;;;;;;;;;;;;;;;;;;
2: ; Functions for adding a command to the command history, printing
3: ; the command history, processing aliased atoms and handling
4: ; the history-invoking splice macros ! and $.
5: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
6: ; Copyright (c) 1983 , The Regents of the University of California.
7: ; All rights reserved.
8: ; Authors: Joseph Faletti and Michael Deering.
9:
10: ; Given two lists of atoms, determine if the first is a prefix of the second.
11: (de prefix (item1 item2)
12: (prog ()
13: prefixloop
14: (cond ((null item1) (return t)) ; item1 ran out first: succeed.
15: ((null item2) (return nil)) ; item2 ran out first: fail.
16: ((neq (car item1) (car item2)) ; no match: fail.
17: (return nil))
18: ; Otherwise, try next atoms.
19: ( t (setq item1 (cdr item1))
20: (setq item2 (cdr item2))
21: (go prefixloop)))))
22:
23: ; Add the LINE to the *history* hunk in the *historynumber* spot,
24: ; after possibly replacing it with its alias (for atoms) saved
25: ; on the property list under the ALIAS property.
26: (de addhistory (line)
27: (let (alias)
28: ; Replace with alias if there is one.
29: (and *usealiases*
30: (litatom line)
31: (setq alias (get line 'alias))
32: (setq line alias))
33:
34: ; Store in the command history table.
35: (setq *historynumber* (1+ *historynumber*))
36: (rplacx (\\ *historynumber* *historysize*)
37: *history*
38: (copy line)) ; To eliminate macroexpansions.
39:
40: ; If it has been changed by read macros, print it out again.
41: (cond (*readlinechanged*
42: (pearlprintfn line)
43: (terpri)))
44: line))
45:
46: ; Print the command history. Optional argument determines how
47: ; many commands get printed, otherwise, the whole history.
48: (de history narg
49: (cond ((\=& 0 narg)
50: (cond ((ge *historynumber* *historysize*)
51: (for command (1+ (- *historynumber* *historysize*))
52: *historynumber*
53: (msg t command ": "
54: (cxr (\\ command *historysize*)
55: *history*))))
56: ( t (for command 0 *historynumber*
57: (msg t command ": " (cxr command *history*))))))
58: ( t
59: (cond ((ge *historynumber* (arg 1))
60: (for command (1+ (- *historynumber* (arg 1)))
61: *historynumber*
62: (msg t command ": "
63: (cxr (\\ command *historysize*)
64: *history*))))
65: ( t (for command 0 *historynumber*
66: (msg t command ": " (cxr command *history*)))))))
67: '*invisible*)
68:
69: ; Look for a command with the next atom as a prefix and return the command.
70: (de prefixcommandhistory ()
71: (let* ((wanted (read))
72: (wanthead (explode wanted))
73: (commandnum *historynumber*)
74: (stoppingcommand (cond ((ge *historynumber* *historysize*)
75: (- *historynumber* *historysize*))
76: ( t -1.)))
77: commandhead)
78: (setq *readlinechanged* t)
79: (while (and (>& commandnum stoppingcommand)
80: (not (prefix wanthead
81: (prog2 (setq commandhead
82: (cxr (\\ commandnum
83: *historysize*)
84: *history*))
85: (setq commandhead
86: (explode
87: (cond ((atom commandhead)
88: commandhead)
89: ( t (car commandhead)))))
90: ))))
91: (setq commandnum (1- commandnum)))
92:
93: (cond ((>& commandnum stoppingcommand)
94: (ncons (cxr (\\ commandnum *historysize*)
95: *history*)))
96: ( t (ncons (concat '\! wanted))))))
97:
98: ; History command invoker.
99: (dsm \!
100: (lambda ()
101: (let
102: (num whole)
103: (selectq (tyipeek)
104: (33. (readc) ; !!
105: (setq *readlinechanged* t)
106: (ncons (cxr (\\ *historynumber* *historysize*)
107: *history*)))
108: (58. (readc) (setq num (read)) ; !:
109: (setq *readlinechanged* t)
110: (setq whole (cxr (\\ *historynumber* *historysize*)
111: *history*))
112: (cond ((atom whole) (ncons whole))
113: ( t (ncons (nth num whole)))))
114: (94. (readc) ; !^
115: (setq *readlinechanged* t)
116: (setq whole (cxr (\\ *historynumber* *historysize*)
117: *history*))
118: (cond ((atom whole) (ncons whole))
119: ( t (ncons (cadr whole)))))
120: (42. (readc) ; !*
121: (setq *readlinechanged* t)
122: (setq whole (cxr (\\ *historynumber* *historysize*)
123: *history*))
124: (cond ((atom whole) (ncons whole))
125: ( t (cdr whole))))
126: (36. (readc) ; !$
127: (setq *readlinechanged* t)
128: (setq whole (cxr (\\ *historynumber* *historysize*)
129: *history*))
130: (cond ((atom whole) (ncons whole))
131: ( t (ncons (last whole)))))
132: (9. (ncons '\!)) ; !Tab
133: (10. (ncons '\!)) ; !LF
134: (13. (ncons '\!)) ; !CR
135: (32. (ncons '\!)) ; !Blank
136: (41. (ncons '\!)) ; !rpar
137: ((48. 49. 50. 51. 52. 53. 54. 55. 56. 57.) ; !Number
138: (setq *readlinechanged* t)
139: (setq num (read))
140: (ncons (cxr (\\ num *historysize*)
141: *history*)))
142: (otherwise (prefixcommandhistory))) ; !Prefix
143: )))
144:
145: ; Look for a command with the next atom as a prefix and return its value.
146: (de prefixcommandvalue ()
147: (let* ((wanted (read))
148: (wanthead (explode wanted))
149: (commandnum *historynumber*)
150: (stoppingcommand (cond ((ge *historynumber* *historysize*)
151: (- *historynumber* *historysize*))
152: ( t -1.)))
153: commandhead)
154: (setq *readlinechanged* t)
155: (while (and (>& commandnum stoppingcommand)
156: (not (prefix wanthead
157: (prog2 (setq commandhead
158: (cxr (\\ commandnum
159: *historysize*)
160: *histval*))
161: (setq commandhead
162: (explode
163: (cond ((atom commandhead)
164: commandhead)
165: ( t (car commandhead)))))
166: ))))
167: (setq commandnum (1- commandnum)))
168:
169: (cond ((>& commandnum stoppingcommand)
170: (cxr (\\ commandnum *historysize*)
171: *histval*))
172: ( t (concat '\$ wanted)))))
173:
174: ; History command result invoker.
175: (dsm \$
176: (lambda ()
177: (let
178: (num whole)
179: (ncons
180: (selectq (tyipeek)
181: (36. (readc) ; $$
182: (setq *readlinechanged* t)
183: (list 'quote
184: (cxr (\\ *historynumber* *historysize*)
185: *histval*)))
186: (9. '\$) ; $Tab
187: (10. '\$) ; $LF
188: (13. '\$) ; $CR
189: (32. '\$) ; $Blank
190: (41. '\$) ; !rpar
191: ((48. 49. 50. 51. 52. 53. 54. 55. 56. 57.) ; $Number
192: (setq *readlinechanged* t)
193: (setq num (read))
194: (list 'quote (cxr (\\ num *historysize*)
195: *histval*)))
196: (otherwise ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; $Prefix
197: (list 'quote (prefixcommandvalue))))))))
198:
199: ; vi: set lisp:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.