0001: #!/usr/bin/env gosh
0002: ; -*- Scheme -*-
0003: ;;;
0004: ;;;   scmxref -- generate cross reference for Gauche code in html format
0005: ;;;
0006: (use gauche.parameter)
0007: (use gauche.parseopt)
0008: (use file.util)
0009: (use text.html-lite)
0010: (use text.tree)
0011: (use scmxref)
0012: (use scmxref.path-util)
0013: 
0014: ;;;
0015: ;;;  Customize
0016: ;;;
0017: ;;(gauche-man-base "http://practical-scheme.net/wiliki/schemexref.cgi?")
0018: ;;(gauche-man-base "http://practical-scheme.net/gauche/man/?l=en&p="   )
0019: ;;(gauche-man-base "http://practical-scheme.net/gauche/man/?l=jp&p="   )
0020: ;;(documented-modules '()) ; see dictionary.scm
0021: (anchor-all-lines #t)
0022: 
0023: ;;;
0024: ;;;
0025: ;;;
0026: (define force-output (make-parameter #f))
0027: (define verbose      (make-parameter #t))
0028: (define (message . x)   (if (verbose) (apply print x)))
0029: 
0030: (define (file->list-of-anchored-strings file)
0031:   (let* ((L (string-split (file->anchored-string file) #\newline))
0032:          (N (length L)))
0033:     (map (lambda (n l)
0034:            (list (format "~4,'0d: " n) l "\n"))
0035:          (iota N 1) L)))
0036: 
0037: (define (generate-html-files files dest-dir)
0038: 
0039:   (if (and (not (force-output)) (file-exists? dest-dir))
0040:     (error #"~|dest-dir| already exists"))
0041: 
0042:   (for-each (lambda (file)
0043:               (let ((outfile #"~|dest-dir|/~(string-append file \".html\")")
0044:                     (prefix (path-to-top file)))
0045:                 (make-directory* (sys-dirname outfile))
0046:                 (message #"~|file| -> ~|outfile|")
0047:                 (with-output-to-file outfile
0048:                   (lambda ()
0049:                     (write-tree
0050:                      (html:html
0051:                       (html:head
0052:                        (html:title file)
0053:                        (html:style stylesheet))
0054:                       (html:body
0055:                        (html:a :href #"~|prefix|index.html" "index")
0056:                        (html:pre
0057:                         (file->list-of-anchored-strings file))
0058:                        (html:a :href #"~|prefix|index.html" "Index"))))))))
0059:             files))
0060: 
0061: (define (generate-files files dest-dir)
0062:   (generate-html-files files dest-dir)
0063:   (with-output-to-file #"~|dest-dir|/index.html" display-index.html))
0064: 
0065: ;;;
0066: ;;;  Main
0067: ;;;
0068: (define (usage progname)
0069:   (print "\
0070: usage: " progname " [options] [file ...]
0071: options:
0072:         -h          Print this message
0073:         -q          Quiet mode
0074:         -d dest     Specify directory where html files are created. Default is html
0075:         -f          Force output even if dest exists.")
0076:   (exit 0))
0077: 
0078: (define (main args)
0079:   (let-args (cdr args)
0080:       ((#f         "q|quiet"   => (cut verbose #f))
0081:        (#f         "f|force"   => (cut force-output #t))
0082:        (#f         "h|help"    => (cut usage (car args)))
0083:        (dest-dir   "d|dest=s" "html")
0084:        . rest)
0085:     (unless (null? rest)
0086:       (build-dictionary rest)
0087:       (generate-files rest dest-dir))
0088:     0))
0089: 
0090: ;;; EOF
0091: