function-documentation.lisp 4.38 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 35
;;
;; 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 function-doc (doc-links-mixin)


  :input-slots
  (package
   return-object)

  :computed-slots
  ((heading "Function and Macro Definitions")
   (part-type 'function-dokumentation)
   (symbols (remove-duplicates
             (let (result (package-object (the :package-object)))
36
               (do-symbols (sym (the :package)
37
                             (sort (nreverse result) #'string< :key #'symbol-name))
38 39 40
                 (when (and (eql (symbol-package sym) package-object)
			    (glisp:function-documentation sym))
                   (push sym result))))))
41 42
   (symbols-external (remove-duplicates
                      (let (result (package-object (the :package-object)))
43
                        (do-external-symbols (sym
44 45 46 47 48 49 50 51
                                                 (the :package)
                                               (sort

                                                (nreverse result)
                                                #'string<

                                                :key
                                                #'symbol-name))
52 53 54
                          (when (and (eql (symbol-package sym) package-object)
				     (glisp:function-documentation sym))
                            (push sym result))))))))
55 56 57 58 59 60 61 62 63 64 65 66 67


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

  :input-slots
  (return-object
   symbol
   (show-package? nil))

  :computed-slots
  ((strings-for-display (format nil "~a" (the symbol)))
68
   (doc-string (glisp:function-documentation (the symbol)))
Dave Cooper's avatar
Dave Cooper committed
69
   (macro? (macro-function (the symbol))))
70 71 72 73 74 75 76 77 78 79

  :functions
  ((write-html-sheet
    nil
    (html (:html
           (:head
            (the default-header-content)
            (:title
             (:princ
              (format nil "~a: ~s" (if (the macro?) "Macro" "Function")
80
                      (the symbol)))))
81
           (:body (when *developing?* (html (:p (the (write-development-links)))))
82
                  ;;(when *adsense?* (html (:p (:princ *adsense-code*))))
83 84 85 86
                  (:p (when (the :return-object) (the (:write-back-link :display-string "&lt;-Back"))))
                  (:h2
                   (:princ
                    (format nil "~a: ~:(~s~)" (if (the macro?) "Macro" "Function")
87
                            (the symbol))))
88 89 90 91 92 93 94 95 96 97
                  (:p
                   ((:table :width "100%" :border 0 :cellpadding 1 :cellspacing 0)
                    (the (:write-row :show-package? (the :show-package?)))))
                  (:p (when (the :return-object) (the (:write-back-link :display-string "&lt;-Back"))))
                  (:p (the :write-footer))))))

   (write-row
    (&key show-package?)
    (html (:tr
           ((:td :align :left)
98
            (:b (:princ (format nil "~a" (the symbol))))
99 100 101 102 103 104 105 106 107
            (when (getf (the :section-plist) :type)
              (html " "
                    (:i
                     (the (:write-type (getf (the :section-plist) :type)
                                       :show-supported-flag? nil))))))
           ((:td :align :right) :br))
          (:tr
           ((:td :colspan 2)
            (the (:write-remark-body (the :section-plist) :show-package
108
                                     (when show-package? (symbol-package (the symbol)))))))
109 110 111 112 113 114 115 116 117 118 119 120
          (:tr ((:td :colspan 2) :br))))

   (remark-string
    nil
    (the :doc-string))))