util/newlispdoc

   1 #!/usr/bin/newlisp
   2
   3 # newlispdoc - generates html documentation from newLISP source files
   4
   5 # Copyright (C) 1992-2007 Lutz Mueller <lutz@nuevatec.com>
   6
   7 # This program is free software; you can redistribute it and/or modify
   8 # it under the terms of the GNU General Public License version 2, 1991,
   9 # as published by the Free Software Foundation.
  10
  11 # This program is distributed in the hope that it will be useful,
  12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 # GNU General Public License for more details.
  15
  16 # You should have received a copy of the GNU General Public License
  17 # along with this program; if not, write to the Free Software
  18 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  19
  20 ;; @module newlispdoc
  21 ;; @description Generates documentation and hightligted source from newLISP source files.
  22 ;; @version 1.3 - handle remote files specified in URLs in a url-file
  23 ;; @version 1.4 - title on page changed to index or module name and new index module option
  24 ;; @version 1.5 - removed font restrictions on h1,h2,h3,h4 and added hr as a legal tag
  25 ;; @author Lutz Mueller, 2006, 2007
  26 ;; @location http://newlisp.org
  27 ;;
  28 ;; <h3>Usage:</h3>
  29 ;; The <tt>-s</tt> switch can be used to generate highlighted source files.
  30 ;; <pre>
  31 ;;    newlispdoc afile.lsp bfile.lsp
  32 ;;    newlispdoc -s afile.lsp bfile.lsp
  33 ;;    newlispdoc -s *.lsp
  34 ;;
  35 ;;    ; or on Win32
  36 ;;    newlisp newlispdoc afile.lsp bfile.lsp
  37 ;;    newlisp newlispdoc -s afile.lsp bfile.lsp
  38 ;;    newlisp newlispdoc -s *.lsp
  39 ;; </pre>
  40 ;; newlispdoc can take a file of URLs and generate documentation and syntax
  41 ;; highlighted source from remote files:
  42 ;; <pre>
  43 ;;    newlispdoc -url file-with-urls.txt 10000
  44 ;;    newlispdoc -s -url file-with-urls.txt 10000
  45 ;;
  46 ;;    ; or on Win32
  47 ;;    newlisp newlispdoc -url file-with-urls.txt 10000
  48 ;;    newlisp newlispdoc -s -url file-with-urls.txt 10000
  49 ;; </pre>
  50 ;; file-with-urls.txt contains one URL per line in the file. A URLstarts either
  51 ;; with http:// or file:// - This allows mixing  remote and local files. An optional
  52 ;; timeout of 10 seconds is specified after the url file name. If no timeout is specified
  53 ;; newlispdoc assumes 5 seconds.
  54 ;;
  55 ;; Execute from within the same directory of the source files when
  56 ;; no url file is given.
  57 ;;
  58 ;; For each file a file with the same name and extension '.html' is generated
  59 ;; and written to the current directory. A file 'index.htm' is written as
  60 ;; an index for all other files generated. If the '-s' switch is specified,
  61 ;; a file with the extension '.src.html' is generated for each file.
  62 ;;
  63 ;; Please read @link http://newlisp.org/newLISPdoc.html newLISPdoc.htm to learn
  64 ;; about tagging of newLISP source code for newlispdoc.
  65 ;;
  66
  67 (set 'version "1.5")
  68
  69 ; get list of files from command line
  70 (set 'files (2 (main-args)))
  71
  72 (if (empty? files)
  73         (begin
  74                 (println "USAGE: newlispdoc [-s] <file-names>")
  75                 (println "USAGE: newlispdoc [-s] -url <file-with-urls>")
  76                 (exit -1)))
  77
  78
  79 (set 'prolog1
  80 [text]<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
  81 <html>
  82 <head>
  83 <META http-equiv="Content-Type" content="text/html; charset=utf-8">
  84 <title>%s</title>
  85 [/text])
  86
  87 (set 'stylesheet
  88 [text]
  89 <style type="text/css" media="screen">
  90 <!--
  91 span.arw {
  92         color:#666666;
  93         }
  94
  95 body, p {
  96         font-family: Georgia, Times New Roman, Times, serif;
  97         }
  98
  99 h1, h2, h3, h4 {
 100         font-family: Georgia, Times New Roman, Times, serif;
 101         }
 102
 103 pre {
 104         font-family: Andale Mono, "Bitstream Vera Sans Mono", Monaco, "Courier New";
 105         }
 106
 107 tt {
 108         font-family: Andale Mono, "Bitstream Vera Sans Mono", Monaco, "Courier New";
 109         }
 110 -->
 111 </style>
 112 </head>
 113 [/text])
 114
 115 (set 'prolog2
 116 [text]
 117 <body style="margin: 20px;" text="#333333" bgcolor="#FFFFFF"
 118                         link="#376590" vlink="#551A8B" alink="#ffAA28">
 119 <blockquote>
 120 <center><h1>%s</h1></center>
 121 [/text])
 122
 123 (set 'prolog3 {<p><a href="index.html">Module index</a></p>})
 124
 125 (set 'epilog [text]
 126 <p></p><center>- &part; -</center><br/>
 127 <center><font face='Arial' size='-2' color='#444444'>
 128 generated with <a href="http://newlisp.org">newLISP</a>&nbsp;
 129 and <a href="http://newlisp.org/newLISPdoc.html">newLISPdoc</a>
 130 </font></center>
 131 </blockquote>
 132 </body>
 133 </html>
 134 [/text])
 135
 136 ; ---------- routines for generating syntax-highlighted file <file-name>.src.html ------------------
 137
 138 (define keyword-color "#0000AA")      ; newLISP keywords
 139 (define string-color "#008800")       ; single line quoted and braced strings
 140 (define long-string-color "#008800")  ; multiline for [text], [/text] tags
 141 (define paren-color "#AA0000")        ; parenthesis
 142 (define comment-color "#555555")      ; comments
 143 (define number-color "#665500")       ; numbers
 144
 145 (define function-name-color "#000088")    ; not implemented yet for func in (define (func x y z) ...)
 146
 147 (set 'keywords (map name (filter (fn (x) (primitive? (eval x))) (sort (symbols) > ))))
 148 (push "nil" keywords)
 149 (push "true" keywords)
 150 (set 'keyword-regex (join keywords "|"))
 151 (replace "?" keyword-regex "\\?")
 152 (replace "$" keyword-regex "\\$")
 153 (replace "!" keyword-regex "\\!")
 154 (replace "+" keyword-regex "\\+")
 155 (replace "*" keyword-regex "\\*")
 156 (replace "||" keyword-regex "|\\|")
 157 (set 'keyword-regex (append {(\s+|\(|\))(} keyword-regex {)(\s+|\(|\))}))
 158
 159 (define (clean-comment str)
 160         (replace {<font color='#......'>} str "" 0)
 161         (replace {</font>} str "")
 162         (replace {[text]} str "&#091&text]")
 163         (replace {[/text]} str "&#091&/text]")
 164 )
 165
 166 (define (format-quoted-string str)
 167         (replace {<font color='#......'>} str "" 0)
 168         (replace {</font>} str "")
 169         (replace ";" str "&#059&")
 170         (replace "{" str "&#123&")
 171         (replace "}" str "&#125&")
 172         (replace {\} str "&#092&")
 173         (replace {[text]} str "&#091&text]")
 174         (replace {[/text]} str "&#091&/text]")
 175         (format {<font color='%s'>%s</font>} string-color str)
 176 )
 177
 178 (define (format-braced-string str)
 179         (replace {<font color='#......'>} str "" 0)
 180         (replace {</font>} str "")
 181         (replace ";" str "&#059&")
 182         (replace {"} str "&#034&")
 183         (replace {[text]} str "&#091&text]")
 184         (replace {[/text]} str "&#091&/text]")
 185         (format {<font color='%s'>%s</font>} string-color str)
 186 )
 187
 188 (define (format-tagged-string str)
 189         (replace {<font color='#......'>} str "" 0)
 190         (replace {</font>} str "")
 191         (replace ";" str "&#059&")
 192         (format {<font color='%s'>%s</font>} string-color str)
 193 )
 194
 195 (define (write-syntax-highlight src-file outputfile)
 196         ; replace special HTML characters
 197         (replace "\r\n" src-file "\n")
 198         (replace "&" src-file "&amp&")
 199         (replace "<(\\w)" src-file (append "&lt&" $1) 0)
 200         (replace "(\\w)>" src-file (append $1 "&gt&") 0)
 201         (replace "/>" src-file "/&gt&" 0)
 202         (replace "</" src-file "&lt&/" 0)
 203         (replace "<!" src-file "&lt&!" 0)
 204         ; replace escaped quotes
 205         (replace  "\092\034"  src-file "&#092&&#034&")
 206
 207         ; color keywords
 208         (replace keyword-regex src-file
 209                 (format {%s<font color='%s'>%s</font>%s} $1 keyword-color $2 $3) 0)
 210
 211         ; color numbers
 212         (replace {(\s+|\(|\))(0x[0-9a-fA-F]+|[+-]?\d+\.\d+|[+-]?\d+|\.\d+)} src-file
 213          (format {%s<font color='%s'>%s</font>} $1 number-color $2) 0)
 214
 215         ; color parens
 216         (replace "(" src-file (format {<font color='%s'>(</font>} paren-color))
 217         (replace ")" src-file (format {<font color='%s'>)</font>} paren-color))
 218
 219         ; color braced strings
 220         (replace "{.*?}" src-file (format-braced-string $0) 0) ; no multiline string
 221         ; color quoted strings
 222         (replace {".*?"} src-file (format-quoted-string $0) 0) ; no multiline strings
 223
 224         ; color ;  comments
 225         (replace ";.*" src-file (clean-comment $0) 0)
 226         (replace ";.*" src-file (format {<font color='%s'>%s</font>} comment-color $0) 0)
 227
 228         ; color # comments
 229         (set 'buff "")
 230         (dolist (lne (parse src-file "\n"))
 231                 (replace "^\\s*#.*" lne  (clean-comment $0) 0)
 232                 (replace "^\\s*#.*" lne (format {<font color='%s'>%s</font>} comment-color $0) 0)
 233                 (write-line lne buff))
 234
 235         (set 'src-file buff)
 236
 237         ; color tagged strings
 238         (replace {\[text\].*?\[/text\]} src-file
 239                 (format-tagged-string $0) 4) ; handles multiline strings
 240
 241         ; xlate back special characters
 242         (replace "&amp&" src-file "&amp;")   ; ampersand
 243         (replace "&lt&" src-file "&lt;")     ; less
 244         (replace "&gt&" src-file "&gt;")     ; greater
 245         (replace {&#034&} src-file "&#034;") ; quotes
 246         (replace {&#059&} src-file "&#059;") ; semicolon
 247         (replace {&#123&} src-file "&#123;") ; left curly brace
 248         (replace {&#125&} src-file "&#125;") ; right curly brace
 249         (replace {&#091&} src-file "&#091;") ; left bracket
 250         (replace {&#092&} src-file "&#092;") ; back slash
 251
 252         ; add pre and post tags
 253         (write-file (string outputfile ".src.html")
 254                 (append
 255                         "<html><body><pre>\n" src-file "\n</pre>"
 256                         {<center><font face='Arial' size='-3' color='#666666'>}
 257                         {syntax highlighting with <a href="http://newlisp.org">newLISP</a>&nbsp;}
 258                         {and <a href="http://newlisp.org/newLISPdoc.html">newLISPdoc</a>}
 259                         {</font></center></body></html>}))
 260 )
 261
 262 ;---------------------------------- End syntax highlighting routines ------------------------
 263
 264 ; get command line switch -s for generating syntax highlighted source
 265 (let (pos (find "-s" files))
 266         (if pos
 267                 (begin
 268                         (pop files pos)
 269                         (set 'source-link true))))
 270
 271 ; get command line switch -url for retrieving files via http from remote location
 272 (let (pos (find "-url" files))
 273         (if pos
 274                 (begin
 275                         (pop files pos)
 276                         (set 'url-file (files pos))
 277                         (set 'time-out (int (last files) 5000)))))
 278
 279 ; if url-file is specified make a list of all urls
 280 (if url-file
 281         (set 'files (parse (read-file url-file) "\\s+" 0)))
 282
 283 (if (= (last files) "") (pop files -1))
 284
 285 (set 'indexpage "") ; buffer for modules index page
 286 (write-buffer indexpage (format prolog1 "Index"))
 287 (write-buffer indexpage stylesheet)
 288 (write-buffer indexpage (format prolog2 "Index"))
 289
 290 ; reformat
 291
 292 (define (protect-html text)
 293         (replace "<h1>" text "[h1]")
 294         (replace "<h2>" text "[h2]")
 295         (replace "<h3>" text "[h3]")
 296         (replace "<h4>" text "[h4]")
 297         (replace "</h1>" text "[/h1]")
 298         (replace "</h2>" text "[/h2]")
 299         (replace "</h3>" text "[/h3]")
 300         (replace "</h4>" text "[/h4]")
 301         (replace "<i>" text "[i]")
 302         (replace "</i>" text "[/i]")
 303         (replace "<em>" text "[em]")
 304         (replace "</em>" text "[/em]")
 305         (replace "<b>" text "[b]")
 306         (replace "</b>" text "[/b]")
 307         (replace "<tt>" text "[tt]")
 308         (replace "</tt>" text "[/tt]")
 309         (replace "<p>" text "[p]")
 310         (replace "</p>" text "[/p]")
 311         (replace "<br>" text "[br]")
 312         (replace "<br/>" text "[br/]")
 313         (replace "<pre>" text "[pre]")
 314         (replace "</pre>" text "[/pre]")
 315         (replace "<center>" text "[center]")
 316         (replace "</center>" text "[/center]")
 317         (replace "<li>" text "[li]")
 318         (replace "</li>" text "[/li]")
 319         (replace "</ul>" text "[/ul]")
 320         (replace "<ul>" text "[ul]")
 321         (replace "</blockquote>" text "[/blockquote]")
 322         (replace "<blockquote>" text "[blockquote]")
 323         (replace "<hr>" text "[hr]")
 324         (replace "<hr/>" text "[hr/]")
 325 )
 326
 327 (define (unprotect-html text)
 328         (replace "[h1]" text "<h1>")
 329         (replace "[h2]" text "<h2>")
 330         (replace "[h3]" text "<h3>")
 331         (replace "[h4]" text "<h4>")
 332         (replace "[/h1]" text "</h1>")
 333         (replace "[/h2]" text "</h2>")
 334         (replace "[/h3]" text "</h3>")
 335         (replace "[/h4]" text "</h4>")
 336         (replace "[i]" text "<i>")
 337         (replace "[/i]" text "</i>")
 338         (replace "[em]" text "<em>")
 339         (replace "[/em]" text "</em>")
 340         (replace "[b]" text "<b>")
 341         (replace "[/b]" text "</b>")
 342         (replace "[tt]" text "<tt>")
 343         (replace "[/tt]" text "</tt>")
 344         (replace "[p]" text "<p>")
 345         (replace "[/p]" text "</p>")
 346         (replace "[br]" text "<br>")
 347         (replace "[br/]" text "<br/>")
 348         (replace "[pre]" text "<pre>")
 349         (replace "[/pre]" text "</pre>")
 350         (replace "[center]" text "<center>")
 351         (replace "[/center]" text "</center>")
 352         (replace "[li]" text "<li>")
 353         (replace "[/li]" text "</li>")
 354         (replace "[ul]" text "<ul>")
 355         (replace "[/ul]" text "</ul>")
 356         (replace "[blockquote]" text "<blockquote>")
 357         (replace "[/blockquote]" text "</blockquote>")
 358         (replace "[hr]" text "<hr>")
 359         (replace "[hr/]" text "<hr/>")
 360 )
 361
 362 ; format the example tags
 363 (define (format-example text)
 364         (replace "<" text "&lt;")
 365         (replace ">" text "&gt;")
 366         (string "<p></p><b>example:</b><blockquote><pre>" (replace ";;" text "") "</pre></blockquote>\n")
 367 )
 368
 369 ; write the module tag link on the index page
 370 ; put source link on doc page if -s flag
 371 (define (format-module text desc filename , module)
 372         (set 'module (string "<br/><br/><h2>Module:&nbsp;" text "</h2>"))
 373         (write-buffer indexpage (string {<a href="} filename {.html">} module "</a>\n" ))
 374         (write-buffer indexpage (string "<p>" desc "</p>\n"))
 375         (if source-link
 376                 (string {<a href="} filename {.src.html">source</a>} module)
 377                 (string "<br/>" module))
 378 )
 379
 380 ; write the function name links on the index page under the module
 381 (define (format-func-link func-name file-name)
 382                 (let (names (if (find ":" func-name) (parse func-name ":") (list "" func-name)))
 383                         (write-buffer indexpage (string {<a href="} file-name
 384                                         {.html#} (names 0) "_" (names 1) {">} (names 1) {</a>&nbsp; &nbsp; }))
 385                         (string (names 0) "_" (names 1))
 386                 )
 387 )
 388
 389 ; format the syntax line
 390 (define (format-syntax text file-name, tag)
 391         (replace "<([^<]*?)>" text (string "<em>" $1 "</em>") 0)
 392         (replace {^ *\((.*?) (.*?\))} text (string "(<font color=#CC0000>" $1 "</font> " $2) 0)
 393         (replace {^ *\(([^ ]*?)\)} text (string "(<font color=#CC0000>" $1 "</font>)") 0)
 394         (string
 395                 (unless (= old-syntax $1)
 396                         (begin
 397                                 (set 'old-syntax $1)
 398                                 (set 'tag (format-func-link $1 file-name))
 399                                 (set 'tag (string {<a name="} tag {"></a>}))
 400                                 (string "<p></p><center>- &sect; -</center><p></p>\n" tag
 401                                                 "<h3><font color=#CC0000>" old-syntax "</font></h3>\n"))
 402                 "")
 403                 "<b>syntax: " (trim text) "</b><br/>\n")
 404 )
 405
 406 (define (format-parameter param text)
 407 ;       (replace "<([^<]*?)>" param (string "<em>" $1 "</em>") 0)
 408 ;       (replace "<([^<]*?)>" text (string "<em>" $1 "</em>") 0)
 409         (string "<b>parameter: </b>" (format-text (trim param)) " - " (format-text text) "<br/>\n")
 410 )
 411
 412 (define (format-return text)
 413         (string "<p><b>return: </b>" (format-text text) "</p>\n")
 414 )
 415
 416 (define (format-text text)
 417         (replace "<([^<]*?)>" text (string "<em>" $1 "</em>") 0)
 418         (replace "'([^\\s].*?[^\\s])'" text (string "<tt>" $1 "</tt>") 0)
 419 )
 420
 421 ;---------------------------------- End newlisdoc formatting subroutines ----------------
 422 ; MAIN function
 423
 424 (dolist (fle files)
 425         (println fle)
 426         (set 'html "")
 427
 428         (set 'original (read-file fle time-out))
 429
 430         (if (not original)
 431                 (begin
 432                         (println "Could not read " fle)
 433                         (exit 1)))
 434
 435         (if (starts-with original "ERR:")
 436                 (println "Could not read " fle " " original))
 437
 438         (set 'outfile (last (parse fle "\\\\|/" 0)))
 439
 440         (set 'page (parse (replace "\r\n" original "\n") "\n"))
 441
 442         (set 'page (filter (fn (ln) (or (starts-with ln ";;") (= (length (trim ln)) 0))) page))
 443         (set 'page (join page "\n"))
 444
 445         ; link to another index page
 446         (if (find ";; *@index ([^ ]*?) ([^ ]*?)\n" page 0)
 447                 (begin
 448                         (write-buffer indexpage
 449                                 (string {<br /><br /><h2><a href="} $2 {">Index:&nbsp;} $1 "</a></h2>\n"))
 450                         (if (find ";; *@description (.*?)\n" page 0)
 451                                 (write-buffer indexpage (string $1 "<br/>\n")))
 452                 )
 453         )
 454
 455
 456         (if (find ";; *@module " page 0)
 457                 (begin
 458                         (replace ";; @example *\n(.*?)\n\\s*\n" page (format-example $1) 4)
 459                         (set 'page (protect-html page))
 460                         (set 'desc "")
 461                         (replace ";; *@description (.*?)\n" page (begin (set 'desc $1) (string "<p>" desc "</p>\n") ) 0)
 462                         (replace ";; *@module (.*?)\n" page (format-module $1 desc outfile)  0)
 463                         (replace ";; *@author (.*?)\n" page (string "<b>Author: </b>" $1 "<br/>\n")  0)
 464                         (replace ";; *@version (.*?)\n" page (string "<b>Version: </b>" $1 "<br/>\n")  0)
 465                         (replace ";; *@location (.*?)\n" page
 466                                 (string {<b>Location: </b><a href="} $1 {">} $1 "</a><br/>\n")  0)
 467                         (replace ";; *@syntax (.*?)\n" page (format-syntax $1 outfile) 0)
 468                         (replace ";; *@param (.*?) (.*?)\n" page (format-parameter $1 $2) 0)
 469                         (replace ";; *@return (.*?)\n" page (format-return $1)  0)
 470                         (replace ";;\\s*\n" page "<p></p>\n" 0)
 471                         (replace ";;(.*\n)" page (format-text $1) 0)
 472                         (replace {@link ([^ ]*?) ([^ ]*?)\s} page (string {<a href="} $1 {">} $2 {</a> }) 0)
 473                         (set 'page (unprotect-html page))
 474                         (write-buffer html (format prolog1 outfile))
 475                         (write-buffer html stylesheet)
 476                         (write-buffer html (format prolog2 outfile))
 477                         (write-buffer html prolog3)
 478                         (write-buffer html page)
 479                         (write-buffer html epilog)
 480
 481                         (write-file (string outfile ".html") html)
 482
 483                         ; write syntax highlighted source
 484                         (if source-link
 485                                 (write-syntax-highlight original outfile))
 486
 487                 )
 488         )
 489 )
 490
 491 ; write the modules index page
 492 (write-buffer indexpage epilog)
 493 (write-file "index.html" indexpage)
 494
 495 (exit)
 496