mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-15 13:52:16 -08:00
Code Issues Projects Releases Packages Wiki Activity

SETF-functions' documentation are now stored with 'SETF-DOCUMENTATION key.

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2010-02-23 17:11:23 +01:00
parent 716e4fd23d
commit b1b20895e3
2 changed files with 15 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

6
src/clos/inspect.lsp
View file

@ -409,13 +409,11 @@ q (or Q): quits the inspection.~%~
(setf (documentation (class-name object) 'structure) new-value)))
(defmethod documentation ((object list) doc-type)
(when (and (si::valid-function-name-p object)
(member doc-type '(function compiler-macro)))
(when (member doc-type '(function compiler-macro))
(si::get-documentation object doc-type)))
(defmethod (setf documentation) (new-value (object list) doc-type)
(when (and (si::valid-function-name-p object)
(member doc-type '(function compiler-macro)))
(when (member doc-type '(function compiler-macro))
(si::set-documentation object doc-type new-value)))
(defmethod documentation ((object standard-generic-function) doc-type)

18
src/lsp/helpfile.lsp
View file

@ -182,14 +182,21 @@ the help file."
(when (functionp object)
(when (null (setq object (compiled-function-name object)))
(return-from get-documentation nil)))
(get-annotation object 'documentation doc-type))
(if (and object (listp object) (si::valid-function-name-p object))
(get-annotation (second object) 'setf-documentation doc-type)
(get-annotation object 'documentation doc-type)))
(defun set-documentation (object doc-type string)
(when (not (or (stringp string) (null string)))
(error "~S is not a valid documentation string" string))
(if string
(annotate object 'documentation doc-type string)
(remove-annotation object 'documentation doc-type))
(when (consp object)
(print (list object doc-type string)))
(let ((key 'documentation))
(when (and object (listp object) (si::valid-function-name-p object))
(setq object (second object) key 'setf-documentation))
(if string
(annotate object key doc-type string)
(remove-annotation object key doc-type)))
string)
(defun expand-set-documentation (symbol doc-type string)
@ -226,7 +233,8 @@ strings."
(let* ((kind (first definition))
(name (second definition)))
;(print (list name kind source-location))
(annotate name 'location kind source-location)
(when (not (member kind '(defmethod)))
(annotate name 'location kind source-location))
(when (member kind '(defun defmacro defgeneric))
(annotate name 'arglist nil (third definition))))
output-form))