Mercurial > hg > xemacs-beta

comparison lisp/ilisp/ilisp-bat.el @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children b82b59fe008d
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 ;;; -*- Mode: Emacs-Lisp -*-
2
3 ;;; ilisp-bat.el --
4
5 ;;; This file is part of ILISP.
6 ;;; Version: 5.7
7 ;;;
8 ;;; Copyright (C) 1990, 1991, 1992, 1993 Chris McConnell
9 ;;; 1993, 1994 Ivan Vasquez
10 ;;; 1994, 1995 Marco Antoniotti and Rick Busdiecker
11 ;;;
12 ;;; Other authors' names for which this Copyright notice also holds
13 ;;; may appear later in this file.
14 ;;;
15 ;;; Send mail to 'ilisp-request@lehman.com' to be included in the
16 ;;; ILISP mailing list. 'ilisp@lehman.com' is the general ILISP
17 ;;; mailing list were bugs and improvements are discussed.
18 ;;;
19 ;;; ILISP is freely redistributable under the terms found in the file
20 ;;; COPYING.
21
22 ;;;
23 ;;; Inferior LISP interaction package batch submodule.
24
25 ;;; See ilisp.el for more information.
26 (defun mark-change-lisp (arg)
27 "Mark the current defun as being changed so that lisp-eval-changes,
28 or lisp-compile-changes will work on it. With a prefix, unmark."
29 (interactive "P")
30 (let (point name)
31 (save-excursion
32 (setq point (lisp-defun-begin)
33 name (lisp-def-name)))
34 (if arg
35 (let ((marker (car (lisp-memk point lisp-changes 'marker-position))))
36 (message "%s marked as unchanged" name)
37 (setq lisp-changes (delq marker lisp-changes)))
38 (message "%s marked as changed" name)
39 (if (not (lisp-memk point lisp-changes 'marker-position))
40 (let ((new (make-marker)))
41 (set-marker new point)
42 (setq lisp-changes (cons new lisp-changes)))))))
43
44 ;;;
45 (defun list-changes-lisp ()
46 "List the name of LISP forms currently marked as being changed."
47 (interactive)
48 (let ((names (reverse (mapcar (function
49 (lambda (change)
50 (save-excursion
51 (set-buffer (marker-buffer change))
52 (goto-char change)
53 (lisp-def-name))))
54 lisp-changes))))
55 (if names
56 (with-output-to-temp-buffer "*Changed-Definitions*"
57 (display-completion-list names)
58 (save-excursion
59 (set-buffer "*Changed-Definitions*")
60 (goto-char (point-min))
61 (kill-line)
62 (insert "Changed LISP forms:")))
63 (error "No changed definitions"))))
64
65 ;;;
66 (defun clear-changes-lisp ()
67 "Clear the list of LISP forms currently marked as being changed."
68 (interactive)
69 (message "Cleared changes")
70 (setq lisp-changes nil))
71
72 ;;;
73 (defun lisp-change-handler (&rest args)
74 "Handle an error during a batch process by keeping the change on the
75 list and passing it on to the normal error handler."
76 (let ((change (car ilisp-pending-changes)))
77 (if (and comint-errorp
78 (not (lisp-memk change lisp-changes 'marker-position)))
79 (setq lisp-changes (nconc lisp-changes (cons change nil)))))
80 (setq ilisp-pending-changes (cdr ilisp-pending-changes))
81 (apply comint-handler args))
82
83 ;;;
84 (defun lisp-changes (command message)
85 "Apply COMMAND to each of the changes and use MESSAGE to print a
86 message given the name of the change. If there is a positive prefix,
87 the change list will not be changed."
88 (save-excursion
89 (set-buffer (ilisp-buffer))
90 (let ((keep (and current-prefix-arg (not (eq current-prefix-arg '-))))
91 (changes (reverse lisp-changes))
92 (lisp-wait-p nil))
93 (setq ilisp-pending-changes (nconc ilisp-pending-changes changes)
94 current-prefix-arg nil) ;Prevent buffer insertion
95 (if comint-queue-emptied
96 (save-excursion
97 (setq comint-queue-emptied nil)
98 (set-buffer (get-buffer-create "*Errors*"))
99 (delete-region (point-min) (point-max))))
100 (while changes
101 (let* ((change (car changes))
102 name)
103 (set-buffer (marker-buffer change))
104 (goto-char change)
105 (setq name (lisp-def-name))
106 (forward-sexp)
107 (funcall command change (point) nil (format message name)
108 nil 'lisp-change-handler)
109 (setq changes (cdr changes))))
110 (comint-send-code
111 (ilisp-process)
112 (function (lambda ()
113 (save-excursion
114 (set-buffer (get-buffer-create "*Last-Changes*"))
115 (delete-region (point-min) (point-max))
116 (insert (save-excursion
117 (set-buffer "*Errors*")
118 (buffer-string)))))))
119 (if keep
120 (message "Started, but keeping changes")
121 (message "Started changes")
122 (setq lisp-changes nil)))))
123
124 ;;;
125 (defun eval-changes-lisp ()
126 "Evaluate the forms marked as being changed. With prefix, do not
127 clear the change list."
128 (interactive)
129 (lisp-changes 'eval-region-lisp "Evaluate changed %s"))
130
131 ;;;
132 (defun compile-changes-lisp ()
133 "Compile the forms marked as being changed. With prefix, do not
134 clear the change list."
135 (interactive)
136 (lisp-changes 'compile-region-lisp "Compile changed %s"))