utilities/doc-split.in

   1 #!@GUILE@ \
   2 -e main -s
   3 !#
   4 ;
   5 ; doc-split - split snarfed documentation into seperate files for
   6 ;       primitives, hooks, concepts, and variables.
   7 ;
   8 (use-modules (ice-9 getopt-long)
   9              (ice-9 common-list)
  10              (ice-9 format)
  11              (ice-9 regex)
  12              (srfi srfi-13))
  13
  14 ;(display "doc-split running\n")
  15 (debug-enable 'debug 'backtrace)
  16 (read-enable 'positions)
  17
  18 ; globals. not very schemy. but I don't care.
  19 (define opt-debug #f)
  20 (define opt-verbose #f)
  21
  22 (define concept-fp #f)
  23 (define hook-fp #f)
  24 (define var-fp #f)
  25 (define proc-fp #f)
  26
  27 ;-----------------------------------------------------------------------------
  28
  29 (define (main a)
  30   (let* ((opts  (getopt-long (program-arguments)
  31                             `((verbose      (single-char #\v))
  32                               (debug        (single-char #\x))
  33                               (basename (value #t))
  34                               )))
  35          (fprefix "X"))
  36
  37 ;    (format #t "opts=~a\n" opts)
  38
  39     (set! opt-verbose
  40           (let ((a (assq 'verbose opts)))
  41             (if a
  42                 (cdr a)
  43                 #f)))
  44     (set! opt-debug
  45           (let ((a (assq 'debug opts)))
  46             (if a
  47                 (cdr a)
  48                 #f)))
  49     (if (assq 'basename opts)
  50         (set! fprefix (cdr (assq 'basename opts))))
  51
  52     (set! concept-fp (open-file (string-append fprefix "-concepts.txt") "w"))
  53     (set! hook-fp (open-file (string-append fprefix "-hooks.txt") "w"))
  54     (set! var-fp (open-file (string-append fprefix "-variables.txt") "w"))
  55     (set! proc-fp (open-file (string-append fprefix "-procedures.txt") "w"))
  56
  57     (for-each
  58      (lambda (f)
  59        (if opt-debug (format #t "~a:\n" f))
  60        (let ((fp (open-file f "r")))
  61          (with-input-from-port fp
  62            (lambda ()
  63              (process-file-by-lines f)))
  64          (close fp)))
  65      (pick string? (assq '() opts)))
  66
  67     (close concept-fp)
  68     (close hook-fp)
  69     (close var-fp)
  70     (close proc-fp)
  71 ))
  72
  73 ; Use the read-hash-extend facility to add a syntax for constant
  74 ; regular expressions that are to be compiled once when read in,
  75 ; instead of during the normal flow of execution.   This can let loops
  76 ; that repeatedly use a constant regexp be optimized without moving the
  77 ; expression's definition far away from its use.
  78 ;
  79 ; With this hash-extension, these two expressions behave identicaly:
  80 ;
  81 ; (regexp-exec (make-regexp "de+") "abcdeeef"))
  82 ; (regexp-exec #+"de+" "abcdeeef")
  83 ;
  84 (read-hash-extend #\+ (lambda (c port)
  85                   (let ((s (read port)))
  86                     (if (string? s)
  87                         (make-regexp s)
  88                         (error "bad #+ value; string expected")))))
  89
  90
  91 (define (process-file-by-lines fname)
  92   (let ((fp #f))
  93     (do ((line (read-line)
  94                (read-line)))
  95         ((eof-object? line) #f)
  96
  97       (if (string-index line #\np )
  98           (let ((line (read-line)))
  99             (if (not (eof-object? line))
 100                 (begin
 101                   (cond
 102                    ((regexp-exec #+"^Concept: " line)
 103                     (set! fp concept-fp))
 104                    ((regexp-exec #+"^Hook: " line)
 105                     (set! fp hook-fp))
 106                    ((regexp-exec #+"^Variable: " line)
 107                     (set! fp var-fp))
 108                    ((regexp-exec #+"^Procedure: " line)
 109                     (set! fp proc-fp))
 110                    (else
 111                     (set! fp #f)))
 112                   (if fp
 113                       (format fp "\f\n~a\n" line)))))
 114           (if fp
 115               (format fp "~a\n" line))
 116           ))))
 117
 118
 119