summaryrefslogtreecommitdiffstats
path: root/schmooz.scm
diff options
context:
space:
mode:
Diffstat (limited to 'schmooz.scm')
-rw-r--r--schmooz.scm56
1 files changed, 38 insertions, 18 deletions
diff --git a/schmooz.scm b/schmooz.scm
index a09f3df..e9950d2 100644
--- a/schmooz.scm
+++ b/schmooz.scm
@@ -1,9 +1,9 @@
;;; "schmooz.scm" Program for extracting texinfo comments from Scheme.
-;;; Copyright (C) 1998 Radey Shouman and Aubrey Jaffer.
+;;; Copyright (C) 1998, 2000 Radey Shouman and Aubrey Jaffer.
;
-;Permission to copy this software, to redistribute it, and to use it
-;for any purpose is granted, subject to the following restrictions and
-;understandings.
+;Permission to copy this software, to modify it, to redistribute it,
+;to distribute modified versions, and to use it for any purpose is
+;granted, subject to the following restrictions and understandings.
;
;1. Any copy made of this software must include this copyright notice
;in full.
@@ -17,9 +17,6 @@
;promotional, or sales literature without prior written consent in
;each case.
-;;$Header: /usr/local/cvsroot/slib/schmooz.scm,v 1.12 1999/10/11 03:36:29 jaffer Exp $
-;;$Name: $
-
;;; REPORT an error or warning
(define report
(lambda args
@@ -365,21 +362,25 @@
(define (schmooz-scm-file file txi-name)
(display "Schmoozing ") (write file)
(display " -> ") (write txi-name) (newline)
- (fluid-let ((*scheme-source* (open-file file "r"))
+ (fluid-let ((*scheme-source* (open-input-file file))
(*scheme-source-name* file)
- (*derived-txi* (open-file txi-name "w"))
+ (*derived-txi* (open-output-file txi-name))
(*derived-txi-name* txi-name))
(set! *output-line* 1)
+ (cond ((scheme-file? file))
+ (else (find-string-from-port? ";" *scheme-source* #\;)
+ (read-line *scheme-source*)))
(schmooz-tops schmooz-top)
(close-input-port *scheme-source*)
(close-output-port *derived-txi*)))
(lambda files
(for-each (lambda (file)
(define sl (string-length file))
- (cond ((scheme-file? file)
- (schmooz-scm-file
- file (scm->txi file)))
- ((texi-file? file) (schmooz-texi-file file))))
+ (cond ((texi-file? file) (schmooz-texi-file file))
+ ((scheme-file? file)
+ (schmooz-scm-file file (scm->txi file)))
+ (else (schmooz-scm-file
+ file (string-append file ".txi")))))
files))))
;;; SCHMOOZ-TOPS - schmooz top level forms.
@@ -407,6 +408,20 @@
(read-cmt-line))
(else (read-line *scheme-source*))))
+ (define (read-meta-cmt)
+ (let skip ((metarg? #f))
+ (let ((c (read-char *scheme-source*)))
+ (case c
+ ((#\newline) (if metarg? (skip #t)))
+ ((#\\) (skip #t))
+ ((#\!) (cond ((eqv? #\# (peek-char *scheme-source*))
+ (read-char *scheme-source*)
+ (if #f #f))
+ (else
+ (skip metarg?))))
+ (else
+ (if (char? c) (skip metarg?) c))))))
+
(define (lp c)
(cond ((eof-object? c)
(cond ((pair? doc-lines)
@@ -415,13 +430,19 @@
((eqv? c #\newline)
(read-char *scheme-source*)
(set! *output-line* (+ 1 *output-line*))
- (newline *derived-txi*)
+ ;;(newline *derived-txi*)
(lp (peek-char *scheme-source*)))
((char-whitespace? c)
(write-char (read-char *scheme-source*) *derived-txi*)
(lp (peek-char *scheme-source*)))
((char=? c #\;)
(c-cmt c))
+ ((char=? c #\#)
+ (read-char *scheme-source*)
+ (if (eqv? #\! (peek-char *scheme-source*))
+ (read-meta-cmt)
+ (report "misread sharp object" (peek-char *scheme-source*)))
+ (lp (peek-char *scheme-source*)))
(else
(sx))))
@@ -450,7 +471,6 @@
(define (out-cmt line)
(let ((subl (substitute-macs line '())))
- (newline *derived-txi*)
(display (car subl) *derived-txi*)
(for-each
(lambda (l)
@@ -459,7 +479,8 @@
(out-cindex (cadr l)))
(else
(report "bad macro" line))))
- (cdr subl))))
+ (cdr subl))
+ (newline *derived-txi*)))
;;Comments not transcribed to generated Texinfo files.
(define (c-cmt c)
@@ -492,7 +513,7 @@
(doc-cmt (peek-char *scheme-source*))))))
;; Transcribe the comment line to C source file.
(else
- (read-line *scheme-source*) ;(out-c-cmt )
+ (read-line *scheme-source*)
(lp (peek-char *scheme-source*)))))
;;Comments incorporated in generated Texinfo files.
@@ -520,7 +541,6 @@
(cond ((eof-object? c) (lp c))
((eqv? #\; c)
(out-cmt (read-cmt-line))
- ;;(out-c-cmt (car ls))
(doc-cmt (peek-char *scheme-source*)))
((eqv? c #\newline)
(read-char *scheme-source*)