![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to sublisp.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 sublisp.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: ;; This file has its (distant) roots in lisp/shell.el, so:
28: ;;
29: ;; Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.
30: ;;
31: ;; This file is derived from part of GNU Emacs.
32: ;;
33: ;; GNU Emacs is distributed in the hope that it will be useful,
34: ;; but WITHOUT ANY WARRANTY. No author or distributor
35: ;; accepts responsibility to anyone for the consequences of using it
36: ;; or for whether it serves any particular purpose or works at all,
37: ;; unless he says so in writing. Refer to the GNU Emacs General Public
38: ;; License for full details.
39: ;;
40: ;; Everyone is granted permission to copy, modify and redistribute
41: ;; GNU Emacs, but only under the conditions described in the
42: ;; GNU Emacs General Public License. A copy of this license is
43: ;; supposed to have been given to you along with GNU Emacs so you
44: ;; can know your rights and responsibilities. It should be in a
45: ;; file named COPYING. Among other things, the copyright notice
46: ;; and this notice must be preserved on all copies.
47:
48: ;; $Header: sublisp.el,v 1.35 89/02/17 19:36:18 layer Exp $
49:
50: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
51: ;;;
52: ;;; User Visibles
53: ;;;
54: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
55:
56: (defvar fi:emacs-to-lisp-transaction-directory "/tmp"
57: "*The directory in which files for Emacs/Lisp communication are stored.
58: When using Lisp and Emacs on different machines, this directory should be
59: accessible on both machine with the same pathname (via the wonders of NFS).")
60:
61: (defvar fi:pop-to-sublisp-buffer-after-lisp-eval t
62: "*If non-nil, then after sending expressions to a Lisp process do pop to
63: the buffer which contains the Lisp.")
64:
65: (defvar fi:package nil
66: "A buffer-local variable whose value should either be nil or a string
67: which names a package in the Lisp world (ie, in a Lisp subprocess running
68: as an inferior of Emacs in some buffer). It is used when expressions are
69: sent from an Emacs buffer to a Lisp process so that the symbols are read
70: into the correct Lisp package.")
71:
72: (defvar fi:echo-evals-from-buffer-in-listener-p nil
73: "*If non-NIL, forms evalutated directly from a lisp buffer by the
74: fi:lisp-eval-* functions will be echoed by the lisp listener.")
75:
76: (defun fi:set-associated-sublisp (buffer-name)
77: "When evaluated in a Lisp source buffer causes further `eval'
78: commands (those which send expressions from Emacs to Lisp) to use
79: BUFFER-NAME as the buffer which contains a Lisp subprocess. If evaluated
80: when not in a Lisp source buffer, then the process type is read from the
81: minibuffer (\"common-lisp\" or \"franz-lisp\"). The buffer name is
82: interactively read and must be the name of an existing buffer. New buffers
83: with the same mode as the current buffer will also use BUFFER-NAME for
84: future `eval' commands."
85: (interactive "bBuffer name containing a Lisp process: ")
86: (let* ((process (get-buffer-process (get-buffer buffer-name)))
87: (mode (or (and (memq major-mode '(fi:common-lisp-mode
88: fi:franz-lisp-mode))
89: major-mode)
90: (let* ((alist '(("common-lisp" . fi:common-lisp-mode)
91: ("franz-lisp" . fi:franz-lisp-mode)))
92: (type (completing-read "Lisp type: "
93: alist nil t "common-lisp")))
94: (cdr (assoc type alist))))))
95: (if process
96: (let ((buffers (buffer-list))
97: (proc-name (process-name process)))
98: (cond ((eq mode 'fi:common-lisp-mode)
99: (setq fi::freshest-common-sublisp-name proc-name))
100: ((eq mode 'fi:franz-lisp-mode)
101: (setq fi::freshest-franz-sublisp-name proc-name)))
102: (while buffers
103: (if (eq mode (fi::symbol-value-in-buffer 'major-mode
104: (car buffers)))
105: (fi::set-in-buffer 'fi::sublisp-name proc-name
106: (car buffers)))
107: (setq buffers (cdr buffers))))
108: (error "There is no process associated with buffer %s!"
109: buffer-name))))
110:
111: ;;;;
112: ;;; Internals
113: ;;;;
114:
115: (defun fi:inferior-lisp-send-input (arg type)
116: "Send ARG, which is an s-expression, to the Lisp subprocess. TYPE
117: must be either 'sexps or 'lists, specifying whether lists or
118: s-expressions should be parsed (internally, either `(scan-sexps)' or
119: `(scan-lists)' is used). If at the end of buffer, everything typed since
120: the last output from the Lisp subprocess is collected and sent to the Lisp
121: subprocess. With an argument, only the specified number of s-expressions
122: or lists from the end of the buffer are sent. If in the middle of the
123: buffer, the current s-expression(s) or list(s) is(are) copied to the end of
124: the buffer and then sent. An argument specifies the number of s-expressions
125: or lists to be sent. If s-expressions are being parsed,the cursor
126: follows a closing parenthesis, the preceding s-expression(s) is(are)
127: processed. If the cursor is at an opening parenthesis, the following
128: s-expression(s) is(are) processed. If the cursor is at a closing
129: parenthesis, the preceding s-expression(s) is(are) processed. Otherwise,
130: the enclosing s-expression(s) is(are) processed. If lists are being
131: parsed, the enclosing list is processed."
132: (if (and (eobp) (null arg))
133: (progn
134: (move-marker fi::last-input-start
135: (process-mark (get-buffer-process (current-buffer))))
136: (insert "\n")
137: (funcall indent-line-function)
138: (move-marker fi::last-input-end (point)))
139:
140: ;; we are in the middle of the buffer somewhere and need to collect
141: ;; and s-exp to re-send
142: ;; we grab everything from the end of the current line back to the end
143: ;; of the last prompt
144: ;;
145: (let ((exp-to-resend "")
146: (start-resend (point))
147: (end-resend (point)))
148: (if (null arg) (setq arg 1))
149: (if (equal type 'sexp)
150: (setq exp-to-resend
151: (buffer-substring
152: (setq start-resend
153: (save-excursion
154: (cond
155: ((= (preceding-char) ?\)) (scan-sexps (point) (- arg)))
156: ((= (following-char) ?\() (point))
157: ((= (following-char) ?\))
158: (forward-char 1) (scan-sexps (point) (- arg)))
159: ((not (memq (char-syntax (preceding-char)) '(?w ?_)))
160: (point))
161: (t (scan-sexps (point) (- arg))))))
162: (setq end-resend
163: (save-excursion
164: (cond
165: ((= (preceding-char) ?\)) (point))
166: ((= (following-char) ?\() (scan-sexps (point) arg))
167: ((= (following-char) ?\)) (forward-char 1) (point))
168: ((not (memq (char-syntax (following-char)) '(?w ?_)))
169: (point))
170: (t (scan-sexps (point) arg)))))))
171: (setq exp-to-resend
172: (buffer-substring
173: (setq start-resend (scan-lists (point) (- arg) 1))
174: (setq end-resend (scan-lists (point) arg 1)))))
175: (if (eobp)
176: (progn
177: (insert "\n")
178: (funcall indent-line-function)
179: (move-marker fi::last-input-start start-resend)
180: (move-marker fi::last-input-end (point-max)))
181: (progn
182: (goto-char (point-max))
183: (move-marker fi::last-input-start (point))
184: (insert exp-to-resend)
185: (if (not (bolp)) (insert "\n"))
186: (move-marker fi::last-input-end (point))))))
187: (let ((process (get-buffer-process (current-buffer))))
188: (fi::send-region-split process fi::last-input-start fi::last-input-end
189: fi:subprocess-map-nl-to-cr)
190: (fi::input-ring-save fi::last-input-start (1- fi::last-input-end))
191: (set-marker (process-mark process) (point))))
192:
193: (defun fi::eval-send (start end compile-file-p)
194: "Send the text from START to END over to the sublisp, in the
195: correct fi:package, of course."
196: (fi::sublisp-select)
197: (let* ((stuff (buffer-substring start end))
198: (sublisp-process (get-process fi::sublisp-name)))
199: (fi::send-string-load
200: sublisp-process stuff fi:subprocess-map-nl-to-cr compile-file-p)
201: (fi::send-string-split sublisp-process "\n" fi:subprocess-map-nl-to-cr)
202: (if fi:pop-to-sublisp-buffer-after-lisp-eval
203: (progn
204: (switch-to-buffer-other-window (process-buffer sublisp-process))
205: (goto-char (point-max))))))
206:
207: (defun fi::eval-string-send (string compile-file-p &optional always-pop-to-p)
208: "Send STRING to the sublisp, in the correct package, of course."
209: (fi::sublisp-select)
210: (let ((sublisp-process (get-process fi::sublisp-name)))
211: (fi::send-string-load
212: sublisp-process string fi:subprocess-map-nl-to-cr compile-file-p)
213: (fi::send-string-split sublisp-process "\n" fi:subprocess-map-nl-to-cr)
214: (if (or always-pop-to-p fi:pop-to-sublisp-buffer-after-lisp-eval)
215: (progn
216: (switch-to-buffer-other-window (process-buffer sublisp-process))
217: (goto-char (point-max))))))
218:
219: (defun fi::sublisp-select ()
220: "Find a sublisp for eval commands to send code to. Result stored in
221: the variable fi::sublisp-name. If fi::sublisp-name is set, and there is an
222: associated process buffer, thats that. If fi::sublisp-name is nil, or if
223: there is no process buffer with that name, then try for
224: freshest-<franz,common>-sublisp-name, which should contain the name of the
225: most recently started sublisp. If neither of these exist, runs the command
226: franz-lisp or common-lisp, depending on the major mode of the buffer."
227: ;; see if sublisp is named yet. if its not, name it intelligently.
228: (cond (fi::sublisp-name t)
229: ((eq major-mode 'fi:inferior-common-lisp-mode)
230: (setq fi::sublisp-name fi::freshest-common-sublisp-name))
231: ((eq major-mode 'fi:inferior-franz-lisp-mode)
232: (setq fi::sublisp-name fi::freshest-franz-sublisp-name))
233: ((eq major-mode 'fi:franz-lisp-mode)
234: (if fi::freshest-franz-sublisp-name
235: (setq fi::sublisp-name fi::freshest-franz-sublisp-name)
236: (setq fi::sublisp-name "franz-lisp")))
237: ((eq major-mode 'fi:common-lisp-mode)
238: (if fi::freshest-common-sublisp-name
239: (setq fi::sublisp-name fi::freshest-common-sublisp-name)
240: (setq fi::sublisp-name "common-lisp")))
241: (t (error "Cant start a subprocess for Major mode %s." major-mode)))
242: ;; start-up the sublisp process if necessary and possible
243: (cond ((get-process fi::sublisp-name) t)
244: ((eql major-mode 'fi:franz-lisp-mode)
245: (if (and fi::freshest-franz-sublisp-name
246: (get-process fi::freshest-franz-sublisp-name))
247: (setq fi::sublisp-name fi::freshest-franz-sublisp-name)
248: (setq fi::sublisp-name (prog1
249: (fi:franz-lisp)
250: (switch-to-buffer nil)
251: (sleep-for 5)))))
252: ((eql major-mode 'fi:common-lisp-mode)
253: (if (and fi::freshest-common-sublisp-name
254: (get-process fi::freshest-common-sublisp-name))
255: (setq fi::sublisp-name fi::freshest-common-sublisp-name)
256: (setq fi::sublisp-name (prog1
257: (fi:common-lisp)
258: (switch-to-buffer nil)
259: (sleep-for 1)))))
260: (t (error "Can't start a subprocess for sublisp-name %s."
261: fi::sublisp-name))))
262:
263: (defun fi::send-string-load (process text nl-to-cr compile-file-p)
264: (let (pkg)
265: (if (null fi::emacs-to-lisp-transaction-file)
266: (let ()
267: (setq fi::emacs-to-lisp-transaction-file
268: (let* ((filename (buffer-file-name (current-buffer))))
269: (format "%s/%s,%s" fi:emacs-to-lisp-transaction-directory
270: (user-login-name)
271: (if filename (file-name-nondirectory filename)
272: "noname"))))
273: (setq fi::emacs-to-lisp-package
274: (if fi:package
275: (format "(in-package :%s)\n" fi:package)
276: nil))
277: (setq fi::emacs-to-lisp-transaction-buf
278: (let ((name (file-name-nondirectory
279: fi::emacs-to-lisp-transaction-file)))
280: (or (get-buffer name)
281: (create-file-buffer name))))
282: (let ((file fi::emacs-to-lisp-transaction-file))
283: (save-window-excursion
284: (pop-to-buffer fi::emacs-to-lisp-transaction-buf)
285: (set 'fi::remove-file-on-kill-emacs file)
286: (set 'fi::remove-file-on-kill-emacs file)))))
287: (setq pkg fi::emacs-to-lisp-package)
288: (save-window-excursion
289: (let ((file fi::emacs-to-lisp-transaction-file))
290: (pop-to-buffer fi::emacs-to-lisp-transaction-buf)
291: (erase-buffer)
292: (if (and pkg (not fi:echo-evals-from-buffer-in-listener-p))
293: (insert pkg))
294: (insert text)
295: ;; (newline) Unneeded? -smh
296: (write-region (point-min) (point-max) file)
297: (bury-buffer)))
298: (let ((load-string
299: (if compile-file-p
300: (format
301: "(let ((*record-source-files* nil))
302: (excl::compile-file-if-needed \"%s\")
303: (load \"%s.fasl\"))"
304: fi::emacs-to-lisp-transaction-file
305: (fi::file-name-sans-type fi::emacs-to-lisp-transaction-file))
306: (if fi:echo-evals-from-buffer-in-listener-p
307: (format "(with-open-file (istm \"%s\")
308: (let ((*record-source-files* nil)
309: (*package* *package*)
310: (stm (make-echo-stream istm *terminal-io*)))
311: %s
312: (princ \" ;; eval from emacs: \") (fresh-line)
313: (load stm :verbose nil)))"
314: fi::emacs-to-lisp-transaction-file
315: (if pkg pkg ""))
316: (format "(let ((*record-source-files* nil)) (load \"%s\"))"
317: fi::emacs-to-lisp-transaction-file)))))
318: (fi::send-string-split process load-string nl-to-cr))))
319:
320: (defun fi:remove-all-temporary-lisp-transaction-files ()
321: "This function will clean up all the files created for Lisp/Emacs
322: communication. See the variable fi:emacs-to-lisp-transaction-directory for
323: the location of the files."
324: (let ((buffers (buffer-list))
325: file)
326: (while buffers
327: (setq file (fi::symbol-value-in-buffer
328: 'fi::remove-file-on-kill-emacs (car buffers)))
329: (if (and file (file-exists-p file)) (delete-file file))
330: (setq buffers (cdr buffers)))))
331:
332: (make-variable-buffer-local 'fi::remove-file-on-kill-emacs)
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.