diff options
| author | Stefan Monnier | 2012-09-13 23:55:16 -0400 |
|---|---|---|
| committer | Stefan Monnier | 2012-09-13 23:55:16 -0400 |
| commit | 2de39f089a464cc265b6c583684226d1a94abbfa (patch) | |
| tree | b73af6099af4765cc78fe1c4ff930749708dcdad | |
| parent | 2a7931e3548f730ca1abdc489cc0575a6c4e7cab (diff) | |
| download | emacs-2de39f089a464cc265b6c583684226d1a94abbfa.tar.gz emacs-2de39f089a464cc265b6c583684226d1a94abbfa.zip | |
* lisp/emacs-lisp/edebug.el: Miscellaneous cleanup.
Remove obsolete byte-compiler hack that tried to silence some warnings.
(edebug-submit-bug-report): Remove.
(edebug-get-buffer-window, edebug-sit-for, edebug-input-pending-p):
Remove aliases, use the un-prefixed name instead.
(edebug-pop-to-buffer): Consider other frames.
(edebug-original-read):: Make it more obvious that it's always defined.
(edebug--make-form-data-entry, edebug--form-data-name)
(edebug--form-data-begin, edebug--form-data-end): Rename from the
single-dashed name, and implement with cl-defstruct.
(edebug-set-form-data-entry): Use the standard accessors.
(edebug-make-top-form-data-entry): Use push.
(edebug-no-match): Drop useless `funcall'.
(mapcar, mapconcat, mapatoms, apply, funcall): Don't add debug specs
to functions.
(defsubst, dont-compile, eval-when-compile, eval-and-compile)
(delay-mode-hooks, with-temp-file, with-temp-message, ad-dolist)
(with-syntax-table, push, pop, 1value, noreturn, defadvice)
(easy-menu-define, with-custom-print): Remove redundant specs.
(edebug-outside-overriding-local-map)
(edebug-outside-overriding-terminal-local-map): Remove, unused.
(edebug--display): Bind unread-command-events directly to nil rather
than binding it to unread-command-events and later setting it to nil.
(edebug--display): Kill edebug-eval-buffer here...
(edebug--recursive-edit): ...rather than here.
Bind standard-output and standard-input.
(edebug-eval): Check cl-macroexpand-all is fboundp.
(edebug-temp-display-freq-count): Fix last change.
* lisp/emacs-lisp/easymenu.el (easy-menu-define): Add `debug' spec.
* lisp/subr.el (noreturn, 1value): Add `debug' spec.
* lisp/emacs-lisp/advice.el: Require cl-lib.
(ad-copy-tree): Remove, use copy-tree instead.
(ad-dolist): Remove use dolist or cl-dolist instead.
(ad-do-return): Remove, use cl-return instead.
(defadvice): Add `debug' spec.
| -rw-r--r-- | lisp/ChangeLog | 39 | ||||
| -rw-r--r-- | lisp/dired.el | 2 | ||||
| -rw-r--r-- | lisp/emacs-lisp/advice.el | 183 | ||||
| -rw-r--r-- | lisp/emacs-lisp/easymenu.el | 2 | ||||
| -rw-r--r-- | lisp/emacs-lisp/edebug.el | 261 | ||||
| -rw-r--r-- | lisp/subr.el | 2 |
6 files changed, 180 insertions, 309 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 15039358559..7163b4b4989 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,42 @@ | |||
| 1 | 2012-09-14 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 2 | |||
| 3 | * emacs-lisp/edebug.el: Miscellaneous cleanup. | ||
| 4 | Remove obsolete byte-compiler hack that tried to silence some warnings. | ||
| 5 | (edebug-submit-bug-report): Remove. | ||
| 6 | (edebug-get-buffer-window, edebug-sit-for, edebug-input-pending-p): | ||
| 7 | Remove aliases, use the un-prefixed name instead. | ||
| 8 | (edebug-pop-to-buffer): Consider other frames. | ||
| 9 | (edebug-original-read):: Make it more obvious that it's always defined. | ||
| 10 | (edebug--make-form-data-entry, edebug--form-data-name) | ||
| 11 | (edebug--form-data-begin, edebug--form-data-end): Rename from the | ||
| 12 | single-dashed name, and implement with cl-defstruct. | ||
| 13 | (edebug-set-form-data-entry): Use the standard accessors. | ||
| 14 | (edebug-make-top-form-data-entry): Use push. | ||
| 15 | (edebug-no-match): Drop useless `funcall'. | ||
| 16 | (mapcar, mapconcat, mapatoms, apply, funcall): Don't add debug specs | ||
| 17 | to functions. | ||
| 18 | (defsubst, dont-compile, eval-when-compile, eval-and-compile) | ||
| 19 | (delay-mode-hooks, with-temp-file, with-temp-message, ad-dolist) | ||
| 20 | (with-syntax-table, push, pop, 1value, noreturn, defadvice) | ||
| 21 | (easy-menu-define, with-custom-print): Remove redundant specs. | ||
| 22 | (edebug-outside-overriding-local-map) | ||
| 23 | (edebug-outside-overriding-terminal-local-map): Remove, unused. | ||
| 24 | (edebug--display): Bind unread-command-events directly to nil rather | ||
| 25 | than binding it to unread-command-events and later setting it to nil. | ||
| 26 | (edebug--display): Kill edebug-eval-buffer here... | ||
| 27 | (edebug--recursive-edit): ...rather than here. | ||
| 28 | Bind standard-output and standard-input. | ||
| 29 | (edebug-eval): Check cl-macroexpand-all is fboundp. | ||
| 30 | (edebug-temp-display-freq-count): Fix last change. | ||
| 31 | |||
| 32 | * emacs-lisp/easymenu.el (easy-menu-define): Add `debug' spec. | ||
| 33 | * subr.el (noreturn, 1value): Add `debug' spec. | ||
| 34 | * emacs-lisp/advice.el: Require cl-lib. | ||
| 35 | (ad-copy-tree): Remove, use copy-tree instead. | ||
| 36 | (ad-dolist): Remove use dolist or cl-dolist instead. | ||
| 37 | (ad-do-return): Remove, use cl-return instead. | ||
| 38 | (defadvice): Add `debug' spec. | ||
| 39 | |||
| 1 | 2012-09-13 Juri Linkov <juri@jurta.org> | 40 | 2012-09-13 Juri Linkov <juri@jurta.org> |
| 2 | 41 | ||
| 3 | * dired-aux.el (dired-do-chxxx): Use `eq' to detect empty input. | 42 | * dired-aux.el (dired-do-chxxx): Use `eq' to detect empty input. |
diff --git a/lisp/dired.el b/lisp/dired.el index f4ae027181a..ebc8f5da6d5 100644 --- a/lisp/dired.el +++ b/lisp/dired.el | |||
| @@ -3744,7 +3744,7 @@ Ask means pop up a menu for the user to select one of copy, move or link." | |||
| 3744 | ;;;;;; dired-run-shell-command dired-do-shell-command dired-do-async-shell-command | 3744 | ;;;;;; dired-run-shell-command dired-do-shell-command dired-do-async-shell-command |
| 3745 | ;;;;;; dired-clean-directory dired-do-print dired-do-touch dired-do-chown | 3745 | ;;;;;; dired-clean-directory dired-do-print dired-do-touch dired-do-chown |
| 3746 | ;;;;;; dired-do-chgrp dired-do-chmod dired-compare-directories dired-backup-diff | 3746 | ;;;;;; dired-do-chgrp dired-do-chmod dired-compare-directories dired-backup-diff |
| 3747 | ;;;;;; dired-diff) "dired-aux" "dired-aux.el" "4b260eda371d319a6c8e8e5ec917e287") | 3747 | ;;;;;; dired-diff) "dired-aux" "dired-aux.el" "22ce64daa7ccb5698cb6b1279aa59ec2") |
| 3748 | ;;; Generated autoloads from dired-aux.el | 3748 | ;;; Generated autoloads from dired-aux.el |
| 3749 | 3749 | ||
| 3750 | (autoload 'dired-diff "dired-aux" "\ | 3750 | (autoload 'dired-diff "dired-aux" "\ |
diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el index cac76d2bce1..f0d277a3f69 100644 --- a/lisp/emacs-lisp/advice.el +++ b/lisp/emacs-lisp/advice.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; advice.el --- an overloading mechanism for Emacs Lisp functions | 1 | ;;; advice.el --- An overloading mechanism for Emacs Lisp functions |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1993-1994, 2000-2012 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1993-1994, 2000-2012 Free Software Foundation, Inc. |
| 4 | 4 | ||
| @@ -1746,7 +1746,7 @@ | |||
| 1746 | (provide 'advice-preload) | 1746 | (provide 'advice-preload) |
| 1747 | ;; During a normal load this is a noop: | 1747 | ;; During a normal load this is a noop: |
| 1748 | (require 'advice-preload "advice.el") | 1748 | (require 'advice-preload "advice.el") |
| 1749 | 1749 | (eval-when-compile (require 'cl-lib)) | |
| 1750 | 1750 | ||
| 1751 | ;; @@ Variable definitions: | 1751 | ;; @@ Variable definitions: |
| 1752 | ;; ======================== | 1752 | ;; ======================== |
| @@ -1812,54 +1812,6 @@ generates a copy of TREE." | |||
| 1812 | (funcall fUnCtIoN tReE)) | 1812 | (funcall fUnCtIoN tReE)) |
| 1813 | (t tReE))) | 1813 | (t tReE))) |
| 1814 | 1814 | ||
| 1815 | ;; this is just faster than `ad-substitute-tree': | ||
| 1816 | (defun ad-copy-tree (tree) | ||
| 1817 | "Return a copy of the list structure of TREE." | ||
| 1818 | (cond ((consp tree) | ||
| 1819 | (cons (ad-copy-tree (car tree)) | ||
| 1820 | (ad-copy-tree (cdr tree)))) | ||
| 1821 | (t tree))) | ||
| 1822 | |||
| 1823 | (defmacro ad-dolist (varform &rest body) | ||
| 1824 | "A Common-Lisp-style dolist iterator with the following syntax: | ||
| 1825 | |||
| 1826 | (ad-dolist (VAR INIT-FORM [RESULT-FORM]) | ||
| 1827 | BODY-FORM...) | ||
| 1828 | |||
| 1829 | which will iterate over the list yielded by INIT-FORM binding VAR to the | ||
| 1830 | current head at every iteration. If RESULT-FORM is supplied its value will | ||
| 1831 | be returned at the end of the iteration, nil otherwise. The iteration can be | ||
| 1832 | exited prematurely with `(ad-do-return [VALUE])'." | ||
| 1833 | (let ((expansion | ||
| 1834 | `(let ((ad-dO-vAr ,(car (cdr varform))) | ||
| 1835 | ,(car varform)) | ||
| 1836 | (while ad-dO-vAr | ||
| 1837 | (setq ,(car varform) (car ad-dO-vAr)) | ||
| 1838 | ,@body | ||
| 1839 | ;;work around a backquote bug: | ||
| 1840 | ;;(` ((,@ '(foo)) (bar))) => (append '(foo) '(((bar)))) wrong | ||
| 1841 | ;;(` ((,@ '(foo)) (, '(bar)))) => (append '(foo) (list '(bar))) | ||
| 1842 | ,'(setq ad-dO-vAr (cdr ad-dO-vAr))) | ||
| 1843 | ,(car (cdr (cdr varform)))))) | ||
| 1844 | ;;ok, this wastes some cons cells but only during compilation: | ||
| 1845 | (if (catch 'contains-return | ||
| 1846 | (ad-substitute-tree | ||
| 1847 | (function (lambda (subtree) | ||
| 1848 | (cond ((eq (car-safe subtree) 'ad-dolist)) | ||
| 1849 | ((eq (car-safe subtree) 'ad-do-return) | ||
| 1850 | (throw 'contains-return t))))) | ||
| 1851 | 'identity body) | ||
| 1852 | nil) | ||
| 1853 | `(catch 'ad-dO-eXiT ,expansion) | ||
| 1854 | expansion))) | ||
| 1855 | |||
| 1856 | (defmacro ad-do-return (value) | ||
| 1857 | `(throw 'ad-dO-eXiT ,value)) | ||
| 1858 | |||
| 1859 | (if (not (get 'ad-dolist 'lisp-indent-hook)) | ||
| 1860 | (put 'ad-dolist 'lisp-indent-hook 1)) | ||
| 1861 | |||
| 1862 | |||
| 1863 | ;; @@ Save real definitions of subrs used by Advice: | 1815 | ;; @@ Save real definitions of subrs used by Advice: |
| 1864 | ;; ================================================= | 1816 | ;; ================================================= |
| 1865 | ;; Advice depends on the real, unmodified functionality of various subrs, | 1817 | ;; Advice depends on the real, unmodified functionality of various subrs, |
| @@ -1924,16 +1876,16 @@ exited prematurely with `(ad-do-return [VALUE])'." | |||
| 1924 | ad-advised-functions))) | 1876 | ad-advised-functions))) |
| 1925 | 1877 | ||
| 1926 | (defmacro ad-do-advised-functions (varform &rest body) | 1878 | (defmacro ad-do-advised-functions (varform &rest body) |
| 1927 | "`ad-dolist'-style iterator that maps over `ad-advised-functions'. | 1879 | "`dolist'-style iterator that maps over `ad-advised-functions'. |
| 1928 | \(ad-do-advised-functions (VAR [RESULT-FORM]) | 1880 | \(ad-do-advised-functions (VAR [RESULT-FORM]) |
| 1929 | BODY-FORM...) | 1881 | BODY-FORM...) |
| 1930 | On each iteration VAR will be bound to the name of an advised function | 1882 | On each iteration VAR will be bound to the name of an advised function |
| 1931 | \(a symbol)." | 1883 | \(a symbol)." |
| 1932 | `(ad-dolist (,(car varform) | 1884 | `(cl-dolist (,(car varform) |
| 1933 | ad-advised-functions | 1885 | ad-advised-functions |
| 1934 | ,(car (cdr varform))) | 1886 | ,(car (cdr varform))) |
| 1935 | (setq ,(car varform) (intern (car ,(car varform)))) | 1887 | (setq ,(car varform) (intern (car ,(car varform)))) |
| 1936 | ,@body)) | 1888 | ,@body)) |
| 1937 | 1889 | ||
| 1938 | (if (not (get 'ad-do-advised-functions 'lisp-indent-hook)) | 1890 | (if (not (get 'ad-do-advised-functions 'lisp-indent-hook)) |
| 1939 | (put 'ad-do-advised-functions 'lisp-indent-hook 1)) | 1891 | (put 'ad-do-advised-functions 'lisp-indent-hook 1)) |
| @@ -1948,7 +1900,7 @@ On each iteration VAR will be bound to the name of an advised function | |||
| 1948 | `(put ,function 'ad-advice-info ,advice-info)) | 1900 | `(put ,function 'ad-advice-info ,advice-info)) |
| 1949 | 1901 | ||
| 1950 | (defmacro ad-copy-advice-info (function) | 1902 | (defmacro ad-copy-advice-info (function) |
| 1951 | `(ad-copy-tree (get ,function 'ad-advice-info))) | 1903 | `(copy-tree (get ,function 'ad-advice-info))) |
| 1952 | 1904 | ||
| 1953 | (defmacro ad-is-advised (function) | 1905 | (defmacro ad-is-advised (function) |
| 1954 | "Return non-nil if FUNCTION has any advice info associated with it. | 1906 | "Return non-nil if FUNCTION has any advice info associated with it. |
| @@ -2022,8 +1974,8 @@ either t or nil, and DEFINITION should be a list of the form | |||
| 2022 | 1974 | ||
| 2023 | (defun ad-has-enabled-advice (function class) | 1975 | (defun ad-has-enabled-advice (function class) |
| 2024 | "True if at least one of FUNCTION's advices in CLASS is enabled." | 1976 | "True if at least one of FUNCTION's advices in CLASS is enabled." |
| 2025 | (ad-dolist (advice (ad-get-advice-info-field function class)) | 1977 | (cl-dolist (advice (ad-get-advice-info-field function class)) |
| 2026 | (if (ad-advice-enabled advice) (ad-do-return t)))) | 1978 | (if (ad-advice-enabled advice) (cl-return t)))) |
| 2027 | 1979 | ||
| 2028 | (defun ad-has-redefining-advice (function) | 1980 | (defun ad-has-redefining-advice (function) |
| 2029 | "True if FUNCTION's advice info defines at least 1 redefining advice. | 1981 | "True if FUNCTION's advice info defines at least 1 redefining advice. |
| @@ -2036,14 +1988,14 @@ Redefining advices affect the construction of an advised definition." | |||
| 2036 | (defun ad-has-any-advice (function) | 1988 | (defun ad-has-any-advice (function) |
| 2037 | "True if the advice info of FUNCTION defines at least one advice." | 1989 | "True if the advice info of FUNCTION defines at least one advice." |
| 2038 | (and (ad-is-advised function) | 1990 | (and (ad-is-advised function) |
| 2039 | (ad-dolist (class ad-advice-classes nil) | 1991 | (cl-dolist (class ad-advice-classes nil) |
| 2040 | (if (ad-get-advice-info-field function class) | 1992 | (if (ad-get-advice-info-field function class) |
| 2041 | (ad-do-return t))))) | 1993 | (cl-return t))))) |
| 2042 | 1994 | ||
| 2043 | (defun ad-get-enabled-advices (function class) | 1995 | (defun ad-get-enabled-advices (function class) |
| 2044 | "Return the list of enabled advices of FUNCTION in CLASS." | 1996 | "Return the list of enabled advices of FUNCTION in CLASS." |
| 2045 | (let (enabled-advices) | 1997 | (let (enabled-advices) |
| 2046 | (ad-dolist (advice (ad-get-advice-info-field function class)) | 1998 | (dolist (advice (ad-get-advice-info-field function class)) |
| 2047 | (if (ad-advice-enabled advice) | 1999 | (if (ad-advice-enabled advice) |
| 2048 | (push advice enabled-advices))) | 2000 | (push advice enabled-advices))) |
| 2049 | (reverse enabled-advices))) | 2001 | (reverse enabled-advices))) |
| @@ -2151,7 +2103,7 @@ function at point for which PREDICATE returns non-nil)." | |||
| 2151 | (ad-do-advised-functions (function) | 2103 | (ad-do-advised-functions (function) |
| 2152 | (if (or (null predicate) | 2104 | (if (or (null predicate) |
| 2153 | (funcall predicate function)) | 2105 | (funcall predicate function)) |
| 2154 | (ad-do-return function))) | 2106 | (cl-return function))) |
| 2155 | (error "ad-read-advised-function: %s" | 2107 | (error "ad-read-advised-function: %s" |
| 2156 | "There are no qualifying advised functions"))) | 2108 | "There are no qualifying advised functions"))) |
| 2157 | (let* ((ad-pReDiCaTe predicate) | 2109 | (let* ((ad-pReDiCaTe predicate) |
| @@ -2184,9 +2136,9 @@ be returned on empty input (defaults to the first non-empty advice | |||
| 2184 | class of FUNCTION)." | 2136 | class of FUNCTION)." |
| 2185 | (setq default | 2137 | (setq default |
| 2186 | (or default | 2138 | (or default |
| 2187 | (ad-dolist (class ad-advice-classes) | 2139 | (cl-dolist (class ad-advice-classes) |
| 2188 | (if (ad-get-advice-info-field function class) | 2140 | (if (ad-get-advice-info-field function class) |
| 2189 | (ad-do-return class))) | 2141 | (cl-return class))) |
| 2190 | (error "ad-read-advice-class: `%s' has no advices" function))) | 2142 | (error "ad-read-advice-class: `%s' has no advices" function))) |
| 2191 | (let ((class (completing-read | 2143 | (let ((class (completing-read |
| 2192 | (format "%s (default %s): " (or prompt "Class") default) | 2144 | (format "%s (default %s): " (or prompt "Class") default) |
| @@ -2255,18 +2207,18 @@ NAME can be a symbol or a regular expression matching part of an advice name. | |||
| 2255 | If CLASS is `any' all valid advice classes will be checked." | 2207 | If CLASS is `any' all valid advice classes will be checked." |
| 2256 | (if (ad-is-advised function) | 2208 | (if (ad-is-advised function) |
| 2257 | (let (found-advice) | 2209 | (let (found-advice) |
| 2258 | (ad-dolist (advice-class ad-advice-classes) | 2210 | (cl-dolist (advice-class ad-advice-classes) |
| 2259 | (if (or (eq class 'any) (eq advice-class class)) | 2211 | (if (or (eq class 'any) (eq advice-class class)) |
| 2260 | (setq found-advice | 2212 | (setq found-advice |
| 2261 | (ad-dolist (advice (ad-get-advice-info-field | 2213 | (cl-dolist (advice (ad-get-advice-info-field |
| 2262 | function advice-class)) | 2214 | function advice-class)) |
| 2263 | (if (or (and (stringp name) | 2215 | (if (or (and (stringp name) |
| 2264 | (string-match | 2216 | (string-match |
| 2265 | name (symbol-name | 2217 | name (symbol-name |
| 2266 | (ad-advice-name advice)))) | 2218 | (ad-advice-name advice)))) |
| 2267 | (eq name (ad-advice-name advice))) | 2219 | (eq name (ad-advice-name advice))) |
| 2268 | (ad-do-return advice))))) | 2220 | (cl-return advice))))) |
| 2269 | (if found-advice (ad-do-return found-advice)))))) | 2221 | (if found-advice (cl-return found-advice)))))) |
| 2270 | 2222 | ||
| 2271 | (defun ad-enable-advice-internal (function class name flag) | 2223 | (defun ad-enable-advice-internal (function class name flag) |
| 2272 | "Set enable FLAG of FUNCTION's advices in CLASS matching NAME. | 2224 | "Set enable FLAG of FUNCTION's advices in CLASS matching NAME. |
| @@ -2277,10 +2229,10 @@ considered. The number of changed advices will be returned (or nil if | |||
| 2277 | FUNCTION was not advised)." | 2229 | FUNCTION was not advised)." |
| 2278 | (if (ad-is-advised function) | 2230 | (if (ad-is-advised function) |
| 2279 | (let ((matched-advices 0)) | 2231 | (let ((matched-advices 0)) |
| 2280 | (ad-dolist (advice-class ad-advice-classes) | 2232 | (dolist (advice-class ad-advice-classes) |
| 2281 | (if (or (eq class 'any) (eq advice-class class)) | 2233 | (if (or (eq class 'any) (eq advice-class class)) |
| 2282 | (ad-dolist (advice (ad-get-advice-info-field | 2234 | (dolist (advice (ad-get-advice-info-field |
| 2283 | function advice-class)) | 2235 | function advice-class)) |
| 2284 | (cond ((or (and (stringp name) | 2236 | (cond ((or (and (stringp name) |
| 2285 | (string-match | 2237 | (string-match |
| 2286 | name (symbol-name (ad-advice-name advice)))) | 2238 | name (symbol-name (ad-advice-name advice)))) |
| @@ -2868,8 +2820,8 @@ in any of these classes." | |||
| 2868 | (if origdoc (setq paragraphs (list origdoc))) | 2820 | (if origdoc (setq paragraphs (list origdoc))) |
| 2869 | (unless (eq style 'plain) | 2821 | (unless (eq style 'plain) |
| 2870 | (push (concat "This " origtype " is advised.") paragraphs)) | 2822 | (push (concat "This " origtype " is advised.") paragraphs)) |
| 2871 | (ad-dolist (class ad-advice-classes) | 2823 | (dolist (class ad-advice-classes) |
| 2872 | (ad-dolist (advice (ad-get-enabled-advices function class)) | 2824 | (dolist (advice (ad-get-enabled-advices function class)) |
| 2873 | (setq advice-docstring | 2825 | (setq advice-docstring |
| 2874 | (ad-make-single-advice-docstring advice class style)) | 2826 | (ad-make-single-advice-docstring advice class style)) |
| 2875 | (if advice-docstring | 2827 | (if advice-docstring |
| @@ -2891,24 +2843,24 @@ in any of these classes." | |||
| 2891 | 2843 | ||
| 2892 | (defun ad-advised-arglist (function) | 2844 | (defun ad-advised-arglist (function) |
| 2893 | "Find first defined arglist in FUNCTION's redefining advices." | 2845 | "Find first defined arglist in FUNCTION's redefining advices." |
| 2894 | (ad-dolist (advice (append (ad-get-enabled-advices function 'before) | 2846 | (cl-dolist (advice (append (ad-get-enabled-advices function 'before) |
| 2895 | (ad-get-enabled-advices function 'around) | 2847 | (ad-get-enabled-advices function 'around) |
| 2896 | (ad-get-enabled-advices function 'after))) | 2848 | (ad-get-enabled-advices function 'after))) |
| 2897 | (let ((arglist (ad-arglist (ad-advice-definition advice)))) | 2849 | (let ((arglist (ad-arglist (ad-advice-definition advice)))) |
| 2898 | (if arglist | 2850 | (if arglist |
| 2899 | ;; We found the first one, use it: | 2851 | ;; We found the first one, use it: |
| 2900 | (ad-do-return arglist))))) | 2852 | (cl-return arglist))))) |
| 2901 | 2853 | ||
| 2902 | (defun ad-advised-interactive-form (function) | 2854 | (defun ad-advised-interactive-form (function) |
| 2903 | "Find first interactive form in FUNCTION's redefining advices." | 2855 | "Find first interactive form in FUNCTION's redefining advices." |
| 2904 | (ad-dolist (advice (append (ad-get-enabled-advices function 'before) | 2856 | (cl-dolist (advice (append (ad-get-enabled-advices function 'before) |
| 2905 | (ad-get-enabled-advices function 'around) | 2857 | (ad-get-enabled-advices function 'around) |
| 2906 | (ad-get-enabled-advices function 'after))) | 2858 | (ad-get-enabled-advices function 'after))) |
| 2907 | (let ((interactive-form | 2859 | (let ((interactive-form |
| 2908 | (ad-interactive-form (ad-advice-definition advice)))) | 2860 | (ad-interactive-form (ad-advice-definition advice)))) |
| 2909 | (if interactive-form | 2861 | (if interactive-form |
| 2910 | ;; We found the first one, use it: | 2862 | ;; We found the first one, use it: |
| 2911 | (ad-do-return interactive-form))))) | 2863 | (cl-return interactive-form))))) |
| 2912 | 2864 | ||
| 2913 | ;; @@@ Putting it all together: | 2865 | ;; @@@ Putting it all together: |
| 2914 | ;; ============================ | 2866 | ;; ============================ |
| @@ -2997,29 +2949,29 @@ and BEFORES, AROUNDS and AFTERS are the lists of advices with which ORIG | |||
| 2997 | should be modified. The assembled function will be returned." | 2949 | should be modified. The assembled function will be returned." |
| 2998 | 2950 | ||
| 2999 | (let (before-forms around-form around-form-protected after-forms definition) | 2951 | (let (before-forms around-form around-form-protected after-forms definition) |
| 3000 | (ad-dolist (advice befores) | 2952 | (dolist (advice befores) |
| 3001 | (cond ((and (ad-advice-protected advice) | 2953 | (cond ((and (ad-advice-protected advice) |
| 3002 | before-forms) | 2954 | before-forms) |
| 3003 | (setq before-forms | 2955 | (setq before-forms |
| 3004 | `((unwind-protect | 2956 | `((unwind-protect |
| 3005 | ,(ad-prognify before-forms) | 2957 | ,(ad-prognify before-forms) |
| 3006 | ,@(ad-body-forms | 2958 | ,@(ad-body-forms |
| 3007 | (ad-advice-definition advice)))))) | 2959 | (ad-advice-definition advice)))))) |
| 3008 | (t (setq before-forms | 2960 | (t (setq before-forms |
| 3009 | (append before-forms | 2961 | (append before-forms |
| 3010 | (ad-body-forms (ad-advice-definition advice))))))) | 2962 | (ad-body-forms (ad-advice-definition advice))))))) |
| 3011 | 2963 | ||
| 3012 | (setq around-form `(setq ad-return-value ,orig)) | 2964 | (setq around-form `(setq ad-return-value ,orig)) |
| 3013 | (ad-dolist (advice (reverse arounds)) | 2965 | (dolist (advice (reverse arounds)) |
| 3014 | ;; If any of the around advices is protected then we | 2966 | ;; If any of the around advices is protected then we |
| 3015 | ;; protect the complete around advice onion: | 2967 | ;; protect the complete around advice onion: |
| 3016 | (if (ad-advice-protected advice) | 2968 | (if (ad-advice-protected advice) |
| 3017 | (setq around-form-protected t)) | 2969 | (setq around-form-protected t)) |
| 3018 | (setq around-form | 2970 | (setq around-form |
| 3019 | (ad-substitute-tree | 2971 | (ad-substitute-tree |
| 3020 | (function (lambda (form) (eq form 'ad-do-it))) | 2972 | (function (lambda (form) (eq form 'ad-do-it))) |
| 3021 | (function (lambda (form) around-form)) | 2973 | (function (lambda (form) around-form)) |
| 3022 | (ad-prognify (ad-body-forms (ad-advice-definition advice)))))) | 2974 | (ad-prognify (ad-body-forms (ad-advice-definition advice)))))) |
| 3023 | 2975 | ||
| 3024 | (setq after-forms | 2976 | (setq after-forms |
| 3025 | (if (and around-form-protected before-forms) | 2977 | (if (and around-form-protected before-forms) |
| @@ -3027,17 +2979,17 @@ should be modified. The assembled function will be returned." | |||
| 3027 | ,(ad-prognify before-forms) | 2979 | ,(ad-prognify before-forms) |
| 3028 | ,around-form)) | 2980 | ,around-form)) |
| 3029 | (append before-forms (list around-form)))) | 2981 | (append before-forms (list around-form)))) |
| 3030 | (ad-dolist (advice afters) | 2982 | (dolist (advice afters) |
| 3031 | (cond ((and (ad-advice-protected advice) | 2983 | (cond ((and (ad-advice-protected advice) |
| 3032 | after-forms) | 2984 | after-forms) |
| 3033 | (setq after-forms | 2985 | (setq after-forms |
| 3034 | `((unwind-protect | 2986 | `((unwind-protect |
| 3035 | ,(ad-prognify after-forms) | 2987 | ,(ad-prognify after-forms) |
| 3036 | ,@(ad-body-forms | 2988 | ,@(ad-body-forms |
| 3037 | (ad-advice-definition advice)))))) | 2989 | (ad-advice-definition advice)))))) |
| 3038 | (t (setq after-forms | 2990 | (t (setq after-forms |
| 3039 | (append after-forms | 2991 | (append after-forms |
| 3040 | (ad-body-forms (ad-advice-definition advice))))))) | 2992 | (ad-body-forms (ad-advice-definition advice))))))) |
| 3041 | 2993 | ||
| 3042 | (setq definition | 2994 | (setq definition |
| 3043 | `(,@(if (memq type '(macro special-form)) '(macro)) | 2995 | `(,@(if (memq type '(macro special-form)) '(macro)) |
| @@ -3171,11 +3123,11 @@ advised definition from scratch." | |||
| 3171 | (nth 2 cache-id))))) | 3123 | (nth 2 cache-id))))) |
| 3172 | 3124 | ||
| 3173 | (defun ad-verify-cache-class-id (cache-class-id advices) | 3125 | (defun ad-verify-cache-class-id (cache-class-id advices) |
| 3174 | (ad-dolist (advice advices (null cache-class-id)) | 3126 | (cl-dolist (advice advices (null cache-class-id)) |
| 3175 | (if (ad-advice-enabled advice) | 3127 | (if (ad-advice-enabled advice) |
| 3176 | (if (eq (car cache-class-id) (ad-advice-name advice)) | 3128 | (if (eq (car cache-class-id) (ad-advice-name advice)) |
| 3177 | (setq cache-class-id (cdr cache-class-id)) | 3129 | (setq cache-class-id (cdr cache-class-id)) |
| 3178 | (ad-do-return nil))))) | 3130 | (cl-return nil))))) |
| 3179 | 3131 | ||
| 3180 | ;; There should be a way to monitor if and why a cache verification failed | 3132 | ;; There should be a way to monitor if and why a cache verification failed |
| 3181 | ;; in order to determine whether a certain preactivation could be used or | 3133 | ;; in order to determine whether a certain preactivation could be used or |
| @@ -3670,7 +3622,16 @@ See Info node `(elisp)Advising Functions' for comprehensive documentation. | |||
| 3670 | usage: (defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...) | 3622 | usage: (defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...) |
| 3671 | [DOCSTRING] [INTERACTIVE-FORM] | 3623 | [DOCSTRING] [INTERACTIVE-FORM] |
| 3672 | BODY...)" | 3624 | BODY...)" |
| 3673 | (declare (doc-string 3)) | 3625 | (declare (doc-string 3) |
| 3626 | (debug (&define name ;; thing being advised. | ||
| 3627 | (name ;; class is [&or "before" "around" "after" | ||
| 3628 | ;; "activation" "deactivation"] | ||
| 3629 | name ;; name of advice | ||
| 3630 | &rest sexp ;; optional position and flags | ||
| 3631 | ) | ||
| 3632 | [&optional stringp] | ||
| 3633 | [&optional ("interactive" interactive)] | ||
| 3634 | def-body))) | ||
| 3674 | (if (not (ad-name-p function)) | 3635 | (if (not (ad-name-p function)) |
| 3675 | (error "defadvice: Invalid function name: %s" function)) | 3636 | (error "defadvice: Invalid function name: %s" function)) |
| 3676 | (let* ((class (car args)) | 3637 | (let* ((class (car args)) |
diff --git a/lisp/emacs-lisp/easymenu.el b/lisp/emacs-lisp/easymenu.el index 7f9f8a33634..939fab78942 100644 --- a/lisp/emacs-lisp/easymenu.el +++ b/lisp/emacs-lisp/easymenu.el | |||
| @@ -148,7 +148,7 @@ unselectable text. A string consisting solely of hyphens is displayed | |||
| 148 | as a solid horizontal line. | 148 | as a solid horizontal line. |
| 149 | 149 | ||
| 150 | A menu item can be a list with the same format as MENU. This is a submenu." | 150 | A menu item can be a list with the same format as MENU. This is a submenu." |
| 151 | (declare (indent defun)) | 151 | (declare (indent defun) (debug (symbolp body))) |
| 152 | `(progn | 152 | `(progn |
| 153 | ,(if symbol `(defvar ,symbol nil ,doc)) | 153 | ,(if symbol `(defvar ,symbol nil ,doc)) |
| 154 | (easy-menu-do-define (quote ,symbol) ,maps ,doc ,menu))) | 154 | (easy-menu-do-define (quote ,symbol) ,maps ,doc ,menu))) |
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 8f0f24ad092..d656dcf9526 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el | |||
| @@ -52,10 +52,7 @@ | |||
| 52 | ;;; Code: | 52 | ;;; Code: |
| 53 | 53 | ||
| 54 | (require 'macroexp) | 54 | (require 'macroexp) |
| 55 | 55 | (eval-when-compile (require 'cl-lib)) | |
| 56 | ;;; Bug reporting | ||
| 57 | |||
| 58 | (defalias 'edebug-submit-bug-report 'report-emacs-bug) | ||
| 59 | 56 | ||
| 60 | ;;; Options | 57 | ;;; Options |
| 61 | 58 | ||
| @@ -362,6 +359,7 @@ Return the result of the last expression in BODY." | |||
| 362 | ;; Select WINDOW if it is provided and still exists. Otherwise, | 359 | ;; Select WINDOW if it is provided and still exists. Otherwise, |
| 363 | ;; if buffer is currently shown in several windows, choose one. | 360 | ;; if buffer is currently shown in several windows, choose one. |
| 364 | ;; Otherwise, find a new window, possibly splitting one. | 361 | ;; Otherwise, find a new window, possibly splitting one. |
| 362 | ;; FIXME: We should probably just be using `pop-to-buffer'. | ||
| 365 | (setq window | 363 | (setq window |
| 366 | (cond | 364 | (cond |
| 367 | ((and (edebug-window-live-p window) | 365 | ((and (edebug-window-live-p window) |
| @@ -370,7 +368,7 @@ Return the result of the last expression in BODY." | |||
| 370 | ((eq (window-buffer (selected-window)) buffer) | 368 | ((eq (window-buffer (selected-window)) buffer) |
| 371 | ;; Selected window already displays BUFFER. | 369 | ;; Selected window already displays BUFFER. |
| 372 | (selected-window)) | 370 | (selected-window)) |
| 373 | ((edebug-get-buffer-window buffer)) | 371 | ((get-buffer-window buffer 0)) |
| 374 | ((one-window-p 'nomini) | 372 | ((one-window-p 'nomini) |
| 375 | ;; When there's one window only, split it. | 373 | ;; When there's one window only, split it. |
| 376 | (split-window)) | 374 | (split-window)) |
| @@ -443,18 +441,14 @@ Return the result of the last expression in BODY." | |||
| 443 | window-info) | 441 | window-info) |
| 444 | (set-window-configuration window-info))) | 442 | (set-window-configuration window-info))) |
| 445 | 443 | ||
| 446 | (defalias 'edebug-get-buffer-window 'get-buffer-window) | ||
| 447 | (defalias 'edebug-sit-for 'sit-for) | ||
| 448 | (defalias 'edebug-input-pending-p 'input-pending-p) | ||
| 449 | |||
| 450 | |||
| 451 | ;;; Redefine read and eval functions | 444 | ;;; Redefine read and eval functions |
| 452 | ;; read is redefined to maybe instrument forms. | 445 | ;; read is redefined to maybe instrument forms. |
| 453 | ;; eval-defun is redefined to check edebug-all-forms and edebug-all-defs. | 446 | ;; eval-defun is redefined to check edebug-all-forms and edebug-all-defs. |
| 454 | 447 | ||
| 455 | ;; Save the original read function | 448 | ;; Save the original read function |
| 456 | (or (fboundp 'edebug-original-read) | 449 | (defalias 'edebug-original-read |
| 457 | (defalias 'edebug-original-read (symbol-function 'read))) | 450 | (symbol-function (if (fboundp 'edebug-original-read) |
| 451 | 'edebug-original-read 'read))) | ||
| 458 | 452 | ||
| 459 | (defun edebug-read (&optional stream) | 453 | (defun edebug-read (&optional stream) |
| 460 | "Read one Lisp expression as text from STREAM, return as Lisp object. | 454 | "Read one Lisp expression as text from STREAM, return as Lisp object. |
| @@ -621,8 +615,8 @@ already is one.)" | |||
| 621 | 615 | ||
| 622 | (defvar-local edebug-form-data nil | 616 | (defvar-local edebug-form-data nil |
| 623 | "A list of entries associating symbols with buffer regions. | 617 | "A list of entries associating symbols with buffer regions. |
| 624 | This is an automatic buffer local variable. Each entry looks like: | 618 | Each entry is an `edebug--form-data' struct with fields: |
| 625 | \(SYMBOL BEGIN-MARKER END-MARKER). The markers | 619 | SYMBOL, BEGIN-MARKER, and END-MARKER. The markers |
| 626 | are at the beginning and end of an entry level form and SYMBOL is | 620 | are at the beginning and end of an entry level form and SYMBOL is |
| 627 | a symbol that holds all edebug related information for the form on its | 621 | a symbol that holds all edebug related information for the form on its |
| 628 | property list. | 622 | property list. |
| @@ -631,24 +625,17 @@ In the future (haha!), the symbol will be irrelevant and edebug data will | |||
| 631 | be stored in the definitions themselves rather than in the property | 625 | be stored in the definitions themselves rather than in the property |
| 632 | list of a symbol.") | 626 | list of a symbol.") |
| 633 | 627 | ||
| 634 | ;; FIXME: Use cl-defstruct. | 628 | (cl-defstruct (edebug--form-data |
| 635 | 629 | ;; Some callers expect accessors to return nil when passed nil. | |
| 636 | (defun edebug-make-form-data-entry (symbol begin end) | 630 | (:type list) |
| 637 | (list symbol begin end)) | 631 | (:constructor edebug--make-form-data-entry (name begin end)) |
| 638 | 632 | (:predicate nil) (:constructor nil) (:copier nil)) | |
| 639 | (defsubst edebug-form-data-name (entry) | 633 | name begin end) |
| 640 | (car entry)) | ||
| 641 | |||
| 642 | (defsubst edebug-form-data-begin (entry) | ||
| 643 | (nth 1 entry)) | ||
| 644 | |||
| 645 | (defsubst edebug-form-data-end (entry) | ||
| 646 | (nth 2 entry)) | ||
| 647 | 634 | ||
| 648 | (defsubst edebug-set-form-data-entry (entry name begin end) | 635 | (defsubst edebug-set-form-data-entry (entry name begin end) |
| 649 | (setcar entry name) ;; In case name is changed. | 636 | (setf (edebug--form-data-name entry) name) ;; In case name is changed. |
| 650 | (set-marker (nth 1 entry) begin) | 637 | (set-marker (edebug--form-data-begin entry) begin) |
| 651 | (set-marker (nth 2 entry) end)) | 638 | (set-marker (edebug--form-data-end entry) end)) |
| 652 | 639 | ||
| 653 | (defun edebug-get-form-data-entry (pnt &optional end-point) | 640 | (defun edebug-get-form-data-entry (pnt &optional end-point) |
| 654 | ;; Find the edebug form data entry which is closest to PNT. | 641 | ;; Find the edebug form data entry which is closest to PNT. |
| @@ -656,17 +643,17 @@ list of a symbol.") | |||
| 656 | ;; Return `nil' if none found. | 643 | ;; Return `nil' if none found. |
| 657 | (let ((rest edebug-form-data) | 644 | (let ((rest edebug-form-data) |
| 658 | closest-entry | 645 | closest-entry |
| 659 | (closest-dist 999999)) ;; need maxint here | 646 | (closest-dist 999999)) ;; Need maxint here. |
| 660 | (while (and rest (< 0 closest-dist)) | 647 | (while (and rest (< 0 closest-dist)) |
| 661 | (let* ((entry (car rest)) | 648 | (let* ((entry (car rest)) |
| 662 | (begin (edebug-form-data-begin entry)) | 649 | (begin (edebug--form-data-begin entry)) |
| 663 | (dist (- pnt begin))) | 650 | (dist (- pnt begin))) |
| 664 | (setq rest (cdr rest)) | 651 | (setq rest (cdr rest)) |
| 665 | (if (and (<= 0 dist) | 652 | (if (and (<= 0 dist) |
| 666 | (< dist closest-dist) | 653 | (< dist closest-dist) |
| 667 | (or (not end-point) | 654 | (or (not end-point) |
| 668 | (= end-point (edebug-form-data-end entry))) | 655 | (= end-point (edebug--form-data-end entry))) |
| 669 | (<= pnt (edebug-form-data-end entry))) | 656 | (<= pnt (edebug--form-data-end entry))) |
| 670 | (setq closest-dist dist | 657 | (setq closest-dist dist |
| 671 | closest-entry entry)))) | 658 | closest-entry entry)))) |
| 672 | closest-entry)) | 659 | closest-entry)) |
| @@ -675,19 +662,19 @@ list of a symbol.") | |||
| 675 | ;; and find an entry given a symbol, which should be just assq. | 662 | ;; and find an entry given a symbol, which should be just assq. |
| 676 | 663 | ||
| 677 | (defun edebug-form-data-symbol () | 664 | (defun edebug-form-data-symbol () |
| 678 | ;; Return the edebug data symbol of the form where point is in. | 665 | "Return the edebug data symbol of the form where point is in. |
| 679 | ;; If point is not inside a edebuggable form, cause error. | 666 | If point is not inside a edebuggable form, cause error." |
| 680 | (or (edebug-form-data-name (edebug-get-form-data-entry (point))) | 667 | (or (edebug--form-data-name (edebug-get-form-data-entry (point))) |
| 681 | (error "Not inside instrumented form"))) | 668 | (error "Not inside instrumented form"))) |
| 682 | 669 | ||
| 683 | (defun edebug-make-top-form-data-entry (new-entry) | 670 | (defun edebug-make-top-form-data-entry (new-entry) |
| 684 | ;; Make NEW-ENTRY the first element in the `edebug-form-data' list. | 671 | ;; Make NEW-ENTRY the first element in the `edebug-form-data' list. |
| 685 | (edebug-clear-form-data-entry new-entry) | 672 | (edebug-clear-form-data-entry new-entry) |
| 686 | (setq edebug-form-data (cons new-entry edebug-form-data))) | 673 | (push new-entry edebug-form-data)) |
| 687 | 674 | ||
| 688 | (defun edebug-clear-form-data-entry (entry) | 675 | (defun edebug-clear-form-data-entry (entry) |
| 689 | ;; If non-nil, clear ENTRY out of the form data. | 676 | "If non-nil, clear ENTRY out of the form data. |
| 690 | ;; Maybe clear the markers and delete the symbol's edebug property? | 677 | Maybe clear the markers and delete the symbol's edebug property?" |
| 691 | (if entry | 678 | (if entry |
| 692 | (progn | 679 | (progn |
| 693 | ;; Instead of this, we could just find all contained forms. | 680 | ;; Instead of this, we could just find all contained forms. |
| @@ -1285,7 +1272,7 @@ expressions; a `progn' form will be returned enclosing these forms." | |||
| 1285 | ;; Set this marker before parsing. | 1272 | ;; Set this marker before parsing. |
| 1286 | (edebug-form-begin-marker | 1273 | (edebug-form-begin-marker |
| 1287 | (if form-data-entry | 1274 | (if form-data-entry |
| 1288 | (edebug-form-data-begin form-data-entry) | 1275 | (edebug--form-data-begin form-data-entry) |
| 1289 | ;; Buffer must be current-buffer for this to work: | 1276 | ;; Buffer must be current-buffer for this to work: |
| 1290 | (set-marker (make-marker) form-begin)))) | 1277 | (set-marker (make-marker) form-begin)))) |
| 1291 | 1278 | ||
| @@ -1295,7 +1282,7 @@ expressions; a `progn' form will be returned enclosing these forms." | |||
| 1295 | ;; For definitions. | 1282 | ;; For definitions. |
| 1296 | ;; (edebug-containing-def-name edebug-def-name) | 1283 | ;; (edebug-containing-def-name edebug-def-name) |
| 1297 | ;; Get name from form-data, if any. | 1284 | ;; Get name from form-data, if any. |
| 1298 | (edebug-old-def-name (edebug-form-data-name form-data-entry)) | 1285 | (edebug-old-def-name (edebug--form-data-name form-data-entry)) |
| 1299 | edebug-def-name | 1286 | edebug-def-name |
| 1300 | edebug-def-args | 1287 | edebug-def-args |
| 1301 | edebug-def-interactive | 1288 | edebug-def-interactive |
| @@ -1325,7 +1312,7 @@ expressions; a `progn' form will be returned enclosing these forms." | |||
| 1325 | ;; In the latter case, pointers to the entry remain eq. | 1312 | ;; In the latter case, pointers to the entry remain eq. |
| 1326 | (if (not form-data-entry) | 1313 | (if (not form-data-entry) |
| 1327 | (setq form-data-entry | 1314 | (setq form-data-entry |
| 1328 | (edebug-make-form-data-entry | 1315 | (edebug--make-form-data-entry |
| 1329 | edebug-def-name | 1316 | edebug-def-name |
| 1330 | edebug-form-begin-marker | 1317 | edebug-form-begin-marker |
| 1331 | ;; Buffer must be current-buffer. | 1318 | ;; Buffer must be current-buffer. |
| @@ -1522,7 +1509,7 @@ expressions; a `progn' form will be returned enclosing these forms." | |||
| 1522 | (if edebug-error-point | 1509 | (if edebug-error-point |
| 1523 | (goto-char edebug-error-point)) | 1510 | (goto-char edebug-error-point)) |
| 1524 | (apply 'edebug-syntax-error args)) | 1511 | (apply 'edebug-syntax-error args)) |
| 1525 | (funcall 'throw 'no-match args))) | 1512 | (throw 'no-match args))) |
| 1526 | 1513 | ||
| 1527 | 1514 | ||
| 1528 | (defun edebug-match (cursor specs) | 1515 | (defun edebug-match (cursor specs) |
| @@ -2012,11 +1999,6 @@ expressions; a `progn' form will be returned enclosing these forms." | |||
| 2012 | ;; (def-edebug-spec anonymous-form ((&or ["lambda" lambda] ["macro" macro]))) | 1999 | ;; (def-edebug-spec anonymous-form ((&or ["lambda" lambda] ["macro" macro]))) |
| 2013 | 2000 | ||
| 2014 | ;; Standard functions that take function-forms arguments. | 2001 | ;; Standard functions that take function-forms arguments. |
| 2015 | (def-edebug-spec mapcar (function-form form)) | ||
| 2016 | (def-edebug-spec mapconcat (function-form form form)) | ||
| 2017 | (def-edebug-spec mapatoms (function-form &optional form)) | ||
| 2018 | (def-edebug-spec apply (function-form &rest form)) | ||
| 2019 | (def-edebug-spec funcall (function-form &rest form)) | ||
| 2020 | 2002 | ||
| 2021 | ;; FIXME? The manual uses this form (maybe that's just for illustration?): | 2003 | ;; FIXME? The manual uses this form (maybe that's just for illustration?): |
| 2022 | ;; (def-edebug-spec let | 2004 | ;; (def-edebug-spec let |
| @@ -2082,49 +2064,12 @@ expressions; a `progn' form will be returned enclosing these forms." | |||
| 2082 | &or ("quote" edebug-\`) def-form)) | 2064 | &or ("quote" edebug-\`) def-form)) |
| 2083 | 2065 | ||
| 2084 | ;; New byte compiler. | 2066 | ;; New byte compiler. |
| 2085 | (def-edebug-spec defsubst defun) | ||
| 2086 | (def-edebug-spec dont-compile t) | ||
| 2087 | (def-edebug-spec eval-when-compile t) | ||
| 2088 | (def-edebug-spec eval-and-compile t) | ||
| 2089 | 2067 | ||
| 2090 | (def-edebug-spec save-selected-window t) | 2068 | (def-edebug-spec save-selected-window t) |
| 2091 | (def-edebug-spec save-current-buffer t) | 2069 | (def-edebug-spec save-current-buffer t) |
| 2092 | (def-edebug-spec delay-mode-hooks t) | ||
| 2093 | (def-edebug-spec with-temp-file t) | ||
| 2094 | (def-edebug-spec with-temp-message t) | ||
| 2095 | (def-edebug-spec with-syntax-table t) | ||
| 2096 | (def-edebug-spec push (form sexp)) | ||
| 2097 | (def-edebug-spec pop (sexp)) | ||
| 2098 | |||
| 2099 | (def-edebug-spec 1value (form)) | ||
| 2100 | (def-edebug-spec noreturn (form)) | ||
| 2101 | |||
| 2102 | 2070 | ||
| 2103 | ;; Anything else? | 2071 | ;; Anything else? |
| 2104 | 2072 | ||
| 2105 | |||
| 2106 | ;; Some miscellaneous specs for macros in public packages. | ||
| 2107 | ;; Send me yours. | ||
| 2108 | |||
| 2109 | ;; advice.el by Hans Chalupsky (hans@cs.buffalo.edu) | ||
| 2110 | |||
| 2111 | (def-edebug-spec ad-dolist ((symbolp form &optional form) body)) | ||
| 2112 | (def-edebug-spec defadvice | ||
| 2113 | (&define name ;; thing being advised. | ||
| 2114 | (name ;; class is [&or "before" "around" "after" | ||
| 2115 | ;; "activation" "deactivation"] | ||
| 2116 | name ;; name of advice | ||
| 2117 | &rest sexp ;; optional position and flags | ||
| 2118 | ) | ||
| 2119 | [&optional stringp] | ||
| 2120 | [&optional ("interactive" interactive)] | ||
| 2121 | def-body)) | ||
| 2122 | |||
| 2123 | (def-edebug-spec easy-menu-define (symbolp body)) | ||
| 2124 | |||
| 2125 | (def-edebug-spec with-custom-print body) | ||
| 2126 | |||
| 2127 | |||
| 2128 | ;;; The debugger itself | 2073 | ;;; The debugger itself |
| 2129 | 2074 | ||
| 2130 | (defvar edebug-active nil) ;; Non-nil when edebug is active | 2075 | (defvar edebug-active nil) ;; Non-nil when edebug is active |
| @@ -2177,8 +2122,6 @@ expressions; a `progn' form will be returned enclosing these forms." | |||
| 2177 | (defvar edebug-outside-debug-on-error) ; the value of debug-on-error outside | 2122 | (defvar edebug-outside-debug-on-error) ; the value of debug-on-error outside |
| 2178 | (defvar edebug-outside-debug-on-quit) ; the value of debug-on-quit outside | 2123 | (defvar edebug-outside-debug-on-quit) ; the value of debug-on-quit outside |
| 2179 | 2124 | ||
| 2180 | (defvar edebug-outside-overriding-local-map) | ||
| 2181 | (defvar edebug-outside-overriding-terminal-local-map) | ||
| 2182 | 2125 | ||
| 2183 | (defvar edebug-outside-pre-command-hook) | 2126 | (defvar edebug-outside-pre-command-hook) |
| 2184 | (defvar edebug-outside-post-command-hook) | 2127 | (defvar edebug-outside-post-command-hook) |
| @@ -2339,7 +2282,7 @@ MSG is printed after `::::} '." | |||
| 2339 | (1+ (aref edebug-freq-count before-index))) | 2282 | (1+ (aref edebug-freq-count before-index))) |
| 2340 | 2283 | ||
| 2341 | (if (or (not (memq edebug-execution-mode '(Go-nonstop next))) | 2284 | (if (or (not (memq edebug-execution-mode '(Go-nonstop next))) |
| 2342 | (edebug-input-pending-p)) | 2285 | (input-pending-p)) |
| 2343 | (edebug-debugger before-index 'before nil))) | 2286 | (edebug-debugger before-index 'before nil))) |
| 2344 | before-index) | 2287 | before-index) |
| 2345 | 2288 | ||
| @@ -2361,7 +2304,7 @@ MSG is printed after `::::} '." | |||
| 2361 | (if edebug-test-coverage (edebug--update-coverage after-index value)) | 2304 | (if edebug-test-coverage (edebug--update-coverage after-index value)) |
| 2362 | 2305 | ||
| 2363 | (if (and (eq edebug-execution-mode 'Go-nonstop) | 2306 | (if (and (eq edebug-execution-mode 'Go-nonstop) |
| 2364 | (not (edebug-input-pending-p))) | 2307 | (not (input-pending-p))) |
| 2365 | ;; Just return result. | 2308 | ;; Just return result. |
| 2366 | value | 2309 | value |
| 2367 | (edebug-debugger after-index 'after value) | 2310 | (edebug-debugger after-index 'after value) |
| @@ -2445,7 +2388,7 @@ MSG is printed after `::::} '." | |||
| 2445 | ;; or break, or input is pending, | 2388 | ;; or break, or input is pending, |
| 2446 | (if (or (not (memq edebug-execution-mode '(go continue Continue-fast))) | 2389 | (if (or (not (memq edebug-execution-mode '(go continue Continue-fast))) |
| 2447 | edebug-break | 2390 | edebug-break |
| 2448 | (edebug-input-pending-p)) | 2391 | (input-pending-p)) |
| 2449 | (edebug--display value offset-index arg-mode)) ; <---------- display | 2392 | (edebug--display value offset-index arg-mode)) ; <---------- display |
| 2450 | 2393 | ||
| 2451 | value))) | 2394 | value))) |
| @@ -2522,7 +2465,7 @@ MSG is printed after `::::} '." | |||
| 2522 | (let ((overlay-arrow-position overlay-arrow-position) | 2465 | (let ((overlay-arrow-position overlay-arrow-position) |
| 2523 | (overlay-arrow-string overlay-arrow-string) | 2466 | (overlay-arrow-string overlay-arrow-string) |
| 2524 | (cursor-in-echo-area nil) | 2467 | (cursor-in-echo-area nil) |
| 2525 | (unread-command-events unread-command-events) | 2468 | (unread-command-events nil) |
| 2526 | ;; any others?? | 2469 | ;; any others?? |
| 2527 | ) | 2470 | ) |
| 2528 | (setq-default cursor-in-non-selected-windows t) | 2471 | (setq-default cursor-in-non-selected-windows t) |
| @@ -2577,7 +2520,7 @@ MSG is printed after `::::} '." | |||
| 2577 | (edebug-adjust-window (cdr edebug-window-data))) | 2520 | (edebug-adjust-window (cdr edebug-window-data))) |
| 2578 | 2521 | ||
| 2579 | ;; Test if there is input, not including keyboard macros. | 2522 | ;; Test if there is input, not including keyboard macros. |
| 2580 | (if (edebug-input-pending-p) | 2523 | (if (input-pending-p) |
| 2581 | (progn | 2524 | (progn |
| 2582 | (setq edebug-execution-mode 'step | 2525 | (setq edebug-execution-mode 'step |
| 2583 | edebug-stop t) | 2526 | edebug-stop t) |
| @@ -2612,27 +2555,26 @@ MSG is printed after `::::} '." | |||
| 2612 | 2555 | ||
| 2613 | (t (message ""))) | 2556 | (t (message ""))) |
| 2614 | 2557 | ||
| 2615 | (setq unread-command-events nil) | ||
| 2616 | (if (eq 'after arg-mode) | 2558 | (if (eq 'after arg-mode) |
| 2617 | (progn | 2559 | (progn |
| 2618 | ;; Display result of previous evaluation. | 2560 | ;; Display result of previous evaluation. |
| 2619 | (if (and edebug-break | 2561 | (if (and edebug-break |
| 2620 | (not (eq edebug-execution-mode 'Continue-fast))) | 2562 | (not (eq edebug-execution-mode 'Continue-fast))) |
| 2621 | (edebug-sit-for edebug-sit-for-seconds)) ; Show message. | 2563 | (sit-for edebug-sit-for-seconds)) ; Show message. |
| 2622 | (edebug-previous-result))) | 2564 | (edebug-previous-result))) |
| 2623 | 2565 | ||
| 2624 | (cond | 2566 | (cond |
| 2625 | (edebug-break | 2567 | (edebug-break |
| 2626 | (cond | 2568 | (cond |
| 2627 | ((eq edebug-execution-mode 'continue) | 2569 | ((eq edebug-execution-mode 'continue) |
| 2628 | (edebug-sit-for edebug-sit-for-seconds)) | 2570 | (sit-for edebug-sit-for-seconds)) |
| 2629 | ((eq edebug-execution-mode 'Continue-fast) (edebug-sit-for 0)) | 2571 | ((eq edebug-execution-mode 'Continue-fast) (sit-for 0)) |
| 2630 | (t (setq edebug-stop t)))) | 2572 | (t (setq edebug-stop t)))) |
| 2631 | ;; not edebug-break | 2573 | ;; not edebug-break |
| 2632 | ((eq edebug-execution-mode 'trace) | 2574 | ((eq edebug-execution-mode 'trace) |
| 2633 | (edebug-sit-for edebug-sit-for-seconds)) ; Force update and pause. | 2575 | (sit-for edebug-sit-for-seconds)) ; Force update and pause. |
| 2634 | ((eq edebug-execution-mode 'Trace-fast) | 2576 | ((eq edebug-execution-mode 'Trace-fast) |
| 2635 | (edebug-sit-for 0))) ; Force update and continue. | 2577 | (sit-for 0))) ; Force update and continue. |
| 2636 | 2578 | ||
| 2637 | (unwind-protect | 2579 | (unwind-protect |
| 2638 | (if (or edebug-stop | 2580 | (if (or edebug-stop |
| @@ -2646,7 +2588,7 @@ MSG is printed after `::::} '." | |||
| 2646 | ;; Reset the edebug-window-data to whatever it is now. | 2588 | ;; Reset the edebug-window-data to whatever it is now. |
| 2647 | (let ((window (if (eq (window-buffer) edebug-buffer) | 2589 | (let ((window (if (eq (window-buffer) edebug-buffer) |
| 2648 | (selected-window) | 2590 | (selected-window) |
| 2649 | (edebug-get-buffer-window edebug-buffer)))) | 2591 | (get-buffer-window edebug-buffer)))) |
| 2650 | ;; Remember window-start for edebug-buffer, if still displayed. | 2592 | ;; Remember window-start for edebug-buffer, if still displayed. |
| 2651 | (if window | 2593 | (if window |
| 2652 | (progn | 2594 | (progn |
| @@ -2724,6 +2666,8 @@ MSG is printed after `::::} '." | |||
| 2724 | (goto-char edebug-buffer-outside-point)) | 2666 | (goto-char edebug-buffer-outside-point)) |
| 2725 | ;; ... nothing more. | 2667 | ;; ... nothing more. |
| 2726 | ) | 2668 | ) |
| 2669 | ;; Could be an option to keep eval display up. | ||
| 2670 | (if edebug-eval-buffer (kill-buffer edebug-eval-buffer)) | ||
| 2727 | (with-timeout-unsuspend edebug-with-timeout-suspend) | 2671 | (with-timeout-unsuspend edebug-with-timeout-suspend) |
| 2728 | ;; Reset global variables to outside values in case they were changed. | 2672 | ;; Reset global variables to outside values in case they were changed. |
| 2729 | (setq | 2673 | (setq |
| @@ -2790,10 +2734,6 @@ MSG is printed after `::::} '." | |||
| 2790 | 2734 | ||
| 2791 | (edebug-outside-map (current-local-map)) | 2735 | (edebug-outside-map (current-local-map)) |
| 2792 | 2736 | ||
| 2793 | (edebug-outside-overriding-local-map overriding-local-map) | ||
| 2794 | (edebug-outside-overriding-terminal-local-map | ||
| 2795 | overriding-terminal-local-map) | ||
| 2796 | |||
| 2797 | ;; Save the outside value of executing macro. (here??) | 2737 | ;; Save the outside value of executing macro. (here??) |
| 2798 | (edebug-outside-executing-macro executing-kbd-macro) | 2738 | (edebug-outside-executing-macro executing-kbd-macro) |
| 2799 | (edebug-outside-pre-command-hook | 2739 | (edebug-outside-pre-command-hook |
| @@ -2832,6 +2772,9 @@ MSG is printed after `::::} '." | |||
| 2832 | (last-nonmenu-event nil) | 2772 | (last-nonmenu-event nil) |
| 2833 | (track-mouse nil) | 2773 | (track-mouse nil) |
| 2834 | 2774 | ||
| 2775 | (standard-output t) | ||
| 2776 | (standard-input t) | ||
| 2777 | |||
| 2835 | ;; Don't keep reading from an executing kbd macro | 2778 | ;; Don't keep reading from an executing kbd macro |
| 2836 | ;; within edebug unless edebug-continue-kbd-macro is | 2779 | ;; within edebug unless edebug-continue-kbd-macro is |
| 2837 | ;; non-nil. Again, local binding may not be best. | 2780 | ;; non-nil. Again, local binding may not be best. |
| @@ -2874,8 +2817,6 @@ MSG is printed after `::::} '." | |||
| 2874 | (setq signal-hook-function 'edebug-signal) | 2817 | (setq signal-hook-function 'edebug-signal) |
| 2875 | (if edebug-backtrace-buffer | 2818 | (if edebug-backtrace-buffer |
| 2876 | (kill-buffer edebug-backtrace-buffer)) | 2819 | (kill-buffer edebug-backtrace-buffer)) |
| 2877 | ;; Could be an option to keep eval display up. | ||
| 2878 | (if edebug-eval-buffer (kill-buffer edebug-eval-buffer)) | ||
| 2879 | 2820 | ||
| 2880 | ;; Remember selected-window after recursive-edit. | 2821 | ;; Remember selected-window after recursive-edit. |
| 2881 | ;; (setq edebug-inside-window (selected-window)) | 2822 | ;; (setq edebug-inside-window (selected-window)) |
| @@ -2923,8 +2864,8 @@ MSG is printed after `::::} '." | |||
| 2923 | 2864 | ||
| 2924 | (defun edebug-adjust-window (old-start) | 2865 | (defun edebug-adjust-window (old-start) |
| 2925 | ;; If pos is not visible, adjust current window to fit following context. | 2866 | ;; If pos is not visible, adjust current window to fit following context. |
| 2926 | ;;; (message "window: %s old-start: %s window-start: %s pos: %s" | 2867 | ;; (message "window: %s old-start: %s window-start: %s pos: %s" |
| 2927 | ;;; (selected-window) old-start (window-start) (point)) (sit-for 5) | 2868 | ;; (selected-window) old-start (window-start) (point)) (sit-for 5) |
| 2928 | (if (not (pos-visible-in-window-p)) | 2869 | (if (not (pos-visible-in-window-p)) |
| 2929 | (progn | 2870 | (progn |
| 2930 | ;; First try old-start | 2871 | ;; First try old-start |
| @@ -2932,7 +2873,7 @@ MSG is printed after `::::} '." | |||
| 2932 | (set-window-start (selected-window) old-start)) | 2873 | (set-window-start (selected-window) old-start)) |
| 2933 | (if (not (pos-visible-in-window-p)) | 2874 | (if (not (pos-visible-in-window-p)) |
| 2934 | (progn | 2875 | (progn |
| 2935 | ;; (message "resetting window start") (sit-for 2) | 2876 | ;; (message "resetting window start") (sit-for 2) |
| 2936 | (set-window-start | 2877 | (set-window-start |
| 2937 | (selected-window) | 2878 | (selected-window) |
| 2938 | (save-excursion | 2879 | (save-excursion |
| @@ -3071,7 +3012,7 @@ before returning. The default is one second." | |||
| 3071 | (current-buffer) (point) | 3012 | (current-buffer) (point) |
| 3072 | (if (marker-buffer (edebug-mark-marker)) | 3013 | (if (marker-buffer (edebug-mark-marker)) |
| 3073 | (marker-position (edebug-mark-marker)) "<not set>")) | 3014 | (marker-position (edebug-mark-marker)) "<not set>")) |
| 3074 | (edebug-sit-for arg) | 3015 | (sit-for arg) |
| 3075 | (edebug-pop-to-buffer edebug-buffer (car edebug-window-data))))) | 3016 | (edebug-pop-to-buffer edebug-buffer (car edebug-window-data))))) |
| 3076 | 3017 | ||
| 3077 | 3018 | ||
| @@ -3398,7 +3339,7 @@ function or macro is called, Edebug will be called there as well." | |||
| 3398 | (save-excursion | 3339 | (save-excursion |
| 3399 | (down-list 1) | 3340 | (down-list 1) |
| 3400 | (if (looking-at "\(") | 3341 | (if (looking-at "\(") |
| 3401 | (edebug-form-data-name | 3342 | (edebug--form-data-name |
| 3402 | (edebug-get-form-data-entry (point))) | 3343 | (edebug-get-form-data-entry (point))) |
| 3403 | (edebug-original-read (current-buffer)))))) | 3344 | (edebug-original-read (current-buffer)))))) |
| 3404 | (edebug-instrument-function func)))) | 3345 | (edebug-instrument-function func)))) |
| @@ -3604,7 +3545,8 @@ Return the result of the last expression." | |||
| 3604 | 3545 | ||
| 3605 | (defun edebug-eval (expr) | 3546 | (defun edebug-eval (expr) |
| 3606 | ;; Are there cl lexical variables active? | 3547 | ;; Are there cl lexical variables active? |
| 3607 | (eval (if (bound-and-true-p cl-debug-env) | 3548 | (eval (if (and (bound-and-true-p cl-debug-env) |
| 3549 | (fboundp 'cl-macroexpand-all)) | ||
| 3608 | (cl-macroexpand-all expr cl-debug-env) | 3550 | (cl-macroexpand-all expr cl-debug-env) |
| 3609 | expr) | 3551 | expr) |
| 3610 | lexical-binding)) | 3552 | lexical-binding)) |
| @@ -4088,15 +4030,15 @@ Otherwise call `debug' normally." | |||
| 4088 | "In buffer BUF-NAME, display FMT and ARGS at the end and make it visible. | 4030 | "In buffer BUF-NAME, display FMT and ARGS at the end and make it visible. |
| 4089 | The buffer is created if it does not exist. | 4031 | The buffer is created if it does not exist. |
| 4090 | You must include newlines in FMT to break lines, but one newline is appended." | 4032 | You must include newlines in FMT to break lines, but one newline is appended." |
| 4091 | ;; e.g. | 4033 | ;; e.g. |
| 4092 | ;; (edebug-trace-display "*trace-point*" | 4034 | ;; (edebug-trace-display "*trace-point*" |
| 4093 | ;; "saving: point = %s window-start = %s" | 4035 | ;; "saving: point = %s window-start = %s" |
| 4094 | ;; (point) (window-start)) | 4036 | ;; (point) (window-start)) |
| 4095 | (let* ((oldbuf (current-buffer)) | 4037 | (let* ((oldbuf (current-buffer)) |
| 4096 | (selected-window (selected-window)) | 4038 | (selected-window (selected-window)) |
| 4097 | (buffer (get-buffer-create buf-name)) | 4039 | (buffer (get-buffer-create buf-name)) |
| 4098 | buf-window) | 4040 | buf-window) |
| 4099 | ;; (message "before pop-to-buffer") (sit-for 1) | 4041 | ;; (message "before pop-to-buffer") (sit-for 1) |
| 4100 | (edebug-pop-to-buffer buffer) | 4042 | (edebug-pop-to-buffer buffer) |
| 4101 | (setq truncate-lines t) | 4043 | (setq truncate-lines t) |
| 4102 | (setq buf-window (selected-window)) | 4044 | (setq buf-window (selected-window)) |
| @@ -4106,8 +4048,8 @@ You must include newlines in FMT to break lines, but one newline is appended." | |||
| 4106 | (vertical-motion (- 1 (window-height))) | 4048 | (vertical-motion (- 1 (window-height))) |
| 4107 | (set-window-start buf-window (point)) | 4049 | (set-window-start buf-window (point)) |
| 4108 | (goto-char (point-max)) | 4050 | (goto-char (point-max)) |
| 4109 | ;; (set-window-point buf-window (point)) | 4051 | ;; (set-window-point buf-window (point)) |
| 4110 | ;; (edebug-sit-for 0) | 4052 | ;; (sit-for 0) |
| 4111 | (bury-buffer buffer) | 4053 | (bury-buffer buffer) |
| 4112 | (select-window selected-window) | 4054 | (select-window selected-window) |
| 4113 | (set-buffer oldbuf)) | 4055 | (set-buffer oldbuf)) |
| @@ -4170,8 +4112,8 @@ reinstrument it." | |||
| 4170 | ;; Insert all the indices for this line. | 4112 | ;; Insert all the indices for this line. |
| 4171 | (forward-line 1) | 4113 | (forward-line 1) |
| 4172 | (setq start-of-count-line (point) | 4114 | (setq start-of-count-line (point) |
| 4173 | first-index i ; really last index for line above this one. | 4115 | first-index i ; Really, last index for line above this one. |
| 4174 | last-count -1) ; cause first count to always appear. | 4116 | last-count -1) ; Cause first count to always appear. |
| 4175 | (insert ";#") | 4117 | (insert ";#") |
| 4176 | ;; i == first-index still | 4118 | ;; i == first-index still |
| 4177 | (while (<= (setq i (1+ i)) last-index) | 4119 | (while (<= (setq i (1+ i)) last-index) |
| @@ -4203,7 +4145,8 @@ It is removed when you hit any char." | |||
| 4203 | (let ((buffer-read-only nil)) | 4145 | (let ((buffer-read-only nil)) |
| 4204 | (undo-boundary) | 4146 | (undo-boundary) |
| 4205 | (edebug-display-freq-count) | 4147 | (edebug-display-freq-count) |
| 4206 | (setq unread-command-events (append unread-command-events (read-event))) | 4148 | (setq unread-command-events |
| 4149 | (append unread-command-events (list (read-event)))) | ||
| 4207 | ;; Yuck! This doesn't seem to work at all for me. | 4150 | ;; Yuck! This doesn't seem to work at all for me. |
| 4208 | (undo))) | 4151 | (undo))) |
| 4209 | 4152 | ||
| @@ -4315,80 +4258,6 @@ With prefix argument, make it a temporary breakpoint." | |||
| 4315 | 4258 | ||
| 4316 | (easy-menu-define edebug-menu edebug-mode-map "Edebug menus" edebug-mode-menus) | 4259 | (easy-menu-define edebug-menu edebug-mode-map "Edebug menus" edebug-mode-menus) |
| 4317 | 4260 | ||
| 4318 | ;;; Byte-compiler | ||
| 4319 | |||
| 4320 | ;; Extension for bytecomp to resolve undefined function references. | ||
| 4321 | ;; Requires new byte compiler. | ||
| 4322 | |||
| 4323 | (eval-when-compile | ||
| 4324 | ;; The body of eval-when-compile seems to get evaluated with eval-defun. | ||
| 4325 | ;; We only want to evaluate when actually byte compiling. | ||
| 4326 | ;; But it is OK to evaluate as long as byte-compiler has been loaded. | ||
| 4327 | (if (featurep 'byte-compile) (progn | ||
| 4328 | |||
| 4329 | (defun byte-compile-resolve-functions (funcs) | ||
| 4330 | "Say it is OK for the named functions to be unresolved." | ||
| 4331 | (mapc | ||
| 4332 | (function | ||
| 4333 | (lambda (func) | ||
| 4334 | (setq byte-compile-unresolved-functions | ||
| 4335 | (delq (assq func byte-compile-unresolved-functions) | ||
| 4336 | byte-compile-unresolved-functions)))) | ||
| 4337 | funcs) | ||
| 4338 | nil) | ||
| 4339 | |||
| 4340 | '(defun byte-compile-resolve-free-references (vars) | ||
| 4341 | "Say it is OK for the named variables to be referenced." | ||
| 4342 | (mapcar | ||
| 4343 | (function | ||
| 4344 | (lambda (var) | ||
| 4345 | (setq byte-compile-free-references | ||
| 4346 | (delq var byte-compile-free-references)))) | ||
| 4347 | vars) | ||
| 4348 | nil) | ||
| 4349 | |||
| 4350 | '(defun byte-compile-resolve-free-assignments (vars) | ||
| 4351 | "Say it is OK for the named variables to be assigned." | ||
| 4352 | (mapcar | ||
| 4353 | (function | ||
| 4354 | (lambda (var) | ||
| 4355 | (setq byte-compile-free-assignments | ||
| 4356 | (delq var byte-compile-free-assignments)))) | ||
| 4357 | vars) | ||
| 4358 | nil) | ||
| 4359 | |||
| 4360 | (byte-compile-resolve-functions | ||
| 4361 | '(reporter-submit-bug-report | ||
| 4362 | edebug-gensym ;; also in cl.el | ||
| 4363 | ;; Interfaces to standard functions. | ||
| 4364 | edebug-original-eval-defun | ||
| 4365 | edebug-original-read | ||
| 4366 | edebug-get-buffer-window | ||
| 4367 | edebug-mark | ||
| 4368 | edebug-mark-marker | ||
| 4369 | edebug-input-pending-p | ||
| 4370 | edebug-sit-for | ||
| 4371 | edebug-prin1-to-string | ||
| 4372 | edebug-format | ||
| 4373 | ;; lemacs | ||
| 4374 | zmacs-deactivate-region | ||
| 4375 | popup-menu | ||
| 4376 | ;; CL | ||
| 4377 | cl-macroexpand-all | ||
| 4378 | ;; And believe it or not, the byte compiler doesn't know about: | ||
| 4379 | byte-compile-resolve-functions | ||
| 4380 | )) | ||
| 4381 | |||
| 4382 | '(byte-compile-resolve-free-references | ||
| 4383 | '(read-expression-history | ||
| 4384 | read-expression-map)) | ||
| 4385 | |||
| 4386 | '(byte-compile-resolve-free-assignments | ||
| 4387 | '(read-expression-history)) | ||
| 4388 | |||
| 4389 | ))) | ||
| 4390 | |||
| 4391 | |||
| 4392 | ;;; Autoloading of Edebug accessories | 4261 | ;;; Autoloading of Edebug accessories |
| 4393 | 4262 | ||
| 4394 | ;; edebug-cl-read and cl-read are available from liberte@cs.uiuc.edu | 4263 | ;; edebug-cl-read and cl-read are available from liberte@cs.uiuc.edu |
diff --git a/lisp/subr.el b/lisp/subr.el index aa1b10ce17d..e9b85ff1f38 100644 --- a/lisp/subr.el +++ b/lisp/subr.el | |||
| @@ -80,6 +80,7 @@ For more information, see Info node `(elisp)Declaring Functions'." | |||
| 80 | (defmacro noreturn (form) | 80 | (defmacro noreturn (form) |
| 81 | "Evaluate FORM, expecting it not to return. | 81 | "Evaluate FORM, expecting it not to return. |
| 82 | If FORM does return, signal an error." | 82 | If FORM does return, signal an error." |
| 83 | (declare (debug t)) | ||
| 83 | `(prog1 ,form | 84 | `(prog1 ,form |
| 84 | (error "Form marked with `noreturn' did return"))) | 85 | (error "Form marked with `noreturn' did return"))) |
| 85 | 86 | ||
| @@ -87,6 +88,7 @@ If FORM does return, signal an error." | |||
| 87 | "Evaluate FORM, expecting a constant return value. | 88 | "Evaluate FORM, expecting a constant return value. |
| 88 | This is the global do-nothing version. There is also `testcover-1value' | 89 | This is the global do-nothing version. There is also `testcover-1value' |
| 89 | that complains if FORM ever does return differing values." | 90 | that complains if FORM ever does return differing values." |
| 91 | (declare (debug t)) | ||
| 90 | form) | 92 | form) |
| 91 | 93 | ||
| 92 | (defmacro def-edebug-spec (symbol spec) | 94 | (defmacro def-edebug-spec (symbol spec) |