Commit | Line | Data |
---|---|---|
7ed39e9d DL |
1 | ;;;; Redefine eval-region, and subroutines that use it, in Lisp |
2 | ;; Copyright (C) 1994 Daniel LaLiberte | |
3 | ||
4 | ;; This file is not part of GNU Emacs. | |
5 | ||
6 | ;; GNU Emacs is free software; you can redistribute it and/or modify | |
7 | ;; it under the terms of the GNU General Public License as published by | |
8 | ;; the Free Software Foundation; either version 1, or (at your option) | |
9 | ;; any later version. | |
10 | ||
11 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
12 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
13 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
14 | ;; GNU General Public License for more details. | |
15 | ||
16 | ;; You should have received a copy of the GNU General Public License | |
17 | ;; along with GNU Emacs; see the file COPYING. If not, write to | |
18 | ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
19 | ||
20 | ;;;; Commentary: | |
21 | ||
22 | ;;; eval-region, eval-buffer, and eval-current-buffer are redefined in | |
23 | ;;; Lisp to allow customizations by Lisp code. eval-region calls | |
24 | ;;; `read', `eval', and `prin1', so Lisp replacements of these | |
25 | ;;; functions will affect eval-region and anything else that calls it. | |
26 | ;;; eval-buffer and eval-current-buffer are redefined in Lisp to call | |
27 | ;;; eval-region on the buffer. | |
28 | ||
29 | ;;; Because of dynamic binding, all local variables are protected from | |
30 | ;;; being seen by eval by giving them funky names. But variables in | |
31 | ;;; routines that call eval-region are similarly exposed. | |
32 | ||
33 | ;;; Perhaps this should be one of several files in an `elisp' package | |
34 | ;;; that replaces Emacs Lisp subroutines with Lisp versions of the | |
35 | ;;; same. | |
36 | ||
37 | ;;;; Installation | |
38 | ;;; ============= | |
39 | ||
40 | ;;; Eval-region may be installed, after loading, by calling: | |
ef2b0b89 DL |
41 | ;;; (elisp-eval-region-install). Installation can be undone with: |
42 | ;;; (elisp-eval-region-uninstall). | |
7ed39e9d DL |
43 | |
44 | '(defpackage "elisp-eval-region" | |
45 | (:nicknames "elisp") | |
46 | (:use "elisp") | |
47 | (:export | |
ef2b0b89 DL |
48 | elisp-eval-region-install |
49 | elisp-eval-region-uninstall | |
7ed39e9d DL |
50 | elisp-eval-region-level |
51 | with-elisp-eval-region | |
52 | )) | |
53 | '(in-package elisp-eval-region) | |
54 | ||
55 | ;; Save standard versions. | |
56 | (if (not (fboundp 'original-eval-region)) | |
57 | (defalias 'original-eval-region (symbol-function 'eval-region))) | |
58 | (if (not (fboundp 'original-eval-buffer)) | |
59 | (defalias 'original-eval-buffer | |
60 | (if (fboundp 'eval-buffer) ;; only in Emacs 19 | |
61 | (symbol-function 'eval-buffer) | |
62 | 'undefined))) | |
63 | (if (not (fboundp 'original-eval-current-buffer)) | |
64 | (defalias 'original-eval-current-buffer | |
65 | (symbol-function 'eval-current-buffer))) | |
66 | ||
67 | (defvar elisp-eval-region-level 0 | |
68 | "If the value is 0, use the original version of elisp-eval-region. | |
69 | Callers of elisp-eval-region should increment elisp-eval-region-level | |
70 | while the Lisp version should be used. Installing elisp-eval-region | |
71 | increments it once, and uninstalling decrements it.") | |
72 | ||
ef2b0b89 DL |
73 | ;; Installing and uninstalling should always be used in pairs, |
74 | ;; or just install once and never uninstall. | |
75 | (defun elisp-eval-region-install () | |
7ed39e9d DL |
76 | (interactive) |
77 | (defalias 'eval-region 'elisp-eval-region) | |
78 | (defalias 'eval-buffer 'elisp-eval-buffer) | |
79 | (defalias 'eval-current-buffer 'elisp-eval-current-buffer) | |
80 | (setq elisp-eval-region-level (1+ elisp-eval-region-level))) | |
81 | ||
ef2b0b89 | 82 | (defun elisp-eval-region-uninstall () |
7ed39e9d DL |
83 | (interactive) |
84 | (if (> 1 elisp-eval-region-level) | |
85 | (setq elisp-eval-region-level (1- elisp-eval-region-level)) | |
86 | (setq elisp-eval-region-level 0) | |
87 | (defalias 'eval-region (symbol-function 'original-eval-region)) | |
88 | (defalias 'eval-buffer (symbol-function 'original-eval-buffer)) | |
89 | (defalias 'eval-current-buffer | |
90 | (symbol-function 'original-eval-current-buffer)) | |
91 | )) | |
92 | ||
93 | (put 'with-elisp-eval-region 'lisp-indent-function 1) | |
94 | (put 'with-elisp-eval-region 'lisp-indent-hook 1) | |
95 | (put 'with-elisp-eval-region 'edebug-form-spec t) | |
96 | ||
97 | (defmacro with-elisp-eval-region (flag &rest body) | |
98 | "If FLAG is nil, decrement eval-region-level while executing BODY. | |
99 | The effect of decrementing all the way to zero is that `eval-region' | |
100 | will use the original eval-region, which may be the Emacs subr or some | |
101 | previous redefinition. Before calling this macro, this package should | |
ef2b0b89 | 102 | already have been installed, using `elisp-eval-region-install', which |
7ed39e9d DL |
103 | increments the count once. So if another package still requires the |
104 | elisp version of the code, the count will still be non-zero. | |
105 | ||
106 | The count is not bound locally by this macro, so changes by BODY to | |
107 | its value will not be lost." | |
108 | (` (let ((elisp-code (function (lambda () (,@ body))))) | |
109 | (if (not (, flag)) | |
110 | (unwind-protect | |
111 | (progn | |
112 | (setq elisp-eval-region-level (1- elisp-eval-region-level)) | |
113 | (funcall elisp-code)) | |
114 | (setq elisp-eval-region-level (1+ elisp-eval-region-level))) | |
115 | (funcall elisp-code))))) | |
116 | ||
117 | ||
118 | (defun elisp-eval-region (elisp-start elisp-end &optional elisp-output) | |
119 | "Execute the region as Lisp code. | |
120 | When called from programs, expects two arguments, | |
121 | giving starting and ending indices in the current buffer | |
122 | of the text to be executed. | |
123 | Programs can pass third argument PRINTFLAG which controls printing of output: | |
124 | nil means discard it; anything else is stream for print. | |
125 | ||
126 | This version, from eval-region, allows Lisp customization of read, | |
127 | eval, and the printer." | |
128 | ||
129 | ;; Because this doesnt narrow to the region, one other difference | |
130 | ;; concerns inserting whitespace after the expression being evaluated. | |
131 | ||
132 | (interactive "r") | |
133 | (if (= 0 elisp-eval-region-level) | |
134 | (original-eval-region elisp-start elisp-end elisp-output) | |
135 | (let ((elisp-pnt (point)) | |
136 | (elisp-buf (current-buffer));; Outside buffer | |
137 | (elisp-inside-buf (current-buffer));; Buffer current while evaling | |
138 | ;; Mark the end because it may move. | |
139 | (elisp-end-marker (set-marker (make-marker) elisp-end)) | |
140 | elisp-form | |
141 | elisp-val) | |
142 | (goto-char elisp-start) | |
143 | (elisp-skip-whitespace) | |
144 | (while (< (point) elisp-end-marker) | |
145 | (setq elisp-form (read elisp-buf)) | |
146 | ||
147 | (let ((elisp-current-buffer (current-buffer))) | |
148 | ;; Restore the inside current-buffer. | |
149 | (set-buffer elisp-inside-buf) | |
150 | (setq elisp-val (eval elisp-form)) | |
151 | ;; Remember current buffer for next time. | |
152 | (setq elisp-inside-buf (current-buffer)) | |
153 | ;; Should this be protected? | |
154 | (set-buffer elisp-current-buffer)) | |
155 | ||
156 | (if elisp-output | |
157 | (let ((standard-output (or elisp-output t))) | |
158 | (setq values (cons elisp-val values)) | |
159 | (if (eq standard-output t) | |
160 | (prin1 elisp-val) | |
161 | (princ "\n") | |
162 | (prin1 elisp-val) | |
163 | (princ "\n") | |
164 | ))) | |
165 | (goto-char (min (max elisp-end-marker (point)) | |
166 | (progn (elisp-skip-whitespace) (point)))) | |
167 | ) ; while | |
168 | (if elisp-output nil | |
169 | ;; like save-excursion recovery, but done only if no error occurs | |
170 | ;; but mark is not restored | |
171 | (set-buffer elisp-buf) | |
172 | (goto-char elisp-pnt)) | |
173 | nil))) | |
174 | ||
175 | ||
176 | (defun elisp-skip-whitespace () | |
177 | ;; Leave point before the next token, skipping white space and comments. | |
178 | (skip-chars-forward " \t\r\n\f") | |
179 | (while (= (following-char) ?\;) | |
180 | (skip-chars-forward "^\n\r") ; skip the comment | |
181 | (skip-chars-forward " \t\r\n\f"))) | |
182 | ||
183 | ||
184 | (defun elisp-eval-current-buffer (&optional elisp-output) | |
185 | "Execute the current buffer as Lisp code. | |
186 | Programs can pass argument PRINTFLAG which controls printing of output: | |
187 | nil means discard it; anything else is stream for print. | |
188 | ||
189 | This version from eval-region calls `eval-region' on the whole buffer." | |
190 | ;; The standard eval-current-buffer doesn't use eval-region. | |
191 | (interactive) | |
192 | (eval-region (point-min) (point-max) elisp-output)) | |
193 | ||
194 | ||
195 | (defun elisp-eval-buffer (&optional elisp-bufname elisp-printflag) | |
196 | "Execute BUFFER as Lisp code. Use current buffer if BUFFER is nil. | |
197 | Programs can pass argument PRINTFLAG which controls printing of | |
198 | output: nil means discard it; anything else is stream for print. | |
199 | ||
200 | This version from eval-region calls `eval-region' on the whole buffer." | |
201 | (interactive) | |
202 | (if (null elisp-bufname) | |
203 | (setq elisp-bufname (current-buffer))) | |
204 | (save-excursion | |
205 | (set-buffer (or (get-buffer elisp-bufname) | |
206 | (error "No such buffer: %s" elisp-bufname))) | |
207 | (eval-region (point-min) (point-max) elisp-printflag))) | |
208 | ||
209 | ||
210 | (provide 'elisp-eval-region) |