;; Author: Simon Josefsson <jas@pdc.kth.se>
;;
+;;; Code:
(require 'elmo-vars)
(require 'elmo-util)
(require 'elmo-date)
(require 'utf7)
(require 'elmo-mime)
-;;; Code:
(eval-when-compile (require 'cl))
(defvar elmo-imap4-disuse-server-flag-mailbox-regexp "^#mh" ; UW imapd
;;; Debug
(defmacro elmo-imap4-debug (message &rest args)
- (` (if elmo-imap4-debug
- (elmo-imap4-debug-1 (, message) (,@ 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*")
(defmacro elmo-imap4-response-continue-req-p (response)
"Returns non-nil if RESPONSE is '+' response."
- (` (assq 'continue-req (, response))))
+ `(assq 'continue-req ,response))
(defmacro elmo-imap4-response-ok-p (response)
"Returns non-nil if RESPONSE is an 'OK' response."
- (` (assq 'ok (, response))))
+ `(assq 'ok ,response))
(defmacro elmo-imap4-response-bye-p (response)
"Returns non-nil if RESPONSE is an 'BYE' response."
- (` (assq 'bye (, response))))
+ `(assq 'bye ,response))
(defmacro elmo-imap4-response-garbage-p (response)
"Returns non-nil if RESPONSE is an 'garbage' response."
- (` (assq 'garbage (, response))))
+ `(assq 'garbage ,response))
(defmacro elmo-imap4-response-value (response symbol)
"Get value of the SYMBOL from RESPONSE."
- (` (nth 1 (assq (, symbol) (, response)))))
+ `(nth 1 (assq ,symbol ,response)))
(defsubst elmo-imap4-response-value-all (response symbol)
"Get all value of the SYMBOL from RESPONSE."
(defmacro elmo-imap4-response-error-text (response)
"Returns text of NO, BAD, BYE response."
- (` (nth 1 (or (elmo-imap4-response-value (, response) 'no)
- (elmo-imap4-response-value (, response) 'bad)
- (elmo-imap4-response-value (, response) 'bye)))))
+ `(nth 1 (or (elmo-imap4-response-value ,response 'no)
+ (elmo-imap4-response-value ,response 'bad)
+ (elmo-imap4-response-value ,response 'bye))))
(defmacro elmo-imap4-response-bodydetail-text (response)
"Returns text of BODY[section]<partial>."
- (` (nth 3 (assq 'bodydetail (, response)))))
+ `(nth 3 (assq 'bodydetail ,response)))
;;; Session commands.
;; rfc2088
(progn
(setq cmdstr (concat cmdstr
- (format "{%d+}" (nth 2 token))))
+ (format "{%d+}" (nth 2 token))
+ "\r\n"))
(process-send-string process cmdstr)
- (process-send-string process "\r\n")
(setq cmdstr nil))
(setq cmdstr (concat cmdstr
- (format "{%d}" (nth 2 token))))
+ (format "{%d}" (nth 2 token))
+ "\r\n"))
(process-send-string process cmdstr)
- (process-send-string process "\r\n")
(setq cmdstr nil)
(elmo-imap4-accept-continue-req session))
(cond ((stringp (nth 1 token))
(t
(error "Invalid argument")))
(setq command-args (cdr command-args)))
- (if cmdstr
- (process-send-string process cmdstr))
- (process-send-string process "\r\n")
+ (process-send-string process (concat cmdstr "\r\n"))
tag)))
(defun elmo-imap4-send-string (session string)
(let ((session (elmo-imap4-get-session folder))
(criteria (elmo-imap4-flag-to-imap-criteria flag)))
(if (elmo-imap4-session-flag-available-p session flag)
- (progn
- (elmo-imap4-session-select-mailbox
- session
- (elmo-imap4-folder-mailbox-internal folder))
- (elmo-imap4-response-value
- (elmo-imap4-send-command-wait
- session
- (format (if elmo-imap4-use-uid "uid search %s"
- "search %s") criteria))
- 'search))
+ (elmo-imap4-list folder criteria)
;; List flagged messages in the msgdb.
(elmo-msgdb-list-flagged (elmo-folder-msgdb folder) flag))))
elmo-network-initialize-session-buffer :after ((session
elmo-imap4-session) buffer)
(with-current-buffer buffer
- (mapcar 'make-variable-buffer-local elmo-imap4-local-variables)
+ (mapc 'make-variable-buffer-local elmo-imap4-local-variables)
(setq elmo-imap4-seqno 0)
(setq elmo-imap4-status 'initial)))
(sasl-mechanisms
(delq nil
(mapcar
- '(lambda (cap)
- (if (string-match "^auth=\\(.*\\)$"
- (symbol-name cap))
- (match-string 1 (upcase (symbol-name cap)))))
+ (lambda (cap)
+ (if (string-match "^auth=\\(.*\\)$"
+ (symbol-name cap))
+ (match-string 1 (upcase (symbol-name cap)))))
(elmo-imap4-session-capability-internal session))))
(mechanism
(sasl-find-mechanism
(delq nil
- (mapcar '(lambda (cap) (upcase (symbol-name cap)))
+ (mapcar (lambda (cap) (upcase (symbol-name cap)))
(if (listp auth)
auth
(list auth)))))) ;)
session
(intern (downcase name)))
(setq sasl-read-passphrase
- (function
- (lambda (prompt)
- (elmo-get-passwd
- (elmo-network-session-password-key session)))))
+ (lambda (prompt)
+ (elmo-get-passwd
+ (elmo-network-session-password-key session))))
(setq tag
(elmo-imap4-send-command
session
(elmo-imap4-forward)
(while (and (not (eq (char-after (point)) ?\)))
;; next line for MS Exchange bug
- (progn (and (eq (char-after (point)) ? ) (elmo-imap4-forward)) t)
+ (progn (and (eq (char-after (point)) (string-to-char " "))
+ (elmo-imap4-forward)) t)
(setq address (elmo-imap4-parse-address)))
(setq addresses (cons address addresses)))
(when (eq (char-after (point)) ?\))
(1-
(progn (re-search-forward "[] ]" nil t)
(point))))))
- (if (eq (char-before) ? )
+ (if (eq (char-before) (string-to-char " "))
(prog1
(mapconcat 'identity
(cons section (elmo-imap4-parse-header-list)) " ")
(setq status
(cons
(let ((token (read (current-buffer))))
- (cond ((eq token 'MESSAGES)
- (list 'messages (read (current-buffer))))
- ((eq token 'RECENT)
- (list 'recent (read (current-buffer))))
- ((eq token 'UIDNEXT)
- (list 'uidnext (read (current-buffer))))
- ((eq token 'UIDVALIDITY)
- (and (looking-at " \\([0-9]+\\)")
- (prog1 (list 'uidvalidity (match-string 1))
- (goto-char (match-end 1)))))
- ((eq token 'UNSEEN)
- (list 'unseen (read (current-buffer))))
- (t
- (message
- "Unknown status data %s in mailbox %s ignored"
- token mailbox))))
+ (case (intern (upcase (symbol-name token)))
+ (MESSAGES
+ (list 'messages (read (current-buffer))))
+ (RECENT
+ (list 'recent (read (current-buffer))))
+ (UIDNEXT
+ (list 'uidnext (read (current-buffer))))
+ (UIDVALIDITY
+ (and (looking-at " \\([0-9]+\\)")
+ (prog1 (list 'uidvalidity (match-string 1))
+ (goto-char (match-end 1)))))
+ (UNSEEN
+ (list 'unseen (read (current-buffer))))
+ (t
+ (message
+ "Unknown status data %s in mailbox %s ignored"
+ token mailbox))))
status))
(skip-chars-forward " ")))
(and elmo-imap4-status-callback
(defmacro elmo-imap4-value (value)
- (` (if (eq (, value) 'NIL) nil
- (, value))))
+ `(if (eq ,value 'NIL)
+ nil
+ ,value))
(defmacro elmo-imap4-nth (pos list)
- (` (let ((value (nth (, pos) (, list))))
- (elmo-imap4-value value))))
+ `(let ((value (nth ,pos ,list)))
+ (elmo-imap4-value value)))
(defun elmo-imap4-parse-namespace ()
(list 'namespace
(defun elmo-imap4-parse-acl ()
(let ((mailbox (elmo-imap4-parse-mailbox))
identifier rights acl)
- (while (eq (char-after (point)) ?\ )
+ (while (eq (char-after (point)) (string-to-char " "))
(elmo-imap4-forward)
(setq identifier (elmo-imap4-parse-astring))
(elmo-imap4-forward)
(let (b-e)
(elmo-imap4-forward)
(push (elmo-imap4-parse-body-extension) b-e)
- (while (eq (char-after (point)) ?\ )
+ (while (eq (char-after (point)) (string-to-char " "))
(elmo-imap4-forward)
(push (elmo-imap4-parse-body-extension) b-e))
(assert (eq (char-after (point)) ?\)))
(defsubst elmo-imap4-parse-body-ext ()
(let (ext)
- (when (eq (char-after (point)) ?\ );; body-fld-dsp
+ (when (eq (char-after (point)) (string-to-char " ")) ; body-fld-dsp
(elmo-imap4-forward)
(let (dsp)
(if (eq (char-after (point)) ?\()
(elmo-imap4-forward))
(assert (elmo-imap4-parse-nil)))
(push (nreverse dsp) ext))
- (when (eq (char-after (point)) ?\ );; body-fld-lang
+ (when (eq (char-after (point)) (string-to-char " ")) ; body-fld-lang
(elmo-imap4-forward)
(if (eq (char-after (point)) ?\()
(push (elmo-imap4-parse-string-list) ext)
(push (elmo-imap4-parse-nstring) ext))
- (while (eq (char-after (point)) ?\ );; body-extension
+ (while (eq (char-after (point)) (string-to-char " "));; body-extension
(elmo-imap4-forward)
(setq ext (append (elmo-imap4-parse-body-extension) ext)))))
ext))
(push subbody body))
(elmo-imap4-forward)
(push (elmo-imap4-parse-string) body);; media-subtype
- (when (eq (char-after (point)) ?\ );; body-ext-mpart:
+ (when (eq (char-after (point)) (string-to-char " ")) ; body-ext-mpart:
(elmo-imap4-forward)
(if (eq (char-after (point)) ?\();; body-fld-param
(push (elmo-imap4-parse-string-list) body)
(push (elmo-imap4-parse-string) body);; media-subtype
(elmo-imap4-forward)
;; next line for Sun SIMS bug
- (and (eq (char-after (point)) ? ) (elmo-imap4-forward))
+ (and (eq (char-after (point)) (string-to-char " "))
+ (elmo-imap4-forward))
(if (eq (char-after (point)) ?\();; body-fld-param
(push (elmo-imap4-parse-string-list) body)
(push (and (elmo-imap4-parse-nil) nil) body))
;; the problem is that the two first are in turn optionally followed
;; by the third. So we parse the first two here (if there are any)...
- (when (eq (char-after (point)) ?\ )
+ (when (eq (char-after (point)) (string-to-char " "))
(elmo-imap4-forward)
(let (lines)
(cond ((eq (char-after (point)) ?\();; body-type-msg:
;; ...and then parse the third one here...
- (when (eq (char-after (point)) ?\ );; body-ext-1part:
+ (when (eq (char-after (point)) (string-to-char " ")) ; body-ext-1part:
(elmo-imap4-forward)
(push (elmo-imap4-parse-nstring) body);; body-fld-md5
(setq body
&optional
enable-killed)
(elmo-imap4-list folder
- (let ((killed
- (elmo-folder-killed-list-internal
- folder)))
- (if (and killed
- (eq (length killed) 1)
- (consp (car killed))
- (eq (car (car killed)) 1))
- (format "uid %d:*" (cdr (car killed)))
- "all"))))
+ (concat
+ (let ((killed
+ (elmo-folder-killed-list-internal
+ folder)))
+ (if (and killed
+ (eq (length killed) 1)
+ (consp (car killed))
+ (eq (car (car killed)) 1))
+ (format "uid %d:*" (cdr (car killed)))
+ "all"))
+ " undeleted")))
(luna-define-method elmo-folder-list-flagged-plugged
((folder elmo-imap4-folder) flag)
(luna-define-method elmo-folder-delete-messages-plugged
((folder elmo-imap4-folder) numbers)
- (let ((session (elmo-imap4-get-session folder)))
+ (let ((session (elmo-imap4-get-session folder))
+ (expunge
+ (or (null (elmo-imap4-list folder "deleted"))
+ (y-or-n-p
+ "There's hidden deleted messages, expunge anyway?"))))
(elmo-imap4-session-select-mailbox
session
(elmo-imap4-folder-mailbox-internal folder))
(unless (elmo-imap4-set-flag folder numbers "\\Deleted")
(error "Failed to set deleted flag"))
- (elmo-imap4-send-command session "expunge")))
+ (when expunge
+ (elmo-imap4-send-command session "expunge"))
+ t))
-(defmacro elmo-imap4-detect-search-charset (string)
- (` (with-temp-buffer
- (insert (, string))
- (detect-mime-charset-region (point-min) (point-max)))))
+(defun 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))
((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)))
+ (string-to-number (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) )
+ (rest (nthcdr (string-to-number (elmo-filter-value filter) )
numbers)))
- (mapcar '(lambda (x) (delete x numbers)) rest)
+ (mapc (lambda (x) (delete x numbers)) rest)
numbers))
((string= "flag" search-key)
(elmo-imap4-folder-list-flagged
(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)))))))
+ `(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-next-message-number-plugged
((folder elmo-imap4-folder))
projects / elisp / wanderlust.git / blobdiff