emacs/xlispstat.el

   1 ;; Running an inferior xlispstat process
   2 ;; Copyright (C) 1985, 1986, 1987, 1988 Free Software Foundation, Inc.
   3
   4 ;; This file is part of GNU Emacs.
   5
   6 ;; GNU Emacs is distributed in the hope that it will be useful,
   7 ;; but WITHOUT ANY WARRANTY.  No author or distributor
   8 ;; accepts responsibility to anyone for the consequences of using it
   9 ;; or for whether it serves any particular purpose or works at all,
  10 ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  11 ;; License for full details.
  12
  13 ;; Everyone is granted permission to copy, modify and redistribute
  14 ;; GNU Emacs, but only under the conditions described in the
  15 ;; GNU Emacs General Public License.   A copy of this license is
  16 ;; supposed to have been given to you along with GNU Emacs so you
  17 ;; can know your rights and responsibilities.  It should be in a
  18 ;; file named COPYING.  Among other things, the copyright notice
  19 ;; and this notice must be preserved on all copies.
  20
  21 (require 'shell)
  22
  23 (defun xlisp-quit-sentinel (proc reason)
  24   (if (and (not (memq reason '(run stop))))
  25       (save-buffers-kill-emacs)))
  26
  27 (defun set-xlisp-sentinel ()
  28   (let ((process (get-process "lisp")))
  29     (set-process-sentinel process 'xlisp-quit-sentinel)
  30     (process-kill-without-query process)))
  31
  32 (defun run-xlispstat-exit ()
  33   (run-xlispstat)
  34   (set-xlisp-sentinel))
  35
  36 (defun run-kcl-exit ()
  37   (run-kcl)
  38   (set-xlisp-sentinel))
  39
  40 (defun run-xlispstat ()
  41   "Run an inferior xlispstat process."
  42   (interactive)
  43   (let ((old-prog inferior-lisp-program))
  44     (setq inferior-lisp-program "xlispstat")
  45     (run-lisp)
  46     (setq inferior-lisp-program old-prog)))
  47
  48 (defun run-kcl ()
  49   (interactive)
  50   (let ((old-prog inferior-lisp-program))
  51     (setq inferior-lisp-program "kcl")
  52     (run-lisp)
  53     (setq inferior-lisp-program old-prog)))
  54
  55 ;; modified to use .lsp suffix on temp file - xlisp gets upset without it.
  56 (defun lisp-send-defun (display-flag)
  57   "Send the current defun to the Lisp process made by M-x run-lisp.
  58 With argument, force redisplay and scrolling of the *lisp* buffer.
  59 Variable `inferior-lisp-load-command' controls formatting of
  60 the `load' form that is set to the Lisp process."
  61   (interactive "P")
  62   (or (get-process "lisp")
  63       (error "No current lisp process"))
  64   (save-excursion
  65    (end-of-defun)
  66    (let ((end (point))
  67          (filename (format "/tmp/emlisp%d.lsp" (process-id (get-process "lisp")))))
  68      (beginning-of-defun)
  69      (write-region (point) end filename nil 'nomessage)
  70      (process-send-string "lisp" (format inferior-lisp-load-command filename)))
  71    (if display-flag
  72        (let* ((process (get-process "lisp"))
  73               (buffer (process-buffer process))
  74               (w (or (get-buffer-window buffer) (display-buffer buffer)))
  75               (height (window-height w))
  76               (end))
  77          (save-excursion
  78            (set-buffer buffer)
  79            (setq end (point-max))
  80            (while (progn
  81                     (accept-process-output process)
  82                     (goto-char (point-max))
  83                     (beginning-of-line)
  84                     (or (= (point-max) end)
  85                         (not (looking-at inferior-lisp-prompt)))))
  86            (setq end (point-max))
  87            (vertical-motion (- 4 height))
  88            (set-window-start w (point)))
  89          (set-window-point w end)))))