bug#8457: 24.0.50; defadvice with BODY referencing args by name: void-var error

bug#8457: 24.0.50; defadvice with BODY referencing args by name: void-var error

[Drew Adams]

(elisp) `Argument Access in Advice' says that you should be able to
access the args using the original names:
 
"The simplest way to access the arguments of an advised function in the
body of a piece of advice is to use the same names that the function
definition uses.  To do this, you need to know the names of the argument
variables of the original function."
 
This should work, and it works prior to the move to lexbind(?), at least.  I
have this defadvice:
 
(defadvice narrow-to-region (before push-wide-n-restrictions activate)
  "Push the region limits to `wide-n-restrictions'.
You can use `C-x n x' to widen to a previous buffer restriction."
  (when (or (interactive-p) wide-n-push-anyway-p)
    (wide-n-push start end)))
 
START and END are the original arg names.  Yes, the doc also says that
this method of referring to args is not the most robust.  Still, it has
worked in general but no longer does.  This is the error:
 
Debugger entered--Lisp error: (void-variable start)
  (wide-n-push start end)
  (progn (wide-n-push start end))
  (if (or (interactive-p) wide-n-push-anyway-p) (progn (wide-n-push start end)))
  (when (or (interactive-p) wide-n-push-anyway-p) (wide-n-push start end))
  (let (ad-return-value) (when (or (interactive-p) wide-n-push-anyway-p)
(wide-n-push start end)) (setq ad-return-value (apply (quote
ad-Orig-narrow-to-region) arg1 arg2 rest)) ad-return-value)
  narrow-to-region(8268 9972)
  call-interactively(narrow-to-region nil nil)
 
Just a guess: this has to do with the move to lexbind.
 

In GNU Emacs 24.0.50.1 (i386-mingw-nt5.1.2600)
 of 2011-04-04 on 3249CTO
Windowing system distributor `Microsoft Corp.', version 5.1.2600
configured using `configure --with-gcc (4.5) --no-opt --cflags
-Ic:/imagesupport/include'
 

bug#8457: 24.0.50; defadvice with BODY referencing args by name: void-var error

[Stefan Monnier]

> (elisp) `Argument Access in Advice' says that you should be able to
> access the args using the original names:

That's indeed not the case any more if the function is defined using
lexical-binding mode or if it's a subroutine (i.e. defined in C).

> START and END are the original arg names.  Yes, the doc also says that
> this method of referring to args is not the most robust.  Still, it has
> worked in general but no longer does.  This is the error:
 
> Just a guess: this has to do with the move to lexbind.
 
Yup.  I think the patch below may fix this problem.


        Stefan


=== modified file 'lisp/emacs-lisp/advice.el'
--- lisp/emacs-lisp/advice.el	2011-03-11 20:04:22 +0000
+++ lisp/emacs-lisp/advice.el	2011-04-10 04:45:13 +0000
@@ -503,36 +503,6 @@
 ;; exact structure of the original argument list as long as the new argument
 ;; list takes a compatible number/magnitude of actual arguments.
 
-;; @@@ Definition of subr argument lists:
-;; ======================================
-;; When advice constructs the advised definition of a function it has to
-;; know the argument list of the original function. For functions and macros
-;; the argument list can be determined from the actual definition, however,
-;; for subrs there is no such direct access available. In Lemacs and for some
-;; subrs in Emacs-19 the argument list of a subr can be determined from
-;; its documentation string, in a v18 Emacs even that is not possible. If
-;; advice cannot at all determine the argument list of a subr it uses
-;; `(&rest ad-subr-args)' which will always work but is inefficient because
-;; it conses up arguments. The macro `ad-define-subr-args' can be used by
-;; the advice programmer to explicitly tell advice about the argument list
-;; of a certain subr, for example,
-;;
-;;    (ad-define-subr-args 'fset '(sym newdef))
-;;
-;; is used by advice itself to tell a v18 Emacs about the arguments of `fset'.
-;; The following can be used to undo such a definition:
-;;
-;;    (ad-undefine-subr-args 'fset)
-;;
-;; The argument list definition is stored on the property list of the subr
-;; name symbol. When an argument list could be determined from the
-;; documentation string it will be cached under that property. The general
-;; mechanism for looking up the argument list of a subr is the following:
-;; 1) look for a definition stored on the property list
-;; 2) if that failed try to infer it from the documentation string and
-;;    if successful cache it on the property list
-;; 3) otherwise use `(&rest ad-subr-args)'
-
 ;; @@ Activation and deactivation:
 ;; ===============================
 ;; The definition of an advised function does not change until all its advice
