Fix PATHNAME-DEFAULT-MODE so that application of auto-mode-alist

ignores any encoding suffixes.

diff --git a/v7/src/edwin/dosfile.scm b/v7/src/edwin/dosfile.scm
index 2ac4ab51210aa4fe5f1957b5641b3f7e1421fe07..61b86f5a019b0673ac53f19ab66fcc6b8be21957 100644 (file)
--- a/v7/src/edwin/dosfile.scm
+++ b/v7/src/edwin/dosfile.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: dosfile.scm,v 1.22 1999/01/02 06:11:34 cph Exp $
+;;; $Id: dosfile.scm,v 1.23 1999/01/14 18:25:09 cph Exp $
 ;;;
 ;;; Copyright (c) 1994-1999 Massachusetts Institute of Technology
 ;;;
@@ -41,13 +41,13 @@ Includes the new backup.  Must be > 0."
   2
   (lambda (n) (and (exact-integer? n) (> n 0))))
 
-(define dos/encoding-pathname-types
+(define os/encoding-pathname-types
   '("gz" "bf" "ky"))
 
 (define dos/backup-suffixes
   (cons "~"
        (map (lambda (type) (string-append "~." type))
-            dos/encoding-pathname-types)))
+            os/encoding-pathname-types)))
 
 (define-variable completion-ignored-extensions
   "Completion ignores filenames ending in any string in this list."
@@ -207,7 +207,7 @@ Switches may be concatenated, e.g. `-lt' is equivalent to `-l -t'."
       (lambda ()
        (if (dos/fs-long-filenames? truename)
            (let ((type (pathname-type truename)))
-             (if (member type dos/encoding-pathname-types)
+             (if (member type os/encoding-pathname-types)
                  (values (pathname-new-type truename #f)
                          (string-append "~." type))
                  (values truename "~")))
@@ -407,12 +407,6 @@ Switches may be concatenated, e.g. `-lt' is equivalent to `-l -t'."
   truename buffer
   #f)
 
-(define (os/pathname-type-for-mode pathname)
-  (let ((type (pathname-type pathname)))
-    (if (member type dos/encoding-pathname-types)
-       (pathname-type (->namestring (pathname-new-type pathname #f)))
-       type)))
-
 (define (os/completion-ignore-filename? filename)
   (or (os/backup-filename? filename)
       (os/auto-save-filename? filename)

diff --git a/v7/src/edwin/fileio.scm b/v7/src/edwin/fileio.scm
index 1fedcbdaee77e2d9be687149c1bedb4a732a4d34..31742857e8b8b63fbed515f11f200d5cda8b1de6 100644 (file)
--- a/v7/src/edwin/fileio.scm
+++ b/v7/src/edwin/fileio.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: fileio.scm,v 1.144 1999/01/02 06:11:34 cph Exp $
+;;; $Id: fileio.scm,v 1.145 1999/01/14 18:24:58 cph Exp $
 ;;;
 ;;; Copyright (c) 1986, 1989-1999 Massachusetts Institute of Technology
 ;;;
@@ -231,21 +231,26 @@ of the predicates is satisfied, the file is written in the usual way."
                           (if (re-search-forward "[ \t]*;" m end false)
                               (re-match-start 0)
                               end)))))))))))
-
+\f
 (define (pathname-default-mode pathname buffer)
-  (or (let ((filename (->namestring pathname)))
-       (let loop ((types (ref-variable auto-mode-alist buffer)))
-         (and (not (null? types))
-              (if (re-string-match (caar types) filename)
-                  (->mode (cdar types))
-                  (loop (cdr types))))))
-      (let ((type (os/pathname-type-for-mode pathname)))
-       (and (string? type)
-            (let loop ((types (ref-variable file-type-to-major-mode buffer)))
-              (and (not (null? types))
-                   (if (string-ci=? type (caar types))
-                       (->mode (cdar types))
-                       (loop (cdr types)))))))))
+  (let ((pathname
+        (if (member (pathname-type pathname) os/encoding-pathname-types)
+            (->namestring (pathname-new-type pathname #f))
+            pathname)))
+    (or (let ((filename (->namestring pathname)))
+         (let loop ((types (ref-variable auto-mode-alist buffer)))
+           (and (not (null? types))
+                (if (re-string-match (caar types) filename)
+                    (->mode (cdar types))
+                    (loop (cdr types))))))
+       (let ((type (pathname-type pathname)))
+         (and (string? type)
+              (let loop
+                  ((types (ref-variable file-type-to-major-mode buffer)))
+                (and (not (null? types))
+                     (if (string-ci=? type (caar types))
+                         (->mode (cdar types))
+                         (loop (cdr types))))))))))
 
 (define (string->mode-alist? object)
   (and (alist? object)

diff --git a/v7/src/edwin/unix.scm b/v7/src/edwin/unix.scm
index 2fb9c26eb11bcfb43fe4713eb726a8703b575ceb..6f1aa930e153071ac150827f02614f72f83829cb 100644 (file)
--- a/v7/src/edwin/unix.scm
+++ b/v7/src/edwin/unix.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: unix.scm,v 1.88 1999/01/02 06:11:34 cph Exp $
+;;; $Id: unix.scm,v 1.89 1999/01/14 18:25:03 cph Exp $
 ;;;
 ;;; Copyright (c) 1989-1999 Massachusetts Institute of Technology
 ;;;
@@ -161,7 +161,7 @@ Includes the new backup.  Must be > 0."
   (call-with-values
       (lambda ()
        (let ((type (pathname-type truename)))
-         (if (member type unix/encoding-pathname-types)
+         (if (member type os/encoding-pathname-types)
              (values (pathname-new-type truename #f)
                      (string-append "~." type))
              (values truename "~"))))
@@ -235,13 +235,13 @@ Includes the new backup.  Must be > 0."
              (directory-channel-close channel)
              result))))))
 \f
-(define unix/encoding-pathname-types
+(define os/encoding-pathname-types
   '("Z" "gz" "KY" "ky" "bf"))
 
 (define unix/backup-suffixes
   (cons "~"
        (map (lambda (type) (string-append "~." type))
-            unix/encoding-pathname-types)))
+            os/encoding-pathname-types)))
 
 (define (os/backup-filename? filename)
   (let ((end (string-length filename)))
@@ -274,12 +274,6 @@ Includes the new backup.  Must be > 0."
                                                  (fix:+ index 1)
                                                  suffix)))))))))
 
-(define (os/pathname-type-for-mode pathname)
-  (let ((type (pathname-type pathname)))
-    (if (member type unix/encoding-pathname-types)
-       (pathname-type (->namestring (pathname-new-type pathname false)))
-       type)))
-
 (define (os/completion-ignore-filename? filename)
   (and (not (file-test-no-errors file-directory? filename))
        (there-exists? (ref-variable completion-ignored-extensions)