home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / gnu / lucid / lemacs-19.6 / lisp / ilisp / ilisp-bat.el < prev    next >
Encoding:
Text File  |  1992-06-29  |  4.1 KB  |  127 lines
  1. ;;; -*-Emacs-Lisp-*-
  2. ;;;%Header
  3. ;;; Inferior LISP interaction package batch submodule.
  4. ;;; Copyright (C) 1990, 1991, 1992 Chris McConnell, ccm@cs.cmu.edu.
  5.  
  6. ;;; See ilisp.el for more information.
  7. (defun mark-change-lisp (arg)
  8.   "Mark the current defun as being changed so that lisp-eval-changes,
  9. or lisp-compile-changes will work on it.  With a prefix, unmark."
  10.   (interactive "P")
  11.   (let (point name)
  12.     (save-excursion
  13.       (setq point (lisp-defun-begin)
  14.         name (lisp-def-name)))
  15.     (if arg
  16.     (let ((marker (car (lisp-memk point lisp-changes 'marker-position))))
  17.       (message "%s marked as unchanged" name)
  18.       (setq lisp-changes (delq marker lisp-changes)))
  19.     (message "%s marked as changed" name)
  20.     (if (not (lisp-memk point lisp-changes 'marker-position))
  21.         (let ((new (make-marker)))
  22.           (set-marker new point)
  23.           (setq lisp-changes (cons new lisp-changes)))))))
  24.  
  25. ;;;
  26. (if (listp popper-pop-buffers)
  27.     (setq popper-pop-buffers 
  28.       (cons "*Changed-Definitions*" popper-pop-buffers)))
  29. (if (consp popper-buffers-to-skip)
  30.     (setq popper-buffers-to-skip 
  31.       (cons "*Changed-Definitions*" popper-buffers-to-skip)))
  32.  
  33. ;;;
  34. (defun list-changes-lisp ()
  35.   "List the name of LISP forms currently marked as being changed."
  36.   (interactive)
  37.   (let ((names (reverse (mapcar (function
  38.                  (lambda (change)
  39.                   (save-excursion
  40.                     (set-buffer (marker-buffer change))
  41.                     (goto-char change)
  42.                     (lisp-def-name))))
  43.                 lisp-changes))))
  44.     (if names
  45.     (with-output-to-temp-buffer "*Changed-Definitions*"
  46.       (display-completion-list names)
  47.       (save-excursion
  48.         (set-buffer "*Changed-Definitions*")
  49.         (goto-char (point-min))
  50.         (kill-line)
  51.         (insert "Changed LISP forms:")))
  52.     (error "No changed definitions"))))
  53.  
  54. ;;;
  55. (defun clear-changes-lisp ()
  56.   "Clear the list of LISP forms currently marked as being changed."
  57.   (interactive)
  58.   (message "Cleared changes")
  59.   (setq lisp-changes nil))
  60.  
  61. ;;;
  62. (defun lisp-change-handler (&rest args)
  63.   "Handle an error during a batch process by keeping the change on the
  64. list and passing it on to the normal error handler." 
  65.   (let ((change (car ilisp-pending-changes)))
  66.     (if (and comint-errorp
  67.          (not (lisp-memk change lisp-changes 'marker-position)))
  68.     (setq lisp-changes (nconc lisp-changes (cons change nil)))))
  69.   (setq ilisp-pending-changes (cdr ilisp-pending-changes))
  70.   (apply comint-handler args))
  71.  
  72. ;;;
  73. (defun lisp-changes (command message)
  74.   "Apply COMMAND to each of the changes and use MESSAGE to print a
  75. message given the name of the change.  If there is a positive prefix,
  76. the change list will not be changed."
  77.   (save-excursion
  78.     (set-buffer (ilisp-buffer))
  79.     (let ((keep (and current-prefix-arg (not (eq current-prefix-arg '-))))
  80.       (changes (reverse lisp-changes))
  81.       (lisp-wait-p nil))
  82.       (setq ilisp-pending-changes (nconc ilisp-pending-changes changes)
  83.         current-prefix-arg nil)    ;Prevent buffer insertion
  84.       (if comint-queue-emptied 
  85.       (save-excursion
  86.         (setq comint-queue-emptied nil)
  87.         (set-buffer (get-buffer-create "*Errors*"))
  88.         (delete-region (point-min) (point-max))))
  89.       (while changes
  90.     (let* ((change (car changes))
  91.            name)
  92.       (set-buffer (marker-buffer change))
  93.       (goto-char change)
  94.       (setq name (lisp-def-name))
  95.       (forward-sexp)
  96.       (funcall command change (point) nil (format message name)
  97.            nil 'lisp-change-handler)
  98.       (setq changes (cdr changes))))
  99.       (comint-send-code
  100.        (ilisp-process)
  101.        (function (lambda ()
  102.      (save-excursion
  103.        (set-buffer (get-buffer-create "*Last-Changes*"))
  104.        (delete-region (point-min) (point-max))
  105.        (insert (save-excursion
  106.              (set-buffer "*Errors*")
  107.              (buffer-string)))))))
  108.       (if keep
  109.       (message "Started, but keeping changes")
  110.       (message "Started changes")
  111.       (setq lisp-changes nil)))))
  112.  
  113. ;;;
  114. (defun eval-changes-lisp ()
  115.   "Evaluate the forms marked as being changed.  With prefix, do not
  116. clear the change list."
  117.   (interactive)
  118.   (lisp-changes 'eval-region-lisp "Evaluate changed %s"))
  119.  
  120. ;;;
  121. (defun compile-changes-lisp ()
  122.   "Compile the forms marked as being changed.  With prefix, do not
  123. clear the change list."
  124.   (interactive)
  125.   (lisp-changes 'compile-region-lisp "Compile changed %s"))
  126.  
  127.