Implement URL-USER-ID.

diff --git a/v7/src/imail/imail-core.scm b/v7/src/imail/imail-core.scm
index cfbdeecca020e063bcf7cfc65230a91a0a3df640..7afd929ea80c3f01c1f8eb4cf669a6b84277802b 100644 (file)
--- a/v7/src/imail/imail-core.scm
+++ b/v7/src/imail/imail-core.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-core.scm,v 1.29 2000/04/18 21:20:00 cph Exp $
+;;; $Id: imail-core.scm,v 1.30 2000/04/23 04:02:38 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -81,6 +81,9 @@
 
 (define url-protocol-parsers
   (make-string-hash-table))
+
+(define-generic url-user-id (url))
+(define-method url-user-id ((url <url>)) url #f)
 \f
 (define (get-memoized-folder url)
   (let ((folder (hash-table/get memoized-folders url #f)))

diff --git a/v7/src/imail/imail-top.scm b/v7/src/imail/imail-top.scm
index a60db506d2737964e3f61b5a605f6fa642291737..d74786a681ab4e2603fc2db0e73b4731335aade5 100644 (file)
--- a/v7/src/imail/imail-top.scm
+++ b/v7/src/imail/imail-top.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-top.scm,v 1.20 2000/04/14 01:45:39 cph Exp $
+;;; $Id: imail-top.scm,v 1.21 2000/04/23 04:02:48 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -101,7 +101,8 @@ May be called with an IMAIL folder URL as argument;
 
 (define (imail-authenticator url)
   (let ((user-name
-        (or (ref-variable imail-user-name)
+        (or (url-user-id url)
+            (ref-variable imail-user-name)
             (current-user-name))))
     (values user-name
            (call-with-pass-phrase