| 1 | ;;; eval-region.el --- Redefine eval-region, and subrs that use it, in Lisp |
| 2 | ;; Copyright (C) 1994 Daniel LaLiberte |
| 3 | |
| 4 | ;; This file is 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 2, 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: |
| 41 | ;;; (elisp-eval-region-install). Installation can be undone with: |
| 42 | ;;; (elisp-eval-region-uninstall). |
| 43 | |
| 44 | '(defpackage "elisp-eval-region" |
| 45 | (:nicknames "elisp") |
| 46 | (:use "elisp") |
| 47 | (:export |
| 48 | elisp-eval-region-install |
| 49 | elisp-eval-region-uninstall |
| 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 | |
| 73 | ;; Installing and uninstalling should always be used in pairs, |
| 74 | ;; or just install once and never uninstall. |
| 75 | (defun elisp-eval-region-install () |
| 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 | |
| 82 | (defun elisp-eval-region-uninstall () |
| 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 |
| 102 | already have been installed, using `elisp-eval-region-install', which |
| 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) |