Fix handling of compressed backup files in Dired.
authorChris Hanson <org/chris-hanson/cph>
Mon, 13 Jan 1992 20:15:34 +0000 (20:15 +0000)
committerChris Hanson <org/chris-hanson/cph>
Mon, 13 Jan 1992 20:15:34 +0000 (20:15 +0000)
v7/src/edwin/dired.scm
v7/src/edwin/unix.scm

index 3c5b80a66ff98e1022955ed845c1caa535fe0998..03b3774b98bab0528c1ecf120cdd9f2cdb8401d1 100644 (file)
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/dired.scm,v 1.121 1991/11/06 22:45:48 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/dired.scm,v 1.122 1992/01/13 20:15:34 cph Exp $
 ;;;
-;;;    Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
+;;;    Copyright (c) 1986, 1989-92 Massachusetts Institute of Technology
 ;;;
 ;;;    This material was developed by the Scheme project at the
 ;;;    Massachusetts Institute of Technology, Department of
@@ -474,8 +474,8 @@ CANNOT contain the 'F' option."
       (lambda ()
        (for-each-file-line (current-buffer)
          (lambda (lstart)
-           (if (let ((lend (line-end lstart 0)))
-                 (match-forward "~" (mark- lend 1) lend))
+           (if (os/backup-filename?
+                (region->string (dired-filename-region lstart)))
                (dired-mark-1 lstart #\D))))))))
 
 (define (dired-kill-files)
index b87199fbb5ee98e7e4bf7ba5279e981ad7edb75f..7b80b5a9b99750ce4561fe73f2933cf675ac7b98 100644 (file)
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/unix.scm,v 1.20 1992/01/13 19:20:25 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/unix.scm,v 1.21 1992/01/13 20:15:26 cph Exp $
 ;;;
 ;;;    Copyright (c) 1989-92 Massachusetts Institute of Technology
 ;;;
@@ -284,6 +284,17 @@ Includes the new backup.  Must be > 0."
 (define unix/encoding-pathname-types
   '("Z"))
 
+(define unix/backup-suffixes
+  (cons "~"
+       (map (lambda (type) (string-append "~." type))
+            unix/encoding-pathname-types)))
+
+(define (os/backup-filename? filename)
+  (let loop ((suffixes unix/backup-suffixes))
+    (and (not (null? suffixes))
+        (or (string-suffix? (car suffixes) filename)
+            (loop (cdr suffixes))))))
+
 (define (os/pathname-type-for-mode pathname)
   (let ((type (pathname-type pathname)))
     (if (member type unix/encoding-pathname-types)
@@ -291,11 +302,10 @@ Includes the new backup.  Must be > 0."
        type)))
 
 (define (os/completion-ignored-extensions)
-  (append '(".o" ".elc" "~" ".bin" ".lbin" ".fasl"
+  (append '(".o" ".elc" ".bin" ".lbin" ".fasl"
                 ".dvi" ".toc" ".log" ".aux"
                 ".lof" ".blg" ".bbl" ".glo" ".idx" ".lot")
-         (map (lambda (type) (string-append "~." type))
-              unix/encoding-pathname-types)))
+         (list-copy unix/backup-suffixes)))
 
 (define (os/file-type-to-major-mode)
   (alist-copy