Simplify handling of file-URL completion: this is now identical for
authorChris Hanson <org/chris-hanson/cph>
Fri, 30 Jun 2000 02:59:57 +0000 (02:59 +0000)
committerChris Hanson <org/chris-hanson/cph>
Fri, 30 Jun 2000 02:59:57 +0000 (02:59 +0000)
all file URLs, so have only one method for that class.

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

index 2bab9b1a0276582045846d63c633f4e1d3e22e6c..d13d363064de4bc10b8039021c96323e4e8427a8 100644 (file)
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-file.scm,v 1.49 2000/06/23 19:29:41 cph Exp $
+;;; $Id: imail-file.scm,v 1.50 2000/06/30 02:59:54 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
 (define-method url-exists? ((url <file-url>))
   (file-exists? (file-url-pathname url)))
 
-(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))
-     (lambda (pathname) pathname #t)
-     (lambda (string)
-       (if-unique (->namestring string)))
-     (lambda (prefix get-completions)
-       (if-not-unique (->namestring prefix)
-                     (lambda () (map ->namestring (get-completions)))))
-     if-not-found))
-  (define-method %url-string-completions
-      ((string <string>) (default-url class))
-    (map ->namestring
-        (pathname-completions-list
-         (merge-pathnames string (file-url-pathname default-url))
-         (lambda (pathname) pathname #t)))))
+(define-method %url-complete-string
+    ((string <string>) (default-url <file-url>)
+                      if-unique if-not-unique if-not-found)
+  (pathname-complete-string
+   (merge-pathnames string (file-url-pathname default-url))
+   (lambda (pathname) pathname #t)
+   (lambda (string)
+     (if-unique (->namestring string)))
+   (lambda (prefix get-completions)
+     (if-not-unique (->namestring prefix)
+                   (lambda () (map ->namestring (get-completions)))))
+   if-not-found))
+
+(define-method %url-string-completions
+    ((string <string>) (default-url <file-url>))
+  (map ->namestring
+       (pathname-completions-list
+       (merge-pathnames string (file-url-pathname default-url))
+       (lambda (pathname) pathname #t))))
 
 ;;;; Server operations
 
index 88dada0429eb9c8a5ba8a05c3f617e10672d5408..4980cac692f091f2b581298f38d329b5697e6c40 100644 (file)
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-rmail.scm,v 1.46 2000/06/30 02:57:22 cph Exp $
+;;; $Id: imail-rmail.scm,v 1.47 2000/06/30 02:59:55 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -26,7 +26,6 @@
 
 (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))))
index 602541bee3e75a113717cddacc20be280748f9b6..6d59471b6c960ea9c926f90c0309cc50fe5d0c2d 100644 (file)
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-umail.scm,v 1.35 2000/06/30 02:57:23 cph Exp $
+;;; $Id: imail-umail.scm,v 1.36 2000/06/30 02:59:57 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -26,7 +26,6 @@
 
 (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))))