From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Tassilo Horn Newsgroups: gmane.emacs.devel Subject: Re: describe-function and advised C functions Date: Wed, 04 Dec 2013 11:54:37 +0100 Message-ID: <87a9ggnaxe.fsf@tsdh.uni-koblenz.de> References: <87txeq8fek.fsf@tsdh.uni-koblenz.de> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: text/plain X-Trace: ger.gmane.org 1386154491 18577 80.91.229.3 (4 Dec 2013 10:54:51 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Wed, 4 Dec 2013 10:54:51 +0000 (UTC) Cc: emacs-devel@gnu.org To: Stefan Monnier Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Wed Dec 04 11:54:56 2013 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1VoA6Z-00037F-IC for ged-emacs-devel@m.gmane.org; Wed, 04 Dec 2013 11:54:55 +0100 Original-Received: from localhost ([::1]:47554 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1VoA6Z-0007DW-89 for ged-emacs-devel@m.gmane.org; Wed, 04 Dec 2013 05:54:55 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:56905) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1VoA6R-00075G-99 for emacs-devel@gnu.org; Wed, 04 Dec 2013 05:54:52 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1VoA6K-0007xj-53 for emacs-devel@gnu.org; Wed, 04 Dec 2013 05:54:47 -0500 Original-Received: from deliver.uni-koblenz.de ([141.26.64.15]:40630) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1VoA6J-0007xQ-Ro for emacs-devel@gnu.org; Wed, 04 Dec 2013 05:54:40 -0500 Original-Received: from localhost (localhost [127.0.0.1]) by deliver.uni-koblenz.de (Postfix) with ESMTP id E777A1A848B; Wed, 4 Dec 2013 11:54:38 +0100 (CET) X-Virus-Scanned: amavisd-new at uni-koblenz.de Original-Received: from deliver.uni-koblenz.de ([127.0.0.1]) by localhost (deliver.uni-koblenz.de [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id aq0wPYr1vZ2q; Wed, 4 Dec 2013 11:54:38 +0100 (CET) X-CHKRCPT: Envelopesender noch tsdh@gnu.org Original-Received: from tsdh.uni-koblenz.de (tsdh.uni-koblenz.de [141.26.67.142]) (using TLSv1 with cipher AES128-SHA (128/128 bits)) (No client certificate requested) by deliver.uni-koblenz.de (Postfix) with ESMTPSA id 49BB61A8488; Wed, 4 Dec 2013 11:54:38 +0100 (CET) Mail-Followup-To: Stefan Monnier , emacs-devel@gnu.org In-Reply-To: (Stefan Monnier's message of "Tue, 03 Dec 2013 08:51:57 -0500") User-Agent: Gnus/5.130008 (Ma Gnus v0.8) Emacs/24.3.50 (gnu/linux) X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6.x X-Received-From: 141.26.64.15 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:166072 Archived-At: Stefan Monnier 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