From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 20 Jun 2000 19:47:15 +0000 (+0000)
Subject: Allow file completion to complete to any file.
X-Git-Tag: 20090517-FFI~3468
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=f10ecd631eb3a4353e383b0d7b6d8302e290c482;p=mit-scheme.git

Allow file completion to complete to any file.
---

diff --git a/v7/src/imail/imail-file.scm b/v7/src/imail/imail-file.scm
index c589ab946..b843c7d48 100644
--- a/v7/src/imail/imail-file.scm
+++ b/v7/src/imail/imail-file.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-file.scm,v 1.45 2000/06/19 05:00:49 cph Exp $
+;;; $Id: imail-file.scm,v 1.46 2000/06/20 19:47:05 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -42,13 +42,13 @@
 (define-method url-exists? ((url <file-url>))
   (file-exists? (file-url-pathname url)))
 
-(define (define-file-url-completers class filter)
+(define (define-file-url-completers class)
   (define-method %url-complete-string
       ((string <string>) (default-url class)
 			 if-unique if-not-unique if-not-found)
     (pathname-complete-string
      (merge-pathnames string (file-url-pathname default-url))
-     filter
+     (lambda (pathname) pathname #t)
      (lambda (string)
        (if-unique (->namestring string)))
      (lambda (prefix get-completions)
@@ -60,12 +60,7 @@
     (map ->namestring
 	 (pathname-completions-list
 	  (merge-pathnames string (file-url-pathname default-url))
-	  filter))))
-
-(define ((file-type-filter type) pathname)
-  (let ((type* (pathname-type pathname)))
-    (and type*
-	 (string=? type* type))))
+	  (lambda (pathname) pathname #t)))))
 
 ;;;; Server operations
 
diff --git a/v7/src/imail/imail-rmail.scm b/v7/src/imail/imail-rmail.scm
index 4a1411796..d6ba41b63 100644
--- a/v7/src/imail/imail-rmail.scm
+++ b/v7/src/imail/imail-rmail.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-rmail.scm,v 1.41 2000/06/19 05:00:51 cph Exp $
+;;; $Id: imail-rmail.scm,v 1.42 2000/06/20 19:47:01 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -26,6 +26,7 @@
 
 (define-class <rmail-url> (<file-url>))
 (define-url-protocol "rmail" <rmail-url>)
+(define-file-url-completers <rmail-url>)
 
 (define make-rmail-url
   (let ((constructor (instance-constructor <rmail-url> '(PATHNAME))))
@@ -40,12 +41,6 @@
    (merge-pathnames (pathname-default-type name "rmail")
 		    (directory-pathname (file-url-pathname url)))))
 
-(define-file-url-completers <rmail-url>
-  (let ((type-filter (file-type-filter "rmail")))
-    (lambda (pathname)
-      (or (string-ci=? (file-namestring pathname) "rmail")
-	  (type-filter pathname)))))
-
 ;;;; Server operations
 
 (define-method %open-folder ((url <rmail-url>))
diff --git a/v7/src/imail/imail-umail.scm b/v7/src/imail/imail-umail.scm
index 8ff64703a..aa26b4df9 100644
--- a/v7/src/imail/imail-umail.scm
+++ b/v7/src/imail/imail-umail.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-umail.scm,v 1.33 2000/06/19 05:00:53 cph Exp $
+;;; $Id: imail-umail.scm,v 1.34 2000/06/20 19:46:56 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -26,6 +26,7 @@
 
 (define-class <umail-url> (<file-url>))
 (define-url-protocol "umail" <umail-url>)
+(define-file-url-completers <umail-url>)
 
 (define make-umail-url
   (let ((constructor (instance-constructor <umail-url> '(PATHNAME))))
@@ -40,9 +41,6 @@
    (merge-pathnames (pathname-default-type name "mail")
 		    (directory-pathname (file-url-pathname url)))))
 
-(define-file-url-completers <umail-url>
-  (file-type-filter "mail"))
-
 ;;;; Server operations
 
 (define-method %open-folder ((url <umail-url>))
diff --git a/v7/src/imail/todo.txt b/v7/src/imail/todo.txt
index 2eee5f103..86d356c96 100644
--- a/v7/src/imail/todo.txt
+++ b/v7/src/imail/todo.txt
@@ -1,11 +1,9 @@
 IMAIL To-Do List
-$Id: todo.txt,v 1.91 2000/06/20 19:44:11 cph Exp $
+$Id: todo.txt,v 1.92 2000/06/20 19:47:15 cph Exp $
 
 Bug fixes
 ---------
 
-* Change file URL completion to complete to any file name.
-
 * Preserve internal-date when copying to rmail folder from any other
   type of folder, by writing a distinguished header field into the
   rmail file.