;;; -*-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
;;; -*-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
;;;
(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)