![[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.