![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to subproc.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 subproc.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: ;; $Header: subproc.el,v 1.46 88/11/22 20:21:39 layer Exp $
28:
29: ;; This file has its (distant) roots in lisp/shell.el, so:
30: ;;
31: ;; Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.
32: ;;
33: ;; This file is derived from part of GNU Emacs.
34: ;;
35: ;; GNU Emacs is distributed in the hope that it will be useful,
36: ;; but WITHOUT ANY WARRANTY. No author or distributor
37: ;; accepts responsibility to anyone for the consequences of using it
38: ;; or for whether it serves any particular purpose or works at all,
39: ;; unless he says so in writing. Refer to the GNU Emacs General Public
40: ;; License for full details.
41: ;;
42: ;; Everyone is granted permission to copy, modify and redistribute
43: ;; GNU Emacs, but only under the conditions described in the
44: ;; GNU Emacs General Public License. A copy of this license is
45: ;; supposed to have been given to you along with GNU Emacs so you
46: ;; can know your rights and responsibilities. It should be in a
47: ;; file named COPYING. Among other things, the copyright notice
48: ;; and this notice must be preserved on all copies.
49:
50: ;; Low-level subprocess mode guts
51:
52: ;;;;
53: ;;; Variables and Constants
54: ;;;;
55:
56: (defvar fi:common-lisp-image-name "cl"
57: "*Default Common Lisp image to invoke from `fi:common-lisp'. If the
58: value is a string then it names the image file or image path that
59: `fi:common-lisp' invokes. Otherwise, the value of this variable is given
60: to funcall, the result of which should yield a string which is the image
61: name or path.")
62:
63: (defvar fi:common-lisp-image-arguments nil
64: "*Default Common Lisp image arguments when invoked from `fi:common-lisp',
65: which must be a list of strings.")
66:
67: (defvar fi:common-lisp-prompt-pattern
68: "^\\(\\[[0-9]+c?\\] \\|\\[step\\] \\)?<[-A-Za-z]* ?[0-9]*?> "
69: "*The regular expression which matches the Common Lisp prompt, used in
70: Inferior Common Lisp mode. Anything from beginning of line up to the end
71: of what this pattern matches is deemed to be a prompt.")
72:
73: (defvar fi:franz-lisp-image-name "lisp"
74: "*Default Franz Lisp image to invoke from `fi:franz-lisp'. If the value
75: is a string then it names the image file or image path that
76: `fi:common-lisp' invokes. Otherwise, the value of this variable is given
77: to funcall, the result of which should yield a string which is the image
78: name or path.")
79:
80: (defvar fi:franz-lisp-image-arguments nil
81: "*Default Franz Lisp image arguments when invoked from `fi:franz-lisp'.")
82:
83: (defvar fi:franz-lisp-prompt-pattern
84: "^[-=]> +\\|^c{[0-9]+} +"
85: "*The regular expression which matches the Franz Lisp prompt, used in
86: Inferior Franz Lisp mode. Anything from beginning of line up to the end
87: of what this pattern matches is deemed to be a prompt.")
88:
89: (defvar fi:shell-popd-regexp ":?popd"
90: "*The regular expression matching the C shell `popd' command. If nil, no
91: automatic directory changes will be made.")
92:
93: (defvar fi:shell-pushd-regexp ":?pushd"
94: "*The regular expression matching the C shell `pushd' command. If nil,
95: no automatic directory changes will be made.")
96:
97: (defvar fi:shell-cd-regexp ":?cd"
98: "*The regular expression matching the C shell `cd' command. If nil,
99: no automatic directory changes will be made.")
100:
101: (defvar fi:common-lisp-package-regexp
102: "(in-package\\>\\|:\\<pa\\>\\|:\\<pac\\>\\|:\\<pack\\>\\|:\\<packa\\>\\|:\\<packag\\>\\|:\\<package\\>"
103: "*The regular expression matching the Common Lisp expression(s) to change
104: packages. If nil, no automatic package tracking will be done.")
105:
106: (defvar fi:subprocess-map-nl-to-cr nil
107: "*If t, then map newline to carriage-return.")
108:
109: (defvar fi:subprocess-continuously-show-output-in-visible-buffer t
110: "*If t, output from a subprocess to a visible buffer is continuously
111: shown. If a subprocess buffer is visible and the window point is beyond
112: the process output marker, output to that buffer from its associated
113: process will be continuously visible. If the window point is before the
114: process output marker, the window is not updated. This is a buffer-local
115: symbol.")
116:
117: (defvar fi:subprocess-write-quantum 120
118: "*Maximum size in bytes of a single write request to a subprocess.")
119:
120: (defvar fi:subprocess-enable-superkeys nil
121: "*If t, certain keys become `superkeys' in subprocess buffers--this
122: should be set before starting any subprocesses. The superkeys are C-a,
123: C-d, C-o,C-u, C-w, C-z, and C-\\, which will behave as they would in the
124: current local keymap when typed at the end of a subprocess buffer. If
125: typed elsewhere, these keys have their normal global binding. This is a
126: buffer-local symbol. Use setq-default to set the default value for this
127: symbol.")
128:
129: (defvar fi:display-buffer-function 'switch-to-buffer
130: "*If non-nil, then it is used as the function which is funcall'd with one
131: argument, a buffer, to display a subprocess buffer when it is created (ie,
132: from `fi:common-lisp').")
133:
134: ;;;;;;;;;;;;;;;;;;;;;; internal vars
135:
136: (defvar fi::cl-package-regexp nil
137: "The real Common Lisp package regexp, which is nil in all buffer except
138: Inferior Common Lisp buffers.")
139:
140: (defvar fi::last-input-start nil
141: "Marker for start of last input in fi:shell-mode or fi:inferior-lisp-mode
142: buffer.")
143:
144: (defvar fi::last-input-end nil
145: "Marker for end of last input in fi:shell-mode or fi:inferior-lisp-mode
146: buffer.")
147:
148: (defvar fi::sublisp-name nil
149: "Name of inferior lisp process.")
150:
151: (defvar fi::freshest-franz-sublisp-name nil
152: "Name of franz lisp subprocess most recently invoked.")
153:
154: (defvar fi::freshest-common-sublisp-name nil
155: "Name of common lisp subprocess most recently invoked.")
156:
157: (defvar fi::shell-directory-stack nil
158: "List of directories saved by pushd in this buffer's shell.")
159:
160: ;;;;
161: ;;; User visible functions
162: ;;;;
163:
164: (defun fi:common-lisp (&optional buffer-number)
165: "Start a Common Lisp subprocess in a buffer whose name is determined
166: from the optional prefix argument BUFFER-NUMBER. Common Lisp buffer names
167: start with `*common-lisp' and end with `*', with an optional `-N' in
168: between. If BUFFER-NUMBER is not given it defaults to 1. If BUFFER-NUMBER
169: is >= 0, then the buffer is named `*common-lisp-<BUFFER-NUMBER>*'. If
170: BUFFER-NUMBER is < 0, then the first available buffer name is chosen.
171:
172: The image file and image arguments are taken from the variables
173: `fi:common-lisp-image-name' and `fi:common-lisp-image-arguments'.
174:
175: See fi:explicit-common-lisp."
176: (interactive "p")
177: (let ((proc (fi::make-subprocess
178: buffer-number "common-lisp"
179: 'fi:inferior-common-lisp-mode
180: fi:common-lisp-prompt-pattern
181: fi:common-lisp-image-name
182: fi:common-lisp-image-arguments)))
183: (setq fi::freshest-common-sublisp-name (process-name proc))
184: proc))
185:
186: (defun fi:explicit-common-lisp (&optional buffer-number
187: image-name image-arguments)
188: "The same as fi:common-lisp, except that the image and image arguments
189: are read from the minibuffer."
190: (interactive "p\nsImage name: \nxImage arguments (a list): ")
191: (let ((proc (fi::make-subprocess
192: buffer-number "common-lisp"
193: 'fi:inferior-common-lisp-mode
194: fi:common-lisp-prompt-pattern
195: image-name image-arguments)))
196: (setq fi::freshest-common-sublisp-name (process-name proc))
197: proc))
198:
199: (defun fi:remote-common-lisp (&optional buffer-number host)
200: "Start a Common Lisp subprocess in a buffer whose name is determined
201: from the optional prefix argument BUFFER-NUMBER, where the Common Lisp
202: image is run on another machine. Common Lisp buffer names start with
203: `*common-lisp' and end with `*', with an optional `-N' in between. If
204: BUFFER-NUMBER is not given it defaults to 1. If BUFFER-NUMBER is >= 0,
205: then the buffer is named `*common-lisp-<BUFFER-NUMBER>*'. If BUFFER-NUMBER
206: is < 0, then the first available buffer name is chosen.
207:
208: The host on which the image is run is read from the minibuffer.
209:
210: The image file and image arguments are taken from the variables
211: `fi:common-lisp-image-name' and `fi:common-lisp-image-arguments'.
212:
213: See fi:explicit-remote-common-lisp."
214: (interactive "p\nsRemote host name: ")
215: (let ((proc (fi::make-subprocess
216: buffer-number "common-lisp"
217: 'fi:inferior-common-lisp-mode
218: fi:common-lisp-prompt-pattern
219: "rsh"
220: (append (list host fi:common-lisp-image-name)
221: fi:common-lisp-image-arguments))))
222: (setq fi::freshest-common-sublisp-name (process-name proc))
223: proc))
224:
225: (defun fi:explicit-remote-common-lisp (&optional buffer-number host
226: image-name image-arguments)
227: "The same as fi:remote-common-lisp, except that the image and image
228: arguments are read from the minibuffer."
229: (interactive
230: "p\nsRemote host name: \nsImage name: \nxImage arguments (a list): ")
231: (let ((proc (fi::make-subprocess
232: buffer-number "common-lisp"
233: 'fi:inferior-common-lisp-mode
234: fi:common-lisp-prompt-pattern
235: "rsh"
236: (append (list host image-name) image-arguments))))
237: (setq fi::freshest-common-sublisp-name (process-name proc))
238: proc))
239:
240: (defun fi:tcp-common-lisp (&optional buffer-number)
241: "In a buffer whose name is determined from the optional prefix argument
242: BUFFER-NAME, connect to a Common Lisp using either a UNIX domain socket
243: file or internet port number. Common Lisp buffer names start with
244: `*common-lisp' and end with `*', with an optional `-N' in between. If
245: BUFFER-NUMBER is not given it defaults to 1. If BUFFER-NUMBER is >= 0,then
246: the buffer is named `*common-lisp-<BUFFER-NUMBER>*'. If BUFFER-NUMBER is <
247: 0, then the first available buffer name is chosen.
248:
249: See `fi:unix-domain' and `fi:explicit-tcp-common-lisp'."
250: (interactive "p")
251: (let ((proc (fi::make-tcp-connection
252: buffer-number "tcp-common-lisp" 'fi:tcp-common-lisp-mode
253: fi:common-lisp-prompt-pattern)))
254: (setq fi::freshest-common-sublisp-name (process-name proc))
255: proc))
256:
257: (defun fi:explicit-tcp-common-lisp (&optional buffer-number host service)
258: "The same as fi:tcp-common-lisp, except that the host name a port number
259: are read from the minibuffer. Use a port number of 0 for UNIX domain
260: sockets."
261: (interactive
262: "p\nsHost name: \nnService port number (0 for UNIX domain): ")
263: (let ((proc (fi::make-tcp-connection
264: buffer-number "tcp-common-lisp" 'fi:tcp-common-lisp-mode
265: fi:common-lisp-prompt-pattern
266: host service)))
267: (setq fi::freshest-common-sublisp-name (process-name proc))
268: proc))
269:
270: (defun fi:franz-lisp (&optional buffer-number)
271: "Start a Franz Lisp subprocess in a buffer whose name is determined
272: from the optional prefix argument BUFFER-NUMBER. Franz Lisp buffer names
273: start with `*franz-lisp' and end with `*', with an optional `-N' in
274: between. If BUFFER-NUMBER is not given it defaults to 1. If BUFFER-NUMBER
275: is >= 0, then the buffer is named `*franz-lisp-<BUFFER-NUMBER>*'. If
276: BUFFER-NUMBER is < 0, then the first available buffer name is chosen.
277:
278: The image file and image arguments are taken from the variables
279: `fi:franz-lisp-image-name' and `fi:franz-lisp-image-arguments'.
280:
281: See fi:explicit-franz-lisp."
282: (interactive "p")
283: (let ((proc (fi::make-subprocess
284: buffer-number "franz-lisp"
285: 'fi:inferior-franz-lisp-mode
286: fi:franz-lisp-prompt-pattern
287: fi:franz-lisp-image-name
288: fi:franz-lisp-image-arguments)))
289: (setq fi::freshest-franz-sublisp-name (process-name proc))
290: proc))
291:
292: (defun fi:explicit-franz-lisp (&optional buffer-number
293: image-name image-arguments)
294: "The same as fi:franz-lisp, except that the image and image arguments
295: are read from the minibuffer."
296: (interactive "p\nsImage name: \nxImage arguments (a list): ")
297: (let ((proc (fi::make-subprocess
298: buffer-number "franz-lisp"
299: 'fi:inferior-franz-lisp-mode
300: fi:franz-lisp-prompt-pattern
301: image-name image-arguments)))
302: (setq fi::freshest-franz-sublisp-name (process-name proc))
303: proc))
304:
305: ;;;;
306: ;;; Internal functions
307: ;;;;
308:
309: (defun fi::make-subprocess (buffer-number process-name mode-function
310: image-prompt image-file
311: image-arguments)
312: (let* ((buffer (fi::make-process-buffer process-name buffer-number))
313: (default-dir default-directory)
314: (buffer-name (buffer-name buffer))
315: (process (get-buffer-process buffer))
316: (status (if process (process-status process)))
317: (runningp (memq status '(run stop)))
318: start-up-feed-name)
319: (if (and (not runningp)
320: (consp image-file))
321: (setq image-file (funcall image-file)))
322: (if fi:display-buffer-function
323: (funcall fi:display-buffer-function buffer)
324: (switch-to-buffer buffer))
325: (if runningp
326: (goto-char (point-max))
327: (setq default-directory default-dir)
328: (if process (delete-process process))
329: (setq process (apply 'start-process
330: (append (list buffer-name buffer image-file)
331: image-arguments)))
332: (set-process-sentinel process 'fi::subprocess-sentinel)
333: (set-process-filter process 'fi::subprocess-filter)
334: (setq start-up-feed-name
335: (if image-file
336: (concat "~/.emacs_" (file-name-nondirectory image-file))))
337: (cond
338: ((and start-up-feed-name (file-exists-p start-up-feed-name))
339: ;; I hope 1 second is enough!
340: (sleep-for 1)
341: (goto-char (point-max))
342: (insert-file-contents start-up-feed-name)
343: (setq start-up-feed-name (buffer-substring (point) (point-max)))
344: (delete-region (point) (point-max))
345: (fi::send-string-split process start-up-feed-name
346: fi:subprocess-map-nl-to-cr)))
347: (goto-char (point-max))
348: (set-marker (process-mark process) (point))
349: (let ((saved-input-ring fi::input-ring))
350: (funcall mode-function)
351: (setq fi::input-ring saved-input-ring))
352: (make-local-variable 'subprocess-prompt-pattern)
353: (setq subprocess-prompt-pattern image-prompt)
354: (fi::make-subprocess-variables))
355: process))
356:
357: (defun fi::make-tcp-connection (buffer-number buffer-name mode image-prompt
358: &optional given-host
359: given-service)
360: (let* ((buffer (fi::make-process-buffer buffer-name buffer-number))
361: (default-dir default-directory)
362: (buffer-name (buffer-name buffer))
363: (host (if given-host
364: (expand-file-name given-host)
365: (if fi:unix-domain
366: (expand-file-name fi:unix-domain-socket)
367: fi:local-host-name)))
368: (service (if given-service
369: given-service
370: (if fi:unix-domain 0 fi:excl-service-name)))
371: proc status)
372: (if fi:display-buffer-function
373: (funcall fi:display-buffer-function buffer)
374: (switch-to-buffer buffer))
375: (setq proc (get-buffer-process buffer))
376: (setq status (if proc (process-status proc)))
377: (if (eq status 'run)
378: (error
379: "can't start a TCP Common Lisp in a buffer which has a subprocess"))
380: (if (eq status 'open)
381: (goto-char (point-max))
382: (setq default-directory default-dir)
383: (setq proc (open-network-stream buffer-name buffer host service))
384: ;;
385: ;; HACK HACK HACK HACK HACK HACK HACK HACK HACK HACK HACK HACK
386: ;; The first input the new (Common Lisp) process is sent is the name
387: ;; of the process. This is so that the processes are named similarly
388: ;; in Emacs and Lisp.
389: ;;
390: (process-send-string proc (format "\"%s\"\n" (buffer-name buffer)))
391:
392: (goto-char (point-max))
393: (set-marker (process-mark proc) (point))
394: (let ((saved-input-ring fi::input-ring))
395: (funcall mode)
396: (setq fi::input-ring saved-input-ring))
397: (make-local-variable 'subprocess-prompt-pattern)
398: (setq subprocess-prompt-pattern image-prompt)
399: (fi::make-subprocess-variables))
400: proc))
401:
402: (defun fi::make-process-buffer (name number)
403: (let ((buffer-name
404: (cond
405: ((not (numberp number))
406: (concat "*" name "*"))
407: ((> number 1)
408: ;; just return the buffer name
409: (concat "*" name "-" number "*"))
410: ((< number 0)
411: ;; search for the first available buffer
412: (let (buffer-name n)
413: (if (not (fi::process-running
414: (setq buffer-name (concat "*" name "*"))))
415: buffer-name
416: (setq n 2)
417: (while (fi::process-running (setq buffer-name
418: (concat "*" name "-" n "*")))
419: (setq n (+ n 1)))
420: buffer-name)))
421: (t (concat "*" name "*")))))
422: (or (get-buffer buffer-name)
423: (get-buffer-create buffer-name))))
424:
425: (defun fi::make-subprocess-variables ()
426: (setq fi::input-ring-max fi:default-input-ring-max)
427: (setq fi::input-ring-yank-pointer nil)
428: (setq fi::shell-directory-stack nil)
429: (setq fi::last-input-search-string "")
430: (setq fi::last-input-start (make-marker))
431: (setq fi::last-input-end (make-marker)))
432:
433: (defun fi::send-region-split (process start-position end-position
434: &optional nl-cr)
435: "Send region to process in small pieces."
436: (interactive "sSend region in pieces (to process): \nr")
437: (let* ((start (if (markerp start-position)
438: (marker-position start-position)
439: start-position))
440: (end (if (markerp end-position)
441: (marker-position end-position)
442: end-position))
443: (string (buffer-substring start end)))
444: (fi::send-string-split process string nl-cr)))
445:
446: (defun fi::send-string-split (process string &optional nl-cr)
447: "Send string to process in small pieces using send-string."
448: (interactive "sSend (to process): \nsSend to process in pieces (string): ")
449: (let ((size (length string))
450: (filtered-string
451: (if nl-cr
452: (fi::substitute-chars-in-string '((?\n . ?\r)) string)
453: string))
454: (start 0))
455: (while (and (> size 0)
456: (condition-case nil
457: (progn
458: (send-string
459: process
460: (substring filtered-string
461: start
462: (+ start
463: (min size
464: fi:subprocess-write-quantum))))
465: t)
466: (error
467: (message "Error writing to subprocess.")
468: nil)))
469: (setq size (- size fi:subprocess-write-quantum))
470: (setq start (+ start fi:subprocess-write-quantum)))))
471:
472: ;;; Sentinel and filter for subprocesses. The sentinel is currently
473: ;;; not used.
474: (defun fi::subprocess-sentinel (process status)
475: t)
476:
477: (defun fi::subprocess-filter (process output &optional stay)
478: "Filter output from processes tied to buffers.
479: This function implements continuous output to visible buffers."
480: (let* ((old-buffer (current-buffer))
481: (buffer (process-buffer process))
482: (in-buffer (eq buffer old-buffer))
483: (window-of-buffer (get-buffer-window buffer))
484: (no-window (or (null window-of-buffer)
485: (not (windowp window-of-buffer))))
486: (xmarker (process-mark process))
487: (marker (if (marker-position xmarker)
488: xmarker
489: (set-marker (make-marker) 0 buffer)))
490: (marker-point (marker-position marker))
491: (output-length (length output))
492: old-point
493: point-not-before-marker
494: new-point)
495: ;; The three symbols below are not bound above because `(window-point)'
496: ;; for the selected window does not always return the same thing as the
497: ;; function `(point)' in that window! [Version 18 is supposed to fix
498: ;; this bug.]
499: ;; Note that there is no function that returns all of the windows that
500: ;; are currently displaying a buffer. Because of this, not all windows
501: ;; will be updated properly by this filter function. What should be
502: ;; done is to loop through all windows displaying the buffer and do
503: ;; `(set-window-point)' in each.
504: (if (not in-buffer)
505: (progn
506: (set-buffer buffer)
507: (setq old-point
508: (if no-window
509: (point)
510: (window-point window-of-buffer))))
511: (setq old-point (point)))
512: (setq point-not-before-marker (>= old-point marker-point))
513: (setq new-point (if point-not-before-marker
514: (+ old-point output-length)
515: old-point))
516: (save-excursion
517: ;; Go to point of last output by fi::make-process and insert new
518: ;; output there, preserving position of the marker.
519: (goto-char marker-point)
520: ;; The code below works around what appears to be a display bug
521: ;; in GNU Emacs 17. If `(insert-before-markers)' is used when
522: ;; the process marker (process-mark), window-start point
523: ;; (window-start), and window point (point) are all coincident,
524: ;; the window display `sticks' on the topmost line. We use
525: ;; `(insert-string)' followed by `(set-marker)' to avoid this
526: ;; problem. This also happens to be the way
527: ;; `handle_process_output()' deals with this in `process.c'.
528: (insert-string output)
529: (set-marker marker (point)))
530: (if (not in-buffer)
531: (if (and fi:subprocess-continuously-show-output-in-visible-buffer
532: point-not-before-marker)
533: ;; Keep window's notion of `point' in a constant relationship to
534: ;; the process output marker.
535: (if no-window
536: (goto-char new-point)
537: (set-window-point window-of-buffer new-point))
538: (if no-window
539: t;; Still there.
540: (set-window-point window-of-buffer old-point)))
541: (goto-char new-point))
542: (cond
543: (in-buffer nil)
544: (stay old-buffer)
545: (t (set-buffer old-buffer)))))
546:
547: (defun fi::subprocess-watch-for-special-commands ()
548: "Watch for special commands like, for example, `cd' in a shell."
549: (if (null fi::shell-directory-stack)
550: (setq fi::shell-directory-stack (list default-directory)))
551: (condition-case ()
552: ;; "To err is really not nice." -dkl 11/21/88
553: (save-excursion
554: (goto-char fi::last-input-start)
555: (cond
556: ((and fi::cl-package-regexp (looking-at fi::cl-package-regexp))
557: (goto-char (match-end 0))
558: (cond
559: ((or (looking-at "[ \t]*[':]\\(.*\\)[ \t]*)")
560: (looking-at "[ \t]*\"\\(.*\\)\"[ \t]*)"))
561: ;; (in-package foo)
562: (setq fi:package
563: (buffer-substring (match-beginning 1) (match-end 1))))
564: ((looking-at "[ \t]+\\(.*\\)[ \t]*$")
565: ;; :pa foo
566: (setq fi:package
567: (buffer-substring (match-beginning 1) (match-end 1)))))
568: ;; need to do something here to force the minibuffer to
569: ;; redisplay:
570: (set-buffer-modified-p (buffer-modified-p)))
571: ((and fi:shell-popd-regexp (looking-at fi:shell-popd-regexp))
572: (goto-char (match-end 0))
573: (cond
574: ((looking-at ".*&[ \t]*$")
575: ;; "popd ... &" executes in a subshell!
576: )
577: (t
578: (let ((n (if (looking-at "[ \t]+\\+\\([0-9]*\\)")
579: (car
580: (read-from-string
581: (buffer-substring (match-beginning 1)
582: (match-end 1)))))))
583: (if (null n)
584: (cd (car (setq fi::shell-directory-stack
585: (cdr fi::shell-directory-stack))))
586: ;; pop n'th entry
587: (if (> n (length fi::shell-directory-stack))
588: (message "Directory stack not that deep.")
589: (let ((tail (nthcdr (+ n 1) fi::shell-directory-stack)))
590: (rplacd (nthcdr (- n 1) fi::shell-directory-stack)
591: nil)
592: (setq fi::shell-directory-stack
593: (append fi::shell-directory-stack tail)))))))))
594: ((and fi:shell-pushd-regexp (looking-at fi:shell-pushd-regexp))
595: (goto-char (match-end 0))
596: (cond
597: ((looking-at ".*&[ \t]*$")
598: ;; "pushd ... &" executes in a subshell!
599: )
600: ((looking-at "[ \t]+\\+\\([0-9]+\\)[ \t]*[;\n]")
601: ;; pushd +n
602: (let ((n (car (read-from-string
603: (buffer-substring (match-beginning 1)
604: (match-end 1))))))
605: (if (< n 1)
606: (message "Illegal stack element: %s" n)
607: (if (> n (length fi::shell-directory-stack))
608: (message "Directory stack not that deep.")
609: (let ((head (nthcdr n fi::shell-directory-stack)))
610: (rplacd (nthcdr (- n 1) fi::shell-directory-stack)
611: nil)
612: (setq fi::shell-directory-stack
613: (append head fi::shell-directory-stack))
614: (cd (car head)))))))
615: ((looking-at "[ \t]+\\([^ \t]+\\)[;\n]")
616: ;; pushd dir
617: (let ((dir (expand-file-name
618: (substitute-in-file-name
619: (buffer-substring (match-beginning 1)
620: (match-end 1))))))
621: (if (file-directory-p dir)
622: (progn
623: (setq fi::shell-directory-stack
624: (cons dir fi::shell-directory-stack))
625: (cd dir)))))
626: ((looking-at "[ \t]*[;\n]")
627: ;; pushd
628: (if (< (length fi::shell-directory-stack) 2)
629: (message "Directory stack not that deep.")
630: (setq fi::shell-directory-stack
631: (append (list (car (cdr fi::shell-directory-stack))
632: (car fi::shell-directory-stack))
633: (cdr (cdr fi::shell-directory-stack))))
634: (cd (car fi::shell-directory-stack))))))
635: ((and fi:shell-cd-regexp (looking-at fi:shell-cd-regexp))
636: (goto-char (match-end 0))
637: (cond
638: ((looking-at ".*&[ \t]*$")
639: ;; "cd foo &" executes in a subshell!
640: )
641: ((looking-at "[ \t]*[;\n]")
642: ;; cd
643: (cd (rplaca fi::shell-directory-stack (getenv "HOME"))))
644: ((looking-at "[ \t]+\\([^ \t]+\\)[ \t]*[;\n]")
645: ;; cd dir
646: (let ((dir (expand-file-name
647: (substitute-in-file-name
648: (buffer-substring (match-beginning 1)
649: (match-end 1))))))
650: (if (file-directory-p dir)
651: (progn
652: (rplaca fi::shell-directory-stack dir)
653: (cd dir)))))))))
654: (error nil)))
655:
656: ;;;;
657: ;;; Initializations
658: ;;;;
659:
660: (mapcar 'make-variable-buffer-local
661: '(fi:shell-popd-regexp
662: fi:shell-pushd-regexp
663: fi:shell-cd-regexp
664: fi::cl-package-regexp
665: fi:package
666: fi:subprocess-map-nl-to-cr
667: fi:subprocess-continuously-show-output-in-visible-buffer
668: fi:subprocess-enable-superkeys
669: fi:subprocess-super-key-map
670:
671: fi::shell-directory-stack
672: fi::last-input-start
673: fi::last-input-end
674: fi::input-ring
675: fi::input-ring-max
676: fi::input-ring-yank-pointer
677: fi::last-input-search-string))
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.