/
class.lisp
65 lines (55 loc) · 2.62 KB
/
class.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
(uiop:define-package #:40ants-doc/locatives/class
(:use #:cl)
(:import-from #:40ants-doc/locatives/base
#:locate-error
#:locate-object
#:define-locative-type)
(:import-from #:40ants-doc/render/args)
(:import-from #:40ants-doc/reference-api
#:canonical-reference)
(:import-from #:40ants-doc/args)
(:import-from #:40ants-doc/reference)
(:import-from #:40ants-doc/builder/vars)
(:import-from #:40ants-doc/utils)
(:import-from #:40ants-doc/page)
(:import-from #:40ants-doc/commondoc/bullet)
(:import-from #:40ants-doc/commondoc/arglist)
(:import-from #:40ants-doc/docstring)
(:import-from #:40ants-doc/commondoc/markdown))
(in-package 40ants-doc/locatives/class)
(define-locative-type class ())
(define-locative-type condition ())
(defmethod locate-object (symbol (locative-type (eql 'class)) locative-args)
(declare (ignore locative-args))
(or (find-class symbol :errorp nil)
(locate-error)))
(defmethod locate-object (symbol (locative-type (eql 'condition))
locative-args)
(assert (= 0 (length locative-args)))
(let ((class (find-class symbol :errorp nil)))
(unless (subtypep class 'condition)
(locate-error))
class))
(defmethod canonical-reference ((class class))
(if (subtypep class 'condition)
(40ants-doc/reference:make-reference (class-name class) 'condition)
(40ants-doc/reference:make-reference (class-name class) 'class)))
(defmethod 40ants-doc/commondoc/builder:to-commondoc ((class class))
(let* ((conditionp (subtypep class 'condition))
(symbol (class-name class))
(superclasses
(remove-if (lambda (name)
(or (eq name 'standard-object)
(and conditionp (eq name 'condition))))
(mapcar #'class-name
(swank-mop:class-direct-superclasses class))))
(docstring (40ants-doc/docstring:get-docstring class t))
(children (when docstring
(40ants-doc/commondoc/markdown:parse-markdown docstring))))
(40ants-doc/commondoc/bullet:make-bullet (canonical-reference class)
;; TODO: transform superclasses to XREFs
:arglist (40ants-doc/commondoc/arglist::make-arglist superclasses)
:children children
:ignore-words symbol)))
(defun find-known-reference (reference)
(find reference 40ants-doc/reference::*references* :test #'40ants-doc/reference::reference=))