[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: describe-function and advised C functions
From: |
Tassilo Horn |
Subject: |
Re: describe-function and advised C functions |
Date: |
Wed, 04 Dec 2013 11:54:37 +0100 |
User-agent: |
Gnus/5.130008 (Ma Gnus v0.8) Emacs/24.3.50 (gnu/linux) |
Stefan Monnier <address@hidden> writes:
>> The following patch restores that behavior for the current trunk. Good
>> to commit?
>
> No: Anything that starts with "ad-" means that it will only work with
> functions advised via the old advice.el but not with the new nadvice.el.
>
> Can you try and adjust your patch to use advice-* functions?
Yeah. Here's a patch that removes all ad-* function usages in
help-fns.el which also fixes the original regression. It's a bit hairy,
especially when you have pieces of advice on aliases, but it seems to do
the trick. It wouldn't be bad if someone else could have a look at the
patch.
--8<---------------cut here---------------start------------->8---
=== modified file 'lisp/help-fns.el'
--- lisp/help-fns.el 2013-06-15 01:12:05 +0000
+++ lisp/help-fns.el 2013-12-04 10:43:34 +0000
@@ -382,8 +382,6 @@
(match-string 1 str))))
(and src-file (file-readable-p src-file) src-file))))))
-(declare-function ad-get-advice-info "advice" (function))
-
(defun help-fns--key-bindings (function)
(when (commandp function)
(let ((pt2 (with-current-buffer standard-output (point)))
@@ -531,27 +529,46 @@
;;;###autoload
(defun describe-function-1 (function)
- (let* ((advised (and (symbolp function) (featurep 'advice)
- (ad-get-advice-info function)))
+ (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.
(real-function
(or (and advised
- (let ((origname (cdr (assq 'origname advised))))
- (and (fboundp origname) origname)))
+ (let* ((f function)
+ (advised-fn (advice--cdr (advice--symbol-function
f))))
+ (while (advice--p advised-fn)
+ (setq f advised-fn)
+ (setq advised-fn (advice--cdr (if (symbolp f)
+
(advice--symbol-function f)
+ f))))
+ advised-fn))
function))
;; Get the real definition.
(def (if (symbolp real-function)
(symbol-function real-function)
- function))
- (aliased (symbolp def))
- (real-def (if aliased
- (let ((f def))
- (while (and (fboundp f)
- (symbolp (symbol-function f)))
- (setq f (symbol-function f)))
- f)
- def))
+ real-function))
+ (aliased (or (symbolp def)
+ ;; advised, aliased lisp function
+ (and (symbolp function)
+ (symbolp real-function)
+ (not (eq function real-function)))
+ ;; advised, aliased subr
+ (and (symbolp function)
+ (subrp def)
+ (not (eq (intern (subr-name def)) function)))))
+ (real-def (cond
+ ((and aliased ;;(symbolp def)
+ )
+ (let ((f real-function))
+ (while (and (fboundp f)
+ (symbolp (symbol-function f)))
+ (setq f (symbol-function f)))
+ f))
+ ((and aliased (symbolp real)))
+ ((subrp def) (intern (subr-name def)))
+ (t def)))
(file-name (find-lisp-object-file-name function def))
(pt1 (with-current-buffer (help-buffer) (point)))
(beg (if (and (or (byte-code-function-p def)
@@ -567,14 +584,14 @@
;; Print what kind of function-like object FUNCTION is.
(princ (cond ((or (stringp def) (vectorp def))
"a keyboard macro")
+ (aliased
+ (format "an alias for `%s'" real-def))
((subrp def)
(if (eq 'unevalled (cdr (subr-arity def)))
(concat beg "special form")
(concat beg "built-in function")))
((byte-code-function-p def)
(concat beg "compiled Lisp function"))
- (aliased
- (format "an alias for `%s'" real-def))
((eq (car-safe def) 'lambda)
(concat beg "Lisp function"))
((eq (car-safe def) 'macro)
--8<---------------cut here---------------end--------------->8---
To test it, I did the following old and new advice definitions in
*scratch*.
--8<---------------cut here---------------start------------->8---
(defadvice load (before my-load-advice activate)
;; do nothing
)
(advice-add 'append :before #'ignore)
(defalias 'concat-seqs 'append)
(advice-add 'concat-seqs :after #'ignore)
(defadvice concat-seqs (around blabla activate)
ad-do-it)
(defalias 'quack-mode 'scheme-mode)
(defadvice scheme-mode (before before-scheme-mode activate)
;; do nothing
)
(advice-add 'quack-mode :before #'ignore)
--8<---------------cut here---------------end--------------->8---
Here's what I now get with C-h f:
,----[ C-h f load RET ]
| load is a built-in function in `C source code'.
|
| (load FILE &optional NOERROR NOMESSAGE NOSUFFIX MUST-SUFFIX)
|
| :around advice: `ad-Advice-load'
`----
,----[ C-h f append RET ]
| append is a built-in function in `C source code'.
|
| (append &rest SEQUENCES)
|
| :before advice: `ignore'
`----
,----[ C-h f concat-seqs RET ]
| concat-seqs is an alias for `append'.
|
| (concat-seqs &rest SEQUENCES)
|
| :around advice: `ad-Advice-concat-seqs'
| :after advice: `ignore'
|
| :before advice: `ignore'
`----
,----[ C-h f scheme-mode RET ]
| scheme-mode is an interactive autoloaded compiled Lisp function in
`scheme.el'.
|
| (scheme-mode)
|
| Parent mode: `prog-mode'.
|
| :around advice: `ad-Advice-scheme-mode'
`----
,----[ C-h f quack-mode RET ]
| quack-mode is an alias for `scheme-mode'.
|
| (quack-mode)
|
| :before advice: `ignore'
|
| :around advice: `ad-Advice-scheme-mode'
`----
That looks reasonable to me.
Bye,
Tassilo
- describe-function and advised C functions, Tassilo Horn, 2013/12/03
- Re: describe-function and advised C functions, Stefan Monnier, 2013/12/03
- Re: describe-function and advised C functions,
Tassilo Horn <=
- Re: describe-function and advised C functions, Tassilo Horn, 2013/12/04
- Re: describe-function and advised C functions, Johan Bockgård, 2013/12/04
- Re: describe-function and advised C functions, Stefan Monnier, 2013/12/04
- Re: describe-function and advised C functions, Tassilo Horn, 2013/12/05
- Re: describe-function and advised C functions, Tassilo Horn, 2013/12/07