cgit.sxemacs.org Git - packages/blob - xemacs-packages/ilisp/ilisp-bat.el

   1 ;;; -*- Mode: Emacs-Lisp -*-
   2
   3 ;;; ilisp-bat.el --
   4 ;;; Inferior LISP interaction package batch submodule.
   5 ;;; See ilisp.el for more information.
   6 ;;;
   7 ;;; This file is part of ILISP.
   8 ;;; Please refer to the file COPYING for copyrights and licensing
   9 ;;; information.
  10 ;;; Please refer to the file ACKNOWLEGDEMENTS for an (incomplete) list
  11 ;;; of present and past contributors.
  12 ;;;
  13 ;;; $Id: ilisp-bat.el,v 1.3 2001-07-02 09:40:45 youngs Exp $
  14
  15 (defun mark-change-lisp (arg)
  16   "Mark the current defun as being changed.
  17 This is to make 'lisp-eval-changes' or 'lisp-compile-changes' work on
  18 it.  With a prefix, unmark."
  19   (interactive "P")
  20   (let (point name)
  21     (save-excursion
  22       (setq point (lisp-defun-begin)
  23             name (lisp-def-name)))
  24     (if arg
  25         (let ((marker (car (member* point lisp-changes
  26                                     :test #'equal
  27                                     :key #'marker-position))))
  28           (message "%s marked as unchanged" name)
  29           (setq lisp-changes (delq marker lisp-changes)))
  30         (message "%s marked as changed" name)
  31         (if (not (member* point lisp-changes
  32                           :test #'equal
  33                           :key #'marker-position))
  34             (let ((new (make-marker)))
  35               (set-marker new point)
  36               (setq lisp-changes (cons new lisp-changes)))))))
  37
  38 ;;;
  39 (defun list-changes-lisp ()
  40   "List the name of LISP forms currently marked as being changed."
  41   (interactive)
  42   (let ((names (reverse (mapcar (function
  43                                  (lambda (change)
  44                                   (save-excursion
  45                                     (set-buffer (marker-buffer change))
  46                                     (goto-char change)
  47                                     (lisp-def-name))))
  48                                 lisp-changes))))
  49     (if names
  50         (with-output-to-temp-buffer "*Changed-Definitions*"
  51           (display-completion-list names)
  52           (save-excursion
  53             (set-buffer "*Changed-Definitions*")
  54             (goto-char (point-min))
  55             (kill-line)
  56             (insert "Changed LISP forms:")))
  57         (error "No changed definitions"))))
  58
  59 ;;;
  60 (defun clear-changes-lisp ()
  61   "Clear the list of LISP forms currently marked as being changed."
  62   (interactive)
  63   (message "Cleared changes")
  64   (setq lisp-changes nil))
  65
  66 ;;;
  67 (defun lisp-change-handler (&rest args)
  68   "Handle an error during a batch process by keeping the change on the
  69 list and passing it on to the normal error handler."
  70   (let ((change (car ilisp-pending-changes)))
  71     (when (and comint-errorp
  72                (not (member* change lisp-changes
  73                              :test #'equal
  74                              :key #'marker-position)))
  75       (setq lisp-changes (nconc lisp-changes (cons change nil)))))
  76   (setq ilisp-pending-changes (cdr ilisp-pending-changes))
  77   (apply comint-handler args))
  78
  79 ;;;
  80 (defun lisp-changes (command message)
  81   "Apply COMMAND to each of the changes and use MESSAGE to print a
  82 message given the name of the change.  If there is a positive prefix,
  83 the change list will not be changed."
  84   (save-excursion
  85     (set-buffer (ilisp-buffer))
  86     (let ((keep (and current-prefix-arg (not (eq current-prefix-arg '-))))
  87           (changes (reverse lisp-changes))
  88           (lisp-wait-p nil))
  89       (setq ilisp-pending-changes (nconc ilisp-pending-changes changes)
  90             current-prefix-arg nil)     ;Prevent buffer insertion
  91       (if comint-queue-emptied
  92           (save-excursion
  93             (setq comint-queue-emptied nil)
  94             (set-buffer (get-buffer-create "*Errors*"))
  95             (delete-region (point-min) (point-max))))
  96       (while changes
  97         (let* ((change (car changes))
  98                name)
  99           (set-buffer (marker-buffer change))
 100           (goto-char change)
 101           (setq name (lisp-def-name))
 102           (forward-sexp)
 103           (funcall command change (point) nil (format message name)
 104                    nil 'lisp-change-handler)
 105           (setq changes (cdr changes))))
 106       (comint-send-code
 107        (ilisp-process)
 108        (function (lambda ()
 109          (save-excursion
 110            (set-buffer (get-buffer-create "*Last-Changes*"))
 111            (delete-region (point-min) (point-max))
 112            (insert (save-excursion
 113                      (set-buffer "*Errors*")
 114                      (buffer-string)))))))
 115       (if keep
 116           (message "Started, but keeping changes")
 117           (message "Started changes")
 118           (setq lisp-changes nil)))))
 119
 120 ;;;
 121 (defun eval-changes-lisp ()
 122   "Evaluate the forms marked as being changed.  With prefix, do not
 123 clear the change list."
 124   (interactive)
 125   (lisp-changes 'eval-region-lisp "Evaluate changed %s"))
 126
 127 ;;;
 128 (defun compile-changes-lisp ()
 129   "Compile the forms marked as being changed.  With prefix, do not
 130 clear the change list."
 131   (interactive)
 132   (lisp-changes 'compile-region-lisp "Compile changed %s"))