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: Thu, 05 Dec 2013 10:52:37 +0100 Message-ID: <87iov31v6i.fsf@tsdh.uni-koblenz.de> References: <87txeq8fek.fsf@tsdh.uni-koblenz.de> <87a9ggnaxe.fsf@tsdh.uni-koblenz.de> <8761r4n242.fsf@tsdh.uni-koblenz.de> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: text/plain X-Trace: ger.gmane.org 1386237173 4493 80.91.229.3 (5 Dec 2013 09:52:53 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Thu, 5 Dec 2013 09:52:53 +0000 (UTC) Cc: emacs-devel@gnu.org To: Stefan Monnier Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Thu Dec 05 10:52:58 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 1VoVc6-0006OU-MK for ged-emacs-devel@m.gmane.org; Thu, 05 Dec 2013 10:52:54 +0100 Original-Received: from localhost ([::1]:52552 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1VoVc6-0002OP-CT for ged-emacs-devel@m.gmane.org; Thu, 05 Dec 2013 04:52:54 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:38698) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1VoVby-0002OE-5Z for emacs-devel@gnu.org; Thu, 05 Dec 2013 04:52:51 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1VoVbs-0007ST-Ip for emacs-devel@gnu.org; Thu, 05 Dec 2013 04:52:46 -0500 Original-Received: from deliver.uni-koblenz.de ([141.26.64.15]:46962) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1VoVbs-0007SO-93 for emacs-devel@gnu.org; Thu, 05 Dec 2013 04:52:40 -0500 Original-Received: from localhost (localhost [127.0.0.1]) by deliver.uni-koblenz.de (Postfix) with ESMTP id 961471A8469; Thu, 5 Dec 2013 10:52: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 iGphzq3BO1W5; Thu, 5 Dec 2013 10:52:37 +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 9C2241A8465; Thu, 5 Dec 2013 10:52:37 +0100 (CET) Mail-Followup-To: Stefan Monnier , emacs-devel@gnu.org In-Reply-To: (Stefan Monnier's message of "Wed, 04 Dec 2013 21:38:07 -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:166111 Archived-At: Stefan Monnier writes: >> ;; 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)) > > Here `f' is unnecessary (you can always replace it either with > `function' or with `advised-fn'). Right. > Doesn't this break the 80-columns limit? Yes. The new attached patch is at most 76 columns wide. > Also, the (symbolp f) test is always nil since (advice--p advised-fn) > can't be true at the same time. Indeed. > More important, for an advised macro, your `real-definition' will be > a function (either a lambda expression or a byte-code-function-p). Oh, yes. I didn't test advising macros, but the new patch contains a fix. >> + (aliased (or (symbolp def) >> + ;; advised & aliased >> + (and (symbolp function) >> + (symbolp real-function) >> + (not (eq function real-function))))) > > Please capitalize and punctuate your comments. Done. > Also, why not use replace the `and' with > > (and advised (symbolp real-function)) That's better. >> + (real-def (cond >> + (aliased (let ((f real-function)) >> + (while (and (fboundp f) >> + (symbolp (symbol-function f))) >> + (setq f (symbol-function f))) >> + f)) >> + ((subrp def) (intern (subr-name def))) >> + (t def))) > > Why do we need `subr-name'? Later comes an `fboundp' check which errors when given a subr. (if (and aliased (not (fboundp real-def))) (princ ",\nwhich is not defined. Please make a bug report.") >> @@ -567,14 +577,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) > > Hmm... Why was this move necessary? You'll probably want to add a > comment explaining it. Done so. For the adviced macro thingy, I also had to move the macro clause upwards and add (macrop function) check. Bye, Tassilo --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-05 09:45:15 +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,34 @@ ;;;###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* ((advised-fn (advice--cdr + (advice--symbol-function function)))) + (while (advice--p advised-fn) + (setq advised-fn (advice--cdr advised-fn))) + 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 function. + (and advised (symbolp real-function)))) + (real-def (cond + (aliased (let ((f real-function)) + (while (and (fboundp f) + (symbolp (symbol-function f))) + (setq f (symbol-function f))) + f)) + ((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) @@ -571,14 +576,20 @@ (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")) + ;; Aliases are Lisp functions, so we need to check + ;; aliases before functions. (aliased (format "an alias for `%s'" real-def)) + ((or (eq (car-safe def) 'macro) + ;; For advised macros, def is a lambda + ;; expression or a byte-code-function-p, so we + ;; need to check macros before functions. + (macrop function)) + (concat beg "Lisp macro")) + ((byte-code-function-p def) + (concat beg "compiled Lisp function")) ((eq (car-safe def) 'lambda) (concat beg "Lisp function")) - ((eq (car-safe def) 'macro) - (concat beg "Lisp macro")) ((eq (car-safe def) 'closure) (concat beg "Lisp closure")) ((autoloadp def) --8<---------------cut here---------------end--------------->8--- Bye, Tassilo