;;; elmo-imap4.el -- IMAP4 Interface for ELMO.
-;; Copyright 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
+;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
+;; Copyright (C) 1999,2000 Kenichi OKADA <okada@opaopa.org>
+;; Copyright (C) 2000 OKAZAKI Tetsurou <okazaki@be.to>
+;; Copyright (C) 2000 Daiki Ueno <ueno@unixuser.org>
;; Author: Yuuichi Teranishi <teranisi@gohome.org>
+;; Kenichi OKADA <okada@opaopa.org>
+;; OKAZAKI Tetsurou <okazaki@be.to>
+;; Daiki Ueno <ueno@unixuser.org>
;; Keywords: mail, net news
;; This file is part of ELMO (Elisp Library for Message Orchestration).
(defvar elmo-imap4-extra-namespace-alist
'(("^{.*/nntp}.*$" . ".")) ; Default is for UW's remote nntp mailbox...
- "Extra namespace alist. A list of cons cell like: (REGEXP . DELIMITER) ")
+ "Extra namespace alist. A list of cons cell like: (REGEXP . DELIMITER).")
(defvar elmo-imap4-default-hierarchy-delimiter "/")
(defvar elmo-imap4-server-capability nil)
(elmo-imap4-response-value (, response) 'bye)))))
(defmacro elmo-imap4-response-bodydetail-text (response)
- "Returns text of BODY[section]<partial>"
+ "Returns text of BODY[section]<partial>."
(` (nth 3 (assq 'bodydetail (, response)))))
;;; Session commands.
(unless (string= (elmo-imap4-spec-username spec)
elmo-default-imap4-user)
(setq append-serv (concat ":" (elmo-imap4-spec-username spec))))
+ (unless (eq (elmo-imap4-spec-auth spec)
+ elmo-default-imap4-authenticate-type)
+ (setq append-serv
+ (concat append-serv "/" (symbol-name (elmo-imap4-spec-auth spec)))))
(unless (string= (elmo-imap4-spec-hostname spec)
elmo-default-imap4-server)
(setq append-serv (concat append-serv "@" (elmo-imap4-spec-hostname
(setq append-serv (concat append-serv
(elmo-network-stream-type-spec-string
type)))))
- (mapcar (lambda (fld)
- (concat "%" (elmo-imap4-decode-folder-string fld)
- (and append-serv
- (eval append-serv))))
- result)))
+ (if hierarchy
+ (let (folder folders ret)
+ (while (setq folders (car result))
+ (if (prog1
+ (string-match
+ (concat "^\\(" root "[^" delim "]" "+\\)" delim)
+ folders)
+ (setq folder (match-string 1 folders)))
+ (progn
+ (setq ret
+ (append ret (list (list
+ (concat "%" (elmo-imap4-decode-folder-string folder)
+ (and append-serv
+ (eval append-serv)))))))
+ (setq result
+ (delq nil
+ (mapcar '(lambda (fld)
+ (unless
+ (string-match
+ (concat "^" (regexp-quote folder))
+ fld)
+ fld))
+ result))))
+ (setq ret (append ret (list
+ (concat "%" (elmo-imap4-decode-folder-string folders)
+ (and append-serv
+ (eval append-serv))))))
+ (setq result (cdr result))))
+ ret)
+ (mapcar (lambda (fld)
+ (concat "%" (elmo-imap4-decode-folder-string fld)
+ (and append-serv
+ (eval append-serv))))
+ result))))
(defun elmo-imap4-folder-exists-p (spec)
(let ((session (elmo-imap4-get-session spec)))
(elmo-imap4-session-select-mailbox
session
(elmo-imap4-spec-mailbox spec)
- 'force))))
+ 'force 'no-error))))
(defun elmo-imap4-folder-creatable-p (spec)
t)
(elmo-imap4-mailbox (elmo-imap4-spec-mailbox spec)))))))
(defun elmo-imap4-rename-folder (old-spec new-spec)
- ;;(elmo-imap4-send-command-wait session "close")
+;;;(elmo-imap4-send-command-wait session "close")
(elmo-imap4-send-command-wait
(elmo-imap4-get-session old-spec)
(list "rename "
'force)
(elmo-imap4-session-check session)))))))
-(defun elmo-imap4-session-select-mailbox (session mailbox &optional force)
+(defun elmo-imap4-session-select-mailbox (session mailbox
+ &optional force no-error)
+ "Select MAILBOX in SESSION.
+If optional argument FORCE is non-nil, select mailbox even if current mailbox
+is same as MAILBOX.
+If second optional argument NO-ERROR is non-nil, don't cause an error when
+selecting folder was failed.
+Returns response value if selecting folder succeed. "
(when (or force
(not (string=
(elmo-imap4-session-current-mailbox-internal session)
mailbox)))
- (let (response)
+ (let (response result)
(unwind-protect
(setq response
(elmo-imap4-read-response
(list
"select "
(elmo-imap4-mailbox mailbox)))))
- (if (elmo-imap4-response-ok-p response)
+ (if (setq result (elmo-imap4-response-ok-p response))
(progn
(elmo-imap4-session-set-current-mailbox-internal session mailbox)
(elmo-imap4-session-set-read-only-internal
session
(nth 1 (assq 'read-only (assq 'ok response)))))
(elmo-imap4-session-set-current-mailbox-internal session nil)
- (error (or
- (elmo-imap4-response-error-text response)
- (format "Select %s failed" mailbox))))))))
+ (unless no-error
+ (error (or
+ (elmo-imap4-response-error-text response)
+ (format "Select %s failed" mailbox))))))
+ (and result response))))
(defun elmo-imap4-check-validity (spec validity-file)
- ;; Not used.
-; (elmo-imap4-send-command-wait
-; (elmo-imap4-get-session spec)
-; (list "status "
-; (elmo-imap4-mailbox
-; (elmo-imap4-spec-mailbox spec))
-; " (uidvalidity)")))
+;;; Not used.
+;;;(elmo-imap4-send-command-wait
+;;;(elmo-imap4-get-session spec)
+;;;(list "status "
+;;; (elmo-imap4-mailbox
+;;; (elmo-imap4-spec-mailbox spec))
+;;; " (uidvalidity)")))
)
(defun elmo-imap4-sync-validity (spec validity-file)
(luna-define-method elmo-network-initialize-session ((session
elmo-imap4-session))
- (let ((process (elmo-network-session-process-internal session))
- capability)
+ (let ((process (elmo-network-session-process-internal session)))
(with-current-buffer (process-buffer process)
;; Skip garbage output from process before greeting.
(while (and (memq (process-status process) '(open run))
(accept-process-output process 1))
(set-process-filter process 'elmo-imap4-arrival-filter)
(set-process-sentinel process 'elmo-imap4-sentinel)
-;; (while (and (memq (process-status process) '(open run))
-;; (eq elmo-imap4-status 'initial))
-;; (message "Waiting for server response...")
-;; (accept-process-output process 1))
-;; (message "")
+;;; (while (and (memq (process-status process) '(open run))
+;;; (eq elmo-imap4-status 'initial))
+;;; (message "Waiting for server response...")
+;;; (accept-process-output process 1))
+;;; (message "")
(unless (memq elmo-imap4-status '(nonauth auth))
(signal 'elmo-open-error
(list 'elmo-network-initialize-session)))
(when (eq (elmo-network-stream-type-symbol
(elmo-network-session-stream-type-internal session))
'starttls)
- (or (memq 'starttls capability)
+ (or (memq 'starttls
+ (elmo-imap4-session-capability-internal session))
(signal 'elmo-open-error
- '(elmo-network-initialize-session)))
+ '(elmo-imap4-starttls-error)))
(elmo-imap4-send-command-wait session "starttls")
(starttls-negotiate process)))))
(let ((session (elmo-imap4-get-session spec))
response)
;; commit.
-; (elmo-imap4-commit spec)
+;;; (elmo-imap4-commit spec)
(with-current-buffer (elmo-network-session-buffer session)
(setq elmo-imap4-status-callback nil)
(setq elmo-imap4-status-callback-data nil))
(defvar elmo-imap4-client-eol "\r\n"
"The EOL string we send to the server.")
-(defvar elmo-imap4-status nil)
-(defvar elmo-imap4-reached-tag nil)
-
(defun elmo-imap4-find-next-line ()
"Return point at end of current line, taking into account literals.
Return nil if no complete line has arrived."
nil
(goto-char (+ pos len))
(buffer-substring pos (+ pos len))))))
- ;(list ' pos (+ pos len))))))
+;;; (list ' pos (+ pos len))))))
(defsubst elmo-imap4-parse-string ()
(cond ((eq (char-after (point)) ?\")
(elmo-imap4-forward))
(OK (progn
(setq elmo-imap4-parsing nil)
+ (setq token (symbol-name token))
+ (elmo-unintern token)
(elmo-imap4-debug "*%s* OK arrived" token)
(setq elmo-imap4-reached-tag token)
(list 'ok (elmo-imap4-parse-resp-text-code))))
(NO (progn
(setq elmo-imap4-parsing nil)
+ (setq token (symbol-name token))
+ (elmo-unintern token)
(elmo-imap4-debug "*%s* NO arrived" token)
(setq elmo-imap4-reached-tag token)
(let (code text)
(BAD (progn
(setq elmo-imap4-parsing nil)
(elmo-imap4-debug "*%s* BAD arrived" token)
+ (setq token (symbol-name token))
+ (elmo-unintern token)
(setq elmo-imap4-reached-tag token)
(let (code text)
(when (eq (char-after (point)) ?\[)
(list 'bodystructure (elmo-imap4-parse-body)))))
(setq list (cons element list))))
(and elmo-imap4-fetch-callback
- (elmo-imap4-fetch-callback
- list
- elmo-imap4-fetch-callback-data))
+ (elmo-imap4-fetch-callback list elmo-imap4-fetch-callback-data))
(list 'fetch list))))
(defun elmo-imap4-parse-status ()
projects / elisp / wanderlust.git / blobdiff