quickdocs-parser/src/print.lisp at d6c9f918e0b599b2b1c211932d5e5dfd33a95b8a · quickdocs/quickdocs-parser · GitHub

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
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
;;;; print-object methods for nodes
(in-package :quickdocs-parser)

;;; Common Lisp classes

(defmethod print-object ((operator operator-node) stream)
  "Print an operator node."
  (print-unreadable-object (operator stream)
    (format stream "~A ~A ~A"
            (typecase operator
              (function-node "function")
              (macro-node "macro")
              (generic-function-node "generic function")
              (method-node "method")
              (t "operator"))
            (render-humanize (node-name operator))
            (operator-lambda-list operator))))

(defmethod print-object ((var variable-node) stream)
  "Print a variable node."
  (print-unreadable-object (var stream)
    (format stream "variable ~A" (render-humanize (node-name var)))))

(defmethod print-object ((struct struct-node) stream)
  "Print a struct definition node."
  (print-unreadable-object (struct stream)
    (format stream "struct ~A" (render-humanize (node-name struct)))))

(defmethod print-object ((class class-node) stream)
  "Print a class definition node."
  (print-unreadable-object (class stream)
    (format stream "class ~A" (render-humanize (node-name class)))))

(defmethod print-object ((condition condition-node) stream)
  "Print a condition definition node."
  (print-unreadable-object (condition stream)
    (format stream "condition ~A" (render-humanize (node-name condition)))))

(defmethod print-object ((type type-node) stream)
  "Print a type definition node."
  (print-unreadable-object (type stream)
    (format stream "type ~A" (render-humanize (node-name type)))))

(defmethod print-object ((optima-pattern optima-pattern-node) stream)
  "Print a optima-pattern definition node."
  (print-unreadable-object (optima-pattern stream)
    (format stream "optima-pattern ~A" (render-humanize (node-name optima-pattern)))))

(defmethod print-object ((trivia-pattern trivia-pattern-node) stream)
  "Print a trivia-pattern definition node."
  (print-unreadable-object (trivia-pattern stream)
    (format stream "trivia-pattern ~A" (render-humanize (node-name trivia-pattern)))))

;;; CFFI classes

(defmethod print-object ((function cffi-function) stream)
  "Print a CFFI function node.")

(defmethod print-object ((type cffi-type) stream)
  "Print a CFFI type definition node."
  (print-unreadable-object (type stream)
    (format stream "defctype ~A (~A)"
            (render-humanize (node-name type))
            (prin1-to-string (cffi-type-base-type type)))))

(defmethod print-object ((struct cffi-struct) stream)
  "Print a CFFI struct definition node.")

(defmethod print-object ((union cffi-union) stream)
  "Print a CFFI union definition node.")

(defmethod print-object ((enum cffi-enum) stream)
  "Print a CFFI enum definition node."
  (print-unreadable-object (enum stream)
    (format stream "defcenum ~A (~{~A~#[~:;, ~]~})"
            (render-humanize (node-name enum))
            (cffi-enum-variants enum))))

;;; Dump

(defun dump (index)
  "Print a tree of the contents of an index to the *standard-output*."
  (do-packages (package index)
    (format t "Package ~S" (package-index-name package))
    (let ((docstring (package-index-docstring package)))
      (when docstring
        (format t " with docstring ~S" docstring)))
    (write-char #\Newline)
    (do-nodes (node package)
      (format t "  ~A~%" (prin1-to-string node)))))