diff options
Diffstat (limited to 'lisp/emacs-lisp')
| -rw-r--r-- | lisp/emacs-lisp/cl-specs.el | 471 | ||||
| -rw-r--r-- | lisp/emacs-lisp/eval-reg.el | 210 |
2 files changed, 681 insertions, 0 deletions
diff --git a/lisp/emacs-lisp/cl-specs.el b/lisp/emacs-lisp/cl-specs.el new file mode 100644 index 00000000000..c2fe5925374 --- /dev/null +++ b/lisp/emacs-lisp/cl-specs.el @@ -0,0 +1,471 @@ +;; cl-specs.el - Edebug specs for cl.el + +;; Copyright (C) 1993 Free Software Foundation, Inc. +;; Author: Daniel LaLiberte <liberte@cs.uiuc.edu> +;; Keywords: lisp, tools, maint + +;; LCD Archive Entry: +;; cl-specs.el|Daniel LaLiberte|liberte@cs.uiuc.edu +;; |Edebug specs for cl.el +;; |$Date: 1994/02/21 21:26:33 $|$Revision: 1.1 $|~/modes/cl-specs.el| + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +;;;; Commentary: + +;; These specs are to be used with edebug.el version 3.3 or later and +;; cl.el version 2.03 or later, by Dave Gillespie <daveg@synaptics.com>. + +;; This file need not be byte-compiled, but it shouldnt hurt. + +(provide 'cl-specs) +;; Do the above provide before the following require. +;; Otherwise if you load this before edebug if cl is already loaded +;; an infinite loading loop would occur. +(require 'edebug) + +;; Blocks + +(def-edebug-spec block (symbolp body)) +(def-edebug-spec return (&optional form)) +(def-edebug-spec return-from (symbolp &optional form)) + +;; Loops + +(def-edebug-spec when t) +(def-edebug-spec unless t) +(def-edebug-spec case (form &rest (sexp body))) +(def-edebug-spec ecase case) +(def-edebug-spec do + ((&rest &or symbolp (symbolp &optional form form)) + (form body) + cl-declarations body)) +(def-edebug-spec do* do) +(def-edebug-spec dolist + ((symbolp form &optional form) cl-declarations body)) +(def-edebug-spec dotimes dolist) +(def-edebug-spec do-symbols + ((symbolp &optional form form) cl-declarations body)) +(def-edebug-spec do-all-symbols + ((symbolp &optional form) cl-declarations body)) + +;; Multiple values + +(def-edebug-spec multiple-value-list (form)) +(def-edebug-spec multiple-value-call (function-form body)) +(def-edebug-spec multiple-value-bind + ((&rest symbolp) form cl-declarations body)) +(def-edebug-spec multiple-value-setq ((&rest symbolp) form)) +(def-edebug-spec multiple-value-prog1 (form body)) + +;; Bindings + +(def-edebug-spec lexical-let let) +(def-edebug-spec lexical-let* let) + +(def-edebug-spec psetq setq) +(def-edebug-spec progv (form form body)) + +(def-edebug-spec flet ((&rest (defun*)) cl-declarations body)) +(def-edebug-spec labels flet) + +(def-edebug-spec macrolet + ((&rest (&define name (&rest arg) cl-declarations-or-string def-body)) + cl-declarations body)) + +(def-edebug-spec symbol-macrolet + ((&rest (symbol sexp)) cl-declarations body)) + +(def-edebug-spec destructuring-bind + (&define cl-macro-list form cl-declarations def-body)) + +;; Setf + +(def-edebug-spec setf (&rest [place form])) ;; sexp is not specific enough +(def-edebug-spec psetf setf) + +(def-edebug-spec letf ;; *not* available in Common Lisp + ((&rest (gate place &optional form)) + body)) +(def-edebug-spec letf* letf) + + +(def-edebug-spec defsetf + (&define name + [&or [symbolp &optional stringp] + [cl-lambda-list (symbolp)]] + cl-declarations-or-string def-body)) + +(def-edebug-spec define-setf-method + (&define name cl-lambda-list cl-declarations-or-string def-body)) + +(def-edebug-spec define-modify-macro + (&define name cl-lambda-list ;; should exclude &key + symbolp &optional stringp)) + +(def-edebug-spec callf (function* place &rest form)) +(def-edebug-spec callf2 (function* form place &rest form)) + +;; Other operations on places + +(def-edebug-spec remf (place form)) + +(def-edebug-spec incf (place &optional form)) +(def-edebug-spec decf incf) +(def-edebug-spec push (form place)) +(def-edebug-spec pushnew + (form place &rest + &or [[&or ":test" ":test-not" ":key"] function-form] + [keywordp form])) +(def-edebug-spec pop (place)) + +(def-edebug-spec shiftf (&rest place)) ;; really [&rest place] form +(def-edebug-spec rotatef (&rest place)) + + +;; Functions with function args. These are only useful if the +;; function arg is quoted with ' instead of function. + +(def-edebug-spec some (function-form form &rest form)) +(def-edebug-spec every some) +(def-edebug-spec notany some) +(def-edebug-spec notevery some) + +;; Mapping + +(def-edebug-spec map (form function-form form &rest form)) +(def-edebug-spec maplist (function-form form &rest form)) +(def-edebug-spec mapc maplist) +(def-edebug-spec mapl maplist) +(def-edebug-spec mapcan maplist) +(def-edebug-spec mapcon maplist) + +;; Sequences + +(def-edebug-spec reduce (function-form form &rest form)) + +;; Types and assertions + +(def-edebug-spec cl-type-spec (sexp)) ;; not worth the trouble to specify, yet. + +(def-edebug-spec deftype defmacro*) +(def-edebug-spec check-type (place cl-type-spec &optional stringp)) +;; (def-edebug-spec assert (form &optional form stringp &rest form)) +(def-edebug-spec assert (form &rest form)) +(def-edebug-spec typecase (form &rest ([&or cl-type-spec "otherwise"] body))) +(def-edebug-spec etypecase typecase) + +(def-edebug-spec ignore-errors t) + +;; Time of Evaluation + +(def-edebug-spec eval-when + ((&rest &or "compile" "load" "eval") body)) +(def-edebug-spec load-time-value (form &optional &or "t" "nil")) + +;; Declarations + +(def-edebug-spec cl-decl-spec + ((symbolp &rest sexp))) + +(def-edebug-spec cl-declarations + (&rest ("declare" &rest cl-decl-spec))) + +(def-edebug-spec cl-declarations-or-string + (&or stringp cl-declarations)) + +(def-edebug-spec declaim (&rest cl-decl-spec)) +(def-edebug-spec declare (&rest cl-decl-spec)) ;; probably not needed. +(def-edebug-spec locally (cl-declarations &rest form)) +(def-edebug-spec the (cl-type-spec form)) + +;;====================================================== +;; Lambda things + +(def-edebug-spec cl-lambda-list + (([&rest arg] + [&optional ["&optional" cl-&optional-arg &rest cl-&optional-arg]] + [&optional ["&rest" arg]] + [&optional ["&key" [cl-&key-arg &rest cl-&key-arg] + &optional "&allow-other-keywords"]] + [&optional ["&aux" &rest + &or (symbolp &optional def-form) symbolp]] + ))) + +(def-edebug-spec cl-&optional-arg + (&or (arg &optional def-form arg) arg)) + +(def-edebug-spec cl-&key-arg + (&or ([&or (symbolp arg) arg] &optional def-form arg) arg)) + +;; The lambda list for macros is different from that of normal lambdas. +;; Note that &environment is only allowed as first or last items in the +;; top level list. + +(def-edebug-spec cl-macro-list + (([&optional "&environment" arg] + [&rest cl-macro-arg] + [&optional ["&optional" &rest + &or (cl-macro-arg &optional def-form cl-macro-arg) arg]] + [&optional [[&or "&rest" "&body"] cl-macro-arg]] + [&optional ["&key" [&rest + [&or ([&or (symbolp cl-macro-arg) arg] + &optional def-form cl-macro-arg) + arg]] + &optional "&allow-other-keywords"]] + [&optional ["&aux" &rest + &or (symbolp &optional def-form) symbolp]] + [&optional "&environment" arg] + ))) + +(def-edebug-spec cl-macro-arg + (&or arg cl-macro-list1)) + +(def-edebug-spec cl-macro-list1 + (([&optional "&whole" arg] ;; only allowed at lower levels + [&rest cl-macro-arg] + [&optional ["&optional" &rest + &or (cl-macro-arg &optional def-form cl-macro-arg) arg]] + [&optional [[&or "&rest" "&body"] cl-macro-arg]] + [&optional ["&key" [&rest + [&or ([&or (symbolp cl-macro-arg) arg] + &optional def-form cl-macro-arg) + arg]] + &optional "&allow-other-keywords"]] + [&optional ["&aux" &rest + &or (symbolp &optional def-form) symbolp]] + . [&or arg nil]))) + + +(def-edebug-spec defun* + ;; Same as defun but use cl-lambda-list. + (&define [&or name + ("setf" :name setf name)] + cl-lambda-list + cl-declarations-or-string + [&optional ("interactive" interactive)] + def-body)) +(def-edebug-spec defsubst* defun*) + +(def-edebug-spec defmacro* + (&define name cl-macro-list cl-declarations-or-string def-body)) +(def-edebug-spec define-compiler-macro defmacro*) + + +(def-edebug-spec function* + (&or symbolp cl-lambda-expr)) + +(def-edebug-spec cl-lambda-expr + (&define ("lambda" cl-lambda-list + ;;cl-declarations-or-string + ;;[&optional ("interactive" interactive)] + def-body))) + +;; Redefine function-form to also match function* +(def-edebug-spec function-form + ;; form at the end could also handle "function", + ;; but recognize it specially to avoid wrapping function forms. + (&or ([&or "quote" "function"] &or symbolp lambda-expr) + ("function*" cl-lambda-expr) + form)) + +;;====================================================== +;; Structures +;; (def-edebug-spec defstruct (&rest sexp)) would be sufficient, but... + +;; defstruct may contain forms that are evaluated when a structure is created. +(def-edebug-spec defstruct + (&define ; makes top-level form not be wrapped + [&or symbolp + (gate + symbolp &rest + (&or [":conc-name" &or stringp "nil"] + [":constructor" symbolp &optional cl-lambda-list] + [":copier" symbolp] + [":predicate" symbolp] + [":include" symbolp &rest sexp];; not finished + ;; The following are not supported. + ;; [":print-function" ...] + ;; [":type" ...] + ;; [":initial-offset" ...] + ))] + [&optional stringp] + ;; All the above is for the following def-form. + &rest &or symbolp (symbolp def-form &optional ":read-only" sexp))) + +;;====================================================== +;; Loop + +;; The loop macro is very complex, and a full spec is found below. +;; The following spec only minimally specifies that +;; parenthesized forms are executable, but single variables used as +;; expressions will be missed. You may want to use this if the full +;; spec causes problems for you. + +(def-edebug-spec loop + (&rest &or symbolp form)) + +;; Below is a complete spec for loop, in several parts that correspond +;; to the syntax given in CLtL2. The specs do more than specify where +;; the forms are; it also specifies, as much as Edebug allows, all the +;; syntactically legal loop clauses. The disadvantage of this +;; completeness is rigidity, but the "for ... being" clause allows +;; arbitrary extensions of the form: [symbolp &rest &or symbolp form]. + +(def-edebug-spec loop + ([&optional ["named" symbolp]] + [&rest + &or + ["repeat" form] + loop-for-as + loop-with + loop-initial-final] + [&rest loop-clause] + )) + +(def-edebug-spec loop-with + ("with" loop-var + loop-type-spec + [&optional ["=" form]] + &rest ["and" loop-var + loop-type-spec + [&optional ["=" form]]])) + +(def-edebug-spec loop-for-as + ([&or "for" "as"] loop-for-as-subclause + &rest ["and" loop-for-as-subclause])) + +(def-edebug-spec loop-for-as-subclause + (loop-var + loop-type-spec + &or + [[&or "in" "on" "in-ref" "across-ref"] + form &optional ["by" function-form]] + + ["=" form &optional ["then" form]] + ["across" form] + ["being" + [&or "the" "each"] + &or + [[&or "element" "elements"] + [&or "of" "in" "of-ref"] form + &optional "using" ["index" symbolp]];; is this right? + [[&or "hash-key" "hash-keys" + "hash-value" "hash-values"] + [&or "of" "in"] + hash-table-p &optional ["using" ([&or "hash-value" "hash-values" + "hash-key" "hash-keys"] sexp)]] + + [[&or "symbol" "present-symbol" "external-symbol" + "symbols" "present-symbols" "external-symbols"] + [&or "in" "of"] package-p] + + ;; Extensions for Emacs Lisp, including Lucid Emacs. + [[&or "frame" "frames" + "screen" "screens" + "buffer" "buffers"]] + + [[&or "window" "windows"] + [&or "of" "in"] form] + + [[&or "overlay" "overlays" + "extent" "extents"] + [&or "of" "in"] form + &optional [[&or "from" "to"] form]] + + [[&or "interval" "intervals"] + [&or "in" "of"] form + &optional [[&or "from" "to"] form] + ["property" form]] + + [[&or "key-code" "key-codes" + "key-seq" "key-seqs" + "key-binding" "key-bindings"] + [&or "in" "of"] form + &optional ["using" ([&or "key-code" "key-codes" + "key-seq" "key-seqs" + "key-binding" "key-bindings"] + sexp)]] + ;; For arbitrary extensions, recognize anything else. + [symbolp &rest &or symbolp form] + ] + + ;; arithmetic - must be last since all parts are optional. + [[&optional [[&or "from" "downfrom" "upfrom"] form]] + [&optional [[&or "to" "downto" "upto" "below" "above"] form]] + [&optional ["by" form]] + ])) + +(def-edebug-spec loop-initial-final + (&or ["initially" + ;; [&optional &or "do" "doing"] ;; CLtL2 doesnt allow this. + &rest loop-non-atomic-expr] + ["finally" &or + [[&optional &or "do" "doing"] &rest loop-non-atomic-expr] + ["return" form]])) + +(def-edebug-spec loop-and-clause + (loop-clause &rest ["and" loop-clause])) + +(def-edebug-spec loop-clause + (&or + [[&or "while" "until" "always" "never" "thereis"] form] + + [[&or "collect" "collecting" + "append" "appending" + "nconc" "nconcing" + "concat" "vconcat"] form + [&optional ["into" loop-var]]] + + [[&or "count" "counting" + "sum" "summing" + "maximize" "maximizing" + "minimize" "minimizing"] form + [&optional ["into" loop-var]] + loop-type-spec] + + [[&or "if" "when" "unless"] + form loop-and-clause + [&optional ["else" loop-and-clause]] + [&optional "end"]] + + [[&or "do" "doing"] &rest loop-non-atomic-expr] + + ["return" form] + loop-initial-final + )) + +(def-edebug-spec loop-non-atomic-expr + ([¬ atom] form)) + +(def-edebug-spec loop-var + ;; The symbolp must be last alternative to recognize e.g. (a b . c) + ;; loop-var => + ;; (loop-var . [&or nil loop-var]) + ;; (symbolp . [&or nil loop-var]) + ;; (symbolp . loop-var) + ;; (symbolp . (symbolp . [&or nil loop-var])) + ;; (symbolp . (symbolp . loop-var)) + ;; (symbolp . (symbolp . symbolp)) == (symbolp symbolp . symbolp) + (&or (loop-var . [&or nil loop-var]) [gate symbolp])) + +(def-edebug-spec loop-type-spec + (&optional ["of-type" loop-d-type-spec])) + +(def-edebug-spec loop-d-type-spec + (&or (loop-d-type-spec . [&or nil loop-d-type-spec]) cl-type-spec)) + diff --git a/lisp/emacs-lisp/eval-reg.el b/lisp/emacs-lisp/eval-reg.el new file mode 100644 index 00000000000..81e01ab8a27 --- /dev/null +++ b/lisp/emacs-lisp/eval-reg.el @@ -0,0 +1,210 @@ +;;;; Redefine eval-region, and subroutines that use it, in Lisp +;; Copyright (C) 1994 Daniel LaLiberte + +;; This file is not part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 1, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +;;;; Commentary: + +;;; eval-region, eval-buffer, and eval-current-buffer are redefined in +;;; Lisp to allow customizations by Lisp code. eval-region calls +;;; `read', `eval', and `prin1', so Lisp replacements of these +;;; functions will affect eval-region and anything else that calls it. +;;; eval-buffer and eval-current-buffer are redefined in Lisp to call +;;; eval-region on the buffer. + +;;; Because of dynamic binding, all local variables are protected from +;;; being seen by eval by giving them funky names. But variables in +;;; routines that call eval-region are similarly exposed. + +;;; Perhaps this should be one of several files in an `elisp' package +;;; that replaces Emacs Lisp subroutines with Lisp versions of the +;;; same. + +;;;; Installation +;;; ============= + +;;; Eval-region may be installed, after loading, by calling: +;;; (install-eval-region). Installation can be undone with: +;;; (uninstall-eval-region). + +'(defpackage "elisp-eval-region" + (:nicknames "elisp") + (:use "elisp") + (:export + install-elisp-eval-region + uninstall-elisp-eval-region + elisp-eval-region-level + with-elisp-eval-region + )) +'(in-package elisp-eval-region) + +;; Save standard versions. +(if (not (fboundp 'original-eval-region)) + (defalias 'original-eval-region (symbol-function 'eval-region))) +(if (not (fboundp 'original-eval-buffer)) + (defalias 'original-eval-buffer + (if (fboundp 'eval-buffer) ;; only in Emacs 19 + (symbol-function 'eval-buffer) + 'undefined))) +(if (not (fboundp 'original-eval-current-buffer)) + (defalias 'original-eval-current-buffer + (symbol-function 'eval-current-buffer))) + +(defvar elisp-eval-region-level 0 + "If the value is 0, use the original version of elisp-eval-region. +Callers of elisp-eval-region should increment elisp-eval-region-level +while the Lisp version should be used. Installing elisp-eval-region +increments it once, and uninstalling decrements it.") + +;; These two should always be used in pairs, or just install once and +;; never uninstall. +(defun install-elisp-eval-region () + (interactive) + (defalias 'eval-region 'elisp-eval-region) + (defalias 'eval-buffer 'elisp-eval-buffer) + (defalias 'eval-current-buffer 'elisp-eval-current-buffer) + (setq elisp-eval-region-level (1+ elisp-eval-region-level))) + +(defun uninstall-elisp-eval-region () + (interactive) + (if (> 1 elisp-eval-region-level) + (setq elisp-eval-region-level (1- elisp-eval-region-level)) + (setq elisp-eval-region-level 0) + (defalias 'eval-region (symbol-function 'original-eval-region)) + (defalias 'eval-buffer (symbol-function 'original-eval-buffer)) + (defalias 'eval-current-buffer + (symbol-function 'original-eval-current-buffer)) + )) + +(put 'with-elisp-eval-region 'lisp-indent-function 1) +(put 'with-elisp-eval-region 'lisp-indent-hook 1) +(put 'with-elisp-eval-region 'edebug-form-spec t) + +(defmacro with-elisp-eval-region (flag &rest body) + "If FLAG is nil, decrement eval-region-level while executing BODY. +The effect of decrementing all the way to zero is that `eval-region' +will use the original eval-region, which may be the Emacs subr or some +previous redefinition. Before calling this macro, this package should +already have been installed, using `install-elisp-eval-region', which +increments the count once. So if another package still requires the +elisp version of the code, the count will still be non-zero. + +The count is not bound locally by this macro, so changes by BODY to +its value will not be lost." + (` (let ((elisp-code (function (lambda () (,@ body))))) + (if (not (, flag)) + (unwind-protect + (progn + (setq elisp-eval-region-level (1- elisp-eval-region-level)) + (funcall elisp-code)) + (setq elisp-eval-region-level (1+ elisp-eval-region-level))) + (funcall elisp-code))))) + + +(defun elisp-eval-region (elisp-start elisp-end &optional elisp-output) + "Execute the region as Lisp code. +When called from programs, expects two arguments, +giving starting and ending indices in the current buffer +of the text to be executed. +Programs can pass third argument PRINTFLAG which controls printing of output: +nil means discard it; anything else is stream for print. + +This version, from eval-region, allows Lisp customization of read, +eval, and the printer." + + ;; Because this doesnt narrow to the region, one other difference + ;; concerns inserting whitespace after the expression being evaluated. + + (interactive "r") + (if (= 0 elisp-eval-region-level) + (original-eval-region elisp-start elisp-end elisp-output) + (let ((elisp-pnt (point)) + (elisp-buf (current-buffer));; Outside buffer + (elisp-inside-buf (current-buffer));; Buffer current while evaling + ;; Mark the end because it may move. + (elisp-end-marker (set-marker (make-marker) elisp-end)) + elisp-form + elisp-val) + (goto-char elisp-start) + (elisp-skip-whitespace) + (while (< (point) elisp-end-marker) + (setq elisp-form (read elisp-buf)) + + (let ((elisp-current-buffer (current-buffer))) + ;; Restore the inside current-buffer. + (set-buffer elisp-inside-buf) + (setq elisp-val (eval elisp-form)) + ;; Remember current buffer for next time. + (setq elisp-inside-buf (current-buffer)) + ;; Should this be protected? + (set-buffer elisp-current-buffer)) + + (if elisp-output + (let ((standard-output (or elisp-output t))) + (setq values (cons elisp-val values)) + (if (eq standard-output t) + (prin1 elisp-val) + (princ "\n") + (prin1 elisp-val) + (princ "\n") + ))) + (goto-char (min (max elisp-end-marker (point)) + (progn (elisp-skip-whitespace) (point)))) + ) ; while + (if elisp-output nil + ;; like save-excursion recovery, but done only if no error occurs + ;; but mark is not restored + (set-buffer elisp-buf) + (goto-char elisp-pnt)) + nil))) + + +(defun elisp-skip-whitespace () + ;; Leave point before the next token, skipping white space and comments. + (skip-chars-forward " \t\r\n\f") + (while (= (following-char) ?\;) + (skip-chars-forward "^\n\r") ; skip the comment + (skip-chars-forward " \t\r\n\f"))) + + +(defun elisp-eval-current-buffer (&optional elisp-output) + "Execute the current buffer as Lisp code. +Programs can pass argument PRINTFLAG which controls printing of output: +nil means discard it; anything else is stream for print. + +This version from eval-region calls `eval-region' on the whole buffer." + ;; The standard eval-current-buffer doesn't use eval-region. + (interactive) + (eval-region (point-min) (point-max) elisp-output)) + + +(defun elisp-eval-buffer (&optional elisp-bufname elisp-printflag) + "Execute BUFFER as Lisp code. Use current buffer if BUFFER is nil. +Programs can pass argument PRINTFLAG which controls printing of +output: nil means discard it; anything else is stream for print. + +This version from eval-region calls `eval-region' on the whole buffer." + (interactive) + (if (null elisp-bufname) + (setq elisp-bufname (current-buffer))) + (save-excursion + (set-buffer (or (get-buffer elisp-bufname) + (error "No such buffer: %s" elisp-bufname))) + (eval-region (point-min) (point-max) elisp-printflag))) + + +(provide 'elisp-eval-region) |