diff options
Diffstat (limited to 'schmooz.scm')
| -rw-r--r-- | schmooz.scm | 56 |
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*) |