From bd9733926076885e3417b74de76e4c9c7bc56254 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 2c7

---
 schmooz.scm | 108 ++++++++++++++++++++++++++++++------------------------------
 1 file changed, 54 insertions(+), 54 deletions(-)

(limited to 'schmooz.scm')

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