"Extra namespace alist.
A list of cons cell like: (REGEXP . DELIMITER).
REGEXP should have a grouping for namespace prefix.")
+
+(defvar elmo-imap4-disabled-extensions nil
+ "List of server extensions that are disabled on the client side.")
+
;;
;;; internal variables
;;
(defconst elmo-imap4-folder-name-syntax
`(mailbox
- (?: [user "^[A-Za-z]"] (?/ [auth ".+"]))
+ (?: [user "^[A-Za-z0-9]"] (?/ [auth ".+"]))
,@elmo-net-folder-name-syntax))
;; For debugging.
(luna-define-internal-accessors 'elmo-imap4-session))
(defmacro elmo-imap4-session-capable-p (session capability)
- `(memq ,capability (elmo-imap4-session-capability-internal ,session)))
+ `(and (memq ,capability (elmo-imap4-session-capability-internal ,session))
+ (not (memq ,capability elmo-imap4-disabled-extensions))))
;;; MIME-ELMO-IMAP Location
(eval-and-compile
(t
(error "Invalid argument")))
(setq command-args (cdr command-args)))
- (elmo-imap4-debug "[%s] <- %s" (time-stamp-hh:mm:ss) cmdstr)
+ (elmo-imap4-debug "[%s] <- %s" (format-time-string "%T") cmdstr)
(process-send-string process (concat cmdstr "\r\n"))
tag)))
(elmo-network-session-process-internal session))
(setq elmo-imap4-current-response nil)
(goto-char (point-min))
- (elmo-imap4-debug "[%s] <-- %s" (time-stamp-hh:mm:ss) string)
+ (elmo-imap4-debug "[%s] <-- %s" (format-time-string "%T") string)
(process-send-string (elmo-network-session-process-internal session)
string)
(process-send-string (elmo-network-session-process-internal session)
'(open run))
(accept-process-output (elmo-network-session-process-internal session)
1)))
- (elmo-imap4-debug "[%s] =>%s" (time-stamp-hh:mm:ss) (prin1-to-string elmo-imap4-current-response))
+ (elmo-imap4-debug "[%s] => %s" (format-time-string "%T") (prin1-to-string elmo-imap4-current-response))
(setq elmo-imap4-parsing nil)
elmo-imap4-current-response))
(with-current-buffer (process-buffer process)
(while (not elmo-imap4-current-response)
(accept-process-output process 1))
- (elmo-imap4-debug "[%s] =>%s" (time-stamp-hh:mm:ss) (prin1-to-string elmo-imap4-current-response))
+ (elmo-imap4-debug "[%s] =>%s" (format-time-string "%T") (prin1-to-string elmo-imap4-current-response))
elmo-imap4-current-response))
(defun elmo-imap4-read-continue-req (session)
(format "Select %s failed" mailbox)))))))
(and result response))))
+(defun elmo-imap4-session-unselect-mailbox (session mailbox)
+ "Unselect MAILBOX in SESSION.
+Deselecting will exit selected state without causing silent
+EXPUNGE for deleted messages."
+ (if (elmo-imap4-session-capable-p session 'unselect)
+ (elmo-imap4-send-command-wait session "unselect")
+ (elmo-imap4-send-command-wait
+ session
+ (list "examine " (elmo-imap4-mailbox mailbox)))
+ (elmo-imap4-send-command-wait session "close")))
+
(defun elmo-imap4-check-validity (spec validity-file)
;;; Not used.
;;;(elmo-imap4-send-command-wait
(t
(elmo-imap4-flag-to-imap-search-key flag))))
-(defun elmo-imap4-folder-list-flagged (folder flag)
+(defun elmo-imap4-folder-list-flagged (folder flag &optional type)
"List flagged message numbers in the FOLDER.
-FLAG is one of the `unread', `read', `important', `answered', `any'."
+FLAG is one of the `unread', `read', `important', `answered',
+`any'.
+When optional argument TYPE is symbol 'unmatch, negate search
+condition."
(let ((session (elmo-imap4-get-session folder))
- (criteria (elmo-imap4-flag-to-imap-criteria flag)))
+ (criteria (concat (if (eq type 'unmatch) "not " "")
+ (elmo-imap4-flag-to-imap-criteria flag))))
(if (elmo-imap4-session-flag-available-p session flag)
(elmo-imap4-list folder criteria)
;; List flagged messages in the msgdb.
(and (elmo-file-cache-exists-p msg-id)
'(cached)))
saved-flags))
- (when (and (or (memq 'important flag-list)
- (memq 'answered flag-list))
- (memq 'unread flag-list))
- (setq elmo-imap4-seen-messages
- (cons (elmo-message-entity-number entity)
- elmo-imap4-seen-messages)))
(elmo-msgdb-append-entity elmo-imap4-current-msgdb
entity
flag-list)))
(if (sasl-step-data step)
(elmo-base64-encode-string (sasl-step-data step)
'no-line-break)
- ""))))))))))))
+ ""))))))))
+;; Some servers return reduced capabilities when client asks for them
+;; before login. It might be a good idea to ask them again, otherwise
+;; we can miss some useful feature.
+ (elmo-imap4-session-set-capability-internal
+ session
+ (elmo-imap4-response-value
+ (elmo-imap4-send-command-wait session "capability")
+ 'capability))))))
(luna-define-method elmo-network-setup-session ((session
elmo-imap4-session))
(while (setq end (elmo-imap4-find-next-line))
(save-restriction
(narrow-to-region (point-min) end)
- (delete-backward-char (length elmo-imap4-server-eol))
+ (delete-char (- (length elmo-imap4-server-eol)))
(goto-char (point-min))
(unwind-protect
(case elmo-imap4-status
(defun elmo-imap4-parse-response ()
"Parse a IMAP command response."
- (elmo-imap4-debug "[%s] -> %s" (time-stamp-hh:mm:ss) (buffer-substring (point) (point-max)))
+ (elmo-imap4-debug "[%s] -> %s" (format-time-string "%T") (buffer-substring (point) (point-max)))
(let (token)
(case (setq token (read (current-buffer)))
(+ (progn
")"))))
(ESEARCH (list
'esearch
- (cddr (split-string (buffer-substring (point) (point-max)) " " "\,"))))
+ (cddr (split-string (buffer-substring (point) (point-max)) " "))))
(STATUS (elmo-imap4-parse-status))
;; Added
(NAMESPACE (elmo-imap4-parse-namespace))
(goto-char (match-end 1)))))
(UNSEEN
(list 'unseen (read (current-buffer))))
- (t
+ (t
(message
"Unknown status data %s in mailbox %s ignored"
token mailbox))))
(elmo-imap4-list
folder
(concat
- (let ((killed
- (elmo-folder-killed-list-internal
- folder)))
+ (let ((killed (elmo-folder-killed-list-internal folder)))
(if (and killed
- (eq (length killed) 1)
- (consp (car killed))
- (eq (car (car killed)) 1))
-;; What about elmo-imap4-use-uid?
- (format "uid %d:%s" (cdr (car killed)) max)
- (format "uid %s:%s" min max)))
+ (eq (length killed) 1)
+ (consp (car killed))
+ (eq (car (car killed)) 1))
+ ;; What about elmo-imap4-use-uid?
+ (format "uid %d:%s" (cdr (car killed)) max)
+ (format "uid %s:%s" min max)))
" undeleted")))
-(luna-define-method elmo-folder-list-messages-plugged ((folder
- elmo-imap4-folder)
- &optional
- enable-killed)
-
+(luna-define-method elmo-folder-list-messages-plugged
+ ((folder elmo-imap4-folder) &optional enable-killed)
(let* ((old (elmo-msgdb-list-messages (elmo-folder-msgdb folder)))
- (new (elmo-imap4-folder-list-range folder
- (1+ (or (elmo-folder-get-info-max folder) 0)) "*"))
- (united-old-new (elmo-union old new)))
+ (new (elmo-imap4-folder-list-range
+ folder (1+ (or (elmo-folder-get-info-max folder) 0)) "*"))
+ (united-old-new (elmo-union old new)))
(if (= (length united-old-new) (or (elmo-folder-get-info-length folder) 0))
- united-old-new
+ united-old-new
(elmo-union new
(elmo-imap4-folder-list-range
folder
(elmo-imap4-session-select-mailbox session
(elmo-imap4-folder-mailbox-internal
folder))
+ (elmo-imap4-session-unselect-mailbox session
+ (elmo-imap4-folder-mailbox-internal
+ folder))
(elmo-imap4-send-command-wait session "close")
(elmo-imap4-send-command-wait
session
numbers))
((string= "flag" search-key)
(elmo-imap4-folder-list-flagged
- folder (intern (elmo-filter-value filter))))
+ folder (intern (elmo-filter-value filter)) (elmo-filter-type filter)))
((or (string= "since" search-key)
(string= "before" search-key))
(setq search-key (concat "sent" search-key)
number strategy
&optional section
outbuf unseen)
+ (when elmo-imap4-set-seen-flag-explicitly
+ (elmo-imap4-set-flag folder (list number) "\\Seen"))
(elmo-imap4-message-fetch folder number strategy section outbuf unseen))
(luna-define-method elmo-message-fetch-field ((folder elmo-imap4-folder)
projects / elisp / wanderlust.git / blobdiff