From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 13 Jan 1992 20:15:34 +0000 (+0000)
Subject: Fix handling of compressed backup files in Dired.
X-Git-Tag: 20090517-FFI~9998
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=aaa2832e6fd9681188104d2f16e288a1800f75d5;p=mit-scheme.git

Fix handling of compressed backup files in Dired.
---

diff --git a/v7/src/edwin/dired.scm b/v7/src/edwin/dired.scm
index 3c5b80a66..03b3774b9 100644
--- a/v7/src/edwin/dired.scm
+++ b/v7/src/edwin/dired.scm
@@ -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)
diff --git a/v7/src/edwin/unix.scm b/v7/src/edwin/unix.scm
index b87199fbb..7b80b5a9b 100644
--- a/v7/src/edwin/unix.scm
+++ b/v7/src/edwin/unix.scm
@@ -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