From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: David Engster Newsgroups: gmane.emacs.devel Subject: Re: Better help support for EIEIO classes and methods Date: Sun, 10 Feb 2013 16:21:48 +0100 Message-ID: <876220gpo3.fsf@engster.org> References: <877gmpz9mt.fsf@engster.org> <87txprhq5g.fsf@engster.org> <87pq0eh2u0.fsf@engster.org> <87lib1h0t5.fsf@engster.org> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: ger.gmane.org 1360509721 12479 80.91.229.3 (10 Feb 2013 15:22:01 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Sun, 10 Feb 2013 15:22:01 +0000 (UTC) Cc: emacs-devel@gnu.org To: Stefan Monnier Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Sun Feb 10 16:22:23 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 1U4YjW-00076O-OK for ged-emacs-devel@m.gmane.org; Sun, 10 Feb 2013 16:22:23 +0100 Original-Received: from localhost ([::1]:56962 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1U4YjC-0000Cz-4v for ged-emacs-devel@m.gmane.org; Sun, 10 Feb 2013 10:22:02 -0500 Original-Received: from eggs.gnu.org ([208.118.235.92]:50882) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1U4Yj7-0000Cr-1R for emacs-devel@gnu.org; Sun, 10 Feb 2013 10:22:00 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1U4Yj4-0003f8-Dr for emacs-devel@gnu.org; Sun, 10 Feb 2013 10:21:56 -0500 Original-Received: from randomsample.de ([83.169.19.17]:43016) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1U4Yj3-0003er-QF for emacs-devel@gnu.org; Sun, 10 Feb 2013 10:21:54 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=randomsample.de; s=a; h=Content-Type:MIME-Version:Message-ID:Date:References:In-Reply-To:Subject:Cc:To:From; bh=cXwpfCSEasqyvSn6qPHrjUfSY1U7/vY5E8LBtxky9Xs=; b=rdwm49ADHcBf373LYZB76Ta7GIp7yR2YJ10aExQGYK19DNvNuwzMANvY1NRY4H7rEbCAHmdpEGuhH5OAn6eqel0qIT0XjyLxPFxbrf7igDY6bgPlSXmD26DkFElB2klK; Original-Received: from dslc-082-082-169-059.pools.arcor-ip.net ([82.82.169.59] helo=spaten) by randomsample.de with esmtpsa (TLS1.0:DHE_RSA_AES_128_CBC_SHA1:16) (Exim 4.72) (envelope-from ) id 1U4Yiy-0004CW-Rx; Sun, 10 Feb 2013 16:21:51 +0100 In-Reply-To: (Stefan Monnier's message of "Wed, 06 Feb 2013 14:16:24 -0500") User-Agent: Gnus/5.130006 (Ma Gnus v0.6) Emacs/24.2.92 (gnu/linux) Mail-Followup-To: Stefan Monnier , emacs-devel@gnu.org X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6.x X-Received-From: 83.169.19.17 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:156944 Archived-At: --=-=-= Content-Type: text/plain Stefan Monnier writes: >> But there's usually more than one implementation for a method, and the >> link will just point to the one which was first defined. > > Can we hope that the first definition is usually a defgeneric rather > than a defmethod? If not, indeed, it might be better to remove the > link (which you should be able to do from the hook I suggested). defgeneric is seldom used, since just defmethod already implicitly includes it. Attached is a first iteration on how this might work. eieio-opt is in dire need of further cleanup, but first I want to make sure you're OK with the general direction this is taking. This patch only hooks into describe-function for class constructors and methods. The next step would be how to describe plain classes. In CEDET upstream, we hooked into describe-variable through defadvice, but it's not clear to me at all where we could place a hook there... -David --=-=-= Content-Type: text/plain Content-Disposition: inline; filename=eieio-describe-patch.diff === modified file 'lisp/emacs-lisp/eieio-opt.el' --- lisp/emacs-lisp/eieio-opt.el 2013-01-01 09:11:05 +0000 +++ lisp/emacs-lisp/eieio-opt.el 2013-02-10 15:13:43 +0000 @@ -77,101 +77,76 @@ ;;;###autoload(defalias 'describe-class 'eieio-describe-class) ;;;###autoload -(defun eieio-describe-class (class &optional headerfcn) +(defun eieio-describe-class (class) "Describe a CLASS defined by a string or symbol. -If CLASS is actually an object, then also display current values of that object. -Optional HEADERFCN should be called to insert a few bits of info first." - (interactive (list (eieio-read-class "Class: "))) - (with-output-to-temp-buffer (help-buffer) ;"*Help*" - (help-setup-xref (list #'eieio-describe-class class headerfcn) - (called-interactively-p 'interactive)) - - (when headerfcn (funcall headerfcn)) - (prin1 class) - (princ " is a") - (if (class-option class :abstract) - (princ "n abstract")) - (princ " class") - ;; Print file location - (when (get class 'class-location) - (princ " in `") - (princ (file-name-nondirectory (get class 'class-location))) - (princ "'")) - (terpri) - ;; Inheritance tree information - (let ((pl (class-parents class))) - (when pl - (princ " Inherits from ") - (while pl - (princ "`") (prin1 (car pl)) (princ "'") - (setq pl (cdr pl)) - (if pl (princ ", "))) - (terpri))) - (let ((ch (class-children class))) - (when ch - (princ " Children ") - (while ch - (princ "`") (prin1 (car ch)) (princ "'") - (setq ch (cdr ch)) - (if ch (princ ", "))) - (terpri))) - (terpri) - ;; System documentation - (let ((doc (documentation-property class 'variable-documentation))) - (when doc - (princ "Documentation:") - (terpri) - (princ doc) - (terpri) - (terpri))) - ;; Describe all the slots in this class - (eieio-describe-class-slots class) - ;; Describe all the methods specific to this class. - (let ((methods (eieio-all-generic-functions class)) - (doc nil)) - (if (not methods) nil - (princ "Specialized Methods:") - (terpri) - (terpri) - (while methods - (setq doc (eieio-method-documentation (car methods) class)) - (princ "`") - (prin1 (car methods)) - (princ "'") - (if (not doc) - (princ " Undocumented") - (if (car doc) - (progn - (princ " :STATIC ") - (prin1 (car (car doc))) - (terpri) - (princ (cdr (car doc))))) - (setq doc (cdr doc)) - (if (car doc) - (progn - (princ " :BEFORE ") - (prin1 (car (car doc))) - (terpri) - (princ (cdr (car doc))))) - (setq doc (cdr doc)) - (if (car doc) - (progn - (princ " :PRIMARY ") - (prin1 (car (car doc))) - (terpri) - (princ (cdr (car doc))))) - (setq doc (cdr doc)) - (if (car doc) - (progn - (princ " :AFTER ") - (prin1 (car (car doc))) - (terpri) - (princ (cdr (car doc))))) - (terpri) - (terpri)) - (setq methods (cdr methods)))))) - (with-current-buffer (help-buffer) - (buffer-string))) +If CLASS is actually an object, then also display current values of that object." + ;; Header line + (prin1 class) + (insert " is a" + (if (class-option class :abstract) + "n abstract" + "") + " class") + (let ((location (get class 'class-location))) + (when location + (insert " in `") + (help-insert-xref-button + (file-name-nondirectory location) + 'eieio-class-def class location) + (insert "'"))) + (insert ".\n") + ;; Parents + (let ((pl (class-parents class)) + cur) + (when pl + (insert " Inherits from ") + (while (setq cur (pop pl)) + (insert "`") + (help-insert-xref-button (symbol-name cur) + 'help-variable cur) + (insert (if pl "', " "'"))) + (insert ".\n"))) + ;; Children + (let ((ch (class-children class)) + cur) + (when ch + (insert " Children ") + (while (setq cur (pop ch)) + (insert "`") + (help-insert-xref-button (symbol-name cur) + 'help-variable cur) + (insert (if ch "', " "'"))) + (insert ".\n"))) + ;; System documentation + (let ((doc (documentation-property class 'variable-documentation))) + (when doc + (insert "\n" doc "\n\n"))) + ;; Describe all the slots in this class + (eieio-describe-class-slots class) + ;; Describe all the methods specific to this class. + (let ((methods (eieio-all-generic-functions class)) + (type [":STATIC" ":BEFORE" ":PRIMARY" ":AFTER"]) + counter doc) + (when methods + (insert (propertize "Specialized Methods:\n\n" 'face 'bold)) + (while methods + (setq doc (eieio-method-documentation (car methods) class)) + (insert "`") + (help-insert-xref-button (symbol-name (car methods)) + 'help-function (car methods)) + (insert "'") + (if (not doc) + (insert " Undocumented") + (setq counter 0) + (dolist (cur doc) + (when cur + (insert " " (aref type counter) " " + (prin1-to-string (car cur) (current-buffer)) + "\n" + (cdr cur))) + (setq counter (1+ counter)))) + (insert "\n\n") + (setq methods (cdr methods)))))) (defun eieio-describe-class-slots (class) "Describe the slots in CLASS. @@ -185,28 +160,27 @@ (i 0) (prot (aref cv class-protection)) ) - (princ "Instance Allocated Slots:") - (terpri) - (terpri) + (insert (propertize "Instance Allocated Slots:\n\n" + 'face 'bold)) (while names - (if (car prot) (princ "Private ")) - (princ "Slot: ") - (prin1 (car names)) - (when (not (eq (aref types i) t)) - (princ " type = ") - (prin1 (aref types i))) - (unless (eq (car deflt) eieio-unbound) - (princ " default = ") - (prin1 (car deflt))) - (when (car publp) - (princ " printer = ") - (prin1 (car publp))) - (when (car docs) - (terpri) - (princ " ") - (princ (car docs)) - (terpri)) - (terpri) + (insert + (concat + (when (car prot) + (propertize "Private " 'face 'bold)) + (propertize "Slot: " 'face 'bold) + (prin1-to-string (car names)) + (unless (eq (aref types i) t) + (concat " type = " + (prin1-to-string (aref types i)))) + (unless (eq (car deflt) eieio-unbound) + (concat " default = " + (prin1-to-string (car deflt)))) + (when (car publp) + (concat " printer = " + (prin1-to-string (car publp)))) + (when (car docs) + (concat "\n " (car docs) "\n")) + "\n")) (setq names (cdr names) docs (cdr docs) deflt (cdr deflt) @@ -219,61 +193,30 @@ i 0 prot (aref cv class-class-allocation-protection)) (when names - (terpri) - (princ "Class Allocated Slots:")) - (terpri) - (terpri) + (insert (propertize "\nClass Allocated Slots:\n\n" 'face 'bold))) (while names - (when (car prot) - (princ "Private ")) - (princ "Slot: ") - (prin1 (car names)) - (unless (eq (aref types i) t) - (princ " type = ") - (prin1 (aref types i))) - (condition-case nil - (let ((value (eieio-oref class (car names)))) - (princ " value = ") - (prin1 value)) + (insert + (concat + (when (car prot) + "Private ") + "Slot: " + (prin1-to-string (car names)) + (unless (eq (aref types i) t) + (concat " type = " + (prin1-to-string (aref types i)))) + (condition-case nil + (let ((value (eieio-oref class (car names)))) + (concat " value = " + (prin1-to-string value))) (error nil)) - (when (car docs) - (terpri) - (princ " ") - (princ (car docs)) - (terpri)) - (terpri) + (when (car docs) + (concat "\n\n " (car docs) "\n")) + "\n")) (setq names (cdr names) docs (cdr docs) prot (cdr prot) i (1+ i))))) -;;;###autoload -(defun eieio-describe-constructor (fcn) - "Describe the constructor function FCN. -Uses `eieio-describe-class' to describe the class being constructed." - (interactive - ;; Use eieio-read-class since all constructors have the same name as - ;; the class they create. - (list (eieio-read-class "Class: "))) - (eieio-describe-class - fcn (lambda () - ;; Describe the constructor part. - (prin1 fcn) - (princ " is an object constructor function") - ;; Print file location - (when (get fcn 'class-location) - (princ " in `") - (princ (file-name-nondirectory (get fcn 'class-location))) - (princ "'")) - (terpri) - (princ "Creates an object of class ") - (prin1 fcn) - (princ ".") - (terpri) - (terpri) - )) - ) - (defun eieio-build-class-list (class) "Return a list of all classes that inherit from CLASS." (if (class-p class) @@ -330,88 +273,99 @@ ;;;###autoload(defalias 'describe-generic 'eieio-describe-generic) (defalias 'eieio-describe-method 'eieio-describe-generic) -;;;###autoload -(defun eieio-describe-generic (generic) - "Describe the generic function GENERIC. -Also extracts information about all methods specific to this generic." - (interactive (list (eieio-read-generic "Generic Method: "))) - (if (not (generic-p generic)) - (signal 'wrong-type-argument '(generic-p generic))) - (with-output-to-temp-buffer (help-buffer) ; "*Help*" - (help-setup-xref (list #'eieio-describe-generic generic) - (called-interactively-p 'interactive)) - - (prin1 generic) - (princ " is a generic function") - (when (generic-primary-only-p generic) - (princ " with only ") - (when (generic-primary-only-one-p generic) - (princ "one ")) - (princ "primary method") - (when (not (generic-primary-only-one-p generic)) - (princ "s")) - ) - (princ ".") - (terpri) - (terpri) - (let ((d (documentation generic))) - (if (not d) - (princ "The generic is not documented.\n") - (princ "Documentation:") - (terpri) - (princ d) - (terpri) - (terpri))) - (princ "Implementations:") - (terpri) - (terpri) - (let ((i 4) - (prefix [ ":STATIC" ":BEFORE" ":PRIMARY" ":AFTER" ] )) - ;; Loop over fanciful generics - (while (< i 7) - (let ((gm (aref (get generic 'eieio-method-tree) i))) - (when gm - (princ "Generic ") - (princ (aref prefix (- i 3))) - (terpri) - (princ (or (nth 2 gm) "Undocumented")) - (terpri) - (terpri))) - (setq i (1+ i))) - (setq i 0) - ;; Loop over defined class-specific methods - (while (< i 4) - (let ((gm (reverse (aref (get generic 'eieio-method-tree) i))) - location) - (while gm - (princ "`") - (prin1 (car (car gm))) - (princ "'") - ;; prefix type - (princ " ") - (princ (aref prefix i)) - (princ " ") - ;; argument list - (let* ((func (cdr (car gm))) - (arglst (eieio-lambda-arglist func))) - (prin1 arglst)) - (terpri) - ;; 3 because of cdr - (princ (or (documentation (cdr (car gm))) - "Undocumented")) - ;; Print file location if available - (when (and (setq location (get generic 'method-locations)) - (setq location (assoc (caar gm) location))) - (setq location (cadr location)) - (princ "\n\nDefined in `") - (princ (file-name-nondirectory location)) - (princ "'\n")) - (setq gm (cdr gm)) - (terpri) - (terpri))) - (setq i (1+ i))))) - (with-current-buffer (help-buffer) - (buffer-string))) +(define-button-type 'eieio-method-def + :supertype 'help-xref + 'help-function (lambda (class method file) + (eieio-help-find-method-definition class method file)) + 'help-echo (purecopy "mouse-2, RET: find method's definition")) + +(define-button-type 'eieio-class-def + :supertype 'help-xref + 'help-function (lambda (class file) + (eieio-help-find-class-definition class file)) + 'help-echo (purecopy "mouse-2, RET: find class definition")) + +;;;###autoload +(defun eieio-help-constructor (ctr) + "Describe CTR if it is a class constructor." + (when (class-p ctr) + (let ((location (file-name-nondirectory (get ctr 'class-location)))) + (goto-char (point-min)) + (delete-region (point) (point-at-eol)) + (prin1 ctr) + (insert " is an object constructor function in `") + (help-insert-xref-button + location + 'eieio-class-def ctr location) + (insert "'.\nCreates an object of class " (symbol-name ctr) ".") + (goto-char (point-max)) + (save-excursion + (insert (propertize "\n\nClass description:\n" 'face 'bold)) + (eieio-describe-class ctr)) + ))) + + +;;;###autoload +(defun eieio-help-generic (generic) + "Describe GENERIC if it is a generic function." + (when (generic-p generic) + (save-excursion + (goto-char (point-min)) + (when (re-search-forward " in `.+'.$" nil t) + (replace-match "."))) + (save-excursion + (insert "\n\nThis is a generic function" + (cond + ((and (generic-primary-only-p generic) + (generic-primary-only-one-p generic)) + " with only one primary method") + ((generic-primary-only-p generic) + " with only primary methods") + (t "")) + ".\n\n") + (insert (propertize "Implementations:\n\n" 'face 'bold)) + (let ((i 4) + (prefix [ ":STATIC" ":BEFORE" ":PRIMARY" ":AFTER" ] )) + ;; Loop over fanciful generics + (while (< i 7) + (let ((gm (aref (get generic 'eieio-method-tree) i))) + (when gm + (insert "Generic " + (aref prefix (- i 3)) + "\n" + (or (nth 2 gm) "Undocumented") + "\n\n"))) + (setq i (1+ i))) + (setq i 0) + ;; Loop over defined class-specific methods + (while (< i 4) + (let* ((gm (reverse (aref (get generic 'eieio-method-tree) i))) + cname location) + (while gm + (setq cname (caar gm)) + (insert "`") + (help-insert-xref-button (symbol-name cname) + 'help-variable cname) + (insert "' " (aref prefix i) " ") + ;; argument list + (let* ((func (cdr (car gm))) + (arglst (eieio-lambda-arglist func))) + (prin1 arglst (current-buffer))) + (insert "\n" + (or (documentation (cdr (car gm))) + "Undocumented")) + ;; Print file location if available + (when (and (setq location (get generic 'method-locations)) + (setq location (assoc cname location))) + (setq location (cadr location)) + (insert "\n\nDefined in `") + (help-insert-xref-button + (file-name-nondirectory location) + 'eieio-method-def cname generic location) + (insert "'\n")) + (setq gm (cdr gm)) + (insert "\n"))) + (setq i (1+ i))))))) (defun eieio-lambda-arglist (func) "Return the argument list of FUNC, a function body." @@ -585,21 +539,13 @@ ;;; HELP AUGMENTATION ;; -(define-button-type 'eieio-method-def - :supertype 'help-xref - 'help-function (lambda (class method file) - (eieio-help-find-method-definition class method file)) - 'help-echo (purecopy "mouse-2, RET: find method's definition")) - -(define-button-type 'eieio-class-def - :supertype 'help-xref - 'help-function (lambda (class file) - (eieio-help-find-class-definition class file)) - 'help-echo (purecopy "mouse-2, RET: find class definition")) - (defun eieio-help-find-method-definition (class method file) (let ((filename (find-library-name file)) location buf) + (when (symbolp class) + (setq class (symbol-name class))) + (when (symbolp method) + (setq method (symbol-name method))) (when (null filename) (error "Cannot find library %s" file)) (setq buf (find-file-noselect filename)) @@ -623,6 +569,8 @@ (beginning-of-line)))) (defun eieio-help-find-class-definition (class file) + (when (symbolp class) + (setq class (symbol-name class))) (let ((filename (find-library-name file)) location buf) (when (null filename) === modified file 'lisp/emacs-lisp/eieio.el' --- lisp/emacs-lisp/eieio.el 2013-02-02 03:38:21 +0000 +++ lisp/emacs-lisp/eieio.el 2013-02-09 14:11:48 +0000 @@ -3013,6 +3013,10 @@ 'method)) (make-obsolete 'eieio-defgeneric nil "24.1") +;; Hook ourselves into help system for describing classes and methods. +(add-hook 'help-fns-describe-function-functions 'eieio-help-generic) +(add-hook 'help-fns-describe-function-functions 'eieio-help-constructor) + ;;; Interfacing with edebug ;; (defun eieio-edebug-prin1-to-string (object &optional noescape) === modified file 'lisp/help-fns.el' --- lisp/help-fns.el 2013-02-01 15:56:22 +0000 +++ lisp/help-fns.el 2013-02-10 15:13:02 +0000 @@ -32,6 +32,12 @@ ;;; Code: +(defvar help-fns-describe-function-functions nil + "List of functions to run in help buffer in `describe-function'. +Those functions will be run after the header line and argument +list was inserted, and before the documentation will be inserted. +The functions will receive the function name as argument.") + ;; Functions ;;;###autoload @@ -633,7 +639,7 @@ (help-fns--compiler-macro function) (help-fns--parent-mode function) (help-fns--obsolete function) - + (run-hook-with-args 'help-fns-describe-function-functions function) (insert "\n" (or doc "Not documented."))))))) --=-=-=--