From b1bc1adca1da5c432218c0df4b9faa2a673b0b8a Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Thu, 3 Feb 2000 22:23:06 +0000 Subject: [PATCH] Fix bug: unable to run gzip properly on Windows systems if the location of the gzip binary is in a directory with spaces in its name. Must quote the name after it is expanded. --- v7/src/edwin/dosfile.scm | 29 ++++++++++++++++++++--------- 1 file changed, 20 insertions(+), 9 deletions(-) diff --git a/v7/src/edwin/dosfile.scm b/v7/src/edwin/dosfile.scm index ef1e22fdd..4260a7961 100644 --- a/v7/src/edwin/dosfile.scm +++ b/v7/src/edwin/dosfile.scm @@ -1,8 +1,8 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: dosfile.scm,v 1.33 1999/10/07 17:08:14 cph Exp $ +;;; $Id: dosfile.scm,v 1.34 2000/02/03 22:23:06 cph Exp $ ;;; -;;; Copyright (c) 1994-1999 Massachusetts Institute of Technology +;;; Copyright (c) 1994-2000 Massachusetts Institute of Technology ;;; ;;; This program is free software; you can redistribute it and/or ;;; modify it under the terms of the GNU General Public License as @@ -502,14 +502,14 @@ Switches may be concatenated, e.g. `-lt' is equivalent to `-l -t'." `((,read/write-compressed-file? . ,(lambda (pathname mark visit?) visit? - (read-compressed-file "gzip -d" pathname mark))) + (read-compressed-file "gzip" '("-d") pathname mark))) ,@(os-independent/read-file-methods))) (define (os/write-file-methods) `((,read/write-compressed-file? . ,(lambda (region pathname visit?) visit? - (write-compressed-file "gzip" region pathname))) + (write-compressed-file "gzip" '() region pathname))) ,@(os-independent/write-file-methods))) (define (os/alternate-pathnames group pathname) @@ -534,7 +534,7 @@ filename suffix \".gz\"." (and (ref-variable enable-compressed-files group) (equal? "gz" (pathname-type pathname)))) -(define (read-compressed-file program pathname mark) +(define (read-compressed-file program arguments pathname mark) (message "Uncompressing file " (->namestring pathname) "...") (let ((value (call-with-temporary-file-pathname @@ -544,7 +544,7 @@ filename suffix \".gz\"." (directory-pathname pathname) #f (string-append - program + (quote-program program arguments) " < " (file-namestring pathname) " > " @@ -562,14 +562,15 @@ filename suffix \".gz\"." (append-message "done") value)) -(define (write-compressed-file program region pathname) +(define (write-compressed-file program arguments region pathname) (message "Compressing file " (->namestring pathname) "...") (if (not (equal? '(EXITED . 0) (shell-command region #f (directory-pathname pathname) #f - (string-append program + (string-append (quote-program program + arguments) " > " (file-namestring pathname))))) (error:file-operation pathname @@ -578,4 +579,14 @@ filename suffix \".gz\"." "[unknown]" write-compressed-file (list region pathname))) - (append-message "done")) \ No newline at end of file + (append-message "done")) + +(define (quote-program program arguments) + (let ((arguments + (apply string-append + (map (lambda (argument) + (string-append " " arg)) + arguments)))) + (if (eq? 'NT microcode-id/operating-system) + (string-append "\"" (os/find-program program #f) "\"" arguments) + (string-append program arguments)))) \ No newline at end of file -- 2.25.1