From: Chris Hanson <org/chris-hanson/cph>
Date: Sat, 20 May 2000 19:39:20 +0000 (+0000)
Subject: Pathname completion filters now accept a pathname rather than a
X-Git-Tag: 20090517-FFI~3769
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=5cd3ffb80aa0cb852d2185fb5aa1bfaa47274724;p=mit-scheme.git

Pathname completion filters now accept a pathname rather than a
string.
---

diff --git a/v7/src/imail/imail-file.scm b/v7/src/imail/imail-file.scm
index a574368f2..06b0758e7 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.29 2000/05/20 03:22:46 cph Exp $
+;;; $Id: imail-file.scm,v 1.30 2000/05/20 19:39:14 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -50,13 +50,14 @@
 (define (file-suffix-filter suffix)
   (let ((suffix (string-append "." suffix)))
     (let ((l (string-length suffix)))
-      (lambda (string)
-	(let ((i (string-search-forward suffix string)))
-	  (and i
-	       (fix:> i 0)
-	       (let ((i (fix:+ i l)))
-		 (or (fix:= i (string-length string))
-		     (char=? #\. (string-ref string i))))))))))
+      (lambda (pathname)
+	(let ((string (file-namestring pathname)))
+	  (let ((i (string-search-forward suffix string)))
+	    (and i
+		 (fix:> i 0)
+		 (let ((i (fix:+ i l)))
+		   (or (fix:= i (string-length string))
+		       (char=? #\. (string-ref string i)))))))))))
 
 ;;;; Server operations
 
diff --git a/v7/src/imail/imail-rmail.scm b/v7/src/imail/imail-rmail.scm
index 8bdcb5fdb..b5a8f8d28 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.32 2000/05/20 03:22:48 cph Exp $
+;;; $Id: imail-rmail.scm,v 1.33 2000/05/20 19:39:20 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -28,8 +28,8 @@
 
 (let ((filter
        (let ((suffix-filter (file-suffix-filter "rmail")))
-	 (lambda (string)
-	   (or (string-ci=? string "rmail")
+	 (lambda (pathname)
+	   (or (string-ci=? (file-namestring pathname) "rmail")
 	       (suffix-filter string))))))
   (define-url-protocol "rmail" <rmail-url>
     (lambda (string)