Change GROUP-INSERT-FILE! to accept an additional argument, which
authorChris Hanson <org/chris-hanson/cph>
Wed, 24 Apr 1996 02:30:14 +0000 (02:30 +0000)
committerChris Hanson <org/chris-hanson/cph>
Wed, 24 Apr 1996 02:30:14 +0000 (02:30 +0000)
specifies the newline translation to be used for the insertion.  This
allows the compressed-file reading code to specify that the
translation being used is that appropriate for the file being
expanded.  Formerly, the wrong translation was sometimes used because
the compressed file is expanded into a temporary file, which can
reside on a file system with a different translation, and the
translation appropriate for the temporary was used.

v7/src/edwin/fileio.scm
v7/src/edwin/os2.scm
v7/src/edwin/unix.scm

index 24ab2128e76b715e4bb38e5686626ef8a67f6ffd..945bf78c047c6d1eb3661f0b21ec5602bc2b8e11 100644 (file)
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Id: fileio.scm,v 1.134 1996/04/24 02:19:48 cph Exp $
+;;;    $Id: fileio.scm,v 1.135 1996/04/24 02:30:01 cph Exp $
 ;;;
 ;;;    Copyright (c) 1986, 1989-96 Massachusetts Institute of Technology
 ;;;
@@ -163,9 +163,11 @@ of the predicates is satisfied, the file is written in the usual way."
        (method truename mark visit?)
        (let ((do-it
               (lambda ()
-                (group-insert-file! (mark-group mark)
-                                    (mark-index mark)
-                                    truename))))
+                (group-insert-file!
+                 (mark-group mark)
+                 (mark-index mark)
+                 truename
+                 (pathname-newline-translation truename)))))
          (if (ref-variable read-file-message mark)
              (let ((msg
                     (string-append "Reading file \""
@@ -177,15 +179,14 @@ of the predicates is satisfied, the file is written in the usual way."
                  value))
              (do-it))))))
 
-(define (group-insert-file! group index truename)
+(define (group-insert-file! group index truename translation)
   (let ((filename (->namestring truename)))
     (let ((channel (file-open-input-channel filename)))
       (let ((length (channel-file-length channel))
            (buffer
-            (and (ref-variable translate-file-data-on-input group)
-                 (let ((translation (pathname-newline-translation truename)))
-                   (and translation
-                        (make-input-buffer channel 4096 translation))))))
+            (and translation
+                 (ref-variable translate-file-data-on-input group)
+                 (make-input-buffer channel 4096 translation))))
        (bind-condition-handler (list condition-type:allocation-failure)
            (lambda (condition)
              condition
index f0d751574a4c0de08bdfb58b11d098077641fb10..d1b350f7800fcf5d5b888604c47dc8d8c2877420 100644 (file)
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Id: os2.scm,v 1.27 1995/12/19 18:18:51 cph Exp $
+;;;    $Id: os2.scm,v 1.28 1996/04/24 02:30:14 cph Exp $
 ;;;
 ;;;    Copyright (c) 1994-95 Massachusetts Institute of Technology
 ;;;
@@ -322,7 +322,8 @@ filename suffix \".gz\"."
                                      (list pathname mark)))
            (group-insert-file! (mark-group mark)
                                (mark-index mark)
-                               temporary)))))
+                               temporary
+                               (pathname-newline-translation pathname))))))
     (append-message "done")
     value))
 
index a1db764ff52e89775be3cb542a384e97dad4ea1e..229610907d715876b0b89bebcafcd6e4f974d205 100644 (file)
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Id: unix.scm,v 1.66 1996/04/24 02:18:04 cph Exp $
+;;;    $Id: unix.scm,v 1.67 1996/04/24 02:29:50 cph Exp $
 ;;;
 ;;;    Copyright (c) 1989-96 Massachusetts Institute of Technology
 ;;;
@@ -467,7 +467,8 @@ of the filename suffixes \".gz\" or \".Z\"."
                                      (list pathname mark)))
            (group-insert-file! (mark-group mark)
                                (mark-index mark)
-                               temporary)))))
+                               temporary
+                               (pathname-newline-translation pathname))))))
     (append-message "done")
     value))