Mercurial > hg > xemacs-beta
diff lisp/ilisp/ilisp-bat.el @ 0:376386a54a3c r19-14
Import from CVS: tag r19-14
author | cvs |
---|---|
date | Mon, 13 Aug 2007 08:45:50 +0200 |
parents | |
children | b82b59fe008d |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/ilisp/ilisp-bat.el Mon Aug 13 08:45:50 2007 +0200 @@ -0,0 +1,136 @@ +;;; -*- Mode: Emacs-Lisp -*- + +;;; ilisp-bat.el -- + +;;; This file is part of ILISP. +;;; Version: 5.7 +;;; +;;; Copyright (C) 1990, 1991, 1992, 1993 Chris McConnell +;;; 1993, 1994 Ivan Vasquez +;;; 1994, 1995 Marco Antoniotti and Rick Busdiecker +;;; +;;; Other authors' names for which this Copyright notice also holds +;;; may appear later in this file. +;;; +;;; Send mail to 'ilisp-request@lehman.com' to be included in the +;;; ILISP mailing list. 'ilisp@lehman.com' is the general ILISP +;;; mailing list were bugs and improvements are discussed. +;;; +;;; ILISP is freely redistributable under the terms found in the file +;;; COPYING. + +;;; +;;; Inferior LISP interaction package batch submodule. + +;;; See ilisp.el for more information. +(defun mark-change-lisp (arg) + "Mark the current defun as being changed so that lisp-eval-changes, +or lisp-compile-changes will work on it. With a prefix, unmark." + (interactive "P") + (let (point name) + (save-excursion + (setq point (lisp-defun-begin) + name (lisp-def-name))) + (if arg + (let ((marker (car (lisp-memk point lisp-changes 'marker-position)))) + (message "%s marked as unchanged" name) + (setq lisp-changes (delq marker lisp-changes))) + (message "%s marked as changed" name) + (if (not (lisp-memk point lisp-changes 'marker-position)) + (let ((new (make-marker))) + (set-marker new point) + (setq lisp-changes (cons new lisp-changes))))))) + +;;; +(defun list-changes-lisp () + "List the name of LISP forms currently marked as being changed." + (interactive) + (let ((names (reverse (mapcar (function + (lambda (change) + (save-excursion + (set-buffer (marker-buffer change)) + (goto-char change) + (lisp-def-name)))) + lisp-changes)))) + (if names + (with-output-to-temp-buffer "*Changed-Definitions*" + (display-completion-list names) + (save-excursion + (set-buffer "*Changed-Definitions*") + (goto-char (point-min)) + (kill-line) + (insert "Changed LISP forms:"))) + (error "No changed definitions")))) + +;;; +(defun clear-changes-lisp () + "Clear the list of LISP forms currently marked as being changed." + (interactive) + (message "Cleared changes") + (setq lisp-changes nil)) + +;;; +(defun lisp-change-handler (&rest args) + "Handle an error during a batch process by keeping the change on the +list and passing it on to the normal error handler." + (let ((change (car ilisp-pending-changes))) + (if (and comint-errorp + (not (lisp-memk change lisp-changes 'marker-position))) + (setq lisp-changes (nconc lisp-changes (cons change nil))))) + (setq ilisp-pending-changes (cdr ilisp-pending-changes)) + (apply comint-handler args)) + +;;; +(defun lisp-changes (command message) + "Apply COMMAND to each of the changes and use MESSAGE to print a +message given the name of the change. If there is a positive prefix, +the change list will not be changed." + (save-excursion + (set-buffer (ilisp-buffer)) + (let ((keep (and current-prefix-arg (not (eq current-prefix-arg '-)))) + (changes (reverse lisp-changes)) + (lisp-wait-p nil)) + (setq ilisp-pending-changes (nconc ilisp-pending-changes changes) + current-prefix-arg nil) ;Prevent buffer insertion + (if comint-queue-emptied + (save-excursion + (setq comint-queue-emptied nil) + (set-buffer (get-buffer-create "*Errors*")) + (delete-region (point-min) (point-max)))) + (while changes + (let* ((change (car changes)) + name) + (set-buffer (marker-buffer change)) + (goto-char change) + (setq name (lisp-def-name)) + (forward-sexp) + (funcall command change (point) nil (format message name) + nil 'lisp-change-handler) + (setq changes (cdr changes)))) + (comint-send-code + (ilisp-process) + (function (lambda () + (save-excursion + (set-buffer (get-buffer-create "*Last-Changes*")) + (delete-region (point-min) (point-max)) + (insert (save-excursion + (set-buffer "*Errors*") + (buffer-string))))))) + (if keep + (message "Started, but keeping changes") + (message "Started changes") + (setq lisp-changes nil))))) + +;;; +(defun eval-changes-lisp () + "Evaluate the forms marked as being changed. With prefix, do not +clear the change list." + (interactive) + (lisp-changes 'eval-region-lisp "Evaluate changed %s")) + +;;; +(defun compile-changes-lisp () + "Compile the forms marked as being changed. With prefix, do not +clear the change list." + (interactive) + (lisp-changes 'compile-region-lisp "Compile changed %s"))