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