From d1d140e640c96395bb06327e63478333e35af3d5 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Wed, 10 May 2000 17:05:24 +0000 Subject: [PATCH] Fix bug: URLs weren't being properly memoized when created from components rather than being translated from a string. --- v7/src/imail/imail-imap.scm | 6 +++--- v7/src/imail/imail-umail.scm | 15 +++++++++------ 2 files changed, 12 insertions(+), 9 deletions(-) diff --git a/v7/src/imail/imail-imap.scm b/v7/src/imail/imail-imap.scm index 6bf6184f8..85f88d9fc 100644 --- a/v7/src/imail/imail-imap.scm +++ b/v7/src/imail/imail-imap.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: imail-imap.scm,v 1.25 2000/05/10 17:03:21 cph Exp $ +;;; $Id: imail-imap.scm,v 1.26 2000/05/10 17:05:24 cph Exp $ ;;; ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology ;;; @@ -41,8 +41,8 @@ ;; Unique ID specifying a message. Ignored. (uid define accessor)) -(define (make-rmail-url user-id auth-type host port mailbox uid) - (save-url (%make-rmail-url user-id auth-type host port mailbox uid))) +(define (make-imap-url user-id auth-type host port mailbox uid) + (save-url (%make-imap-url user-id auth-type host port mailbox uid))) (define-url-protocol "imap" (let ((//server/ diff --git a/v7/src/imail/imail-umail.scm b/v7/src/imail/imail-umail.scm index dc5718d07..991705c21 100644 --- a/v7/src/imail/imail-umail.scm +++ b/v7/src/imail/imail-umail.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: imail-umail.scm,v 1.17 2000/05/08 19:07:54 cph Exp $ +;;; $Id: imail-umail.scm,v 1.18 2000/05/10 17:03:30 cph Exp $ ;;; ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology ;;; @@ -26,15 +26,18 @@ (define-class ()) -(define make-umail-url +(define-url-protocol "umail" + (lambda (string) + (%make-umail-url (short-name->pathname string)))) + +(define (make-umail-url pathname) + (save-url (%make-umail-url pathname))) + +(define %make-umail-url (let ((constructor (instance-constructor '(PATHNAME)))) (lambda (pathname) (constructor (merge-pathnames pathname))))) -(define-url-protocol "umail" - (lambda (string) - (make-umail-url (short-name->pathname string)))) - ;;;; Server operations (define-method %open-folder ((url )) -- 2.25.1