From 5590ebc454b74dd15cf7b70ab0ee48a938ffee79 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Fri, 12 May 2000 18:00:56 +0000 Subject: [PATCH] Eliminate unused parts of IMAP URL. --- v7/src/imail/imail-imap.scm | 42 +++++++++---------------------------- v7/src/imail/imail-top.scm | 12 +++-------- 2 files changed, 13 insertions(+), 41 deletions(-) diff --git a/v7/src/imail/imail-imap.scm b/v7/src/imail/imail-imap.scm index f40ad5ed8..aa2feafcc 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.31 2000/05/12 17:56:24 cph Exp $ +;;; $Id: imail-imap.scm,v 1.32 2000/05/12 18:00:52 cph Exp $ ;;; ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology ;;; @@ -25,24 +25,19 @@ ;;;; URL (define-class ( - (constructor %make-imap-url - (user-id auth-type host port mailbox uid))) + (constructor %make-imap-url (user-id host port mailbox))) () ;; User name to connect as. (user-id define accessor) - ;; Type of authentication to use. Ignored. - (auth-type define accessor) ;; Name or IP address of host to connect to. (host define accessor) ;; Port number to connect to. (port define accessor) ;; Name of mailbox to access. - (mailbox define accessor) - ;; Unique ID specifying a message. Ignored. - (uid define accessor)) + (mailbox define accessor)) -(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 (make-imap-url user-id host port mailbox) + (save-url (%make-imap-url user-id host port mailbox))) (define-url-protocol "imap" (let ((//server/ @@ -58,35 +53,22 @@ (or (parse-substring mbox string (car pv1) end) (error:bad-range-argument string 'STRING->URL)))) (%make-imap-url (parser-token pv1 'USER-ID) - (parser-token pv1 'AUTH-TYPE) (parser-token pv1 'HOST) (let ((port (parser-token pv1 'PORT))) (and port (string->number port))) - (parser-token pv2 'MAILBOX) - (parser-token pv2 'UID)))))))) + (parser-token pv2 'MAILBOX)))))))) (define-method url-body ((url )) (string-append (let ((user-id (imap-url-user-id url)) - (auth-type (imap-url-auth-type url)) (host (imap-url-host url)) (port (imap-url-port url))) - (if (or user-id auth-type host port) + (if (or user-id host port) (string-append "//" - (if (or user-id auth-type) - (string-append (if user-id - (url:encode-string user-id) - "") - (if auth-type - (string-append - ";auth=" - (if (string=? auth-type "*") - auth-type - (url:encode-string auth-type))) - "") - "@") + (if user-id + (string-append (url:encode-string user-id) "@") "") host (if port @@ -94,11 +76,7 @@ "") "/") "")) - (url:encode-string (imap-url-mailbox url)) - (let ((uid (imap-url-uid url))) - (if uid - (string-append "/;uid=" uid) - "")))) + (url:encode-string (imap-url-mailbox url)))) (define-method url-presentation-name ((url )) (imap-url-mailbox url)) diff --git a/v7/src/imail/imail-top.scm b/v7/src/imail/imail-top.scm index 4a0754921..559ba8ea2 100644 --- 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.41 2000/05/12 17:56:28 cph Exp $ +;;; $Id: imail-top.scm,v 1.42 2000/05/12 18:00:56 cph Exp $ ;;; ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology ;;; @@ -182,16 +182,12 @@ May be called with an IMAIL folder URL as argument; (let ((url* (imail-default-imap-url))) (make-imap-url (or (imap-url-user-id url) (imap-url-user-id url*)) - (or (imap-url-auth-type url) - (imap-url-auth-type url*)) (or (imap-url-host url) (imap-url-host url*)) (or (imap-url-port url) (imap-url-port url*)) (or (imap-url-mailbox url) - (imap-url-mailbox url*)) - (or (imap-url-uid url) - (imap-url-uid url*)))) + (imap-url-mailbox url*)))) url))) (define (imail-default-imap-url) @@ -207,11 +203,9 @@ May be called with an IMAIL folder URL as argument; (lambda (host port) (make-imap-url (or (ref-variable imail-default-user-id) (current-user-name)) - #f host port - (ref-variable imail-default-imap-mailbox) - #f)))) + (ref-variable imail-default-imap-mailbox))))) (define (imail-present-user-alert procedure) (call-with-output-to-temporary-buffer " *IMAP alert*" -- 2.25.1