aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2012-09-13 23:55:16 -0400
committerStefan Monnier2012-09-13 23:55:16 -0400
commit2de39f089a464cc265b6c583684226d1a94abbfa (patch)
treeb73af6099af4765cc78fe1c4ff930749708dcdad
parent2a7931e3548f730ca1abdc489cc0575a6c4e7cab (diff)
downloademacs-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/ChangeLog39
-rw-r--r--lisp/dired.el2
-rw-r--r--lisp/emacs-lisp/advice.el183
-rw-r--r--lisp/emacs-lisp/easymenu.el2
-rw-r--r--lisp/emacs-lisp/edebug.el261
-rw-r--r--lisp/subr.el2
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 @@
12012-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
12012-09-13 Juri Linkov <juri@jurta.org> 402012-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
1829which will iterate over the list yielded by INIT-FORM binding VAR to the
1830current head at every iteration. If RESULT-FORM is supplied its value will
1831be returned at the end of the iteration, nil otherwise. The iteration can be
1832exited 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...)
1930On each iteration VAR will be bound to the name of an advised function 1882On 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
2184class of FUNCTION)." 2136class 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.
2255If CLASS is `any' all valid advice classes will be checked." 2207If 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
2277FUNCTION was not advised)." 2229FUNCTION 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
2997should be modified. The assembled function will be returned." 2949should 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.
3670usage: (defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...) 3622usage: (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
148as a solid horizontal line. 148as a solid horizontal line.
149 149
150A menu item can be a list with the same format as MENU. This is a submenu." 150A 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.
624This is an automatic buffer local variable. Each entry looks like: 618Each entry is an `edebug--form-data' struct with fields:
625\(SYMBOL BEGIN-MARKER END-MARKER). The markers 619SYMBOL, BEGIN-MARKER, and END-MARKER. The markers
626are at the beginning and end of an entry level form and SYMBOL is 620are at the beginning and end of an entry level form and SYMBOL is
627a symbol that holds all edebug related information for the form on its 621a symbol that holds all edebug related information for the form on its
628property list. 622property list.
@@ -631,24 +625,17 @@ In the future (haha!), the symbol will be irrelevant and edebug data will
631be stored in the definitions themselves rather than in the property 625be stored in the definitions themselves rather than in the property
632list of a symbol.") 626list 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. 666If 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? 677Maybe 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.
4089The buffer is created if it does not exist. 4031The buffer is created if it does not exist.
4090You must include newlines in FMT to break lines, but one newline is appended." 4032You 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.
82If FORM does return, signal an error." 82If 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.
88This is the global do-nothing version. There is also `testcover-1value' 89This is the global do-nothing version. There is also `testcover-1value'
89that complains if FORM ever does return differing values." 90that 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)