Pathname completion filters now accept a pathname rather than a
authorChris Hanson <org/chris-hanson/cph>
Sat, 20 May 2000 19:39:20 +0000 (19:39 +0000)
committerChris Hanson <org/chris-hanson/cph>
Sat, 20 May 2000 19:39:20 +0000 (19:39 +0000)
string.

v7/src/imail/imail-file.scm
v7/src/imail/imail-rmail.scm

index a574368f2b25a6f15f37e2db317d9aa9648d8478..06b0758e7085455c8aebb340c6d0dff1158c4297 100644 (file)
@@ -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
 ;;;
 (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
 
index 8bdcb5fdb7f2c98c6a7784d2ab72971ef92d9819..b5a8f8d28bc22023945bdbbca7d90fcc48de8d3a 100644 (file)
@@ -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)