-;;; elmo-imap4.el -- IMAP4 Interface for ELMO.
+;;; elmo-imap4.el --- IMAP4 Interface for ELMO.
;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
;; Copyright (C) 1999,2000 Kenichi OKADA <okada@opaopa.org>
;;
;;; Commentary:
-;;
+;;
;; Origin of IMAP parser part is imap.el, included in Gnus.
;;
;; Copyright (C) 1998, 1999, 2000
(require 'elmo-vars)
(require 'elmo-util)
-(require 'elmo-msgdb)
(require 'elmo-date)
+(require 'elmo-msgdb)
(require 'elmo-cache)
+(require 'elmo)
(require 'elmo-net)
(require 'utf7)
+(require 'elmo-mime)
;;; Code:
(eval-when-compile (require 'cl))
-(defvar elmo-imap4-use-lock t
- "USE IMAP4 with locking process.")
+(defvar elmo-imap4-disuse-server-flag-mailbox-regexp "^#mh" ; UW imapd
+ "Regexp to match IMAP4 mailbox names whose message flags on server should be ignored.
+\(Except `\\Deleted' flag\).")
+
+(defvar elmo-imap4-overview-fetch-chop-length 200
+ "*Number of overviews to fetch in one request.")
+
+;; c.f. rfc2683 3.2.1.5 Long Command Lines
+;;
+;; "A client should limit the length of the command lines it generates
+;; to approximately 1000 octets (including all quoted strings but not
+;; including literals). If the client is unable to group things into
+;; ranges so that the command line is within that length, it should
+;; split the request into multiple commands. The client should use
+;; literals instead of long quoted strings, in order to keep the command
+;; length down.
+;; For its part, a server should allow for a command line of at least
+;; 8000 octets. This provides plenty of leeway for accepting reasonable
+;; length commands from clients. The server should send a BAD response
+;; to a command that does not end within the server's maximum accepted
+;; command length. "
+
+;; To limit command line length, chop number set.
+(defvar elmo-imap4-number-set-chop-length 1000
+ "*Number of messages to specify as a number-set argument for one request.")
+
+(defvar elmo-imap4-force-login nil
+ "*Non-nil forces to try 'login' if there is no 'auth' capability in imapd.")
+
+(defvar elmo-imap4-use-select-to-update-status nil
+ "*Some imapd have to send select command to update status.
+\(ex. UW imapd 4.5-BETA?\). For these imapd, you must set this variable t.")
+
+(defvar elmo-imap4-use-modified-utf7 nil
+ "*Use mofidied UTF-7 (rfc2060) encoding for IMAP4 folder name.")
+
+(defvar elmo-imap4-use-cache t
+ "Use cache in imap4 folder.")
+
+(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).
+REGEXP should have a grouping for namespace prefix.")
;;
;;; internal variables
;;
(defvar elmo-imap4-reached-tag "elmo-imap40")
;;; buffer local variables
-
-(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).")
(defvar elmo-imap4-default-hierarchy-delimiter "/")
(defvar elmo-imap4-server-capability nil)
;;; XXX Temporal implementation
(defvar elmo-imap4-current-msgdb nil)
+(defvar elmo-imap4-seen-messages nil)
(defvar elmo-imap4-local-variables
'(elmo-imap4-status
elmo-imap4-fetch-callback-data
elmo-imap4-status-callback
elmo-imap4-status-callback-data
- elmo-imap4-current-msgdb))
+ elmo-imap4-current-msgdb
+ elmo-imap4-seen-messages))
;;;;
(defvar elmo-imap4-debug-inhibit-logging nil)
-;;;
+;;; ELMO IMAP4 folder
+(eval-and-compile
+ (luna-define-class elmo-imap4-folder (elmo-net-folder)
+ (mailbox))
+ (luna-define-internal-accessors 'elmo-imap4-folder))
+;;; Session
(eval-and-compile
(luna-define-class elmo-imap4-session (elmo-network-session)
(capability current-mailbox read-only))
(luna-define-internal-accessors 'elmo-imap4-session))
-;;; imap4 spec
-
-(defsubst elmo-imap4-spec-mailbox (spec)
- (nth 1 spec))
-
-(defsubst elmo-imap4-spec-username (spec)
- (nth 2 spec))
-
-(defsubst elmo-imap4-spec-auth (spec)
- (nth 3 spec))
-
-(defsubst elmo-imap4-spec-hostname (spec)
- (nth 4 spec))
-
-(defsubst elmo-imap4-spec-port (spec)
- (nth 5 spec))
+;;; MIME-ELMO-IMAP Location
+(eval-and-compile
+ (luna-define-class mime-elmo-imap-location
+ (mime-imap-location)
+ (folder number rawbuf strategy))
+ (luna-define-internal-accessors 'mime-elmo-imap-location))
-(defsubst elmo-imap4-spec-stream-type (spec)
- (nth 6 spec))
+;;; Debug
+(defmacro elmo-imap4-debug (message &rest args)
+ (` (if elmo-imap4-debug
+ (elmo-imap4-debug-1 (, message) (,@ args)))))
+(defun elmo-imap4-debug-1 (message &rest args)
+ (with-current-buffer (get-buffer-create "*IMAP4 DEBUG*")
+ (goto-char (point-max))
+ (if elmo-imap4-debug-inhibit-logging
+ (insert "NO LOGGING\n")
+ (insert (apply 'format message args) "\n"))))
-;;; Debug
+(defsubst elmo-imap4-decode-folder-string (string)
+ (if elmo-imap4-use-modified-utf7
+ (utf7-decode-string string 'imap)
+ string))
-(defsubst elmo-imap4-debug (message &rest args)
- (if elmo-imap4-debug
- (with-current-buffer (get-buffer-create "*IMAP4 DEBUG*")
- (goto-char (point-max))
- (if elmo-imap4-debug-inhibit-logging
- (insert "NO LOGGING\n")
- (insert (apply 'format message args) "\n")))))
+(defsubst elmo-imap4-encode-folder-string (string)
+ (if elmo-imap4-use-modified-utf7
+ (utf7-encode-string string 'imap)
+ string))
;;; Response
"Returns non-nil if RESPONSE is an 'BYE' response."
(` (assq 'bye (, response))))
+(defmacro elmo-imap4-response-garbage-p (response)
+ "Returns non-nil if RESPONSE is an 'garbage' response."
+ (` (assq 'garbage (, response))))
+
(defmacro elmo-imap4-response-value (response symbol)
"Get value of the SYMBOL from RESPONSE."
(` (nth 1 (assq (, symbol) (, response)))))
; "Send COMMAND to the SESSION and wait for response.
; Returns RESPONSE (parsed lisp object) of IMAP session."
; (elmo-imap4-read-response session
-; (elmo-imap4-send-command
-; session
-; command)))
+; (elmo-imap4-send-command
+; session
+; command)))
(defun elmo-imap4-send-command-wait (session command)
"Send COMMAND to the SESSION.
(defun elmo-imap4-send-command (session command)
"Send COMMAND to the SESSION.
-Returns a TAG string which is assigned to the COMAND."
+Returns a TAG string which is assigned to the COMMAND."
(let* ((command-args (if (listp command)
command
(list command)))
(setq cmdstr (concat tag " "))
;; (erase-buffer) No need.
(goto-char (point-min))
- (if (elmo-imap4-response-bye-p elmo-imap4-current-response)
- (signal 'elmo-imap4-bye-error
- (list (elmo-imap4-response-error-text
- elmo-imap4-current-response))))
+ (when (elmo-imap4-response-bye-p elmo-imap4-current-response)
+ (elmo-imap4-process-bye session))
(setq elmo-imap4-current-response nil)
(if elmo-imap4-parsing
- (error "IMAP process is running. Please wait (or plug again.)"))
+ (error "IMAP process is running. Please wait (or plug again)"))
(setq elmo-imap4-parsing t)
(elmo-imap4-debug "<-(%s)- %s" tag command)
(while (setq token (car command-args))
(with-current-buffer (process-buffer
(elmo-network-session-process-internal session))
(while (not (or (string= tag elmo-imap4-reached-tag)
- (elmo-imap4-response-bye-p elmo-imap4-current-response)))
+ (elmo-imap4-response-bye-p elmo-imap4-current-response)
+ (when (elmo-imap4-response-garbage-p
+ elmo-imap4-current-response)
+ (message "Garbage response: %s"
+ (elmo-imap4-response-value
+ elmo-imap4-current-response
+ 'garbage))
+ t)))
(when (memq (process-status
(elmo-network-session-process-internal session))
'(open run))
(elmo-network-session-process-internal session))
'continue-req))
+(defun elmo-imap4-process-bye (session)
+ (with-current-buffer (elmo-network-session-buffer session)
+ (let ((r elmo-imap4-current-response))
+ (setq elmo-imap4-current-response nil)
+ (elmo-network-close-session session)
+ (signal 'elmo-imap4-bye-error
+ (list (concat (elmo-imap4-response-error-text r))
+ "Try Again")))))
+
(defun elmo-imap4-accept-continue-req (session)
"Returns non-nil if `+' (continue-req) response is arrived in SESSION.
If response is not `+' response, cause an error."
(if (elmo-imap4-response-ok-p response)
response
(if (elmo-imap4-response-bye-p response)
- (signal 'elmo-imap4-bye-error
- (list (elmo-imap4-response-error-text response)))
+ (elmo-imap4-process-bye session)
(error "IMAP error: %s"
(or (elmo-imap4-response-error-text response)
"No `OK' response from server."))))))
+
+;;; MIME-ELMO-IMAP Location
+(luna-define-method mime-imap-location-section-body ((location
+ mime-elmo-imap-location)
+ section)
+ (if (and (stringp section)
+ (string= section "HEADER"))
+ ;; Even in the section mode, header fields should be saved to the
+ ;; raw buffer .
+ (with-current-buffer (mime-elmo-imap-location-rawbuf-internal location)
+ (erase-buffer)
+ (elmo-message-fetch
+ (mime-elmo-imap-location-folder-internal location)
+ (mime-elmo-imap-location-number-internal location)
+ (mime-elmo-imap-location-strategy-internal location)
+ section
+ (current-buffer)
+ 'unseen)
+ (buffer-string))
+ (elmo-message-fetch
+ (mime-elmo-imap-location-folder-internal location)
+ (mime-elmo-imap-location-number-internal location)
+ (mime-elmo-imap-location-strategy-internal location)
+ section
+ nil 'unseen)))
+
+
+(luna-define-method mime-imap-location-bodystructure
+ ((location mime-elmo-imap-location))
+ (elmo-imap4-fetch-bodystructure
+ (mime-elmo-imap-location-folder-internal location)
+ (mime-elmo-imap-location-number-internal location)
+ (mime-elmo-imap-location-strategy-internal location)))
+
+(luna-define-method mime-imap-location-fetch-entity-p
+ ((location mime-elmo-imap-location) entity)
+ (or (not elmo-message-displaying) ; Fetching entity to save or force display.
+ ;; cache exists
+ (file-exists-p
+ (expand-file-name
+ (mmimap-entity-section (mime-entity-node-id-internal entity))
+ (elmo-fetch-strategy-cache-path
+ (mime-elmo-imap-location-strategy-internal location))))
+ ;; not too large to fetch.
+ (> elmo-message-fetch-threshold
+ (or (mime-imap-entity-size-internal entity) 0))))
+
;;;
(defun elmo-imap4-session-check (session)
(car (nth 1 entry))))
response)))
-;;; Backend methods.
-(defun elmo-imap4-list-folders (spec &optional hierarchy)
- (let* ((root (elmo-imap4-spec-mailbox spec))
- (session (elmo-imap4-get-session spec))
- (delim (or
- (cdr
- (elmo-string-matched-assoc
- root
- (with-current-buffer (elmo-network-session-buffer session)
- elmo-imap4-server-namespace)))
- elmo-imap4-default-hierarchy-delimiter))
- result append-serv type)
- ;; Append delimiter
- (if (and root
- (not (string= root ""))
- (not (string-match (concat "\\(.*\\)"
- (regexp-quote delim)
- "\\'")
- root)))
- (setq root (concat root delim)))
- (setq result (elmo-imap4-response-get-selectable-mailbox-list
- (elmo-imap4-send-command-wait
- session
- (list "list " (elmo-imap4-mailbox root) " *"))))
- (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
- spec))))
- (unless (eq (elmo-imap4-spec-port spec)
- elmo-default-imap4-port)
- (setq append-serv (concat append-serv ":"
- (int-to-string
- (elmo-imap4-spec-port spec)))))
- (setq type (elmo-imap4-spec-stream-type spec))
- (unless (eq (elmo-network-stream-type-symbol type)
- elmo-default-imap4-stream-type)
- (if type
- (setq append-serv (concat append-serv
- (elmo-network-stream-type-spec-string
- type)))))
- (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)))
- (if (string=
- (elmo-imap4-session-current-mailbox-internal session)
- (elmo-imap4-spec-mailbox spec))
- t
+(defun elmo-imap4-fetch-bodystructure (folder number strategy)
+ "Fetch BODYSTRUCTURE for the message in the FOLDER with NUMBER using STRATEGY."
+ (if (elmo-fetch-strategy-use-cache strategy)
+ (elmo-object-load
+ (elmo-file-cache-expand-path
+ (elmo-fetch-strategy-cache-path strategy)
+ "bodystructure"))
+ (let ((session (elmo-imap4-get-session folder))
+ bodystructure)
(elmo-imap4-session-select-mailbox
session
- (elmo-imap4-spec-mailbox spec)
- 'force 'no-error))))
-
-(defun elmo-imap4-folder-creatable-p (spec)
- t)
-
-(defun elmo-imap4-create-folder-maybe (spec dummy)
- (unless (elmo-imap4-folder-exists-p spec)
- (elmo-imap4-create-folder spec)))
+ (elmo-imap4-folder-mailbox-internal folder))
+ (with-current-buffer (elmo-network-session-buffer session)
+ (setq elmo-imap4-fetch-callback nil)
+ (setq elmo-imap4-fetch-callback-data nil))
+ (prog1 (setq bodystructure
+ (elmo-imap4-response-value
+ (elmo-imap4-response-value
+ (elmo-imap4-send-command-wait
+ session
+ (format
+ (if elmo-imap4-use-uid
+ "uid fetch %s bodystructure"
+ "fetch %s bodystructure")
+ number))
+ 'fetch)
+ 'bodystructure))
+ (when (elmo-fetch-strategy-save-cache strategy)
+ (elmo-file-cache-delete
+ (elmo-fetch-strategy-cache-path strategy))
+ (elmo-object-save
+ (elmo-file-cache-expand-path
+ (elmo-fetch-strategy-cache-path strategy)
+ "bodystructure")
+ bodystructure))))))
-(defun elmo-imap4-create-folder (spec)
+;;; Backend methods.
+(luna-define-method elmo-create-folder-plugged ((folder elmo-imap4-folder))
(elmo-imap4-send-command-wait
- (elmo-imap4-get-session spec)
+ (elmo-imap4-get-session folder)
(list "create " (elmo-imap4-mailbox
- (elmo-imap4-spec-mailbox spec)))))
-
-(defun elmo-imap4-delete-folder (spec)
- (let ((session (elmo-imap4-get-session spec))
- msgs)
- (when (elmo-imap4-spec-mailbox spec)
- (when (setq msgs (elmo-imap4-list-folder spec))
- (elmo-imap4-delete-msgs spec msgs))
- (elmo-imap4-send-command-wait session "close")
- (elmo-imap4-send-command-wait
- session
- (list "delete "
- (elmo-imap4-mailbox (elmo-imap4-spec-mailbox spec)))))))
+ (elmo-imap4-folder-mailbox-internal folder)))))
-(defun elmo-imap4-rename-folder (old-spec new-spec)
- (let ((session (elmo-imap4-get-session old-spec)))
- (elmo-imap4-session-select-mailbox session
- (elmo-imap4-spec-mailbox old-spec))
- (elmo-imap4-send-command-wait session "close")
- (elmo-imap4-send-command-wait
- session
- (list "rename "
- (elmo-imap4-mailbox
- (elmo-imap4-spec-mailbox old-spec))
- " "
- (elmo-imap4-mailbox
- (elmo-imap4-spec-mailbox new-spec))))))
-
-(defun elmo-imap4-max-of-folder (spec)
- (let ((session (elmo-imap4-get-session spec))
- (killed (and elmo-use-killed-list
- (elmo-msgdb-killed-list-load
- (elmo-msgdb-expand-path spec))))
- status)
- (with-current-buffer (elmo-network-session-buffer session)
- (setq elmo-imap4-status-callback nil)
- (setq elmo-imap4-status-callback-data nil))
- (setq status (elmo-imap4-response-value
- (elmo-imap4-send-command-wait
- session
- (list "status "
- (elmo-imap4-mailbox
- (elmo-imap4-spec-mailbox spec))
- " (uidnext messages)"))
- 'status))
- (cons
- (- (elmo-imap4-response-value status 'uidnext) 1)
- (if killed
- (-
- (elmo-imap4-response-value status 'messages)
- (elmo-msgdb-killed-list-length killed))
- (elmo-imap4-response-value status 'messages)))))
+(defun elmo-imap4-get-session (folder &optional if-exists)
+ (elmo-network-get-session 'elmo-imap4-session
+ (concat
+ (if (elmo-folder-biff-internal folder)
+ "BIFF-")
+ "IMAP")
+ folder if-exists))
-(defun elmo-imap4-folder-diff (spec folder &optional number-list)
- (if elmo-use-server-diff
- (elmo-imap4-server-diff spec)
- (elmo-generic-folder-diff spec folder number-list)))
-
-(defun elmo-imap4-get-session (spec &optional if-exists)
- (elmo-network-get-session
- 'elmo-imap4-session
- "IMAP"
- (elmo-imap4-spec-hostname spec)
- (elmo-imap4-spec-port spec)
- (elmo-imap4-spec-username spec)
- (elmo-imap4-spec-auth spec)
- (elmo-imap4-spec-stream-type spec)
- if-exists))
-
-(defun elmo-imap4-commit (spec)
- (if (elmo-imap4-plugged-p spec)
- (let ((session (elmo-imap4-get-session spec 'if-exists)))
- (when session
- (if (string=
- (elmo-imap4-session-current-mailbox-internal session)
- (elmo-imap4-spec-mailbox spec))
- (if elmo-imap4-use-select-to-update-status
- (elmo-imap4-session-select-mailbox
- session
- (elmo-imap4-spec-mailbox spec)
- 'force)
- (elmo-imap4-session-check session)))))))
-
(defun elmo-imap4-session-select-mailbox (session mailbox
&optional force no-error)
"Select MAILBOX in SESSION.
is same as MAILBOX.
If second optional argument NO-ERROR is non-nil, don't cause an error when
selecting folder was failed.
+If NO-ERROR is 'notify-bye, only BYE response is reported as error.
Returns response value if selecting folder succeed. "
(when (or force
(not (string=
session
(nth 1 (assq 'read-only (assq 'ok response)))))
(elmo-imap4-session-set-current-mailbox-internal session nil)
- (unless no-error
- (error (or
- (elmo-imap4-response-error-text response)
- (format "Select %s failed" mailbox))))))
+ (if (and (eq no-error 'notify-bye)
+ (elmo-imap4-response-bye-p response))
+ (elmo-imap4-process-bye session)
+ (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.
)
-(defun elmo-imap4-list (spec flag)
- (let ((session (elmo-imap4-get-session spec)))
- (elmo-imap4-session-select-mailbox session
- (elmo-imap4-spec-mailbox spec))
+(defun elmo-imap4-list (folder flag)
+ (let ((session (elmo-imap4-get-session folder)))
+ (elmo-imap4-session-select-mailbox
+ session
+ (elmo-imap4-folder-mailbox-internal folder))
(elmo-imap4-response-value
(elmo-imap4-send-command-wait
session
"search %s") flag))
'search)))
-(defun elmo-imap4-list-folder (spec &optional nohide)
- (let* ((killed (and elmo-use-killed-list
- (elmo-msgdb-killed-list-load
- (elmo-msgdb-expand-path spec))))
- (max (elmo-msgdb-max-of-killed killed))
- numbers)
- (setq numbers (elmo-imap4-list spec
- (if (or nohide
- (null (eq max 0)))
- (format "uid %d:*" (1+ max))
- "all")))
- (elmo-living-messages numbers killed)))
-
-(defun elmo-imap4-list-folder-unread (spec number-alist mark-alist
- unread-marks)
- (if (and (elmo-imap4-plugged-p spec)
- (elmo-imap4-use-flag-p spec))
- (elmo-imap4-list spec "unseen")
- (elmo-generic-list-folder-unread spec number-alist mark-alist
- unread-marks)))
-
-(defun elmo-imap4-list-folder-important (spec number-alist)
- (if (and (elmo-imap4-plugged-p spec)
- (elmo-imap4-use-flag-p spec))
- (elmo-imap4-list spec "flagged")))
-
-(defmacro elmo-imap4-detect-search-charset (string)
- (` (with-temp-buffer
- (insert (, string))
- (detect-mime-charset-region (point-min) (point-max)))))
-
-(defun elmo-imap4-search-internal-primitive (spec session filter from-msgs)
- (let ((search-key (elmo-filter-key filter))
- (imap-search-keys '("bcc" "body" "cc" "from" "subject" "to"))
- charset)
- (cond
- ((string= "last" search-key)
- (let ((numbers (or from-msgs (elmo-imap4-list-folder spec))))
- (nthcdr (max (- (length numbers)
- (string-to-int (elmo-filter-value filter)))
- 0)
- numbers)))
- ((string= "first" search-key)
- (let* ((numbers (or from-msgs (elmo-imap4-list-folder spec)))
- (rest (nthcdr (string-to-int (elmo-filter-value filter) )
- numbers)))
- (mapcar '(lambda (x) (delete x numbers)) rest)
- numbers))
- ((or (string= "since" search-key)
- (string= "before" search-key))
- (setq search-key (concat "sent" search-key))
- (elmo-imap4-response-value
- (elmo-imap4-send-command-wait session
- (format
- (if elmo-imap4-use-uid
- "uid search %s%s%s %s"
- "search %s%s%s %s")
- (if from-msgs
- (concat
- (if elmo-imap4-use-uid "uid ")
- (cdr
- (car
- (elmo-imap4-make-number-set-list
- from-msgs)))
- " ")
- "")
- (if (eq (elmo-filter-type filter)
- 'unmatch)
- "not " "")
- search-key
- (elmo-date-get-description
- (elmo-date-get-datevec
- (elmo-filter-value filter)))))
- 'search))
- (t
- (setq charset
- (if (eq (length (elmo-filter-value filter)) 0)
- (setq charset 'us-ascii)
- (elmo-imap4-detect-search-charset
- (elmo-filter-value filter))))
- (elmo-imap4-response-value
- (elmo-imap4-send-command-wait session
- (list
- (if elmo-imap4-use-uid "uid ")
- "search "
- "CHARSET "
- (elmo-imap4-astring
- (symbol-name charset))
- " "
- (if from-msgs
- (concat
- (if elmo-imap4-use-uid "uid ")
- (cdr
- (car
- (elmo-imap4-make-number-set-list
- from-msgs)))
- " ")
- "")
- (if (eq (elmo-filter-type filter)
- 'unmatch)
- "not " "")
- (format "%s%s "
- (if (member
- (elmo-filter-key filter)
- imap-search-keys)
- ""
- "header ")
- (elmo-filter-key filter))
- (elmo-imap4-astring
- (encode-mime-charset-string
- (elmo-filter-value filter) charset))))
- 'search)))))
-
-(defun elmo-imap4-search-internal (spec session condition from-msgs)
- (let (result)
- (cond
- ((vectorp condition)
- (setq result (elmo-imap4-search-internal-primitive
- spec session condition from-msgs)))
- ((eq (car condition) 'and)
- (setq result (elmo-imap4-search-internal spec session (nth 1 condition)
- from-msgs)
- result (elmo-list-filter result
- (elmo-imap4-search-internal
- spec session (nth 2 condition)
- from-msgs))))
- ((eq (car condition) 'or)
- (setq result (elmo-imap4-search-internal
- spec session (nth 1 condition) from-msgs)
- result (elmo-uniq-list
- (nconc result
- (elmo-imap4-search-internal
- spec session (nth 2 condition) from-msgs)))
- result (sort result '<))))))
-
-
-(defun elmo-imap4-search (spec condition &optional from-msgs)
- (save-excursion
- (let ((session (elmo-imap4-get-session spec)))
- (elmo-imap4-session-select-mailbox
- session
- (elmo-imap4-spec-mailbox spec))
- (elmo-imap4-search-internal spec session condition from-msgs))))
-
-(defun elmo-imap4-use-flag-p (spec)
- (not (string-match elmo-imap4-disuse-server-flag-mailbox-regexp
- (elmo-imap4-spec-mailbox spec))))
-
(static-cond
((fboundp 'float)
;; Emacs can parse dot symbol.
(nreverse set-list)))
;;
-;; set mark
-;; read-mark -> "\\Seen"
-;; important -> "\\Flagged"
-;;
-;; (delete -> \\Deleted)
-(defun elmo-imap4-mark-set-on-msgs (spec msgs mark &optional unmark no-expunge)
- "SET flag of MSGS as MARK.
-If optional argument UNMARK is non-nil, unmark."
- (let ((session (elmo-imap4-get-session spec))
- set-list)
- (elmo-imap4-session-select-mailbox session
- (elmo-imap4-spec-mailbox spec))
- (setq set-list (elmo-imap4-make-number-set-list msgs))
- (when set-list
- (with-current-buffer (elmo-network-session-buffer session)
- (setq elmo-imap4-fetch-callback nil)
- (setq elmo-imap4-fetch-callback-data nil))
- (elmo-imap4-send-command-wait
- session
- (format
- (if elmo-imap4-use-uid
- "uid store %s %sflags.silent (%s)"
- "store %s %sflags.silent (%s)")
- (cdr (car set-list))
- (if unmark "-" "+")
- mark))
- (unless no-expunge
- (elmo-imap4-send-command-wait session "expunge")))
- t))
-
-(defun elmo-imap4-mark-as-important (spec msgs)
- (and (elmo-imap4-use-flag-p spec)
- (elmo-imap4-mark-set-on-msgs spec msgs "\\Flagged" nil 'no-expunge)))
-
-(defun elmo-imap4-mark-as-read (spec msgs)
- (and (elmo-imap4-use-flag-p spec)
- (elmo-imap4-mark-set-on-msgs spec msgs "\\Seen" nil 'no-expunge)))
-
-(defun elmo-imap4-unmark-important (spec msgs)
- (and (elmo-imap4-use-flag-p spec)
- (elmo-imap4-mark-set-on-msgs spec msgs "\\Flagged" 'unmark
- 'no-expunge)))
-
-(defun elmo-imap4-mark-as-unread (spec msgs)
- (and (elmo-imap4-use-flag-p spec)
- (elmo-imap4-mark-set-on-msgs spec msgs "\\Seen" 'unmark 'no-expunge)))
-
-(defun elmo-imap4-delete-msgs (spec msgs)
- (elmo-imap4-mark-set-on-msgs spec msgs "\\Deleted"))
-
-(defun elmo-imap4-delete-msgs-no-expunge (spec msgs)
- (elmo-imap4-mark-set-on-msgs spec msgs "\\Deleted" nil 'no-expunge))
-
-(defun elmo-imap4-msgdb-create-as-numlist (spec numlist new-mark already-mark
- seen-mark important-mark
- seen-list)
- "Create msgdb for SPEC for NUMLIST."
- (elmo-imap4-msgdb-create spec numlist new-mark already-mark
- seen-mark important-mark seen-list t))
-
-;; Current buffer is process buffer.
-(defun elmo-imap4-fetch-callback (element app-data)
- (funcall elmo-imap4-fetch-callback
- (with-temp-buffer
- (insert (or (elmo-imap4-response-bodydetail-text element)
- ""))
- ;; Delete CR.
- (goto-char (point-min))
- (while (search-forward "\r\n" nil t)
- (replace-match "\n"))
- (elmo-msgdb-create-overview-from-buffer
- (elmo-imap4-response-value element 'uid)
- (elmo-imap4-response-value element 'rfc822size)))
- (elmo-imap4-response-value element 'flags)
- app-data))
-
-;;
;; app-data:
;; cons of list
;; 0: new-mark 1: already-mark 2: seen-mark 3: important-mark
;; 4: seen-list
;; and result of use-flag-p.
-(defun elmo-imap4-fetch-callback-1 (entity flags app-data)
+(defsubst elmo-imap4-fetch-callback-1-subr (entity flags app-data)
"A msgdb entity callback function."
(let* ((use-flag (cdr app-data))
(app-data (car app-data))
mark)
(if (member "\\Flagged" flags)
(elmo-msgdb-global-mark-set (car entity) (nth 3 app-data)))
- (setq mark (or (elmo-msgdb-global-mark-get (car entity))
- (if (elmo-cache-exists-p (car entity)) ;; XXX
+ (if (setq mark (elmo-msgdb-global-mark-get (car entity)))
+ (unless (member "\\Seen" flags)
+ (setq elmo-imap4-seen-messages
+ (cons
+ (elmo-msgdb-overview-entity-get-number entity)
+ elmo-imap4-seen-messages)))
+ (setq mark (or (if (elmo-file-cache-status
+ (elmo-file-cache-get (car entity)))
+ (if (or seen
+ (and use-flag
+ (member "\\Seen" flags)))
+ nil
+ (nth 1 app-data))
(if (or seen
(and use-flag
(member "\\Seen" flags)))
- nil
- (nth 1 app-data))
- (if (or seen
- (and use-flag
- (member "\\Seen" flags)))
- (if elmo-imap4-use-cache
- (nth 2 app-data))
- (nth 0 app-data)))))
+ (if elmo-imap4-use-cache
+ (nth 2 app-data))
+ (nth 0 app-data))))))
(setq elmo-imap4-current-msgdb
(elmo-msgdb-append
elmo-imap4-current-msgdb
(list (elmo-msgdb-overview-entity-get-number entity)
mark))))))))
-(defun elmo-imap4-msgdb-create (spec numlist &rest args)
- "Create msgdb for SPEC."
- (when numlist
- (let ((session (elmo-imap4-get-session spec))
- (headers
- (append
- '("Subject" "From" "To" "Cc" "Date"
- "Message-Id" "References" "In-Reply-To")
- elmo-msgdb-extra-fields))
- (total 0)
- (length (length numlist))
- rfc2060 set-list)
- (setq rfc2060 (memq 'imap4rev1
- (elmo-imap4-session-capability-internal
- session)))
- (message "Getting overview...")
- (elmo-imap4-session-select-mailbox session
- (elmo-imap4-spec-mailbox spec))
- (setq set-list (elmo-imap4-make-number-set-list
- numlist
- elmo-imap4-overview-fetch-chop-length))
- ;; Setup callback.
- (with-current-buffer (elmo-network-session-buffer session)
- (setq elmo-imap4-current-msgdb nil
- elmo-imap4-fetch-callback 'elmo-imap4-fetch-callback-1
- elmo-imap4-fetch-callback-data (cons args
- (elmo-imap4-use-flag-p
- spec)))
- (while set-list
- (elmo-imap4-send-command-wait
- session
- ;; get overview entity from IMAP4
- (format "%sfetch %s (%s rfc822.size flags)"
- (if elmo-imap4-use-uid "uid " "")
- (cdr (car set-list))
- (if rfc2060
- (format "body.peek[header.fields %s]" headers)
- (format "%s" headers))))
- (when (> length elmo-display-progress-threshold)
- (setq total (+ total (car (car set-list))))
- (elmo-display-progress
- 'elmo-imap4-msgdb-create "Getting overview..."
- (/ (* total 100) length)))
- (setq set-list (cdr set-list)))
- (message "Getting overview...done")
- elmo-imap4-current-msgdb))))
+;; Current buffer is process buffer.
+(defun elmo-imap4-fetch-callback-1 (element app-data)
+ (elmo-imap4-fetch-callback-1-subr
+ (with-temp-buffer
+ (insert (or (elmo-imap4-response-bodydetail-text element)
+ ""))
+ ;; Delete CR.
+ (goto-char (point-min))
+ (while (search-forward "\r\n" nil t)
+ (replace-match "\n"))
+ (elmo-msgdb-create-overview-from-buffer
+ (elmo-imap4-response-value element 'uid)
+ (elmo-imap4-response-value element 'rfc822size)))
+ (elmo-imap4-response-value element 'flags)
+ app-data))
(defun elmo-imap4-parse-capability (string)
(if (string-match "^\\*\\(.*\\)$" string)
(or (elmo-imap4-read-ok session tag)
(signal 'elmo-authenticate-error '(elmo-imap4-auth-login)))
(setq elmo-imap4-status 'auth)))
-
+
(luna-define-method
elmo-network-initialize-session-buffer :after ((session
elmo-imap4-session) buffer)
(signal 'elmo-open-error
'(elmo-imap4-starttls-error)))
(elmo-imap4-send-command-wait session "starttls")
- (starttls-negotiate process)))))
+ (starttls-negotiate process)
+ (elmo-imap4-session-set-capability-internal
+ session
+ (elmo-imap4-response-value
+ (elmo-imap4-send-command-wait session "capability")
+ 'capability))))))
(luna-define-method elmo-network-authenticate-session ((session
- elmo-imap4-session))
+ elmo-imap4-session))
(with-current-buffer (process-buffer
(elmo-network-session-process-internal session))
(let* ((auth (elmo-network-session-auth-internal session))
mechanism
(elmo-network-session-user-internal session)
"imap"
- (elmo-network-session-host-internal session)))
+ (elmo-network-session-server-internal session)))
;;; (if elmo-imap4-auth-user-realm
;;; (sasl-client-set-property client 'realm elmo-imap4-auth-user-realm))
(setq name (sasl-mechanism-name mechanism)
session
(concat "AUTHENTICATE " name
(and (sasl-step-data step)
- (concat
+ (concat
" "
(elmo-base64-encode-string
(sasl-step-data step)
- 'no-lin-break)))))) ;)
+ 'no-lin-break))))))
(catch 'done
(while t
(setq response
(elmo-imap4-read-untagged
(elmo-network-session-process-internal session)))
- (if (elmo-imap4-response-continue-req-p response)
- (unless (sasl-next-step client step)
- ;; response is '+' but there's no next step.
- (signal 'elmo-authenticate-error
- (list (intern
- (concat "elmo-imap4-auth-"
- (downcase name))))))
- ;; response is OK.
- (if (elmo-imap4-response-ok-p response)
- (throw 'done nil) ; finished.
- ;; response is NO or BAD.
- (signal 'elmo-authenticate-error
- (list (intern
- (concat "elmo-imap4-auth-"
- (downcase name)))))))
+ (if (elmo-imap4-response-ok-p response)
+ (if (sasl-next-step client step)
+ ;; Bogus server?
+ (signal 'elmo-authenticate-error
+ (list (intern
+ (concat "elmo-imap4-auth-"
+ (downcase name)))))
+ ;; The authentication process is finished.
+ (throw 'done nil)))
+ (unless (elmo-imap4-response-continue-req-p response)
+ ;; response is NO or BAD.
+ (signal 'elmo-authenticate-error
+ (list (intern
+ (concat "elmo-imap4-auth-"
+ (downcase name))))))
(sasl-step-set-data
step
(elmo-base64-decode-string
(elmo-imap4-send-command-wait session "namespace")
'namespace)))))
-(defun elmo-imap4-setup-send-buffer (string)
- (let ((tmp-buf (get-buffer-create " *elmo-imap4-setup-send-buffer*")))
+(defun elmo-imap4-setup-send-buffer (&optional string)
+ (let ((send-buf (get-buffer-create " *elmo-imap4-setup-send-buffer*"))
+ (source-buf (unless string (current-buffer))))
(save-excursion
(save-match-data
- (set-buffer tmp-buf)
+ (set-buffer send-buf)
(erase-buffer)
(elmo-set-buffer-multibyte nil)
- (insert string)
+ (if string
+ (insert string)
+ (with-current-buffer source-buf
+ (copy-to-buffer send-buf (point-min) (point-max))))
(goto-char (point-min))
(if (eq (re-search-forward "^$" nil t)
(point-max))
(goto-char (point-min))
(while (search-forward "\n" nil t)
(replace-match "\r\n"))))
- tmp-buf))
-
-(defun elmo-imap4-read-part (folder msg part)
- (let* ((spec (elmo-folder-get-spec folder))
- (session (elmo-imap4-get-session spec)))
- (elmo-imap4-session-select-mailbox session
- (elmo-imap4-spec-mailbox spec))
- (with-current-buffer (elmo-network-session-buffer session)
- (setq elmo-imap4-fetch-callback nil)
- (setq elmo-imap4-fetch-callback-data nil))
- (elmo-delete-cr
- (elmo-imap4-response-bodydetail-text
- (elmo-imap4-response-value-all
- (elmo-imap4-send-command-wait session
- (format
- (if elmo-imap4-use-uid
- "uid fetch %s body.peek[%s]"
- "fetch %s body.peek[%s]")
- msg part))
- 'fetch)))))
-
-(defun elmo-imap4-prefetch-msg (spec msg outbuf)
- (elmo-imap4-read-msg spec msg outbuf nil 'unseen))
-
-(defun elmo-imap4-read-msg (spec msg outbuf
- &optional msgdb leave-seen-flag-untouched)
- (let ((session (elmo-imap4-get-session spec))
- response)
- (elmo-imap4-session-select-mailbox session
- (elmo-imap4-spec-mailbox spec))
- (with-current-buffer (elmo-network-session-buffer session)
- (setq elmo-imap4-fetch-callback nil)
- (setq elmo-imap4-fetch-callback-data nil))
- (setq response
- (elmo-imap4-send-command-wait session
- (format
- (if elmo-imap4-use-uid
- "uid fetch %s body%s[]"
- "fetch %s body%s[]")
- msg
- (if leave-seen-flag-untouched
- ".peek" ""))))
- (and (setq response (elmo-imap4-response-bodydetail-text
- (elmo-imap4-response-value-all
- response 'fetch )))
- (with-current-buffer outbuf
- (erase-buffer)
- (insert response)
- (elmo-delete-cr-get-content-type)))))
+ send-buf))
(defun elmo-imap4-setup-send-buffer-from-file (file)
(let ((tmp-buf (get-buffer-create
(replace-match "\r\n"))))
tmp-buf))
-(defun elmo-imap4-delete-msgids (spec msgids)
- "If actual message-id is matched, then delete it."
- (let ((message-ids msgids)
- (i 0)
- (num (length msgids)))
- (while message-ids
- (setq i (+ 1 i))
- (message "Deleting message...%d/%d" i num)
- (elmo-imap4-delete-msg-by-id spec (car message-ids))
- (setq message-ids (cdr message-ids)))
- (elmo-imap4-send-command-wait (elmo-imap4-get-session spec) "expunge")))
-
-(defun elmo-imap4-delete-msg-by-id (spec msgid)
- (let ((session (elmo-imap4-get-session spec)))
- (elmo-imap4-session-select-mailbox session
- (elmo-imap4-spec-mailbox spec))
- (elmo-imap4-delete-msgs-no-expunge
- spec
- (elmo-imap4-response-value
- (elmo-imap4-send-command-wait session
- (list
- (if elmo-imap4-use-uid
- "uid search header message-id "
- "search header message-id ")
- (elmo-imap4-field-body msgid)))
- 'search))))
-
-(defun elmo-imap4-append-msg-by-id (spec msgid)
- (let ((session (elmo-imap4-get-session spec))
- send-buf)
- (elmo-imap4-session-select-mailbox session
- (elmo-imap4-spec-mailbox spec))
- (setq send-buf (elmo-imap4-setup-send-buffer-from-file
- (elmo-cache-get-path msgid)))
- (unwind-protect
- (elmo-imap4-send-command-wait
- session
- (list
- "append "
- (elmo-imap4-mailbox (elmo-imap4-spec-mailbox spec))
- " (\\Seen) "
- (elmo-imap4-buffer-literal send-buf)))
- (kill-buffer send-buf)))
- t)
-
-(defun elmo-imap4-append-msg (spec string &optional msg no-see)
- (let ((session (elmo-imap4-get-session spec))
- send-buf)
- (elmo-imap4-session-select-mailbox session
- (elmo-imap4-spec-mailbox spec))
- (setq send-buf (elmo-imap4-setup-send-buffer string))
- (unwind-protect
- (elmo-imap4-send-command-wait
- session
- (list
- "append "
- (elmo-imap4-mailbox (elmo-imap4-spec-mailbox spec))
- (if no-see " " " (\\Seen) ")
- (elmo-imap4-buffer-literal send-buf)))
- (kill-buffer send-buf)))
- t)
-
-(defun elmo-imap4-copy-msgs (dst-spec
- msgs src-spec &optional expunge-it same-number)
- "Equivalence of hostname, username is assumed."
- (let ((session (elmo-imap4-get-session src-spec)))
- (elmo-imap4-session-select-mailbox session
- (elmo-imap4-spec-mailbox src-spec))
- (while msgs
- (elmo-imap4-send-command-wait session
- (list
- (format
- (if elmo-imap4-use-uid
- "uid copy %s "
- "copy %s ")
- (car msgs))
- (elmo-imap4-mailbox
- (elmo-imap4-spec-mailbox dst-spec))))
- (setq msgs (cdr msgs)))
- (when expunge-it
- (elmo-imap4-send-command-wait session "expunge"))
- t))
+(luna-define-method elmo-delete-message-safe ((folder elmo-imap4-folder)
+ number msgid)
+ (let ((session (elmo-imap4-get-session folder))
+ candidates)
+ (elmo-imap4-session-select-mailbox
+ session
+ (elmo-imap4-folder-mailbox-internal folder))
+ (setq candidates
+ (elmo-imap4-response-value
+ (elmo-imap4-send-command-wait session
+ (list
+ (if elmo-imap4-use-uid
+ "uid search header message-id "
+ "search header message-id ")
+ (elmo-imap4-field-body msgid)))
+ 'search))
+ (if (memq number candidates)
+ (elmo-folder-delete-messages folder (list number)))))
(defun elmo-imap4-server-diff-async-callback-1 (status data)
(funcall elmo-imap4-server-diff-async-callback
- (cons (elmo-imap4-response-value status 'unseen)
+ (list (elmo-imap4-response-value status 'recent)
+ (elmo-imap4-response-value status 'unseen)
(elmo-imap4-response-value status 'messages))
data))
-(defun elmo-imap4-server-diff-async (spec)
- (let ((session (elmo-imap4-get-session spec)))
- ;; commit.
- ;; (elmo-imap4-commit spec)
+(defun elmo-imap4-server-diff-async (folder)
+ (let ((session (elmo-imap4-get-session folder)))
+ ;; We should `check' folder to obtain newest information here.
+ ;; But since there's no asynchronous check mechanism in elmo yet,
+ ;; checking is not done here.
(with-current-buffer (elmo-network-session-buffer session)
(setq elmo-imap4-status-callback
'elmo-imap4-server-diff-async-callback-1)
(list
"status "
(elmo-imap4-mailbox
- (elmo-imap4-spec-mailbox spec))
- " (unseen messages)"))))
+ (elmo-imap4-folder-mailbox-internal folder))
+ " (recent unseen messages)"))))
-(defun elmo-imap4-server-diff (spec)
- "Get server status"
- (let ((session (elmo-imap4-get-session spec))
- response)
+(luna-define-method elmo-server-diff-async ((folder elmo-imap4-folder))
+ (let ((session (elmo-imap4-get-session folder)))
;; 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))
- (setq response
- (elmo-imap4-send-command-wait session
- (list
- "status "
- (elmo-imap4-mailbox
- (elmo-imap4-spec-mailbox spec))
- " (unseen messages)")))
- (setq response (elmo-imap4-response-value response 'status))
- (cons (elmo-imap4-response-value response 'unseen)
- (elmo-imap4-response-value response 'messages))))
-
-(defun elmo-imap4-use-cache-p (spec number)
- elmo-imap4-use-cache)
-
-(defun elmo-imap4-local-file-p (spec number)
- nil)
-
-(defun elmo-imap4-port-label (spec)
- (concat "imap4"
- (if (elmo-imap4-spec-stream-type spec)
- (concat "!" (symbol-name
- (elmo-network-stream-type-symbol
- (elmo-imap4-spec-stream-type spec)))))))
-
-
-(defsubst elmo-imap4-portinfo (spec)
- (list (elmo-imap4-spec-hostname spec) (elmo-imap4-spec-port spec)))
-
-(defun elmo-imap4-plugged-p (spec)
- (apply 'elmo-plugged-p
- (append (elmo-imap4-portinfo spec)
- (list nil (quote (elmo-imap4-port-label spec))))))
-
-(defun elmo-imap4-set-plugged (spec plugged add)
- (apply 'elmo-set-plugged plugged
- (append (elmo-imap4-portinfo spec)
- (list nil nil (quote (elmo-imap4-port-label spec)) add))))
-
-(defalias 'elmo-imap4-sync-number-alist 'elmo-generic-sync-number-alist)
+ (setq elmo-imap4-status-callback
+ 'elmo-imap4-server-diff-async-callback-1)
+ (setq elmo-imap4-status-callback-data
+ elmo-imap4-server-diff-async-callback-data))
+ (elmo-imap4-send-command session
+ (list
+ "status "
+ (elmo-imap4-mailbox
+ (elmo-imap4-folder-mailbox-internal folder))
+ " (recent unseen messages)"))))
;;; IMAP parser.
(defvar elmo-imap4-client-eol "\r\n"
"The EOL string we send to the server.")
+(defvar elmo-imap4-display-literal-progress 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 t)
(if (match-string 1)
(if (< (point-max) (+ (point) (string-to-number (match-string 1))))
- nil
+ (progn
+ (if (and elmo-imap4-display-literal-progress
+ (> (string-to-number (match-string 1))
+ (min elmo-display-retrieval-progress-threshold 100)))
+ (elmo-display-progress
+ 'elmo-imap4-display-literal-progress
+ (format "Retrieving (%d/%d bytes)..."
+ (- (point-max) (point))
+ (string-to-number (match-string 1)))
+ (/ (- (point-max) (point))
+ (/ (string-to-number (match-string 1)) 100))))
+ nil)
(goto-char (+ (point) (string-to-number (match-string 1))))
(elmo-imap4-find-next-line))
(point))))
(concat "(" (downcase (buffer-substring
(point) (point-max)))
")"))))
- (ACL (elmo-imap4-parse-acl))
+ (ACL (elmo-imap4-parse-acl))
(t (case (prog1 (elmo-read (current-buffer))
(elmo-imap4-forward))
(EXISTS (list 'exists token))
(setq text (buffer-substring (point) (point-max)))
(list 'bad (list code text)))))
(t (list 'garbage (buffer-string)))))))))
-
+
(defun elmo-imap4-parse-bye ()
(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))
+ (funcall elmo-imap4-fetch-callback
+ list elmo-imap4-fetch-callback-data))
(list 'fetch list))))
(defun elmo-imap4-parse-status ()
(message
"Unknown status data %s in mailbox %s ignored"
token mailbox))))
- status))))
+ status))
+ (skip-chars-forward " ")))
(and elmo-imap4-status-callback
(funcall elmo-imap4-status-callback
status
(if (eq (length prefix) 0)
(progn (setq default-delim delim) nil)
(cons
- (concat "^"
+ (concat "^\\("
(if (string= (downcase prefix) "inbox")
"[Ii][Nn][Bb][Oo][Xx]"
(regexp-quote prefix))
- ".*$")
+ "\\).*$")
delim)))
(elmo-imap4-nth i ns))))))
(if default-delim
(push (elmo-imap4-parse-nstring) body);; body-fld-md5
(setq body
(append (elmo-imap4-parse-body-ext) body)));; body-ext-1part..
-
+
(assert (eq (char-after (point)) ?\)))
(elmo-imap4-forward)
(nreverse body)))))
+(luna-define-method elmo-folder-initialize :around ((folder
+ elmo-imap4-folder)
+ name)
+ (let ((default-user elmo-imap4-default-user)
+ (default-server elmo-imap4-default-server)
+ (default-port elmo-imap4-default-port)
+ (elmo-network-stream-type-alist
+ (if elmo-imap4-stream-type-alist
+ (append elmo-imap4-stream-type-alist
+ elmo-network-stream-type-alist)
+ elmo-network-stream-type-alist))
+ parse)
+ (when (string-match "\\(.*\\)@\\(.*\\)" default-server)
+ ;; case: imap4-default-server is specified like
+ ;; "hoge%imap.server@gateway".
+ (setq default-user (elmo-match-string 1 default-server))
+ (setq default-server (elmo-match-string 2 default-server)))
+ (setq name (luna-call-next-method))
+ ;; mailbox
+ (setq parse (elmo-parse-token name ":"))
+ (elmo-imap4-folder-set-mailbox-internal folder
+ (elmo-imap4-encode-folder-string
+ (car parse)))
+ ;; user
+ (setq parse (elmo-parse-prefixed-element ?: (cdr parse) "/"))
+ (elmo-net-folder-set-user-internal folder
+ (if (eq (length (car parse)) 0)
+ default-user
+ (car parse)))
+ ;; auth
+ (setq parse (elmo-parse-prefixed-element ?/ (cdr parse)))
+ (elmo-net-folder-set-auth-internal
+ folder
+ (if (eq (length (car parse)) 0)
+ (or elmo-imap4-default-authenticate-type 'clear)
+ (intern (car parse))))
+ (unless (elmo-net-folder-server-internal folder)
+ (elmo-net-folder-set-server-internal folder default-server))
+ (unless (elmo-net-folder-port-internal folder)
+ (elmo-net-folder-set-port-internal folder default-port))
+ (unless (elmo-net-folder-stream-type-internal folder)
+ (elmo-net-folder-set-stream-type-internal
+ folder
+ (elmo-get-network-stream-type elmo-imap4-default-stream-type)))
+ folder))
+
+;;; ELMO IMAP4 folder
+(luna-define-method elmo-folder-expand-msgdb-path ((folder
+ elmo-imap4-folder))
+ (convert-standard-filename
+ (let ((mailbox (elmo-imap4-folder-mailbox-internal folder)))
+ (if (string= "inbox" (downcase mailbox))
+ (setq mailbox "inbox"))
+ (if (eq (string-to-char mailbox) ?/)
+ (setq mailbox (substring mailbox 1 (length mailbox))))
+ (expand-file-name
+ mailbox
+ (expand-file-name
+ (or (elmo-net-folder-user-internal folder) "nobody")
+ (expand-file-name (or (elmo-net-folder-server-internal folder)
+ "nowhere")
+ (expand-file-name
+ "imap"
+ elmo-msgdb-directory)))))))
+
+(luna-define-method elmo-folder-status-plugged ((folder
+ elmo-imap4-folder))
+ (elmo-imap4-folder-status-plugged folder))
+
+(defun elmo-imap4-folder-status-plugged (folder)
+ (let ((session (elmo-imap4-get-session folder))
+ (killed (elmo-msgdb-killed-list-load
+ (elmo-folder-msgdb-path folder)))
+ status)
+ (with-current-buffer (elmo-network-session-buffer session)
+ (setq elmo-imap4-status-callback nil)
+ (setq elmo-imap4-status-callback-data nil))
+ (setq status (elmo-imap4-response-value
+ (elmo-imap4-send-command-wait
+ session
+ (list "status "
+ (elmo-imap4-mailbox
+ (elmo-imap4-folder-mailbox-internal folder))
+ " (uidnext messages)"))
+ 'status))
+ (cons
+ (- (elmo-imap4-response-value status 'uidnext) 1)
+ (if killed
+ (-
+ (elmo-imap4-response-value status 'messages)
+ (elmo-msgdb-killed-list-length killed))
+ (elmo-imap4-response-value status 'messages)))))
+
+(luna-define-method elmo-folder-list-messages-plugged ((folder
+ elmo-imap4-folder)
+ &optional nohide)
+ (elmo-imap4-list folder
+ (let ((max (elmo-msgdb-max-of-killed
+ (elmo-folder-killed-list-internal folder))))
+ (if (or nohide
+ (null (eq max 0)))
+ (format "uid %d:*" (1+ max))
+ "all"))))
+
+(luna-define-method elmo-folder-list-unreads-plugged
+ ((folder elmo-imap4-folder))
+ (elmo-imap4-list folder "unseen"))
+
+(luna-define-method elmo-folder-list-importants-plugged
+ ((folder elmo-imap4-folder))
+ (elmo-imap4-list folder "flagged"))
+
+(luna-define-method elmo-folder-use-flag-p ((folder elmo-imap4-folder))
+ (not (string-match elmo-imap4-disuse-server-flag-mailbox-regexp
+ (elmo-imap4-folder-mailbox-internal folder))))
+
+(luna-define-method elmo-folder-list-subfolders ((folder elmo-imap4-folder)
+ &optional one-level)
+ (let* ((root (elmo-imap4-folder-mailbox-internal folder))
+ (session (elmo-imap4-get-session folder))
+ (prefix (elmo-folder-prefix-internal folder))
+ (namespace-assoc
+ (elmo-string-matched-assoc
+ root
+ (with-current-buffer (elmo-network-session-buffer session)
+ elmo-imap4-server-namespace)))
+ (delim (or (cdr namespace-assoc)
+ elmo-imap4-default-hierarchy-delimiter))
+ ;; Append delimiter when root with namespace.
+ (root (if (and namespace-assoc
+ (match-end 1)
+ (string= (substring root (match-end 1))
+ ""))
+ (concat root delim)
+ root))
+ result append-serv type)
+ (setq result (elmo-imap4-response-get-selectable-mailbox-list
+ (elmo-imap4-send-command-wait
+ session
+ (list "list " (elmo-imap4-mailbox root) " *"))))
+ (when (or (not (string= (elmo-net-folder-user-internal folder)
+ elmo-imap4-default-user))
+ (not (eq (elmo-net-folder-auth-internal folder)
+ (or elmo-imap4-default-authenticate-type 'clear))))
+ (setq append-serv (concat ":" (elmo-net-folder-user-internal folder))))
+ (unless (eq (elmo-net-folder-auth-internal folder)
+ (or elmo-imap4-default-authenticate-type 'clear))
+ (setq append-serv
+ (concat append-serv "/"
+ (symbol-name (elmo-net-folder-auth-internal folder)))))
+ (unless (string= (elmo-net-folder-server-internal folder)
+ elmo-imap4-default-server)
+ (setq append-serv (concat append-serv "@"
+ (elmo-net-folder-server-internal folder))))
+ (unless (eq (elmo-net-folder-port-internal folder) elmo-imap4-default-port)
+ (setq append-serv (concat append-serv ":"
+ (int-to-string
+ (elmo-net-folder-port-internal folder)))))
+ (setq type (elmo-net-folder-stream-type-internal folder))
+ (unless (eq (elmo-network-stream-type-symbol type)
+ elmo-imap4-default-stream-type)
+ (if type
+ (setq append-serv (concat append-serv
+ (elmo-network-stream-type-spec-string
+ type)))))
+ (if one-level
+ (let ((re-delim (regexp-quote delim))
+ (case-fold-search nil)
+ folder ret has-child-p)
+ ;; Append delimiter
+ (when (and root
+ (not (string= root ""))
+ (not (string-match
+ (concat "\\(.*\\)" re-delim "\\'")
+ root)))
+ (setq root (concat root delim)))
+ (while (setq folder (car result))
+ (when (string-match
+ (concat "^\\(" (regexp-quote root) "[^" re-delim "]" "+\\)"
+ re-delim)
+ folder)
+ (setq folder (match-string 1 folder)))
+ (setq has-child-p nil
+ result (delq
+ nil
+ (mapcar (lambda (fld)
+ (if (string-match
+ (concat "^" (regexp-quote folder)
+ "\\(" re-delim "\\|\\'\\)")
+ fld)
+ (progn (setq has-child-p t) nil)
+ fld))
+ (cdr result)))
+ folder (concat prefix
+ (elmo-imap4-decode-folder-string folder)
+ (and append-serv
+ (eval append-serv)))
+ ret (append ret (if has-child-p
+ (list (list folder))
+ (list folder)))))
+ ret)
+ (mapcar (lambda (fld)
+ (concat prefix (elmo-imap4-decode-folder-string fld)
+ (and append-serv
+ (eval append-serv))))
+ result))))
+
+(luna-define-method elmo-folder-exists-p-plugged ((folder elmo-imap4-folder))
+ (let ((session (elmo-imap4-get-session folder)))
+ (if (string=
+ (elmo-imap4-session-current-mailbox-internal session)
+ (elmo-imap4-folder-mailbox-internal folder))
+ t
+ (elmo-imap4-session-select-mailbox
+ session
+ (elmo-imap4-folder-mailbox-internal folder)
+ 'force 'notify-bye))))
+
+(luna-define-method elmo-folder-creatable-p ((folder elmo-imap4-folder))
+ t)
+
+(luna-define-method elmo-folder-writable-p ((folder elmo-imap4-folder))
+ t)
+
+(luna-define-method elmo-folder-delete :before ((folder elmo-imap4-folder))
+ (let ((session (elmo-imap4-get-session folder))
+ msgs)
+ (when (elmo-imap4-folder-mailbox-internal folder)
+ (when (setq msgs (elmo-folder-list-messages folder))
+ (elmo-folder-delete-messages folder msgs))
+ (elmo-imap4-send-command-wait session "close")
+ (elmo-imap4-send-command-wait
+ session
+ (list "delete "
+ (elmo-imap4-mailbox
+ (elmo-imap4-folder-mailbox-internal folder)))))))
+
+(luna-define-method elmo-folder-rename-internal ((folder elmo-imap4-folder)
+ new-folder)
+ (let ((session (elmo-imap4-get-session folder)))
+ ;; make sure the folder is selected.
+ (elmo-imap4-session-select-mailbox session
+ (elmo-imap4-folder-mailbox-internal
+ folder))
+ (elmo-imap4-send-command-wait session "close")
+ (elmo-imap4-send-command-wait
+ session
+ (list "rename "
+ (elmo-imap4-mailbox
+ (elmo-imap4-folder-mailbox-internal folder))
+ " "
+ (elmo-imap4-mailbox
+ (elmo-imap4-folder-mailbox-internal new-folder))))
+ (elmo-imap4-session-set-current-mailbox-internal
+ session (elmo-imap4-folder-mailbox-internal new-folder))))
+
+(defun elmo-imap4-copy-messages (src-folder dst-folder numbers)
+ (let ((session (elmo-imap4-get-session src-folder))
+ (set-list (elmo-imap4-make-number-set-list
+ numbers
+ elmo-imap4-number-set-chop-length))
+ succeeds)
+ (elmo-imap4-session-select-mailbox session
+ (elmo-imap4-folder-mailbox-internal
+ src-folder))
+ (while set-list
+ (if (elmo-imap4-send-command-wait session
+ (list
+ (format
+ (if elmo-imap4-use-uid
+ "uid copy %s "
+ "copy %s ")
+ (cdr (car set-list)))
+ (elmo-imap4-mailbox
+ (elmo-imap4-folder-mailbox-internal
+ dst-folder))))
+ (setq succeeds (append succeeds numbers)))
+ (setq set-list (cdr set-list)))
+ succeeds))
+
+(defun elmo-imap4-set-flag (folder numbers flag &optional remove)
+ "Set flag on messages.
+FOLDER is the ELMO folder structure.
+NUMBERS is the message numbers to be flagged.
+FLAG is the flag name.
+If optional argument REMOVE is non-nil, remove FLAG."
+ (let ((session (elmo-imap4-get-session folder))
+ response set-list)
+ (elmo-imap4-session-select-mailbox session
+ (elmo-imap4-folder-mailbox-internal
+ folder))
+ (setq set-list (elmo-imap4-make-number-set-list
+ numbers
+ elmo-imap4-number-set-chop-length))
+ (while set-list
+ (with-current-buffer (elmo-network-session-buffer session)
+ (setq elmo-imap4-fetch-callback nil)
+ (setq elmo-imap4-fetch-callback-data nil))
+ (unless (elmo-imap4-response-ok-p
+ (elmo-imap4-send-command-wait
+ session
+ (format
+ (if elmo-imap4-use-uid
+ "uid store %s %sflags.silent (%s)"
+ "store %s %sflags.silent (%s)")
+ (cdr (car set-list))
+ (if remove "-" "+")
+ flag)))
+ (setq response 'fail))
+ (setq set-list (cdr set-list)))
+ (not (eq response 'fail))))
+
+(luna-define-method elmo-folder-delete-messages-plugged
+ ((folder elmo-imap4-folder) numbers)
+ (let ((session (elmo-imap4-get-session folder)))
+ (elmo-imap4-set-flag folder numbers "\\Deleted")
+ (elmo-imap4-send-command-wait session "expunge")))
+
+(defmacro elmo-imap4-detect-search-charset (string)
+ (` (with-temp-buffer
+ (insert (, string))
+ (detect-mime-charset-region (point-min) (point-max)))))
+
+(defun elmo-imap4-search-internal-primitive (folder session filter from-msgs)
+ (let ((search-key (elmo-filter-key filter))
+ (imap-search-keys '("bcc" "body" "cc" "from" "subject" "to"
+ "larger" "smaller"))
+ (total 0)
+ (length (length from-msgs))
+ charset set-list end results)
+ (message "Searching...")
+ (cond
+ ((string= "last" search-key)
+ (let ((numbers (or from-msgs (elmo-folder-list-messages folder))))
+ (nthcdr (max (- (length numbers)
+ (string-to-int (elmo-filter-value filter)))
+ 0)
+ numbers)))
+ ((string= "first" search-key)
+ (let* ((numbers (or from-msgs (elmo-folder-list-messages folder)))
+ (rest (nthcdr (string-to-int (elmo-filter-value filter) )
+ numbers)))
+ (mapcar '(lambda (x) (delete x numbers)) rest)
+ numbers))
+ ((or (string= "since" search-key)
+ (string= "before" search-key))
+ (setq search-key (concat "sent" search-key)
+ set-list (elmo-imap4-make-number-set-list
+ from-msgs
+ elmo-imap4-number-set-chop-length)
+ end nil)
+ (while (not end)
+ (setq results
+ (append
+ results
+ (elmo-imap4-response-value
+ (elmo-imap4-send-command-wait
+ session
+ (format
+ (if elmo-imap4-use-uid
+ "uid search %s%s%s %s"
+ "search %s%s%s %s")
+ (if from-msgs
+ (concat
+ (if elmo-imap4-use-uid "uid ")
+ (cdr (car set-list))
+ " ")
+ "")
+ (if (eq (elmo-filter-type filter)
+ 'unmatch)
+ "not " "")
+ search-key
+ (elmo-date-get-description
+ (elmo-date-get-datevec
+ (elmo-filter-value filter)))))
+ 'search)))
+ (when (> length elmo-display-progress-threshold)
+ (setq total (+ total (car (car set-list))))
+ (elmo-display-progress
+ 'elmo-imap4-search "Searching..."
+ (/ (* total 100) length)))
+ (setq set-list (cdr set-list)
+ end (null set-list)))
+ results)
+ (t
+ (setq charset
+ (if (eq (length (elmo-filter-value filter)) 0)
+ (setq charset 'us-ascii)
+ (elmo-imap4-detect-search-charset
+ (elmo-filter-value filter)))
+ set-list (elmo-imap4-make-number-set-list
+ from-msgs
+ elmo-imap4-number-set-chop-length)
+ end nil)
+ (while (not end)
+ (setq results
+ (append
+ results
+ (elmo-imap4-response-value
+ (elmo-imap4-send-command-wait
+ session
+ (list
+ (if elmo-imap4-use-uid "uid ")
+ "search "
+ "CHARSET "
+ (elmo-imap4-astring
+ (symbol-name charset))
+ " "
+ (if from-msgs
+ (concat
+ (if elmo-imap4-use-uid "uid ")
+ (cdr (car set-list))
+ " ")
+ "")
+ (if (eq (elmo-filter-type filter)
+ 'unmatch)
+ "not " "")
+ (format "%s%s "
+ (if (member
+ (elmo-filter-key filter)
+ imap-search-keys)
+ ""
+ "header ")
+ (elmo-filter-key filter))
+ (elmo-imap4-astring
+ (encode-mime-charset-string
+ (elmo-filter-value filter) charset))))
+ 'search)))
+ (when (> length elmo-display-progress-threshold)
+ (setq total (+ total (car (car set-list))))
+ (elmo-display-progress
+ 'elmo-imap4-search "Searching..."
+ (/ (* total 100) length)))
+ (setq set-list (cdr set-list)
+ end (null set-list)))
+ results))))
+
+(defun elmo-imap4-search-internal (folder session condition from-msgs)
+ (let (result)
+ (cond
+ ((vectorp condition)
+ (setq result (elmo-imap4-search-internal-primitive
+ folder session condition from-msgs)))
+ ((eq (car condition) 'and)
+ (setq result (elmo-imap4-search-internal folder session (nth 1 condition)
+ from-msgs)
+ result (elmo-list-filter result
+ (elmo-imap4-search-internal
+ folder session (nth 2 condition)
+ from-msgs))))
+ ((eq (car condition) 'or)
+ (setq result (elmo-imap4-search-internal
+ folder session (nth 1 condition) from-msgs)
+ result (elmo-uniq-list
+ (nconc result
+ (elmo-imap4-search-internal
+ folder session (nth 2 condition) from-msgs)))
+ result (sort result '<))))))
+
+(luna-define-method elmo-folder-search :around ((folder elmo-imap4-folder)
+ condition &optional numbers)
+ (if (elmo-folder-plugged-p folder)
+ (save-excursion
+ (let ((session (elmo-imap4-get-session folder)))
+ (elmo-imap4-session-select-mailbox
+ session
+ (elmo-imap4-folder-mailbox-internal folder))
+ (elmo-imap4-search-internal folder session condition numbers)))
+ (luna-call-next-method)))
+
+(luna-define-method elmo-folder-msgdb-create-plugged
+ ((folder elmo-imap4-folder) numbers &rest args)
+ (when numbers
+ (let ((session (elmo-imap4-get-session folder))
+ (headers
+ (append
+ '("Subject" "From" "To" "Cc" "Date"
+ "Message-Id" "References" "In-Reply-To")
+ elmo-msgdb-extra-fields))
+ (total 0)
+ (length (length numbers))
+ rfc2060 set-list)
+ (setq rfc2060 (memq 'imap4rev1
+ (elmo-imap4-session-capability-internal
+ session)))
+ (message "Getting overview...")
+ (elmo-imap4-session-select-mailbox
+ session (elmo-imap4-folder-mailbox-internal folder))
+ (setq set-list (elmo-imap4-make-number-set-list
+ numbers
+ elmo-imap4-overview-fetch-chop-length))
+ ;; Setup callback.
+ (with-current-buffer (elmo-network-session-buffer session)
+ (setq elmo-imap4-current-msgdb nil
+ elmo-imap4-seen-messages nil
+ elmo-imap4-fetch-callback 'elmo-imap4-fetch-callback-1
+ elmo-imap4-fetch-callback-data (cons args
+ (elmo-folder-use-flag-p
+ folder)))
+ (while set-list
+ (elmo-imap4-send-command-wait
+ session
+ ;; get overview entity from IMAP4
+ (format "%sfetch %s (%s rfc822.size flags)"
+ (if elmo-imap4-use-uid "uid " "")
+ (cdr (car set-list))
+ (if rfc2060
+ (format "body.peek[header.fields %s]" headers)
+ (format "%s" headers))))
+ (when (> length elmo-display-progress-threshold)
+ (setq total (+ total (car (car set-list))))
+ (elmo-display-progress
+ 'elmo-imap4-msgdb-create "Getting overview..."
+ (/ (* total 100) length)))
+ (setq set-list (cdr set-list)))
+ (message "Getting overview...done")
+ (when elmo-imap4-seen-messages
+ (elmo-imap4-set-flag folder elmo-imap4-seen-messages "\\Seen"))
+ elmo-imap4-current-msgdb))))
+
+(luna-define-method elmo-folder-unmark-important-plugged
+ ((folder elmo-imap4-folder) numbers)
+ (elmo-imap4-set-flag folder numbers "\\Flagged" 'remove))
+
+(luna-define-method elmo-folder-mark-as-important-plugged
+ ((folder elmo-imap4-folder) numbers)
+ (elmo-imap4-set-flag folder numbers "\\Flagged"))
+
+(luna-define-method elmo-folder-unmark-read-plugged
+ ((folder elmo-imap4-folder) numbers)
+ (elmo-imap4-set-flag folder numbers "\\Seen" 'remove))
+
+(luna-define-method elmo-folder-mark-as-read-plugged
+ ((folder elmo-imap4-folder) numbers)
+ (elmo-imap4-set-flag folder numbers "\\Seen"))
+
+(luna-define-method elmo-message-use-cache-p ((folder elmo-imap4-folder)
+ number)
+ elmo-imap4-use-cache)
+
+(luna-define-method elmo-folder-message-appendable-p ((folder elmo-imap4-folder))
+ (if (elmo-folder-plugged-p folder)
+ (not (elmo-imap4-session-read-only-internal
+ (elmo-imap4-get-session folder)))
+ elmo-enable-disconnected-operation)) ; offline refile.
+
+(luna-define-method elmo-folder-check-plugged ((folder elmo-imap4-folder))
+ (let ((session (elmo-imap4-get-session folder 'if-exists)))
+ (when session
+ (if (string=
+ (elmo-imap4-session-current-mailbox-internal session)
+ (elmo-imap4-folder-mailbox-internal folder))
+ (if elmo-imap4-use-select-to-update-status
+ (elmo-imap4-session-select-mailbox
+ session
+ (elmo-imap4-folder-mailbox-internal folder)
+ 'force)
+ (elmo-imap4-session-check session))))))
+
+(defsubst elmo-imap4-folder-diff-plugged (folder)
+ (let ((session (elmo-imap4-get-session folder))
+ messages new unread response killed)
+;;; (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))
+ (setq response
+ (elmo-imap4-send-command-wait session
+ (list
+ "status "
+ (elmo-imap4-mailbox
+ (elmo-imap4-folder-mailbox-internal
+ folder))
+ " (recent unseen messages)")))
+ (setq response (elmo-imap4-response-value response 'status))
+ (setq messages (elmo-imap4-response-value response 'messages))
+ (setq killed (elmo-msgdb-killed-list-load (elmo-folder-msgdb-path folder)))
+ (if killed
+ (setq messages (- messages
+ (elmo-msgdb-killed-list-length
+ killed))))
+ (setq new (elmo-imap4-response-value response 'recent)
+ unread (elmo-imap4-response-value response 'unseen))
+ (if (< unread new) (setq new unread))
+ (list new unread messages)))
+
+(luna-define-method elmo-folder-diff-plugged ((folder elmo-imap4-folder))
+ (elmo-imap4-folder-diff-plugged folder))
+
+(luna-define-method elmo-folder-diff-async ((folder elmo-imap4-folder)
+ &optional number-alist)
+ (setq elmo-imap4-server-diff-async-callback
+ elmo-folder-diff-async-callback)
+ (setq elmo-imap4-server-diff-async-callback-data
+ elmo-folder-diff-async-callback-data)
+ (elmo-imap4-server-diff-async folder))
+
+(luna-define-method elmo-folder-open :around ((folder elmo-imap4-folder)
+ &optional load-msgdb)
+ (if (elmo-folder-plugged-p folder)
+ (let (session mailbox msgdb result response tag)
+ (condition-case err
+ (progn
+ (setq session (elmo-imap4-get-session folder)
+ mailbox (elmo-imap4-folder-mailbox-internal folder)
+ tag (elmo-imap4-send-command session
+ (list "select "
+ (elmo-imap4-mailbox
+ mailbox))))
+ (message "Selecting %s..."
+ (elmo-folder-name-internal folder))
+ (if load-msgdb
+ (setq msgdb (elmo-msgdb-load folder 'silent)))
+ (elmo-folder-set-killed-list-internal
+ folder
+ (elmo-msgdb-killed-list-load (elmo-folder-msgdb-path folder)))
+ (if (setq result (elmo-imap4-response-ok-p
+ (setq response
+ (elmo-imap4-read-response session tag))))
+ (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)
+ (if (elmo-imap4-response-bye-p response)
+ (elmo-imap4-process-bye session)
+ (error (or
+ (elmo-imap4-response-error-text response)
+ (format "Select %s failed" mailbox)))))
+ (message "Selecting %s...done"
+ (elmo-folder-name-internal folder))
+ (elmo-folder-set-msgdb-internal
+ folder msgdb))
+ (quit
+ (if (elmo-imap4-response-ok-p response)
+ (elmo-imap4-session-set-current-mailbox-internal
+ session mailbox)
+ (and session
+ (elmo-imap4-session-set-current-mailbox-internal
+ session nil))))
+ (error
+ (if (elmo-imap4-response-ok-p response)
+ (elmo-imap4-session-set-current-mailbox-internal
+ session mailbox)
+ (and session
+ (elmo-imap4-session-set-current-mailbox-internal
+ session nil))))))
+ (luna-call-next-method)))
+
+;; elmo-folder-open-internal: do nothing.
+
+(luna-define-method elmo-find-fetch-strategy
+ ((folder elmo-imap4-folder) entity &optional ignore-cache)
+ (let ((number (elmo-msgdb-overview-entity-get-number entity))
+ cache-file size message-id)
+ (setq size (elmo-msgdb-overview-entity-get-size entity))
+ (setq message-id (elmo-msgdb-overview-entity-get-id entity))
+ (setq cache-file (elmo-file-cache-get message-id))
+ (if (or ignore-cache
+ (null (elmo-file-cache-status cache-file)))
+ (if (and elmo-message-fetch-threshold
+ (integerp size)
+ (>= size elmo-message-fetch-threshold)
+ (or (not elmo-message-fetch-confirm)
+ (not (prog1 (y-or-n-p
+ (format
+ "Fetch entire message at once? (%dbytes)"
+ size))
+ (message "")))))
+ ;; Fetch message as imap message.
+ (elmo-make-fetch-strategy 'section
+ nil
+ (elmo-message-use-cache-p
+ folder number)
+ (elmo-file-cache-path
+ cache-file))
+ ;; Don't use existing cache and fetch entire message at once.
+ (elmo-make-fetch-strategy 'entire nil
+ (elmo-message-use-cache-p
+ folder number)
+ (elmo-file-cache-path cache-file)))
+ ;; Cache found and use it.
+ (if (not ignore-cache)
+ (if (eq (elmo-file-cache-status cache-file) 'section)
+ ;; Fetch message with imap message.
+ (elmo-make-fetch-strategy 'section
+ t
+ (elmo-message-use-cache-p
+ folder number)
+ (elmo-file-cache-path
+ cache-file))
+ (elmo-make-fetch-strategy 'entire
+ t
+ (elmo-message-use-cache-p
+ folder number)
+ (elmo-file-cache-path
+ cache-file)))))))
+
+(luna-define-method elmo-folder-create-plugged ((folder elmo-imap4-folder))
+ (elmo-imap4-send-command-wait
+ (elmo-imap4-get-session folder)
+ (list "create "
+ (elmo-imap4-mailbox
+ (elmo-imap4-folder-mailbox-internal folder)))))
+
+(luna-define-method elmo-folder-append-buffer
+ ((folder elmo-imap4-folder) unread &optional number)
+ (if (elmo-folder-plugged-p folder)
+ (let ((session (elmo-imap4-get-session folder))
+ send-buffer result)
+ (elmo-imap4-session-select-mailbox session
+ (elmo-imap4-folder-mailbox-internal
+ folder))
+ (setq send-buffer (elmo-imap4-setup-send-buffer))
+ (unwind-protect
+ (setq result
+ (elmo-imap4-send-command-wait
+ session
+ (list
+ "append "
+ (elmo-imap4-mailbox (elmo-imap4-folder-mailbox-internal
+ folder))
+ (if unread " () " " (\\Seen) ")
+ (elmo-imap4-buffer-literal send-buffer))))
+ (kill-buffer send-buffer))
+ result)
+ ;; Unplugged
+ (if elmo-enable-disconnected-operation
+ (elmo-folder-append-buffer-dop folder unread number)
+ (error "Unplugged"))))
+
+(eval-when-compile
+ (defmacro elmo-imap4-identical-system-p (folder1 folder2)
+ "Return t if FOLDER1 and FOLDER2 are in the same IMAP4 system."
+ (` (and (string= (elmo-net-folder-server-internal (, folder1))
+ (elmo-net-folder-server-internal (, folder2)))
+ (eq (elmo-net-folder-port-internal (, folder1))
+ (elmo-net-folder-port-internal (, folder2)))
+ (string= (elmo-net-folder-user-internal (, folder1))
+ (elmo-net-folder-user-internal (, folder2)))))))
+
+(luna-define-method elmo-folder-append-messages :around
+ ((folder elmo-imap4-folder) src-folder numbers unread-marks
+ &optional same-number)
+ (if (and (eq (elmo-folder-type-internal src-folder) 'imap4)
+ (elmo-imap4-identical-system-p folder src-folder)
+ (elmo-folder-plugged-p folder))
+ ;; Plugged
+ (prog1
+ (elmo-imap4-copy-messages src-folder folder numbers)
+ (elmo-progress-notify 'elmo-folder-move-messages (length numbers)))
+ (luna-call-next-method)))
+
+(luna-define-method elmo-message-deletable-p ((folder elmo-imap4-folder)
+ number)
+ (if (elmo-folder-plugged-p folder)
+ (not (elmo-imap4-session-read-only-internal
+ (elmo-imap4-get-session folder)))
+ elmo-enable-disconnected-operation)) ; offline refile.
+
+;(luna-define-method elmo-message-fetch-unplugged
+; ((folder elmo-imap4-folder)
+; number strategy &optional section outbuf unseen)
+; (error "%d%s is not cached." number (if section
+; (format "(%s)" section)
+; "")))
+
+(defsubst elmo-imap4-message-fetch (folder number strategy
+ section outbuf unseen)
+ (let ((session (elmo-imap4-get-session folder))
+ response)
+ (elmo-imap4-session-select-mailbox session
+ (elmo-imap4-folder-mailbox-internal
+ folder))
+ (with-current-buffer (elmo-network-session-buffer session)
+ (setq elmo-imap4-fetch-callback nil)
+ (setq elmo-imap4-fetch-callback-data nil))
+ (unless elmo-inhibit-display-retrieval-progress
+ (setq elmo-imap4-display-literal-progress t))
+ (unwind-protect
+ (setq response
+ (elmo-imap4-send-command-wait session
+ (format
+ (if elmo-imap4-use-uid
+ "uid fetch %s body%s[%s]"
+ "fetch %s body%s[%s]")
+ number
+ (if unseen ".peek" "")
+ (or section "")
+ )))
+ (setq elmo-imap4-display-literal-progress nil))
+ (unless elmo-inhibit-display-retrieval-progress
+ (elmo-display-progress 'elmo-imap4-display-literal-progress
+ "Retrieving..." 100) ; remove progress bar.
+ (message "Retrieving...done"))
+ (if (setq response (elmo-imap4-response-bodydetail-text
+ (elmo-imap4-response-value-all
+ response 'fetch)))
+ (with-current-buffer outbuf
+ (erase-buffer)
+ (insert response)
+ t))))
+
+(luna-define-method elmo-message-fetch-plugged ((folder elmo-imap4-folder)
+ number strategy
+ &optional section
+ outbuf unseen)
+ (elmo-imap4-message-fetch folder number strategy section outbuf unseen))
+
+(luna-define-method elmo-message-fetch-field ((folder elmo-imap4-folder)
+ number field)
+ (let ((session (elmo-imap4-get-session folder)))
+ (elmo-imap4-session-select-mailbox session
+ (elmo-imap4-folder-mailbox-internal
+ folder))
+ (with-current-buffer (elmo-network-session-buffer session)
+ (setq elmo-imap4-fetch-callback nil)
+ (setq elmo-imap4-fetch-callback-data nil))
+ (with-temp-buffer
+ (insert
+ (elmo-imap4-response-bodydetail-text
+ (elmo-imap4-response-value
+ (elmo-imap4-send-command-wait session
+ (concat
+ (if elmo-imap4-use-uid
+ "uid ")
+ (format
+ "fetch %s (body.peek[header.fields (%s)])"
+ number field)))
+ 'fetch)))
+ (elmo-delete-cr-buffer)
+ (goto-char (point-min))
+ (std11-field-body (symbol-name field)))))
+
+
+
(require 'product)
(product-provide (provide 'elmo-imap4) (require 'elmo-version))
projects / elisp / wanderlust.git / blobdiff