| 32 | | (defun write-entry-header (name type &key (write-name-p t)) |
|---|
| 33 | | "Writes the header for a documentation entry of name NAME and |
|---|
| 34 | | type TYPE. The HTML anchor will only get a 'name' attribute if |
|---|
| 35 | | WRITE-NAME-P is true and NAME is not a SETF name." |
|---|
| 36 | | (format t "~%~%<!-- Entry for ~A -->~%~%<p><br>[~A]<br><a class=none~@[ name='~A'~]>" |
|---|
| 37 | | name type (and write-name-p (atom name) (string-downcase name)))) |
|---|
| 38 | | |
|---|
| 39 | | (defun write-entry-footer (name doc-string) |
|---|
| 40 | | "Writes the footer for a documentation entry for the name NAME |
|---|
| 41 | | including the documentation string DOC-STRING." |
|---|
| 42 | | (format t "~%<blockquote><br>~%~%~@[~A~]~%~%</blockquote>~%~%<!-- End of entry for ~A -->~%" |
|---|
| 43 | | (and doc-string (escape-string-iso-8859 doc-string)) name)) |
|---|
| 44 | | |
|---|
| 60 | | (write-entry-header symbol (if (subtypep symbol 'condition) |
|---|
| 61 | | "Condition type" "Standard class")) |
|---|
| 62 | | |
|---|
| 63 | | (format t "<b>~A</b></a>" (string-downcase symbol)) |
|---|
| 64 | | (write-entry-footer symbol doc-string)) |
|---|
| | 46 | (with-html-output (*doc-output* nil :indent 2) |
|---|
| | 47 | (cond ((subtypep symbol 'condition) |
|---|
| | 48 | (htm |
|---|
| | 49 | (:|clix:condition| :name (string-downcase symbol) |
|---|
| | 50 | (:|clix:description| (esc doc-string))))) |
|---|
| | 51 | (t |
|---|
| | 52 | (htm |
|---|
| | 53 | (:|clix:class| :name (string-downcase symbol) |
|---|
| | 54 | (:|clix:description| (esc doc-string)))))))) |
|---|
| 94 | | (cond ((and specializer (not (eq specializer t))) |
|---|
| 95 | | ;; add specializers if there are any left |
|---|
| 96 | | (write-string (escape-string |
|---|
| 97 | | (string-downcase |
|---|
| 98 | | (format nil "(~A ~A)" part specializer))))) |
|---|
| 99 | | (t (write-string (escape-string (string-downcase part))))))))))))) |
|---|
| 100 | | |
|---|
| 101 | | (defun write-lambda-list (lambda-list &key (resultp t) specializers) |
|---|
| | 85 | (write-string (escape-string |
|---|
| | 86 | (string-downcase |
|---|
| | 87 | (cond ((and specializer (not (eq specializer t))) |
|---|
| | 88 | ;; add specializers if there are any left |
|---|
| | 89 | (format nil "(~A ~A)" part specializer)) |
|---|
| | 90 | (t part)))) |
|---|
| | 91 | *doc-output*))))))))) |
|---|
| | 92 | |
|---|
| | 93 | (defun write-lambda-list (lambda-list &key specializers qualifiers (resultp t)) |
|---|
| 142 | | qualifiers))))) |
|---|
| 143 | | (cond (signature-only-p |
|---|
| 144 | | (write-string "<a class=none>")) |
|---|
| 145 | | (t |
|---|
| 146 | | (write-entry-header name (if writer |
|---|
| 147 | | (ecase type |
|---|
| 148 | | (:method "Specialized accessor") |
|---|
| 149 | | (:generic-function "Generic accessor") |
|---|
| 150 | | (:function "Accessor")) |
|---|
| 151 | | (ecase type |
|---|
| 152 | | (:method "Method") |
|---|
| 153 | | (:generic-function "Generic function") |
|---|
| 154 | | (:function "Function"))) |
|---|
| 155 | | :write-name-p (null specializers)))) |
|---|
| 156 | | (cond (setfp |
|---|
| 157 | | (format t "<tt>(setf (</tt><b>~A</b> " (string-downcase symbol)) |
|---|
| 158 | | (write-lambda-list (rest lambda-list) :resultp resultp :specializers (rest specializers)) |
|---|
| 159 | | (write-string "<tt>)</tt> ") |
|---|
| 160 | | ;; we should use the specializer here as well |
|---|
| 161 | | (format t "<i>~A</i>" (string-downcase (first lambda-list))) |
|---|
| 162 | | (write-string "<tt>)</tt></a>") |
|---|
| 163 | | (format t "~(~{<tt> ~S</tt>~^~}~)" qualifiers)) |
|---|
| 164 | | (t (format t "<b>~A</b> " (string-downcase symbol)) |
|---|
| 165 | | (write-lambda-list lambda-list :specializers specializers :resultp resultp) |
|---|
| 166 | | (format t "~(~{<tt> ~S</tt>~^~}~)" qualifiers))) |
|---|
| 167 | | (when writer |
|---|
| 168 | | ;; if this is an accessor, the add the writer immediately after |
|---|
| 169 | | ;; the reader.. |
|---|
| 170 | | (format t "~%<br>") |
|---|
| 171 | | (destructuring-bind (name doc-type lambda-list doc-string &optional specializers qualifiers) |
|---|
| 172 | | writer |
|---|
| 173 | | (declare (ignore doc-type doc-string)) |
|---|
| 174 | | (write-function-entry name lambda-list nil nil |
|---|
| 175 | | :signature-only-p t |
|---|
| 176 | | :specializers specializers |
|---|
| 177 | | :qualifiers qualifiers)) |
|---|
| 178 | | ;; ...and remove it from the list of entries which haven't been |
|---|
| 179 | | ;; written yet |
|---|
| 180 | | (setq other-entries (remove writer other-entries)))) |
|---|
| 181 | | (unless signature-only-p |
|---|
| 182 | | (write-entry-footer name doc-string)) |
|---|
| | 137 | qualifiers))))) |
|---|
| | 138 | (cond |
|---|
| | 139 | (writer |
|---|
| | 140 | (with-html-output (*doc-output* nil :indent 2) |
|---|
| | 141 | (:|clix:accessor| |
|---|
| | 142 | :generic (and genericp "true") |
|---|
| | 143 | :specialized specializers |
|---|
| | 144 | :name (string-downcase symbol) |
|---|
| | 145 | (write-lambda-list lambda-list |
|---|
| | 146 | :specializers specializers |
|---|
| | 147 | :qualifiers qualifiers |
|---|
| | 148 | :resultp resultp) |
|---|
| | 149 | (:|clix:description| (esc doc-string)))) |
|---|
| | 150 | (setq other-entries (remove writer other-entries))) |
|---|
| | 151 | (t |
|---|
| | 152 | (with-html-output (*doc-output* nil :indent 2) |
|---|
| | 153 | (:|clix:accessor| |
|---|
| | 154 | :generic (and genericp "true") |
|---|
| | 155 | :specialized specializers |
|---|
| | 156 | :name (string-downcase symbol) |
|---|
| | 157 | (write-lambda-list lambda-list |
|---|
| | 158 | :specializers (if setfp (rest specializers) specializers) |
|---|
| | 159 | :qualifiers (if setfp (rest qualifiers) qualifiers) |
|---|
| | 160 | :resultp resultp) |
|---|
| | 161 | (:|clix:description| (esc doc-string))))))) |
|---|
| 211 | | (defun write-page-header (package-name subtitle symbols) |
|---|
| 212 | | "Writes the header of the HTML page. Assumes that the library |
|---|
| 213 | | has the same name as the package. Adds a list of all exported |
|---|
| 214 | | symbols with links." |
|---|
| 215 | | (format t "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0 Transitional//EN\"> |
|---|
| 216 | | <html> |
|---|
| 217 | | |
|---|
| 218 | | <head> |
|---|
| 219 | | <meta http-equiv=\"Content-Type\" content=\"text/html; charset=iso-8859-1\"> |
|---|
| 220 | | <title>~A - ~A</title> |
|---|
| 221 | | <style type=\"text/css\"> |
|---|
| 222 | | pre { padding:5px; background-color:#e0e0e0 } |
|---|
| 223 | | h3, h4 { text-decoration: underline; } |
|---|
| 224 | | a { text-decoration: none; padding: 1px 2px 1px 2px; } |
|---|
| 225 | | a:visited { text-decoration: none; padding: 1px 2px 1px 2px; } |
|---|
| 226 | | a:hover { text-decoration: none; padding: 1px 1px 1px 1px; border: 1px solid #000000; } |
|---|
| 227 | | a:focus { text-decoration: none; padding: 1px 2px 1px 2px; border: none; } |
|---|
| 228 | | a.none { text-decoration: none; padding: 0; } |
|---|
| 229 | | a.none:visited { text-decoration: none; padding: 0; } |
|---|
| 230 | | a.none:hover { text-decoration: none; border: none; padding: 0; } |
|---|
| 231 | | a.none:focus { text-decoration: none; border: none; padding: 0; } |
|---|
| 232 | | a.noborder { text-decoration: none; padding: 0; } |
|---|
| 233 | | a.noborder:visited { text-decoration: none; padding: 0; } |
|---|
| 234 | | a.noborder:hover { text-decoration: none; border: none; padding: 0; } |
|---|
| 235 | | a.noborder:focus { text-decoration: none; border: none; padding: 0; } |
|---|
| 236 | | pre.none { padding:5px; background-color:#ffffff } |
|---|
| 237 | | </style> |
|---|
| 238 | | </head> |
|---|
| 239 | | |
|---|
| 240 | | <body bgcolor=white> |
|---|
| 241 | | |
|---|
| 242 | | <h2> ~2:*~A - ~A</h2> |
|---|
| 243 | | |
|---|
| 244 | | <blockquote> |
|---|
| 245 | | <br> <br><h3><a name=abstract class=none>Abstract</a></h3> |
|---|
| 246 | | |
|---|
| 247 | | The code comes with |
|---|
| 248 | | a <a |
|---|
| 249 | | href=\"http://www.opensource.org/licenses/bsd-license.php\">BSD-style |
|---|
| 250 | | license</a> so you can basically do with it whatever you want. |
|---|
| 251 | | |
|---|
| 252 | | <p> |
|---|
| 253 | | <font color=red>Download shortcut:</font> <a href=\"http://weitz.de/files/~A.tar.gz\">http://weitz.de/files/~:*~A.tar.gz</a>. |
|---|
| 254 | | </blockquote> |
|---|
| 255 | | |
|---|
| 256 | | <br> <br><h3><a class=none name=\"contents\">Contents</a></h3> |
|---|
| 257 | | <ol> |
|---|
| 258 | | <li><a href=\"#download\">Download</a> |
|---|
| 259 | | <li><a href=\"#dictionary\">The ~A dictionary</a> |
|---|
| 260 | | <ol> |
|---|
| 261 | | ~{ <li><a href=\"#~A\"><code>~:*~A</code></a> |
|---|
| 262 | | ~} </ol> |
|---|
| 263 | | <li><a href=\"#ack\">Acknowledgements</a> |
|---|
| 264 | | </ol> |
|---|
| 265 | | |
|---|
| 266 | | <br> <br><h3><a class=none name=\"download\">Download</a></h3> |
|---|
| 267 | | |
|---|
| 268 | | ~2:*~A together with this documentation can be downloaded from <a |
|---|
| 269 | | href=\"http://weitz.de/files/~2:*~A.tar.gz\">http://weitz.de/files/~:*~A.tar.gz</a>. The |
|---|
| 270 | | current version is 0.1.0. |
|---|
| 271 | | |
|---|
| 272 | | <br> <br><h3><a class=none name=\"dictionary\">The ~A dictionary</a></h3> |
|---|
| 273 | | |
|---|
| 274 | | " |
|---|
| 275 | | package-name subtitle (string-downcase package-name) |
|---|
| 276 | | package-name symbols)) |
|---|
| 277 | | |
|---|
| 278 | | (defun write-page-footer () |
|---|
| 279 | | "Writes the footer of the HTML page." |
|---|
| 280 | | (write-string " |
|---|
| 281 | | |
|---|
| 282 | | <br> <br><h3><a class=none name=\"ack\">Acknowledgements</a></h3> |
|---|
| 283 | | |
|---|
| 284 | | <p> |
|---|
| 285 | | This documentation was prepared with <a href=\"http://weitz.de/documentation-template/\">DOCUMENTATION-TEMPLATE</a>. |
|---|
| 286 | | </p> |
|---|
| 287 | | <p> |
|---|
| 288 | | $Header: /usr/local/cvsrep/documentation-template/output.lisp,v 1.14 2008/05/29 08:23:37 edi Exp $ |
|---|
| 289 | | <p><a href=\"http://weitz.de/index.html\">BACK TO MY HOMEPAGE</a> |
|---|
| 290 | | |
|---|
| 291 | | </body> |
|---|
| 292 | | </html>")) |
|---|
| 293 | | |
|---|
| 301 | | :filter "*.HTML;*.HTM"))) |
|---|
| 302 | | (subtitle "a cool library") |
|---|
| 303 | | ((:maybe-skip-methods-p *maybe-skip-methods-p*) |
|---|
| 304 | | *maybe-skip-methods-p*) |
|---|
| 305 | | (if-exists :supersede) |
|---|
| 306 | | (if-does-not-exist :create)) |
|---|
| 307 | | "Writes an HTML page with preliminary documentation entries and an |
|---|
| 308 | | index for all exported symbols of the package PACKAGE to the file |
|---|
| 309 | | TARGET. If MAYBE-SKIP-METHODS-P is true, documentation entries for |
|---|
| 310 | | inidividual methods are skipped if the corresponding generic function |
|---|
| 311 | | has a documentation string." |
|---|
| | 194 | :filter "*.XML"))) |
|---|
| | 195 | (subtitle "a cool library") |
|---|
| | 196 | ((:maybe-skip-methods-p *maybe-skip-methods-p*) |
|---|
| | 197 | *maybe-skip-methods-p*) |
|---|
| | 198 | (if-exists :supersede) |
|---|
| | 199 | (if-does-not-exist :create)) |
|---|
| | 200 | "Writes an XML file with documentation entries for all exported |
|---|
| | 201 | symbols of the package PACKAGE to the file TARGET. If |
|---|
| | 202 | MAYBE-SKIP-METHODS-P is true, documentation entries for inidividual |
|---|
| | 203 | methods are skipped if the corresponding generic function has a |
|---|
| | 204 | documentation string." |
|---|
| 314 | | (let (*symbols*) |
|---|
| 315 | | (with-open-file (*standard-output* target |
|---|
| 316 | | :direction :output |
|---|
| 317 | | :if-exists if-exists |
|---|
| 318 | | :if-does-not-exist if-does-not-exist) |
|---|
| 319 | | (let ((body |
|---|
| 320 | | (with-output-to-string (*standard-output*) |
|---|
| 321 | | (let ((entries (collect-all-doc-entries package))) |
|---|
| 322 | | (loop |
|---|
| 323 | | (let ((entry (or (pop entries) (return)))) |
|---|
| 324 | | (setq entries (write-entry entry entries)))))))) |
|---|
| 325 | | (write-page-header (package-name package) subtitle |
|---|
| 326 | | (mapcar #'string-downcase (reverse *symbols*))) |
|---|
| 327 | | (write-string body) |
|---|
| 328 | | (write-page-footer)))) |
|---|
| | 207 | (with-open-file (*doc-output* target |
|---|
| | 208 | :direction :output |
|---|
| | 209 | :if-exists if-exists |
|---|
| | 210 | :if-does-not-exist if-does-not-exist) |
|---|
| | 211 | (setf (html-mode) :xml) |
|---|
| | 212 | (let ((*html-empty-tag-aware-p* nil) |
|---|
| | 213 | (package-name (package-name package))) |
|---|
| | 214 | (with-html-output (*doc-output* *doc-output* :prologue #.+clix-prologue+ :indent 2) |
|---|
| | 215 | (:|clix:documentation| |
|---|
| | 216 | :xmlns "http://www.w3.org/1999/xhtml" |
|---|
| | 217 | :|xmlns:clix| "http://bknr.net/clixdoc" |
|---|
| | 218 | (:|clix:title| |
|---|
| | 219 | (esc package-name) |
|---|
| | 220 | " - " |
|---|
| | 221 | (esc subtitle)) |
|---|
| | 222 | (:|clix:short-description| |
|---|
| | 223 | (esc subtitle)) |
|---|
| | 224 | (:h2 |
|---|
| | 225 | (esc package-name) |
|---|
| | 226 | " - " |
|---|
| | 227 | (esc subtitle)) |
|---|
| | 228 | (:blockquote |
|---|
| | 229 | (:|clix:chapter| :name "abstract" :title "Abstract") |
|---|
| | 230 | (:p |
|---|
| | 231 | "The code comes with a " |
|---|
| | 232 | (:a :href "http://www.opensource.org/licenses/bsd-license.php" "BSD-style license") |
|---|
| | 233 | " so you can basically do with it whatever you want.") |
|---|
| | 234 | (:p |
|---|
| | 235 | (:font :color "red" "Download shortcut:") |
|---|
| | 236 | (:a :href (format nil "http://weitz.de/files/~(~A~).tar.gz" package-name) |
|---|
| | 237 | (fmt "http://weitz.de/files/~(~A~).tar.gz" package-name)) |
|---|
| | 238 | ".")) |
|---|
| | 239 | (:|clix:chapter| :name "contents" :title "Contents") |
|---|
| | 240 | (:|clix:contents|) |
|---|
| | 241 | (:|clix:chapter| :name "dict" :title (format nil "The ~A dictionary" package-name) |
|---|
| | 242 | (let ((entries (collect-all-doc-entries package))) |
|---|
| | 243 | (loop |
|---|
| | 244 | (let ((entry (or (pop entries) (return)))) |
|---|
| | 245 | (setq entries (write-entry entry entries)))))) |
|---|
| | 246 | (:|clix:chapter| :name "index" :title "Symbol index" |
|---|
| | 247 | "Here are all exported symbols of the " |
|---|
| | 248 | (:code (str package-name)) |
|---|
| | 249 | " package in alphabetical order linked to their |
|---|
| | 250 | corresponding documentation entries:" |
|---|
| | 251 | (:|clix:index|)) |
|---|
| | 252 | (:|clix:chapter| :name "ack" :title "Ackknowledgements" |
|---|
| | 253 | (:p |
|---|
| | 254 | "This documentation was prepared with " |
|---|
| | 255 | (:a :href "http://weitz.de/documentation-template/" "DOCUMENTATION-TEMPLATE"))) |
|---|
| | 256 | (:p "$Header: /usr/local/cvsrep/documentation-template/output.lisp,v 1.16 2008/06/01 21:26:20 edi Exp $") |
|---|
| | 257 | (:p (:a :href "http://weitz.de/index.html" "BACK TO MY HOMEPAGE")))))) |
|---|