variable-documentation.lisp 5.27 KB
Newer Older
1
;;
2
;; Copyright 2002-2011 Genworks International 
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
;;
;; This source file is part of the General-purpose Declarative
;; Language project (GDL).
;;
;; This source file contains free software: you can redistribute it
;; and/or modify it under the terms of the GNU Affero General Public
;; License as published by the Free Software Foundation, either
;; version 3 of the License, or (at your option) any later version.
;; 
;; This source file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; Affero General Public License for more details.
;; 
;; You should have received a copy of the GNU Affero General Public
;; License along with this source file.  If not, see
;; <http://www.gnu.org/licenses/>.
;;

(in-package :yadd)

(define-object variable-doc (doc-links-mixin)


  :computed-slots
  ((heading "Variables and Constants")
   (part-type 'variable-dokumentation)
   (symbols (remove-duplicates
             (let (result (package-object (the :package-object)))
               (do-symbols (symbol (the :package)
                             (sort (nreverse result) #'string< :key #'symbol-name))
                 (when (and (eql (symbol-package symbol) package-object)
Dave Cooper's avatar
Dave Cooper committed
35
			    (glisp:variable-documentation symbol))
36
37
38
39
40
41
42
43
44
45
46
47
48
                   (push symbol result))))))
   (symbols-external (remove-duplicates
                      (let (result (package-object (the :package-object)))
                        (do-external-symbols (symbol
                                                 (the :package)
                                               (sort

                                                (nreverse result)
                                                #'string<

                                                :key
                                                #'symbol-name))
                          (when (and (eql (symbol-package symbol) package-object)
Dave Cooper's avatar
Dave Cooper committed
49
				     (glisp:variable-documentation symbol))
50
51
52
53
54
55
56
57
58
59
60
61
62
                            (push symbol result))))))))


(define-object variable-dokumentation (doc-string-parser-mixin
                                       remark-writers-mixin base-yadd-sheet)

  :input-slots
  (
   ;;symbol 
   
   (show-package? nil))

  :computed-slots
Dave Cooper's avatar
Dave Cooper committed
63
  ((remark-string (glisp:variable-documentation (the symbol))))
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
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128

  :functions
  ((write-html-sheet
    nil
    (html (:html
           (:head
            (the default-header-content)
            (:title (:princ (format nil "Documentation for ~s" (the :symbol)))))
           (:body (when *developing?* (html (:p (the (write-development-links)))))
                  (:p (when (the :return-object) (the (:write-back-link :display-string "&lt;-Back"))))
                  (:h2
                   (:princ
                    (format nil "~a: ~:(~s~)"
                            (if (constantp (the symbol)) "Constant" "Parameter")
                            (the :symbol))))
                  (:p
                   ((:table :width "100%" :border 0 :cellpadding 1 :cellspacing 0)
                    (the (:write-row))))
                  (let ((new-list (copy-list (the :section-plist))))
                    (remf new-list :type)
                    (remf new-list :value-default)
                    (remf new-list :intro)
                    (mapcar #'(lambda (key value)
                                (html (:dt
                                       (:i
                                        (:princ
                                         (string-capitalize
                                          (case key
                                            (:&optional "Optional Arguments")
                                            (:&key "Keyword Arguments")
                                            (otherwise key))))
                                        ":"))
                                      (:dd
                                       (case key
                                         (:arguments (the (:write-arguments value)))
                                         ((:&optional :&key)
                                          (the (:write-optional-arguments value)))
                                         (otherwise (html (:princ value)))))))
                            (plist-keys new-list) (plist-values new-list)))
                  (:p (when (the :return-object) (the (:write-back-link :display-string "&lt;-Back"))))
                  (:p (the :write-footer))))))

   (write-row
    nil
    (html (:tr
           ((:td :align :left)
            (:b (:princ (format nil "~a" (the :symbol))))
            (when (getf (the :section-plist) :type)
              (html " "
                    (:i
                     (the (:write-type (getf (the :section-plist) :type)
                                       :show-supported-flag? nil)))))
            (when (getf (the :section-plist) :value-default)
              (html ", " "Default Value: "
                    (:tt
                     (:princ
                      (read-from-string
                       (getf (the :section-plist) :value-default))))))))
          (:tr ((:td :align :left) (:princ (getf (the :section-plist) :intro))))))))