diff options
Diffstat (limited to 'batch.scm')
| -rw-r--r-- | batch.scm | 47 |
1 files changed, 27 insertions, 20 deletions
@@ -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)))) |