summaryrefslogtreecommitdiffstats
path: root/schmooz.scm
diff options
context:
space:
mode:
Diffstat (limited to 'schmooz.scm')
-rw-r--r--schmooz.scm108
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))