Rewrite EIEIO help functions and hook them into help system.
* help-fns.el (help-fns-describe-function-functions): New variable to call functions for augmenting help buffers. (describe-function-1): Remove explicit calls to `help-fns--compiler-macro', `help-fns--parent-mode' and `help-fns--obsolete'. Put them in above new variable instead, and call them through `run-hook-with-args'. * emacs-lisp/eieio-opt.el (eieio-help-class): Rename from `eieio-describe-class'. Not meant for interactive use anymore, but to augment existing help buffers. Remove optional second argument. Create proper button for file location. Rewrite function to use `insert' instead of `princ' and `prin1' where possible. (eieio-help-class-slots): Rename from `eieio-describe-class-slots'. (eieio-method-def, eieio-class-def): Move further up. (describe-method, describe-generic, eieio-describe-method): Remove aliases. (eieio-help-constructor, eieio-help-generic): Rename from `eieio-describe-constructor' and `eieio-describe-generic', resp. Rewrite to use `insert' in the current buffer and use proper help buttons. (eieio-help-find-method-definition) (eieio-help-find-class-definition): Also accept symbols as arguments. (eieio-help-mode-augmentation-maybee): Remove. (eieio-describe-class-sb): Use `describe-function'. * emacs-lisp/eieio.el (help-fns-describe-function-functions): Add `eieio-help-generic' and `eieio-help-constructor'.
This commit is contained in:
David Engster
parent
abb82152dc
commit
0f918d96d7
3 changed files with 248 additions and 332 deletions
|
|
@ -1,11 +1,32 @@
|
|||
2014-01-07 David Engster <deng@randomsample.de>
|
||||
2014-01-08 David Engster <deng@randomsample.de>
|
||||
|
||||
* help-fns.el (help-fns-describe-function-functions): New
|
||||
variable to call functions for augmenting help buffers.
|
||||
(describe-function-1): Remove explicit calls to
|
||||
`help-fns--compiler-macro', `help-fns--parent-mode' and
|
||||
`help-fns--obsolete'. Put them in above new variable instead.
|
||||
Call all of them through `run-hook-with-args'.
|
||||
`help-fns--obsolete'. Put them in above new variable instead, and
|
||||
call them through `run-hook-with-args'.
|
||||
* emacs-lisp/eieio-opt.el (eieio-help-class): Rename from
|
||||
`eieio-describe-class'. Not meant for interactive use anymore,
|
||||
but to augment existing help buffers. Remove optional second
|
||||
argument. Create proper button for file location. Rewrite
|
||||
function to use `insert' instead of `princ' and `prin1' where
|
||||
possible.
|
||||
(eieio-help-class-slots): Rename from `eieio-describe-class-slots'.
|
||||
(eieio-method-def, eieio-class-def): Move further up.
|
||||
(describe-method, describe-generic, eieio-describe-method): Remove
|
||||
aliases.
|
||||
(eieio-help-constructor, eieio-help-generic): Rename from
|
||||
`eieio-describe-constructor' and `eieio-describe-generic', resp.
|
||||
Rewrite to use `insert' in the current buffer and use proper help
|
||||
buttons.
|
||||
(eieio-help-find-method-definition)
|
||||
(eieio-help-find-class-definition): Also accept symbols as
|
||||
arguments.
|
||||
(eieio-help-mode-augmentation-maybee): Remove.
|
||||
(eieio-describe-class-sb): Use `describe-function'.
|
||||
* emacs-lisp/eieio.el (help-fns-describe-function-functions): Add
|
||||
`eieio-help-generic' and `eieio-help-constructor'.
|
||||
|
||||
2014-01-07 Martin Rudalics <rudalics@gmx.at>
|
||||
|
||||
|
|
|
|||
|
|
@ -74,108 +74,81 @@ Argument CH-PREFIX is another character prefix to display."
|
|||
|
||||
;;; CLASS COMPLETION / DOCUMENTATION
|
||||
|
||||
;;;###autoload(defalias 'describe-class 'eieio-describe-class)
|
||||
|
||||
;;;###autoload
|
||||
(defun eieio-describe-class (class &optional headerfcn)
|
||||
"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))
|
||||
(defun eieio-help-class (class)
|
||||
"Print help description for CLASS.
|
||||
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-help-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))))))
|
||||
|
||||
(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)))
|
||||
|
||||
(defun eieio-describe-class-slots (class)
|
||||
"Describe the slots in CLASS.
|
||||
Outputs to the standard output."
|
||||
(defun eieio-help-class-slots (class)
|
||||
"Print help description for the slots in CLASS.
|
||||
Outputs to the current buffer."
|
||||
(let* ((cv (class-v class))
|
||||
(docs (eieio--class-public-doc cv))
|
||||
(names (eieio--class-public-a cv))
|
||||
|
|
@ -185,28 +158,27 @@ Outputs to the standard output."
|
|||
(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 +191,30 @@ Outputs to the standard output."
|
|||
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)
|
||||
|
|
@ -326,91 +267,112 @@ are not abstract."
|
|||
|
||||
;;; METHOD COMPLETION / DOC
|
||||
|
||||
(defalias 'describe-method 'eieio-describe-generic)
|
||||
;;;###autoload(defalias 'describe-generic 'eieio-describe-generic)
|
||||
(defalias 'eieio-describe-method 'eieio-describe-generic)
|
||||
(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-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))
|
||||
(defun eieio-help-constructor (ctr)
|
||||
"Describe CTR if it is a class constructor."
|
||||
(when (class-p ctr)
|
||||
(erase-buffer)
|
||||
(let ((location (get ctr 'class-location))
|
||||
(def (symbol-function ctr)))
|
||||
(goto-char (point-min))
|
||||
(prin1 ctr)
|
||||
(insert (format " is an %s object constructor function"
|
||||
(if (autoloadp def)
|
||||
"autoloaded"
|
||||
"")))
|
||||
(when (and (autoloadp def)
|
||||
(null location))
|
||||
(setq location
|
||||
(find-lisp-object-file-name ctr def)))
|
||||
(when location
|
||||
(insert " in `")
|
||||
(help-insert-xref-button
|
||||
(file-name-nondirectory location)
|
||||
'eieio-class-def ctr location)
|
||||
(insert "'"))
|
||||
(insert ".\nCreates an object of class " (symbol-name ctr) ".")
|
||||
(goto-char (point-max))
|
||||
(if (autoloadp def)
|
||||
(insert "\n\n[Class description not available until class definition is loaded.]\n")
|
||||
(save-excursion
|
||||
(insert (propertize "\n\nClass description:\n" 'face 'bold))
|
||||
(eieio-help-class ctr))
|
||||
))))
|
||||
|
||||
(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)))
|
||||
|
||||
;;;###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 +546,13 @@ Optional argument HISTORYVAR is the variable to use as history."
|
|||
|
||||
;;; 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 +576,8 @@ Optional argument HISTORYVAR is the variable to use as history."
|
|||
(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)
|
||||
|
|
@ -642,71 +598,6 @@ Optional argument HISTORYVAR is the variable to use as history."
|
|||
(recenter)
|
||||
(beginning-of-line))))
|
||||
|
||||
|
||||
(defun eieio-help-mode-augmentation-maybee (&rest unused)
|
||||
"For buffers thrown into help mode, augment for EIEIO.
|
||||
Arguments UNUSED are not used."
|
||||
;; Scan created buttons so far if we are in help mode.
|
||||
(when (eq major-mode 'help-mode)
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(let ((pos t) (inhibit-read-only t))
|
||||
(while pos
|
||||
(if (get-text-property (point) 'help-xref) ; move off reference
|
||||
(goto-char
|
||||
(or (next-single-property-change (point) 'help-xref)
|
||||
(point))))
|
||||
(setq pos (next-single-property-change (point) 'help-xref))
|
||||
(when pos
|
||||
(goto-char pos)
|
||||
(let* ((help-data (get-text-property (point) 'help-xref))
|
||||
;(method (car help-data))
|
||||
(args (cdr help-data)))
|
||||
(when (symbolp (car args))
|
||||
(cond ((class-p (car args))
|
||||
(setcar help-data 'eieio-describe-class))
|
||||
((generic-p (car args))
|
||||
(setcar help-data 'eieio-describe-generic))
|
||||
(t nil))
|
||||
))))
|
||||
;; start back at the beginning, and highlight some sections
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward "^\\(Documentation\\|Implementations\\):$" nil t)
|
||||
(put-text-property (match-beginning 0) (match-end 0) 'face 'bold))
|
||||
(goto-char (point-min))
|
||||
(if (re-search-forward "^Specialized Methods:$" nil t)
|
||||
(put-text-property (match-beginning 0) (match-end 0) 'face 'bold))
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward "^\\(Instance\\|Class\\) Allocated Slots:$" nil t)
|
||||
(put-text-property (match-beginning 0) (match-end 0) 'face 'bold))
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward ":\\(STATIC\\|BEFORE\\|AFTER\\|PRIMARY\\)" nil t)
|
||||
(put-text-property (match-beginning 0) (match-end 0) 'face 'bold))
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward "^\\(Private \\)?Slot:" nil t)
|
||||
(put-text-property (match-beginning 0) (match-end 0) 'face 'bold))
|
||||
(goto-char (point-min))
|
||||
(cond
|
||||
((looking-at "\\(.+\\) is a generic function")
|
||||
(let ((mname (match-string 1))
|
||||
cname)
|
||||
(while (re-search-forward "^`\\(.+\\)'[^\0]+?Defined in `\\(.+\\)'" nil t)
|
||||
(setq cname (match-string-no-properties 1))
|
||||
(help-xref-button 2 'eieio-method-def cname
|
||||
mname
|
||||
(cadr (assoc (intern cname)
|
||||
(get (intern mname)
|
||||
'method-locations)))))))
|
||||
((looking-at "\\(.+\\) is an object constructor function in `\\(.+\\)'")
|
||||
(let ((cname (match-string-no-properties 1)))
|
||||
(help-xref-button 2 'eieio-class-def cname
|
||||
(get (intern cname) 'class-location))))
|
||||
((looking-at "\\(.+\\) is a\\(n abstract\\)? class in `\\(.+\\)'")
|
||||
(let ((cname (match-string-no-properties 1)))
|
||||
(help-xref-button 3 'eieio-class-def cname
|
||||
(get (intern cname) 'class-location)))))
|
||||
))))
|
||||
|
||||
;;; SPEEDBAR SUPPORT
|
||||
;;
|
||||
|
||||
|
|
@ -796,7 +687,7 @@ Argument INDENT is the depth of indentation."
|
|||
"Describe the class TEXT in TOKEN.
|
||||
INDENT is the current indentation level."
|
||||
(dframe-with-attached-buffer
|
||||
(eieio-describe-class token))
|
||||
(describe-function token))
|
||||
(dframe-maybee-jump-to-attached-frame))
|
||||
|
||||
(provide 'eieio-opt)
|
||||
|
|
|
|||
|
|
@ -865,6 +865,10 @@ This may create or delete slots, but does not affect the return value
|
|||
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)
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue