summaryrefslogtreecommitdiffstats
path: root/batch.scm
diff options
context:
space:
mode:
authorBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:31 -0800
committerBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:31 -0800
commit5145dd3aa0c02c9fc496d1432fc4410674206e1d (patch)
tree540afc30c51da085f5bd8ec3f4c89f6496e7900d /batch.scm
parent8466d8cfa486fb30d1755c4261b781135083787b (diff)
downloadslib-5145dd3aa0c02c9fc496d1432fc4410674206e1d.tar.gz
slib-5145dd3aa0c02c9fc496d1432fc4410674206e1d.zip
Import Upstream version 3a2upstream/3a2
Diffstat (limited to 'batch.scm')
-rw-r--r--batch.scm47
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))))