Implement new operation OS/FILE-END-OF-LINE-TRANSLATION, which is used

to determine appropriate line-translation by interrogating the file
system to determine its type.  Currently this is interesting only for
OS/2, in which it is common to mount unix file systems.

diff --git a/v7/src/runtime/dosprm.scm b/v7/src/runtime/dosprm.scm
index f327a5ec439afb7bcc94e74c1bab11660e9f7bbc..672dc2cadd66176c6fc935c60354812e9c176d70 100644 (file)
--- a/v7/src/runtime/dosprm.scm
+++ b/v7/src/runtime/dosprm.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: dosprm.scm,v 1.30 1995/10/18 05:09:08 cph Exp $
+$Id: dosprm.scm,v 1.31 1995/10/23 06:39:32 cph Exp $
 
 Copyright (c) 1992-95 Massachusetts Institute of Technology
 
@@ -290,6 +290,10 @@ MIT in each case. |#
   ((ucode-primitive directory-delete 1)
    (->namestring (directory-pathname-as-file (merge-pathnames name)))))
 
+(define (os/file-end-of-line-translation pathname)
+  pathname
+  "\r\n")
+
 (define (os/default-end-of-line-translation)
   "\r\n")
 

diff --git a/v7/src/runtime/dospth.scm b/v7/src/runtime/dospth.scm
index ff5093e23fec6f33687554c001d600bf11dc7789..13e16d0a5aea3c4d00ff040dc897be208bdc2e18 100644 (file)
--- a/v7/src/runtime/dospth.scm
+++ b/v7/src/runtime/dospth.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: dospth.scm,v 1.30 1995/10/18 05:00:30 cph Exp $
+$Id: dospth.scm,v 1.31 1995/10/23 06:38:26 cph Exp $
 
 Copyright (c) 1992-95 Massachusetts Institute of Technology
 
@@ -371,5 +371,4 @@ MIT in each case. |#
   (hook/dos/end-of-line-string pathname))
 
 (define (default/dos/end-of-line-string pathname)
-  pathname                             ; ignored
-  (os/default-end-of-line-translation))
\ No newline at end of file
+  (os/file-end-of-line-translation pathname))
\ No newline at end of file

diff --git a/v7/src/runtime/os2prm.scm b/v7/src/runtime/os2prm.scm
index 8dca1e2abd3095aeebf4fa35597840b6a084d437..bbcdab741cb29589ec9b58e743a3c5534753bd96 100644 (file)
--- a/v7/src/runtime/os2prm.scm
+++ b/v7/src/runtime/os2prm.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: os2prm.scm,v 1.18 1995/07/07 06:37:24 cph Exp $
+$Id: os2prm.scm,v 1.19 1995/10/23 06:38:35 cph Exp $
 
 Copyright (c) 1994-95 Massachusetts Institute of Technology
 
@@ -228,11 +228,6 @@ MIT in each case. |#
          (try-directory "\\")
          (error "Can't find temporary directory.")))))
 
-(define (os2/fs-long-filenames? pathname)
-  (not (string-ci=? "fat"
-                   ((ucode-primitive drive-type 1)
-                    (pathname-device pathname)))))
-
 (define-integrable os2/current-pid
   (ucode-primitive current-pid 0))
 
@@ -255,6 +250,32 @@ MIT in each case. |#
                    (pathname-as-directory (merge-pathnames directory))
                    user-name)))))
       "\\"))
+\f
+(define (os2/fs-drive-type pathname)
+  (let ((type ((ucode-primitive drive-type 1) (pathname-device pathname))))
+    (let ((colon (string-find-next-char type #\:)))
+      (if colon
+         (cons (string-head type colon) (string-tail type (fix:+ colon 1)))
+         (cons type "")))))
+
+(define (os2/fs-long-filenames? pathname)
+  (not (string-ci=? "fat" (car (os2/fs-drive-type pathname)))))
+
+(define (os/file-end-of-line-translation pathname)
+  (let ((type (os2/fs-drive-type pathname)))
+    ;; "ext2" is the Linux ext2 file-system driver.  "NFS" is the IBM
+    ;; TCP/IP NFS driver, which we further qualify by examining the
+    ;; mount info -- if the directory starts with a "/", we assume
+    ;; that it is a unix system.
+    (if (or (string=? "ext2" (car type))
+           (and (string=? "NFS" (car type))
+                (let* ((mount (cdr type))
+                       (colon (string-find-next-char mount #\:)))
+                  (and colon
+                       (fix:< (fix:+ colon 1) (string-length mount))
+                       (char=? #\/ (string-ref mount (fix:+ colon 1)))))))
+       #f
+       "\r\n")))
 
 (define (os/default-end-of-line-translation)
   "\r\n")

diff --git a/v7/src/runtime/unxprm.scm b/v7/src/runtime/unxprm.scm
index 93cc4d7ec606efd89bd9f5f895153686f6cf64f9..6cd60dbc75fbcdffb22ffcc9dc378a1c13ff98a8 100644 (file)
--- a/v7/src/runtime/unxprm.scm
+++ b/v7/src/runtime/unxprm.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: unxprm.scm,v 1.39 1995/10/18 05:02:57 cph Exp $
+$Id: unxprm.scm,v 1.40 1995/10/23 06:39:22 cph Exp $
 
 Copyright (c) 1988-95 Massachusetts Institute of Technology
 
@@ -290,6 +290,10 @@ MIT in each case. |#
   ((ucode-primitive directory-delete 1)
    (->namestring (directory-pathname-as-file (merge-pathnames name)))))
 
+(define (os/file-end-of-line-translation pathname)
+  pathname
+  #f)
+
 (define (os/default-end-of-line-translation)
   #f)
 \f