diff options
Diffstat (limited to 'lisp/emacs-lisp')
| -rw-r--r-- | lisp/emacs-lisp/advice.el | 21 | ||||
| -rw-r--r-- | lisp/emacs-lisp/checkdoc.el | 2 | ||||
| -rw-r--r-- | lisp/emacs-lisp/cl-lib.el | 4 | ||||
| -rw-r--r-- | lisp/emacs-lisp/cl-loaddefs.el | 12 | ||||
| -rw-r--r-- | lisp/emacs-lisp/cl-macs.el | 18 | ||||
| -rw-r--r-- | lisp/emacs-lisp/eieio-datadebug.el | 2 | ||||
| -rw-r--r-- | lisp/emacs-lisp/nadvice.el | 100 | ||||
| -rw-r--r-- | lisp/emacs-lisp/syntax.el | 20 |
8 files changed, 115 insertions, 64 deletions
diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el index f9b4491e6e0..c2ebb3bbdc6 100644 --- a/lisp/emacs-lisp/advice.el +++ b/lisp/emacs-lisp/advice.el @@ -2239,16 +2239,15 @@ definition (see the code for `documentation')." (defun ad-definition-type (definition) "Return symbol that describes the type of DEFINITION." + ;; These symbols are only ever used to check a cache entry's validity. + ;; The suffix `2' reflects the fact that we're using version 2 of advice + ;; representations, so cache entries preactivated with version + ;; 1 can't be used. (cond - ((ad-macro-p definition) 'macro) - ((ad-subr-p definition) - (if (special-form-p definition) - 'special-form - 'subr)) - ((or (ad-lambda-p definition) - (ad-compiled-p definition)) - 'function) - ((ad-advice-p definition) 'advice))) + ((ad-macro-p definition) 'macro2) + ((ad-subr-p definition) 'subr2) + ((or (ad-lambda-p definition) (ad-compiled-p definition)) 'fun2) + ((ad-advice-p definition) 'advice2))) ;; FIXME: Can this ever happen? (defun ad-has-proper-definition (function) "True if FUNCTION is a symbol with a proper definition. @@ -2597,7 +2596,9 @@ in any of these classes." (ad-has-redefining-advice function)) (let* ((origdef (ad-real-orig-definition function)) ;; Construct the individual pieces that we need for assembly: - (orig-arglist (ad-arglist origdef)) + (orig-arglist (let ((args (ad-arglist origdef))) + ;; The arglist may still be unknown. + (if (listp args) args '(&rest args)))) (advised-arglist (or (ad-advised-arglist function) orig-arglist)) (interactive-form (ad-advised-interactive-form function)) diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index ffa42e97221..1cbed17cbab 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -124,7 +124,7 @@ ;; Adding your own checks: ;; ;; You can experiment with adding your own checks by setting the -;; hooks `checkdoc-style-functions' and `checkdoc-comment-style-hooks'. +;; hooks `checkdoc-style-functions' and `checkdoc-comment-style-functions'. ;; Return a string which is the error you wish to report. The cursor ;; position should be preserved. ;; diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el index a9be08b1383..d5e5f4bbfbc 100644 --- a/lisp/emacs-lisp/cl-lib.el +++ b/lisp/emacs-lisp/cl-lib.el @@ -3,7 +3,7 @@ ;; Copyright (C) 1993, 2001-2012 Free Software Foundation, Inc. ;; Author: Dave Gillespie <daveg@synaptics.com> -;; Version: 2.02 +;; Version: 1.0 ;; Keywords: extensions ;; This file is part of GNU Emacs. @@ -661,7 +661,7 @@ If ALIST is non-nil, the new pairs are prepended to it." (gv-define-setter face-foreground (x f &optional s) `(set-face-foreground ,f ,x ,s)) (gv-define-setter face-underline-p (x f &optional s) - `(set-face-underline-p ,f ,x ,s)) + `(set-face-underline ,f ,x ,s)) (gv-define-simple-setter file-modes set-file-modes t) (gv-define-simple-setter frame-height set-screen-height t) (gv-define-simple-setter frame-parameters modify-frame-parameters t) diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el index eb58d17c02e..69882e36f22 100644 --- a/lisp/emacs-lisp/cl-loaddefs.el +++ b/lisp/emacs-lisp/cl-loaddefs.el @@ -267,7 +267,7 @@ including `cl-block' and `cl-eval-when'. ;;;;;; cl-typecase cl-ecase cl-case cl-load-time-value cl-eval-when ;;;;;; cl-destructuring-bind cl-function cl-defmacro cl-defun cl-gentemp ;;;;;; cl-gensym cl--compiler-macro-cXXr cl--compiler-macro-list*) -;;;;;; "cl-macs" "cl-macs.el" "c7ad09a74a1d2969406e7e2aaf3812fc") +;;;;;; "cl-macs" "cl-macs.el" "a7d9b56ea588b869813de8ed7ec1fbcd") ;;; Generated autoloads from cl-macs.el (autoload 'cl--compiler-macro-list* "cl-macs" "\ @@ -416,7 +416,7 @@ This is compatible with Common Lisp, but note that `defun' and (put 'cl-return-from 'lisp-indent-function '1) (autoload 'cl-loop "cl-macs" "\ -The Common Lisp `cl-loop' macro. +The Common Lisp `loop' macro. Valid clauses are: for VAR from/upfrom/downfrom NUM to/upto/downto/above/below NUM by NUM, for VAR in LIST by FUNC, for VAR on LIST by FUNC, for VAR = INIT then EXPR, @@ -432,14 +432,14 @@ Valid clauses are: \(fn CLAUSE...)" nil t) (autoload 'cl-do "cl-macs" "\ -The Common Lisp `cl-do' loop. +The Common Lisp `do' loop. \(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" nil t) (put 'cl-do 'lisp-indent-function '2) (autoload 'cl-do* "cl-macs" "\ -The Common Lisp `cl-do*' loop. +The Common Lisp `do*' loop. \(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" nil t) @@ -501,7 +501,7 @@ a `let' form, except that the list of symbols can be computed at run-time. (put 'cl-progv 'lisp-indent-function '2) (autoload 'cl-flet "cl-macs" "\ -Make temporary function definitions. +Make local function definitions. Like `cl-labels' but the definitions are not recursive. \(fn ((FUNC ARGLIST BODY...) ...) FORM...)" nil t) @@ -509,7 +509,7 @@ Like `cl-labels' but the definitions are not recursive. (put 'cl-flet 'lisp-indent-function '1) (autoload 'cl-flet* "cl-macs" "\ -Make temporary function definitions. +Make local function definitions. Like `cl-flet' but the definitions can refer to previous ones. \(fn ((FUNC ARGLIST BODY...) ...) FORM...)" nil t) diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 3c46c40242d..918e992512c 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -260,9 +260,11 @@ The name is made by appending a number to PREFIX, default \"G\"." (require 'help-fns) (cons (help-add-fundoc-usage (if (stringp (car hdr)) (pop hdr)) - (format "%S" - (cons 'fn - (cl--make-usage-args orig-args)))) + ;; Be careful with make-symbol and (back)quote, + ;; see bug#12884. + (let ((print-gensym nil) (print-quoted t)) + (format "%S" (cons 'fn (cl--make-usage-args + orig-args))))) hdr))) (list `(let* ,cl--bind-lets ,@(nreverse cl--bind-forms) @@ -756,7 +758,7 @@ This is compatible with Common Lisp, but note that `defun' and ;;;###autoload (defmacro cl-loop (&rest loop-args) - "The Common Lisp `cl-loop' macro. + "The Common Lisp `loop' macro. Valid clauses are: for VAR from/upfrom/downfrom NUM to/upto/downto/above/below NUM by NUM, for VAR in LIST by FUNC, for VAR on LIST by FUNC, for VAR = INIT then EXPR, @@ -1501,7 +1503,7 @@ such that COMBO is equivalent to (and . CLAUSES)." ;;;###autoload (defmacro cl-do (steps endtest &rest body) - "The Common Lisp `cl-do' loop. + "The Common Lisp `do' loop. \(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" (declare (indent 2) @@ -1513,7 +1515,7 @@ such that COMBO is equivalent to (and . CLAUSES)." ;;;###autoload (defmacro cl-do* (steps endtest &rest body) - "The Common Lisp `cl-do*' loop. + "The Common Lisp `do*' loop. \(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" (declare (indent 2) (debug cl-do)) @@ -1648,7 +1650,7 @@ a `let' form, except that the list of symbols can be computed at run-time." ;;;###autoload (defmacro cl-flet (bindings &rest body) - "Make temporary function definitions. + "Make local function definitions. Like `cl-labels' but the definitions are not recursive. \(fn ((FUNC ARGLIST BODY...) ...) FORM...)" @@ -1672,7 +1674,7 @@ Like `cl-labels' but the definitions are not recursive. ;;;###autoload (defmacro cl-flet* (bindings &rest body) - "Make temporary function definitions. + "Make local function definitions. Like `cl-flet' but the definitions can refer to previous ones. \(fn ((FUNC ARGLIST BODY...) ...) FORM...)" diff --git a/lisp/emacs-lisp/eieio-datadebug.el b/lisp/emacs-lisp/eieio-datadebug.el index ec470d21bf3..a1db1972b83 100644 --- a/lisp/emacs-lisp/eieio-datadebug.el +++ b/lisp/emacs-lisp/eieio-datadebug.el @@ -131,7 +131,7 @@ PREBUTTONTEXT is some text between PREFIX and the object button." (defun eieio-debug-methodinvoke (method class) "Show the method invocation order for METHOD with CLASS object." (interactive "aMethod: \nXClass Expression: ") - (let* ((eieio-pre-method-execution-hooks + (let* ((eieio-pre-method-execution-functions (lambda (l) (throw 'moose l) )) (data (catch 'moose (eieio-generic-call diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el index ff30d9e7fa4..540e0166ec2 100644 --- a/lisp/emacs-lisp/nadvice.el +++ b/lisp/emacs-lisp/nadvice.el @@ -109,18 +109,33 @@ Each element has the form (WHERE BYTECODE STACK) where: (propertize "Advised function" 'dynamic-docstring-function #'advice--make-docstring)) ;; ) +(defun advice-eval-interactive-spec (spec) + "Evaluate the interactive spec SPEC." + (cond + ((stringp spec) + ;; There's no direct access to the C code (in call-interactively) that + ;; processes those specs, but that shouldn't stop us, should it? + ;; FIXME: Despite appearances, this is not faithful: SPEC and + ;; (advice-eval-interactive-spec SPEC) will behave subtly differently w.r.t + ;; command-history (and maybe a few other details). + (call-interactively `(lambda (&rest args) (interactive ,spec) args))) + ;; ((functionp spec) (funcall spec)) + (t (eval spec)))) + (defun advice--make-interactive-form (function main) - ;; TODO: Make it possible to do around-like advising on the - ;; interactive forms (bug#12844). ;; TODO: make it so that interactive spec can be a constant which ;; dynamically checks the advice--car/cdr to do its job. - ;; TODO: Implement interactive-read-args: - ;;(when (or (commandp function) (commandp main)) - ;; `(interactive-read-args - ;; (cadr (or (interactive-form function) (interactive-form main))))) - ;; FIXME: This loads autoloaded functions too eagerly. + ;; For that, advice-eval-interactive-spec needs to be more faithful. + ;; FIXME: The calls to interactive-form below load autoloaded functions + ;; too eagerly. + (let ((fspec (cadr (interactive-form function)))) + (when (eq 'function (car-safe fspec)) ;; Macroexpanded lambda? + (setq fspec (nth 1 fspec))) + (if (functionp fspec) + `(funcall ',fspec + ',(cadr (interactive-form main))) (cadr (or (interactive-form function) - (interactive-form main)))) + (interactive-form main)))))) (defsubst advice--make-1 (byte-code stack-depth function main props) "Build a function value that adds FUNCTION to MAIN." @@ -167,17 +182,31 @@ WHERE is a symbol to select an entry in `advice--where-alist'." (advice--make-1 (aref flist 1) (aref flist 3) first nrest props))))))) +(defvar advice--buffer-local-function-sample nil) + +(defun advice--set-buffer-local (var val) + (if (function-equal val advice--buffer-local-function-sample) + (kill-local-variable var) + (set (make-local-variable var) val))) + +;;;###autoload +(defun advice--buffer-local (var) + "Buffer-local value of VAR, presumed to contain a function." + (declare (gv-setter advice--set-buffer-local)) + (if (local-variable-p var) (symbol-value var) + (setq advice--buffer-local-function-sample + (lambda (&rest args) (apply (default-value var) args))))) + ;;;###autoload (defmacro add-function (where place function &optional props) ;; TODO: - ;; - provide something like `around' for interactive forms. - ;; - provide some kind of buffer-local functionality at least when `place' - ;; is a variable. ;; - obsolete with-wrapper-hook (mostly requires buffer-local support). ;; - provide some kind of control over ordering. E.g. debug-on-entry, ELP ;; and tracing want to stay first. - ;; - maybe also let `where' specify some kind of predicate and use it + ;; - maybe let `where' specify some kind of predicate and use it ;; to implement things like mode-local or eieio-defmethod. + ;; Of course, that only makes sense if the predicates of all advices can + ;; be combined and made more efficient. ;; :before is like a normal add-hook on a normal hook. ;; :before-while is like add-hook on run-hook-with-args-until-failure. ;; :before-until is like add-hook on run-hook-with-args-until-success. @@ -197,8 +226,24 @@ call OLDFUN here: If FUNCTION was already added, do nothing. PROPS is an alist of additional properties, among which the following have a special meaning: -- `name': a string or symbol. It can be used to refer to this piece of advice." +- `name': a string or symbol. It can be used to refer to this piece of advice. + +PLACE cannot be a simple variable. Instead it should either be +\(default-value 'VAR) or (local 'VAR) depending on whether FUNCTION +should be applied to VAR buffer-locally or globally. + +If one of FUNCTION or OLDFUN is interactive, then the resulting function +is also interactive. There are 3 cases: +- FUNCTION is not interactive: the interactive spec of OLDFUN is used. +- The interactive spec of FUNCTION is itself a function: it should take one + argument (the interactive spec of OLDFUN, which it can pass to + `advice-eval-interactive-spec') and return the list of arguments to use. +- Else, use the interactive spec of FUNCTION and ignore the one of OLDFUN." (declare (debug t)) ;;(indent 2) + (cond ((eq 'local (car-safe place)) + (setq place `(advice--buffer-local ,@(cdr place)))) + ((symbolp place) + (error "Use (default-value '%S) or (local '%S)" place place))) `(advice--add-function ,where (gv-ref ,place) ,function ,props)) ;;;###autoload @@ -213,6 +258,10 @@ If FUNCTION was not added to PLACE, do nothing. Instead of FUNCTION being the actual function, it can also be the `name' of the piece of advice." (declare (debug t)) + (cond ((eq 'local (car-safe place)) + (setq place `(advice--buffer-local ,@(cdr place)))) + ((symbolp place) + (error "Use (default-value '%S) or (local '%S)" place place))) (gv-letplace (getter setter) place (macroexp-let2 nil new `(advice--remove-function ,getter ,function) `(unless (eq ,new ,getter) ,(funcall setter new))))) @@ -285,28 +334,21 @@ is defined as a macro, alias, command, ..." ;; - change all defadvice in lisp/**/*.el. ;; - rewrite advice.el on top of this. ;; - obsolete advice.el. - ;; To make advice.el and nadvice.el interoperate properly I see 2 different - ;; ways: - ;; - keep them separate: complete the defalias-fset-function setter with - ;; a matching accessor which both nadvice.el and advice.el will have to use - ;; in place of symbol-function. This can probably be made to work, but - ;; they have to agree on a "protocol". - ;; - layer advice.el on top of nadvice.el. I prefer this approach. the - ;; simplest way is to make advice.el build one ad-Advice-foo function for - ;; each advised function which is advice-added/removed whenever ad-activate - ;; ad-deactivate is called. (let* ((f (and (fboundp symbol) (symbol-function symbol))) (nf (advice--normalize symbol f))) (unless (eq f nf) ;; Most importantly, if nf == nil! (fset symbol nf)) (add-function where (cond ((eq (car-safe nf) 'macro) (cdr nf)) - ;; If the function is not yet defined, we can't yet - ;; install the advice. - ;; FIXME: If it's an autoloaded command, we also - ;; have a problem because we need to load the - ;; command to build the interactive-form. - ((or (not nf) (and (autoloadp nf))) ;; (commandp nf) + ;; Reasons to delay installation of the advice: + ;; - If the function is not yet defined, installing + ;; the advice would affect `fboundp'ness. + ;; - If it's an autoloaded command, + ;; advice--make-interactive-form would end up + ;; loading the command eagerly. + ;; - `autoload' does nothing if the function is + ;; not an autoload or undefined. + ((or (not nf) (autoloadp nf)) (get symbol 'advice--pending)) (t (symbol-function symbol))) function props) diff --git a/lisp/emacs-lisp/syntax.el b/lisp/emacs-lisp/syntax.el index c3d78b3444b..592cb1b0174 100644 --- a/lisp/emacs-lisp/syntax.el +++ b/lisp/emacs-lisp/syntax.el @@ -55,12 +55,18 @@ ;; have to flush that cache between each function, and we couldn't use ;; syntax-ppss-flush-cache since that would not only flush the cache but also ;; reset syntax-propertize--done which should not be done in this case). - "Mode-specific function to apply the syntax-table properties. -Called with two arguments: START and END. -This function can call `syntax-ppss' on any position before END, but it -should not call `syntax-ppss-flush-cache', which means that it should not -call `syntax-ppss' on some position and later modify the buffer on some -earlier position.") + "Mode-specific function to apply `syntax-table' text properties. +The value of this variable is a function to be called by Font +Lock mode, prior to performing syntactic fontification on a +stretch of text. It is given two arguments, START and END: the +start and end of the text to be fontified. Major modes can +specify a custom function to apply `syntax-table' properties to +override the default syntax table in special cases. + +The specified function may call `syntax-ppss' on any position +before END, but it should not call `syntax-ppss-flush-cache', +which means that it should not call `syntax-ppss' on some +position and later modify the buffer on some earlier position.") (defvar syntax-propertize-chunk-size 500) @@ -118,7 +124,7 @@ The arg RULES can be of the same form as in `syntax-propertize-rules'. The return value is an object that can be passed as a rule to `syntax-propertize-rules'. I.e. this is useful only when you want to share rules among several -syntax-propertize-functions." +`syntax-propertize-function's." (declare (debug syntax-propertize-rules)) ;; Precompile? Yeah, right! ;; Seriously, tho, this is a macro for 2 reasons: |