diff options
Diffstat (limited to 'lazybones.lisp')
| -rw-r--r-- | lazybones.lisp | 39 |
1 files changed, 39 insertions, 0 deletions
diff --git a/lazybones.lisp b/lazybones.lisp index de2aeba..e23037f 100644 --- a/lazybones.lisp +++ b/lazybones.lisp @@ -402,3 +402,42 @@ making a new one if not." "Remove definition keyed by LINK-TARGET from APP." (remhash name (app-definitions app))) +(defun names-equal-p (s1 s2) + (or (equalp s1 s2) + (and (symbolp s1) (equalp (symbol-name s1) s2)) + (and (symbolp s2) (equalp s1 (symbol-name s2))) + (and (symbolp s1) (symbolp s2) + (string-equal (symbol-name s1) (symbol-name s2))))) + +(defun getplist (indicator plist &key (test 'names-equal-p ) key) + (let ((indicator (if key (funcall key indicator) indicator))) + (loop for (k0 v . more) on plist by #'cddr + for k = (if key (funcall key k0) k0) + when (funcall test indicator k) + return (values v t) + finally (return (values nil least-negative-long-float ))))) + +(defun class-docs (class-name) + (closer-mop:ensure-finalized (find-class class-name)) + (loop for plist in (trivial-documentation:symbol-definitions class-name) + when (eql :class (getf plist :kind)) + return (list (getf plist :documentation) + (getf plist :slots)))) + +(defun add-class-to-definitions (app class-name &rest slot-names) + "Generates a definition entry from class and slot documentation +CLASS-NAME should be a symbol, and SLOT-NAMES symbols." + (destructuring-bind (documentation slots) (class-docs class-name) + (set-definition (string-downcase (symbol-name class-name)) + (string-downcase (format nil "#~a" class-name)) + (with-output-to-string (*standard-output*) + (princ documentation) + (princ #\newline) (princ #\newline) + (princ "**Slots:**") (princ #\newline) + (dolist (sn slot-names) + (a:when-let (slot-doc (getplist sn slots)) + (princ "- ") (princ sn) (princ ": ") + (princ slot-doc) + (princ #\newline))) + (princ #\newline)) + app))) |