![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to ring.el CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / dist-1.3 / fi|
Return to ring.el CVS log | Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / dist-1.3 / fi |
1.1 root 1: ;;
2: ;; copyright (C) 1987, 1988 Franz Inc, Berkeley, Ca.
3: ;;
4: ;; The software, data and information contained herein are the property
5: ;; of Franz, Inc.
6: ;;
7: ;; This file (or any derivation of it) may be distributed without
8: ;; further permission from Franz Inc. as long as:
9: ;;
10: ;; * it is not part of a product for sale,
11: ;; * no charge is made for the distribution, other than a tape
12: ;; fee, and
13: ;; * all copyright notices and this notice are preserved.
14: ;;
15: ;; If you have any comments or questions on this interface, please feel
16: ;; free to contact Franz Inc. at
17: ;; Franz Inc.
18: ;; Attn: Kevin Layer
19: ;; 1995 University Ave
20: ;; Suite 275
21: ;; Berkeley, CA 94704
22: ;; (415) 548-3600
23: ;; or
24: ;; emacs-info%[email protected]
25: ;; ucbvax!franz!emacs-info
26: ;;
27:
28: ;; Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.
29: ;;
30: ;; This file is derived from part of GNU Emacs.
31: ;;
32: ;; GNU Emacs is distributed in the hope that it will be useful,
33: ;; but WITHOUT ANY WARRANTY. No author or distributor
34: ;; accepts responsibility to anyone for the consequences of using it
35: ;; or for whether it serves any particular purpose or works at all,
36: ;; unless he says so in writing. Refer to the GNU Emacs General Public
37: ;; License for full details.
38: ;;
39: ;; Everyone is granted permission to copy, modify and redistribute
40: ;; GNU Emacs, but only under the conditions described in the
41: ;; GNU Emacs General Public License. A copy of this license is
42: ;; supposed to have been given to you along with GNU Emacs so you
43: ;; can know your rights and responsibilities. It should be in a
44: ;; file named COPYING. Among other things, the copyright notice
45: ;; and this notice must be preserved on all copies.
46:
47: ;; $Header: ring.el,v 1.8 88/07/15 18:32:33 layer Exp $
48:
49: ;; This code is very similar to the kill-ring implementation
50: ;; and implements the fi::subprocess input ring. Each fi::subprocess buffer
51: ;; has its own input ring.
52:
53: (defvar fi:default-input-ring-max 50
54: "*The default maximum length to which an input ring is allowed to grow.")
55:
56: (defvar fi::input-ring nil
57: "A list of previous input to a subprocess.")
58:
59: (defvar fi::input-ring-max fi:default-input-ring-max
60: "Maximum length of input ring before oldest elements are thrown away.")
61:
62: (defvar fi::input-ring-yank-pointer nil
63: "The tail of the input ring whose car is the last thing yanked.")
64:
65: (defvar fi::last-input-search-string ""
66: "Last input search string in each fi::subprocess buffer.")
67:
68: (defvar fi::last-command-was-successful-search nil
69: "Switch to indicate that last command was a successful input re-search.")
70:
71: (defun fi::input-append (string before-p)
72: (setq fi::last-command-was-successful-search nil)
73: (setcar fi::input-ring
74: (if before-p
75: (concat string (car fi::input-ring))
76: (concat (car fi::input-ring) string))))
77:
78: (defun fi::input-region (beg end)
79: "Delete text between point and mark and save in input ring.
80: This is the primitive for programs to kill text into the input ring.
81: Supply two arguments, character numbers indicating the stretch of text to
82: be killed. If the previous command was also a kill command, the text
83: killed this time appends to the text killed last time to make one entry in
84: the subprocess input ring."
85: (interactive "*r")
86: (setq fi::last-command-was-successful-search nil)
87: (fi::input-ring-save beg end)
88: (delete-region beg end))
89:
90: (defun fi::input-ring-save (beg end)
91: "Save the region on the subprocess input ring but don't kill it."
92: (interactive "r")
93: (setq fi::last-command-was-successful-search nil)
94: (if (eq last-command 'fi::input-region)
95: (fi::input-append (buffer-substring beg end) (< end beg))
96: (setq fi::input-ring (cons (buffer-substring beg end) fi::input-ring))
97: (if (> (length fi::input-ring) fi::input-ring-max)
98: (setcdr (nthcdr (1- fi::input-ring-max) fi::input-ring) nil)))
99: (setq this-command 'fi::input-region)
100: (setq fi::input-ring-yank-pointer fi::input-ring))
101:
102: (defun fi::rotate-yank-input-pointer (arg)
103: "Rotate the yanking point in the fi::subprocess input ring."
104: (interactive "p")
105: (setq fi::last-command-was-successful-search nil)
106: (let ((ring-length (length fi::input-ring))
107: (yank-ring-length (length fi::input-ring-yank-pointer)))
108: (cond
109: ((zerop ring-length)
110: (error "Fi::subprocess input ring is empty."))
111: ((< arg 0)
112: (setq arg (- ring-length (% (- arg) ring-length)))
113: (setq fi::input-ring-yank-pointer
114: (nthcdr (% (+ arg (- ring-length yank-ring-length)) ring-length)
115: fi::input-ring)))
116: (t
117: (setq fi::input-ring-yank-pointer
118: (nthcdr (% (+ arg (- ring-length yank-ring-length)) ring-length)
119: fi::input-ring))))))
120:
121: (defun fi:pop-input (&optional arg)
122: "Yank previous text from input ring. Cycle through input ring with each
123: successive invocation."
124: (interactive "*p")
125: (setq fi::last-command-was-successful-search nil)
126: (if (not (memq last-command '(fi::yank-input
127: fi:re-search-backward-input
128: fi:re-search-forward-input)))
129: (progn
130: (fi::yank-input arg)
131: (setq this-command 'fi::yank-input))
132: (progn
133: (setq this-command 'fi::yank-input)
134: (let ((before (< (point) (mark))))
135: (delete-region (point) (mark))
136: (fi::rotate-yank-input-pointer arg)
137: (set-mark (point))
138: (insert (car fi::input-ring-yank-pointer))
139: (if before (exchange-point-and-mark))))))
140:
141: (defun fi:push-input (&optional arg)
142: "Yank next text from input ring. Cycle through input ring in reverse
143: order with each successive invocation."
144: (interactive "*p")
145: (setq fi::last-command-was-successful-search nil)
146: (if (not (memq last-command '(fi::yank-input
147: fi:re-search-backward-input
148: fi:re-search-forward-input)))
149: (progn
150: (fi::yank-input (- (1- arg)))
151: (setq this-command 'fi::yank-input))
152: (progn
153: (setq this-command 'fi::yank-input)
154: (let ((before (< (point) (mark))))
155: (delete-region (point) (mark))
156: (fi::rotate-yank-input-pointer (- arg))
157: (set-mark (point))
158: (insert (car fi::input-ring-yank-pointer))
159: (if before (exchange-point-and-mark))))))
160:
161: (defun fi::yank-input (&optional arg)
162: "Reinsert the last fi::subprocess input text.
163: More precisely, reinsert the input text most recently killed OR yanked.
164: With just C-U as argument, same but put point in front (and mark at end).
165: With argument n, reinsert the nth most recent input text.
166: See also the command fi::yank-input-pop."
167: (interactive "*P")
168: (setq fi::last-command-was-successful-search nil)
169: (fi::rotate-yank-input-pointer (if (listp arg) 0
170: (if (eq arg '-) -1
171: (1- arg))))
172: (set-mark (point))
173: (insert (car fi::input-ring-yank-pointer))
174: (if (consp arg)
175: (exchange-point-and-mark)))
176:
177: (defun fi:list-input-ring (arg &optional reflect)
178: "Display contents of input ring, starting at arg. The list is displayed
179: in reverse order if called from a program and the optional second parameter
180: is non-nil."
181: (interactive "p")
182: (let* ((input-ring-for-list fi::input-ring)
183: (input-ring-max-for-list fi::input-ring-max)
184: (input-ring-yank-pointer-for-list fi::input-ring-yank-pointer)
185: (ring-length (length fi::input-ring))
186: (yank-ring-length (length fi::input-ring-yank-pointer))
187: (loops ring-length)
188: nth
189: first
190: count)
191: (if (zerop ring-length) (error "Input ring is empty."))
192: ;; We rely on (error) to exit from this function. [HW]
193: (if reflect
194: (if (= arg 1)
195: (setq arg -1)
196: (setq arg (1- arg))))
197: (cond
198: ((< arg 0)
199: (setq arg (- ring-length (% (- arg) ring-length)))
200: (setq count (1+ arg))
201: (setq nth (% (+ arg (- ring-length yank-ring-length)) ring-length)))
202: ((= arg 0)
203: (setq count 1)
204: (setq nth (% (+ arg (- ring-length yank-ring-length)) ring-length)))
205: (t
206: (setq count arg)
207: (setq arg (1- arg))
208: (setq nth (% (+ arg (- ring-length yank-ring-length)) ring-length))))
209: (setq first nth)
210: (with-output-to-temp-buffer
211: "*Input Ring*"
212: (save-excursion
213: (set-buffer standard-output)
214: (let ((lastcdr (nthcdr nth input-ring-for-list)))
215: ; GNU Emacs really needs better looping constructs. [HW]
216: (while
217: (not (cond
218: ((= loops 0)
219: t)
220: ((and (= nth (1- ring-length)) (not reflect))
221: (setq nth 0)
222: nil)
223: ((and (= nth 0) reflect)
224: (setq nth (1- ring-length))
225: nil)
226: (t
227: (setq nth (if reflect (1- nth) (1+ nth)))
228: nil)))
229: (insert (int-to-string count) " " (car lastcdr) "\n")
230: (setq lastcdr (nthcdr nth input-ring-for-list))
231: (setq count (if reflect (1- count) (1+ count)))
232: (setq loops (1- loops))
233: (cond
234: ((> count ring-length)
235: (setq count 1))
236: ((< count 1)
237: (setq count ring-length)))))))))
238:
239: (defun fi::re-search-input-ring (regexp direction)
240: "Look for input text that contains string regexp.
241: Set fi::input-ring-yank-pointer to text."
242: (let* ((ring-length (length fi::input-ring))
243: (yank-ring-length (length fi::input-ring-yank-pointer))
244: (nth (- ring-length yank-ring-length))
245: (loops ring-length)
246: (return-value nil)
247: (lastcdr (nthcdr nth fi::input-ring)))
248: (if (zerop ring-length) (error "Input ring is empty."))
249: ;; We rely on (error) to exit from this function. [HW]
250: (while
251: (not
252: (cond
253: ((= loops 0)
254: t)
255: ((string-match regexp (car lastcdr) nil)
256: (setq fi::input-ring-yank-pointer lastcdr)
257: (setq return-value t))
258: ((and (= nth (1- ring-length)) (>= direction 0))
259: (setq nth 0)
260: nil)
261: ((and (= nth 0) (< direction 0))
262: (setq nth (1- ring-length))
263: nil)
264: (t
265: (setq nth (if (< direction 0) (1- nth) (1+ nth)))
266: nil)))
267: (setq lastcdr (nthcdr nth fi::input-ring))
268: (setq loops (1- loops)))
269: (if return-value (setq fi::last-input-search-string regexp))
270: return-value))
271:
272: (defun fi:re-search-backward-input (arg regexp)
273: "Search in input ring for text that contains regexp and yank."
274: (interactive "*p\nsRE search input backward: ")
275: (if (string= regexp "") (setq regexp fi::last-input-search-string))
276: (if fi::last-command-was-successful-search
277: (fi::rotate-yank-input-pointer 1))
278: (setq fi::last-command-was-successful-search nil)
279: (if (let ((found t))
280: (while (and (> arg 0) found)
281: (setq found (fi::re-search-input-ring regexp 1))
282: (setq arg (1- arg))
283: (if (and (> arg 0) found)
284: (fi::rotate-yank-input-pointer 1)))
285: found)
286: (progn
287: (fi::yank-input-at-pointer)
288: (setq this-command 'fi:re-search-backward-input)
289: (setq fi::last-command-was-successful-search t))
290: (message "Matching string not found in input ring.")))
291:
292: (defun fi:re-search-forward-input (arg regexp)
293: "Search in input ring for text that contains regexp and yank."
294: (interactive "*p\nsRE search input forward: ")
295: (if fi::last-command-was-successful-search
296: (fi::rotate-yank-input-pointer -1))
297: (setq fi::last-command-was-successful-search nil)
298: (if (string= regexp "") (setq regexp fi::last-input-search-string))
299: (if (let ((found t))
300: (while (and (> arg 0) found)
301: (setq found (fi::re-search-input-ring regexp -1))
302: (setq arg (1- arg))
303: (if (and (> arg 0) found)
304: (fi::rotate-yank-input-pointer -1)))
305: found)
306: (progn
307: (fi::yank-input-at-pointer)
308: (setq this-command 'fi:re-search-backward-input)
309: (setq fi::last-command-was-successful-search t))
310: (message "Matching string not found in input ring.")))
311:
312: (defun fi::yank-input-at-pointer ()
313: "Yank input at current input ring pointer.
314: Used internally by fi:re-search-backward-input and fi:re-search-forward-input."
315: ;; This business of last-command does not work here since the
316: ;; `last command' was self-insert-command because of the prompt
317: ;; for a regular expression by (fi:re-search-forward-input) and
318: ;; (fi:re-search-backward-input).
319: (delete-region (process-mark (get-buffer-process (current-buffer))) (point))
320: (set-mark (point))
321: (insert (car fi::input-ring-yank-pointer)))
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.