Import Upstream version 3a2upstream/3a2

1 files changed, 27 insertions, 20 deletions

diff --git a/batch.scm b/batch.scm
index bef29cc..8c122af 100644
--- a/batch.scm
+++ b/batch.scm
@@ -1,5 +1,5 @@
 ;;; "batch.scm" Group and execute commands on various systems.
-;Copyright (C) 1994, 1995, 1997 Aubrey Jaffer
+;Copyright (C) 1994, 1995, 1997, 2004 Aubrey Jaffer
 ;
 ;Permission to copy this software, to modify it, to redistribute it,
 ;to distribute modified versions, and to use it for any purpose is
@@ -49,14 +49,18 @@
 (define (batch:operating-system parms)
   (car (parameter-list-ref parms 'operating-system)))
 
-(define (write-batch-line str line-limit port)
-  (cond ((and line-limit (>= (string-length str) line-limit))
-	 (slib:warn 'write-batch-line 'too-long
-		    (string-length str) '> line-limit)
-	 #f)
-	(else (write-line str port) #t)))
 (define (batch-line parms str)
-  (write-batch-line str (batch:line-length-limit parms) (batch:port parms)))
+  (define line-limit (batch:line-length-limit parms))
+  (define port (batch:port parms))
+  (cond ((and line-limit (>= (string-length str) line-limit))
+	 (let ((msg (string-append "batch line is too long "
+				   (number->string (string-length str))
+				   " > "
+				   (number->string line-limit))))
+	   (batch:comment parms (string-append "WARN: " msg))
+	   (if (not (eq? port (current-output-port))) (slib:warn msg)))))
+  (write-line str port)
+  #t)
 
 ;;; add a Scheme batch-dialect?
 ;@
@@ -107,16 +111,19 @@
     ((vms) (batch:command parms (string-append "@" name) strings))
     (else (batch:command parms name strings))))
 
-(define (batch:write-comment-line dialect line port)
+(define (batch:comment-prefix dialect)
   (case dialect
-    ((unix) (write-batch-line (string-append "# " line) #f port))
-    ((dos) (write-batch-line (string-append "rem " line) #f port))
-    ((vms) (write-batch-line (string-append "$! " line) #f port))
-    ((amigaos) (write-batch-line (string-append "; " line) #f port))
-    ((system) (write-batch-line (string-append "; " line) #f port))
-    ((*unknown*) (write-batch-line (string-append ";;; " line) #f port)
-     ;;(newline port)
-     #f)))
+    ((unix)      "# ")
+    ((dos)       "rem ")
+    ((vms)       "$! ")
+    ((amigaos)   "; ")
+    ((system)    "; ")
+    ((*unknown*) ";;; ")))
+
+;;; Comment lines usually don't have a length limit.
+(define (batch:write-comment-line dialect line port)
+  (write-line (string-append (batch:comment-prefix dialect) line) port)
+  #t)
 ;@
 (define (batch:comment parms . lines)
   (define port (batch:port parms))
@@ -464,7 +471,7 @@
   )
 ;@
 (define *operating-system*
-  (cond ((and (eq? 'unix (software-type)) (provided? 'system))
+  (cond ((and (eq? 'UNIX (software-type)) (provided? 'system))
 	 (let* ((file-name (tmpnam))
 		(uname (and (system (string-append "uname > " file-name))
 			    (call-with-input-file file-name read)))
@@ -473,11 +480,11 @@
 	   (cond ((and ustr
 		       (> (string-length ustr) 5)
 		       (string-ci=? "cygwin" (substring ustr 0 6)))
-		  'gnu-win32)
+		  'GNU-WIN32)
 		 ((and ustr
 		       (> (string-length ustr) 4)
 		       (string-ci=? "mingw" (substring ustr 0 5)))
-		  'gnu-win32)
+		  'GNU-WIN32)
 		 (ustr uname)
 		 (else (software-type)))))
 	(else (software-type))))