From 87b82b5822ca54228cfa6df29be3ad9d4bc47d16 Mon Sep 17 00:00:00 2001
From: Bryan Newbold <bnewbold@robocracy.org>
Date: Mon, 20 Feb 2017 00:05:28 -0800
Subject: Import Upstream version 2d2

---
 schmooz.scm | 56 ++++++++++++++++++++++++++++++++++++++------------------
 1 file changed, 38 insertions(+), 18 deletions(-)

(limited to 'schmooz.scm')

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*)
-- 
cgit v1.2.3