diff options
Diffstat (limited to 'schmooz.scm')
| -rw-r--r-- | schmooz.scm | 108 |
1 files changed, 54 insertions, 54 deletions
diff --git a/schmooz.scm b/schmooz.scm index 9664ac3..a09f3df 100644 --- a/schmooz.scm +++ b/schmooz.scm @@ -1,4 +1,4 @@ -;;; schmooz.scm: Program for extracting texinfo comments from Scheme. +;;; "schmooz.scm" Program for extracting texinfo comments from Scheme. ;;; Copyright (C) 1998 Radey Shouman and Aubrey Jaffer. ; ;Permission to copy this software, to redistribute it, and to use it @@ -17,7 +17,7 @@ ;promotional, or sales literature without prior written consent in ;each case. -;;$Header: /usr/local/cvsroot/slib/schmooz.scm,v 1.7 1998/09/10 20:34:26 radey Exp $ +;;$Header: /usr/local/cvsroot/slib/schmooz.scm,v 1.12 1999/10/11 03:36:29 jaffer Exp $ ;;$Name: $ ;;; REPORT an error or warning @@ -75,10 +75,10 @@ (display a *derived-txi*)) ((string? a) (display a *derived-txi*) - #+f - (cond ((string-index a #\nl) - (set! *output-line* (+ 1 *output-line*)) - (report "newline in string" a)))) +; (cond ((string-index a #\newline) +; (set! *output-line* (+ 1 *output-line*)) +; (report "newline in string" a))) + ) (else (display a *derived-txi*)))) args)) @@ -97,7 +97,7 @@ (if close (slib:error close "not found in" line) (cons iend - (reverse + (reverse (if (> iend istrt) (cons (substring line istrt iend) args) args))))) @@ -127,7 +127,7 @@ (tok1 (+ 1 istrt) #\} (lambda (c) (eqv? c #\,)) #f)) ((eqv? #\( (string-ref line istrt)) (tok1 (+ 1 istrt) #\) char-whitespace? ".")) - (else + (else (tok1 istrt #f char-whitespace? #f))))) @@ -150,15 +150,15 @@ (res '())) (cond ((>= i (string-length line)) (list - (apply string-append - (reverse + (apply string-append + (reverse (cons (substring line istrt (string-length line)) res))))) ((char=? #\@ (string-ref line i)) (let* ((w (get-word i)) (symw (string->symbol w))) (cond ((eq? '@cname symw) - (let ((args (parse-args + (let ((args (parse-args line (+ i (string-length w))))) (cond ((and args (= 2 (length args))) (loop (car args) (car args) @@ -234,7 +234,7 @@ (else (slib:error 'schmooz "doesn't look like definition" sexp)))) ;; Generate alist of argument macro definitions. -;; If ARGS is a symbol or string, then the definitions will be used in a +;; If ARGS is a symbol or string, then the definitions will be used in a ;; `defvar', if ARGS is a (possibly improper) list, they will be used in ;; a `defun'. (define (scheme-args->macros args) @@ -250,7 +250,7 @@ (args (if fun? (cdr args) '()))) (let ((m0 (string-append (if fun? "@code{" "@var{") (arg->string arg0) "}"))) - (append + (append (list (cons '@arg0 m0) (cons '@0 m0)) (let recur ((i 1) (args args)) @@ -262,7 +262,7 @@ (append (arg->macros (car args) i) (recur (+ i 1) (cdr args)))))))))) -;; Extra processing to be done for @dfn +;; Extra processing to be done for @dfn (define (out-cindex arg) (out 0 "@cindex " arg)) @@ -285,7 +285,7 @@ args)) " @dots{}")) ((pair? args) - (out CONTLINE " " + (out CONTLINE " " (if (or (eq? '... (car args)) (equal? "..." (car args))) "@dots{}" @@ -309,7 +309,7 @@ ((@dfn) (out-cindex (cadr l))) ((@args) - (out-header + (out-header (cons (car args) (cdr l)) (cdr ops))))) (cdr subl))) @@ -348,7 +348,9 @@ (texi? (filename:match-ci?? "*??texi"))) (lambda (filename) (or (txi-file? filename) (tex? filename) - (texi? filename)))))) + (texi? filename))))) + (txi->scm (filename:substitute?? "*txi" "*scm")) + (scm->txi (filename:substitute?? "*scm" "*txi"))) (define (schmooz-texi-file file) (call-with-input-file file (lambda (port) @@ -358,10 +360,8 @@ (let ((fname #f)) (cond ((not (eqv? 1 (fscanf port " %s" fname)))) ((not (txi-file? fname))) - ((not (file-exists? - (replace-suffix fname "txi" "scm")))) - (else (schmooz - (replace-suffix fname "txi" "scm"))))))))) + ((not (file-exists? (txi->scm fname)))) + (else (schmooz (txi->scm fname))))))))) (define (schmooz-scm-file file txi-name) (display "Schmoozing ") (write file) (display " -> ") (write txi-name) (newline) @@ -378,7 +378,7 @@ (define sl (string-length file)) (cond ((scheme-file? file) (schmooz-scm-file - file (replace-suffix file "scm" "txi"))) + file (scm->txi file))) ((texi-file? file) (schmooz-texi-file file)))) files)))) @@ -407,19 +407,13 @@ (read-cmt-line)) (else (read-line *scheme-source*)))) - (define (read-newline) - (if (char=? #\cr (read-char *scheme-source*)) - (if (char=? #\nl (peek-char *scheme-source*)) - (read-char *scheme-source*) - (report "stranded #\\cr")))) - (define (lp c) (cond ((eof-object? c) (cond ((pair? doc-lines) (report "No definition found for @body doc lines" (reverse doc-lines))))) - ((memv c '(#\cr #\nl)) - (read-newline) + ((eqv? c #\newline) + (read-char *scheme-source*) (set! *output-line* (+ 1 *output-line*)) (newline *derived-txi*) (lp (peek-char *scheme-source*))) @@ -428,20 +422,25 @@ (lp (peek-char *scheme-source*))) ((char=? c #\;) (c-cmt c)) - (else + (else (sx)))) (define (sx) (let* ((s1 (read *scheme-source*)) - (ss ;Read all forms separated only by single newlines. - (let recur () - (case (peek-char *scheme-source*) - ((#\cr) (read-char *scheme-source*) (recur)) - ((#\nl) (read-char *scheme-source*) - (if (eqv? #\( (peek-char *scheme-source*)) - (cons (read *scheme-source*) (recur)) - '())) - (else '()))))) + ;;Read all forms separated only by single newlines + ;;and trailing whitespace. + (ss (let recur () + (let ((c (peek-char *scheme-source*))) + (cond ((eqv? c #\newline) + (read-char *scheme-source*) + (if (eqv? #\( (peek-char *scheme-source*)) + (let ((s (read *scheme-source*))) + (cons s (recur))) + '())) + ((char-whitespace? c) + (read-char *scheme-source*) + (recur)) + (else '())))))) (cond ((eof-object? s1)) (else (schmooz-top s1 ss (reverse doc-lines) doc-args) @@ -453,12 +452,12 @@ (let ((subl (substitute-macs line '()))) (newline *derived-txi*) (display (car subl) *derived-txi*) - (for-each + (for-each (lambda (l) (case (car l) ((@dfn) (out-cindex (cadr l))) - (else + (else (report "bad macro" line)))) (cdr subl)))) @@ -474,8 +473,8 @@ (tok (tok1 line))) (cond ((or (string=? tok "@body") (string=? tok "@text")) - (set! doc-lines - (cons (skip-ws line (string-length tok)) + (set! doc-lines + (cons (skip-ws line (string-length tok)) doc-lines)) (body-cmt (peek-char *scheme-source*))) ((string=? tok "@args") @@ -504,14 +503,14 @@ ((eqv? #\; c) (set! doc-lines (cons (read-cmt-line) doc-lines)) (body-cmt (peek-char *scheme-source*))) - ((memv c '(#\nl #\cr)) - (read-newline) + ((eqv? c #\newline) + (read-char *scheme-source*) (lp (peek-char *scheme-source*))) ;; Allow whitespace before ; in doc comments. ((char-whitespace? c) (read-char *scheme-source*) (body-cmt (peek-char *scheme-source*))) - (else + (else (lp (peek-char *scheme-source*))))) ;;Comments incorporated in generated Texinfo files. @@ -523,15 +522,15 @@ (out-cmt (read-cmt-line)) ;;(out-c-cmt (car ls)) (doc-cmt (peek-char *scheme-source*))) - ((memv c '(#\nl #\cr)) - (read-newline) + ((eqv? c #\newline) + (read-char *scheme-source*) (newline *derived-txi*) (lp (peek-char *scheme-source*))) ;; Allow whitespace before ; in doc comments. ((char-whitespace? c) (read-char *scheme-source*) (doc-cmt (peek-char *scheme-source*))) - (else + (else (newline *derived-txi*) (lp (peek-char *scheme-source*))))) (lp (peek-char *scheme-source*)))) @@ -559,10 +558,10 @@ (let ((a (def->args (car ss)))) (loop (cdr ss) (if args - (if a + (if a (cons a smatch) smatch) - (if a + (if a smatch (cons (def->var-name (car ss)) smatch))))))))))))) @@ -571,7 +570,8 @@ (define (schmooz-top sexp1 sexps doc proc-args) (cond ((not (pair? sexp1))) ((pair? sexps) - (schmooz-top-doc-begin sexp1 sexps doc proc-args) + (if (pair? doc) + (schmooz-top-doc-begin sexp1 sexps doc proc-args)) (set! doc '())) (else (case (car sexp1) @@ -599,7 +599,7 @@ (schmooz-var (car sexp1) (cadr sexp1) doc '()) (set! doc '())))))))))) (or (null? doc) - (report + (report "SCHMOOZ: no definition found for Texinfo documentation" doc sexp)) (set! *procedure* #f)) |