* lisp/emacs-lisp/bytecomp.el: Fix bug#14860.
* lisp/emacs-lisp/bytecomp.el (byte-compile--function-signature): New fun. Dig into advice wrappers to find the "real" signature. (byte-compile-callargs-warn, byte-compile-arglist-warn): Use it. (byte-compile-arglist-signature): Don't bother with "new-style" arglists, since bytecode functions are now handled in byte-compile--function-signature. * lisp/files.el (create-file-buffer, insert-directory): Remove workaround introduced for (bug#14860). * lisp/help-fns.el (help-fns--analyse-function): `nadvice` is preloaded. * lisp/help.el (help-function-arglist): Dig into advice wrappers to find the "real" signature.
This commit is contained in:
parent
583995c62d
commit
6e2d6d54e1
4 changed files with 18 additions and 38 deletions
|
@ -1263,12 +1263,6 @@ when printing the error message."
|
|||
|
||||
(defun byte-compile-arglist-signature (arglist)
|
||||
(cond
|
||||
;; New style byte-code arglist.
|
||||
((integerp arglist)
|
||||
(cons (logand arglist 127) ;Mandatory.
|
||||
(if (zerop (logand arglist 128)) ;No &rest.
|
||||
(lsh arglist -8)))) ;Nonrest.
|
||||
;; Old style byte-code, or interpreted function.
|
||||
((listp arglist)
|
||||
(let ((args 0)
|
||||
opts
|
||||
|
@ -1289,6 +1283,19 @@ when printing the error message."
|
|||
;; Unknown arglist.
|
||||
(t '(0))))
|
||||
|
||||
(defun byte-compile--function-signature (f)
|
||||
;; Similar to help-function-arglist, except that it returns the info
|
||||
;; in a different format.
|
||||
(and (eq 'macro (car-safe f)) (setq f (cdr f)))
|
||||
;; Advice wrappers have "catch all" args, so fetch the actual underlying
|
||||
;; function to find the real arguments.
|
||||
(while (advice--p f) (setq f (advice--cdr f)))
|
||||
(if (eq (car-safe f) 'declared)
|
||||
(byte-compile-arglist-signature (nth 1 f))
|
||||
(condition-case nil
|
||||
(let ((sig (func-arity f)))
|
||||
(if (numberp (cdr sig)) sig (list (car sig))))
|
||||
(error '(0)))))
|
||||
|
||||
(defun byte-compile-arglist-signatures-congruent-p (old new)
|
||||
(not (or
|
||||
|
@ -1330,19 +1337,7 @@ when printing the error message."
|
|||
(defun byte-compile-callargs-warn (form)
|
||||
(let* ((def (or (byte-compile-fdefinition (car form) nil)
|
||||
(byte-compile-fdefinition (car form) t)))
|
||||
(sig (if (and def (not (eq def t)))
|
||||
(progn
|
||||
(and (eq (car-safe def) 'macro)
|
||||
(eq (car-safe (cdr-safe def)) 'lambda)
|
||||
(setq def (cdr def)))
|
||||
(byte-compile-arglist-signature
|
||||
(if (memq (car-safe def) '(declared lambda))
|
||||
(nth 1 def)
|
||||
(if (byte-code-function-p def)
|
||||
(aref def 0)
|
||||
'(&rest def)))))
|
||||
(if (subrp (symbol-function (car form)))
|
||||
(subr-arity (symbol-function (car form))))))
|
||||
(sig (byte-compile--function-signature def))
|
||||
(ncall (length (cdr form))))
|
||||
;; Check many or unevalled from subr-arity.
|
||||
(if (and (cdr-safe sig)
|
||||
|
@ -1461,15 +1456,7 @@ extra args."
|
|||
(and initial (symbolp initial)
|
||||
(setq old (byte-compile-fdefinition initial nil)))
|
||||
(when (and old (not (eq old t)))
|
||||
(and (eq 'macro (car-safe old))
|
||||
(eq 'lambda (car-safe (cdr-safe old)))
|
||||
(setq old (cdr old)))
|
||||
(let ((sig1 (byte-compile-arglist-signature
|
||||
(pcase old
|
||||
(`(lambda ,args . ,_) args)
|
||||
(`(closure ,_ ,args . ,_) args)
|
||||
((pred byte-code-function-p) (aref old 0))
|
||||
(_ '(&rest def)))))
|
||||
(let ((sig1 (byte-compile--function-signature old))
|
||||
(sig2 (byte-compile-arglist-signature arglist)))
|
||||
(unless (byte-compile-arglist-signatures-congruent-p sig1 sig2)
|
||||
(byte-compile-set-symbol-position name)
|
||||
|
|
|
@ -1821,10 +1821,6 @@ otherwise a string <2> or <3> or ... is appended to get an unused name.
|
|||
Emacs treats buffers whose names begin with a space as internal buffers.
|
||||
To avoid confusion when visiting a file whose name begins with a space,
|
||||
this function prepends a \"|\" to the final result if necessary."
|
||||
;; We need the following 'declare' form to shut up the byte
|
||||
;; compiler, which displays a bogus warning for advised functions,
|
||||
;; see bug#14860.
|
||||
(declare (advertised-calling-convention (filename) "18.59"))
|
||||
(let ((lastname (file-name-nondirectory filename)))
|
||||
(if (string= lastname "")
|
||||
(setq lastname filename))
|
||||
|
@ -6594,11 +6590,6 @@ When SWITCHES contains the long `--dired' option, this function
|
|||
treats it specially, for the sake of dired. However, the
|
||||
normally equivalent short `-D' option is just passed on to
|
||||
`insert-directory-program', as any other option."
|
||||
;; We need the following 'declare' form to shut up the byte
|
||||
;; compiler, which displays a bogus warning for advised functions,
|
||||
;; see bug#14860.
|
||||
(declare (advertised-calling-convention
|
||||
(file switches &optional wildcard full-directory-p) "19.34"))
|
||||
;; We need the directory in order to find the right handler.
|
||||
(let ((handler (find-file-name-handler (expand-file-name file)
|
||||
'insert-directory)))
|
||||
|
|
|
@ -564,7 +564,6 @@ FILE is the file where FUNCTION was probably defined."
|
|||
"Return information about FUNCTION.
|
||||
Returns a list of the form (REAL-FUNCTION DEF ALIASED REAL-DEF)."
|
||||
(let* ((advised (and (symbolp function)
|
||||
(featurep 'nadvice)
|
||||
(advice--p (advice--symbol-function function))))
|
||||
;; If the function is advised, use the symbol that has the
|
||||
;; real definition, if that symbol is already set up.
|
||||
|
|
|
@ -1384,6 +1384,9 @@ If PRESERVE-NAMES is non-nil, return a formal arglist that uses
|
|||
the same names as used in the original source code, when possible."
|
||||
;; Handle symbols aliased to other symbols.
|
||||
(if (and (symbolp def) (fboundp def)) (setq def (indirect-function def)))
|
||||
;; Advice wrappers have "catch all" args, so fetch the actual underlying
|
||||
;; function to find the real arguments.
|
||||
(while (advice--p def) (setq def (advice--cdr def)))
|
||||
;; If definition is a macro, find the function inside it.
|
||||
(if (eq (car-safe def) 'macro) (setq def (cdr def)))
|
||||
(cond
|
||||
|
|
Loading…
Add table
Reference in a new issue