annotate lisp/ilisp/ilisp-bat.el @ 12:bcdc7deadc19 r19-15b7

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