@@ -1654,41 +1624,6 @@
 ;; (fii 3 2)
 ;; 5
 ;;
-;; @@ Specifying argument lists of subrs:
-;; ======================================
-;; The argument lists of subrs cannot be determined directly from Lisp.
-;; This means that Advice has to use `(&rest ad-subr-args)' as the
-;; argument list of the advised subr which is not very efficient. In Lemacs
-;; subr argument lists can be determined from their documentation string, in
-;; Emacs-19 this is the case for some but not all subrs. To accommodate
-;; for the cases where the argument lists cannot be determined (e.g., in a
-;; v18 Emacs) Advice comes with a specification mechanism that allows the
-;; advice programmer to tell advice what the argument list of a certain subr
-;; really is.
-;;
-;; In a v18 Emacs the following will return the &rest idiom:
-;;
-;; (ad-arglist (symbol-function 'car))
-;; (&rest ad-subr-args)
-;;
-;; To tell advice what the argument list of `car' really is we
-;; can do the following:
-;;
-;; (ad-define-subr-args 'car '(list))
-;; ((list))
-;;
-;; Now `ad-arglist' will return the proper argument list (this method is
-;; actually used by advice itself for the advised definition of `fset'):
-;;
-;; (ad-arglist (symbol-function 'car))
-;; (list)
-;;
-;; The defined argument list will be stored on the property list of the
-;; subr name symbol. When advice looks for a subr argument list it first
-;; checks for a definition on the property list, if that fails it tries
-;; to infer it from the documentation string and caches it on the property
-;; list if it was successful, otherwise `(&rest ad-subr-args)' will be used.
-;;
 ;; @@ Advising interactive subrs:
 ;; ==============================
 ;; For the most part there is no difference between advising functions and
@@ -2538,50 +2473,8 @@
   (require 'help-fns)
   (cond
    ((or (ad-macro-p definition) (ad-advice-p definition))
-    (help-function-arglist (cdr definition)))
-   (t (help-function-arglist definition))))
-
-;; Store subr-args as `((arg1 arg2 ...))' so I can distinguish
-;; a defined empty arglist `(nil)' from an undefined arglist:
-(defmacro ad-define-subr-args (subr arglist)
-  `(put ,subr 'ad-subr-arglist (list ,arglist)))
-(defmacro ad-undefine-subr-args (subr)
-  `(put ,subr 'ad-subr-arglist nil))
-(defmacro ad-subr-args-defined-p (subr)
-  `(get ,subr 'ad-subr-arglist))
-(defmacro ad-get-subr-args (subr)
-  `(car (get ,subr 'ad-subr-arglist)))
-
-(defun ad-subr-arglist (subr-name)
-  "Retrieve arglist of the subr with SUBR-NAME.
-Either use the one stored under the `ad-subr-arglist' property,
-or try to retrieve it from the docstring and cache it under
-that property, or otherwise use `(&rest ad-subr-args)'."
-  (if (ad-subr-args-defined-p subr-name)
-      (ad-get-subr-args subr-name)
-    ;; says jwz: Should use this for Lemacs 19.8 and above:
-    ;;((fboundp 'subr-min-args)
-    ;;  ...)
-    ;; says hans: I guess what Jamie means is that I should use the values
-    ;; of `subr-min-args' and `subr-max-args' to construct the subr arglist
-    ;; without having to look it up via parsing the docstring, e.g.,
-    ;; values 1 and 2 would suggest `(arg1 &optional arg2)' as an
-    ;; argument list.  However, that won't work because there is no
-    ;; way to distinguish a subr with args `(a &optional b &rest c)' from
-    ;; one with args `(a &rest c)' using that mechanism. Also, the argument
-    ;; names from the docstring are more meaningful. Hence, I'll stick with
-    ;; the old way of doing things.
-    (let ((doc (or (ad-real-documentation subr-name t) "")))
-      (if (not (string-match "\n\n\\((.+)\\)\\'" doc))
-	  ;; Signalling an error leads to bugs during bootstrapping because
-	  ;; the DOC file is not yet built (which is an error, BTW).
-	  ;; (error "The usage info is missing from the subr %s" subr-name)
-	  '(&rest ad-subr-args)
-	(ad-define-subr-args
-	 subr-name
-	 (cdr (car (read-from-string
-		    (downcase (match-string 1 doc))))))
-	(ad-get-subr-args subr-name)))))
+    (help-function-arglist (cdr definition) 'faithful-names))
+   (t (help-function-arglist definition 'faithful-names))))
 
 (defun ad-docstring (definition)
   "Return the unexpanded docstring of DEFINITION."
@@ -3921,10 +3814,6 @@
 ;; Use the advice mechanism to advise `documentation' to make it
 ;; generate proper documentation strings for advised definitions:
 
-;; This makes sure we get the right arglist for `documentation'
-;; during bootstrapping.
-(ad-define-subr-args 'documentation '(function &optional raw))
-
 ;; @@ Starting, stopping and recovering from the advice package magic:
 ;; ===================================================================
 

=== modified file 'lisp/help-fns.el'
--- lisp/help-fns.el	2011-04-08 18:53:26 +0000
+++ lisp/help-fns.el	2011-04-10 04:45:42 +0000
@@ -99,14 +99,42 @@
 	      (format "%S" (help-make-usage 'fn arglist))))))
 
 ;; FIXME: Move to subr.el?
-(defun help-function-arglist (def)
+(defun help-function-arglist (def &optional faithful-names)
+  "Return a formal argument list for the function DEF.
+IF FAITHFUL-NAMES is non-nil, try to return a formal arglist that uses
+the same names as used in the original source code (this may not always work)."
   ;; Handle symbols aliased to other symbols.
   (if (and (symbolp def) (fboundp def)) (setq def (indirect-function def)))
   ;; If definition is a macro, find the function inside it.
   (if (eq (car-safe def) 'macro) (setq def (cdr def)))
   (cond
-   ((and (byte-code-function-p def) (integerp (aref def 0)))
-    (let* ((args-desc (aref def 0))
+   ((and (byte-code-function-p def) (listp (aref def 0))) (aref def 0))
+   ((eq (car-safe def) 'lambda) (nth 1 def))
+   ((eq (car-safe def) 'closure) (nth 2 def))
+   ((or (and (byte-code-function-p def) (integerp (aref def 0)))
+        (subrp def))
+    (or (when faithful-names
+          (let* ((doc (condition-case nil (documentation def) (error nil)))
+                 (docargs (if doc (car (help-split-fundoc doc nil))))
+                 (arglist (if docargs
+                              (cdar (read-from-string (downcase docargs)))))
+                 (valid t))
+            ;; Check validity.
+            (dolist (arg arglist)
+              (unless (and (symbolp arg)
+                           (let ((name (symbol-name arg)))
+                             (if (eq (aref name 0) ?&)
+                                 (memq arg '(&rest &optional))
+                               (not (string-match "\\." name)))))
+                (setq valid nil)))
+            (when valid arglist)))
+        (let* ((args-desc (if (not (subrp def))
+                              (aref def 0)
+                            (let ((a (subr-arity def)))
+                              (logior (car a)
+                                      (if (numberp (cdr a))
+                                          (lsh (cdr a) 8)
+                                        (lsh 1 7))))))
            (max (lsh args-desc -8))
            (min (logand args-desc 127))
            (rest (logand args-desc 128))
@@ -119,26 +147,7 @@
           (push (intern (concat "arg" (number-to-string (+ 1 i min))))
                 arglist)))
       (unless (zerop rest) (push '&rest arglist) (push 'rest arglist))
-      (nreverse arglist)))
-   ((byte-code-function-p def) (aref def 0))
-   ((eq (car-safe def) 'lambda) (nth 1 def))
-   ((eq (car-safe def) 'closure) (nth 2 def))
-   ((subrp def)
-    (let ((arity (subr-arity def))
-          (arglist ()))
-      (dotimes (i (car arity))
-        (push (intern (concat "arg" (number-to-string (1+ i)))) arglist))
-      (cond
-       ((not (numberp (cdr arglist)))
-        (push '&rest arglist)
-        (push 'rest arglist))
-       ((< (car arity) (cdr arity))
-        (push '&optional arglist)
-        (dotimes (i (- (cdr arity) (car arity)))
-          (push (intern (concat "arg" (number-to-string
-                                       (+ 1 i (car arity)))))
-                arglist))))
-      (nreverse arglist)))
+          (nreverse arglist))))
    ((and (eq (car-safe def) 'autoload) (not (eq (nth 4 def) 'keymap)))
     "[Arg list not available until function definition is loaded.]")
    (t t)))

bug#8457: 24.0.50; defadvice with BODY referencing args by name: void-var error

[Stefan Monnier]

> Yup.  I think the patch below may fix this problem.

Installed,


        Stefan