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: Feature freeze Date: Mon, 06 Jan 2014 22:47:54 +0100 Message-ID: <87eh4kzss5.fsf@engster.org> References: <87d2kmuyxg.fsf@engster.org> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: ger.gmane.org 1389044901 6872 80.91.229.3 (6 Jan 2014 21:48:21 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Mon, 6 Jan 2014 21:48:21 +0000 (UTC) Cc: emacs-devel@gnu.org To: Stefan Monnier Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Mon Jan 06 22:48:27 2014 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 1W0I26-00061m-KG for ged-emacs-devel@m.gmane.org; Mon, 06 Jan 2014 22:48:26 +0100 Original-Received: from localhost ([::1]:37718 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1W0I26-00043F-AC for ged-emacs-devel@m.gmane.org; Mon, 06 Jan 2014 16:48:26 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:48729) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1W0I1x-00041k-6t for emacs-devel@gnu.org; Mon, 06 Jan 2014 16:48:23 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1W0I1r-0004r3-4j for emacs-devel@gnu.org; Mon, 06 Jan 2014 16:48:17 -0500 Original-Received: from randomsample.de ([5.45.97.173]:59373) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1W0I1q-0004pM-Iu for emacs-devel@gnu.org; Mon, 06 Jan 2014 16:48:11 -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=dbKvQJeRLWvnBJ4g3/m02uqYkCHYC8Yi+KPZaXNYbK0=; b=nMAzqPu8V08U0/NNRdDjDg3DdcIiZd2N94aTSSQU2QjNt+6gsy61eARMYev8M28u9Fjxmm6IkD4jU+mMQXSm2xBEgcT61UZOi5Pd4kfqHXtnXyE+wQfsRVvLiXI4bWjO; Original-Received: from dslc-082-083-045-175.pools.arcor-ip.net ([82.83.45.175] helo=spaten) by randomsample.de with esmtpsa (TLS1.2:DHE_RSA_AES_128_CBC_SHA1:128) (Exim 4.80) (envelope-from ) id 1W0I1f-00029Z-Km; Mon, 06 Jan 2014 22:48:02 +0100 In-Reply-To: (Stefan Monnier's message of "Tue, 24 Dec 2013 10:18:42 -0500") User-Agent: Gnus/5.130008 (Ma Gnus v0.8) Emacs/24.3 (gnu/linux) Mail-Followup-To: Stefan Monnier , emacs-devel@gnu.org X-detected-operating-system: by eggs.gnu.org: GNU/Linux 3.x X-Received-From: 5.45.97.173 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:167529 Archived-At: --=-=-= Content-Type: text/plain Stefan Monnier writes: >> I got sidetracked at that time, but I'm currently working it. The >> essential functionality won't change, though: the main work is done in >> eieio.el and eieio-opt.el. The only things that get's added to >> help-fns.el is the new `help-fns-describe-function-functions' hook. >> Would it be OK to apply it in the coming days? > > I remember discussions around that, yes. Send us the patch and we'll > see if that can be installed. Much to my surprise I didn't get much done over the holidays, but anyway, here it is. The patch looks large, but as you can see, most of the stuff is just for displaying the class/constructor/slot descriptions. The real core of the patch is, as I've written above, the new hook in help-fns.el. Is it OK to install, or will it have to wait? -David --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=eieio-help-fns-patch.diff === modified file 'lisp/emacs-lisp/eieio-opt.el' --- lisp/emacs-lisp/eieio-opt.el 2014-01-01 07:43:34 +0000 +++ lisp/emacs-lisp/eieio-opt.el 2014-01-06 21:32:16 +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 (eieio-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 (eieio-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 (eieio-class-parents class)) + cur) + (when pl + (insert " Inherits from ") + (while (setq cur (pop pl)) + (insert "`") + (help-insert-xref-button (symbol-name cur) + 'help-function cur) + (insert (if pl "', " "'"))) + (insert ".\n"))) + ;; Children + (let ((ch (eieio-class-children class)) + cur) + (when ch + (insert " Children ") + (while (setq cur (pop ch)) + (insert "`") + (help-insert-xref-button (symbol-name cur) + 'help-function 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 argshl dochl) + (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 (eieio--class-protection cv)) ) - (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 (eieio--class-class-allocation-protection cv)) (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,87 +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: "))) - (eieio--check-type 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 (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 + (file-name-nondirectory 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." @@ -584,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)) @@ -622,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 2014-01-01 07:43:34 +0000 +++ lisp/emacs-lisp/eieio.el 2014-01-04 09:04:08 +0000 @@ -865,6 +865,10 @@ of `eq'." (error "EIEIO: `change-class' is unimplemented")) +;; 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 2014-01-01 07:43:34 +0000 +++ lisp/help-fns.el 2014-01-04 09:04:08 +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 @@ -653,7 +659,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."))))))) --=-=-=--