1 ;;; elmo-imap4.el -- IMAP4 Interface for ELMO.
3 ;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
4 ;; Copyright (C) 1999,2000 Kenichi OKADA <okada@opaopa.org>
5 ;; Copyright (C) 2000 OKAZAKI Tetsurou <okazaki@be.to>
6 ;; Copyright (C) 2000 Daiki Ueno <ueno@unixuser.org>
8 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
9 ;; Kenichi OKADA <okada@opaopa.org>
10 ;; OKAZAKI Tetsurou <okazaki@be.to>
11 ;; Daiki Ueno <ueno@unixuser.org>
12 ;; Keywords: mail, net news
14 ;; This file is part of ELMO (Elisp Library for Message Orchestration).
16 ;; This program is free software; you can redistribute it and/or modify
17 ;; it under the terms of the GNU General Public License as published by
18 ;; the Free Software Foundation; either version 2, or (at your option)
21 ;; This program is distributed in the hope that it will be useful,
22 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
23 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
24 ;; GNU General Public License for more details.
26 ;; You should have received a copy of the GNU General Public License
27 ;; along with GNU Emacs; see the file COPYING. If not, write to the
28 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
29 ;; Boston, MA 02111-1307, USA.
34 ;; Origin of IMAP parser part is imap.el, included in Gnus.
36 ;; Copyright (C) 1998, 1999, 2000
37 ;; Free Software Foundation, Inc.
38 ;; Author: Simon Josefsson <jas@pdc.kth.se>
50 (eval-when-compile (require 'cl))
52 (defvar elmo-imap4-use-lock t
53 "USE IMAP4 with locking process.")
55 ;;; internal variables
57 (defvar elmo-imap4-seq-prefix "elmo-imap4")
58 (defvar elmo-imap4-seqno 0)
59 (defvar elmo-imap4-use-uid t
60 "Use UID as message number.")
62 (defvar elmo-imap4-current-response nil)
63 (defvar elmo-imap4-status nil)
64 (defvar elmo-imap4-reached-tag "elmo-imap40")
66 ;;; buffer local variables
68 (defvar elmo-imap4-extra-namespace-alist
69 '(("^{.*/nntp}.*$" . ".")) ; Default is for UW's remote nntp mailbox...
70 "Extra namespace alist. A list of cons cell like: (REGEXP . DELIMITER).")
71 (defvar elmo-imap4-default-hierarchy-delimiter "/")
73 (defvar elmo-imap4-server-capability nil)
74 (defvar elmo-imap4-server-namespace nil)
76 (defvar elmo-imap4-parsing nil) ; indicates parsing.
78 (defvar elmo-imap4-fetch-callback nil)
79 (defvar elmo-imap4-fetch-callback-data nil)
80 (defvar elmo-imap4-status-callback nil)
81 (defvar elmo-imap4-status-callback-data nil)
83 (defvar elmo-imap4-server-diff-async-callback nil)
84 (defvar elmo-imap4-server-diff-async-callback-data nil)
86 ;;; progress...(no use?)
87 (defvar elmo-imap4-count-progress nil)
88 (defvar elmo-imap4-count-progress-message nil)
89 (defvar elmo-imap4-progress-count nil)
91 ;;; XXX Temporal implementation
92 (defvar elmo-imap4-current-msgdb nil)
94 (defvar elmo-imap4-local-variables
96 elmo-imap4-current-response
99 elmo-imap4-reached-tag
100 elmo-imap4-count-progress
101 elmo-imap4-count-progress-message
102 elmo-imap4-progress-count
103 elmo-imap4-fetch-callback
104 elmo-imap4-fetch-callback-data
105 elmo-imap4-status-callback
106 elmo-imap4-status-callback-data
107 elmo-imap4-current-msgdb))
109 (defvar elmo-imap4-display-literal-progress nil)
112 (defconst elmo-imap4-quoted-specials-list '(?\\ ?\"))
114 (defconst elmo-imap4-non-atom-char-regex
116 (concat "[^" "]!#$&'+,./0-9:;<=>?@A-Z[^_`a-z|}~-" "]")))
118 (defconst elmo-imap4-non-text-char-regex
121 "]\x01-\x09\x0b\x0c\x0e-\x1f\x7f !\"#$%&'()*+,./0-9:;<=>?@A-Z[\\^_`a-z{|}~-"
124 (defconst elmo-imap4-literal-threshold 1024
125 "Limitation of characters that can be used in a quoted string.")
128 (defvar elmo-imap4-debug nil
129 "Non-nil forces IMAP4 folder as debug mode.
130 Debug information is inserted in the buffer \"*IMAP4 DEBUG*\"")
132 (defvar elmo-imap4-debug-inhibit-logging nil)
137 (luna-define-class elmo-imap4-session (elmo-network-session)
138 (capability current-mailbox read-only))
139 (luna-define-internal-accessors 'elmo-imap4-session))
143 (defsubst elmo-imap4-spec-mailbox (spec)
146 (defsubst elmo-imap4-spec-username (spec)
149 (defsubst elmo-imap4-spec-auth (spec)
152 (defsubst elmo-imap4-spec-hostname (spec)
155 (defsubst elmo-imap4-spec-port (spec)
158 (defsubst elmo-imap4-spec-stream-type (spec)
164 (defsubst elmo-imap4-debug (message &rest args)
166 (with-current-buffer (get-buffer-create "*IMAP4 DEBUG*")
167 (goto-char (point-max))
168 (if elmo-imap4-debug-inhibit-logging
169 (insert "NO LOGGING\n")
170 (insert (apply 'format message args) "\n")))))
174 (defmacro elmo-imap4-response-continue-req-p (response)
175 "Returns non-nil if RESPONSE is '+' response."
176 (` (assq 'continue-req (, response))))
178 (defmacro elmo-imap4-response-ok-p (response)
179 "Returns non-nil if RESPONSE is an 'OK' response."
180 (` (assq 'ok (, response))))
182 (defmacro elmo-imap4-response-bye-p (response)
183 "Returns non-nil if RESPONSE is an 'BYE' response."
184 (` (assq 'bye (, response))))
186 (defmacro elmo-imap4-response-value (response symbol)
187 "Get value of the SYMBOL from RESPONSE."
188 (` (nth 1 (assq (, symbol) (, response)))))
190 (defsubst elmo-imap4-response-value-all (response symbol)
191 "Get all value of the SYMBOL from RESPONSE."
194 (if (eq (car (car response)) symbol)
195 (setq matched (nconc matched (nth 1 (car response)))))
196 (setq response (cdr response)))
199 (defmacro elmo-imap4-response-error-text (response)
200 "Returns text of NO, BAD, BYE response."
201 (` (nth 1 (or (elmo-imap4-response-value (, response) 'no)
202 (elmo-imap4-response-value (, response) 'bad)
203 (elmo-imap4-response-value (, response) 'bye)))))
205 (defmacro elmo-imap4-response-bodydetail-text (response)
206 "Returns text of BODY[section]<partial>."
207 (` (nth 3 (assq 'bodydetail (, response)))))
209 ;;; Session commands.
211 ; (defun elmo-imap4-send-command-wait (session command)
212 ; "Send COMMAND to the SESSION and wait for response.
213 ; Returns RESPONSE (parsed lisp object) of IMAP session."
214 ; (elmo-imap4-read-response session
215 ; (elmo-imap4-send-command
219 (defun elmo-imap4-send-command-wait (session command)
220 "Send COMMAND to the SESSION.
221 Returns RESPONSE (parsed lisp object) of IMAP session.
222 If response is not `OK', causes error with IMAP response text."
223 (elmo-imap4-accept-ok session
224 (elmo-imap4-send-command
228 (defun elmo-imap4-send-command (session command)
229 "Send COMMAND to the SESSION.
230 Returns a TAG string which is assigned to the COMAND."
231 (let* ((command-args (if (listp command)
234 (process (elmo-network-session-process-internal session))
235 cmdstr tag token kind)
236 (with-current-buffer (process-buffer process)
237 (setq tag (concat elmo-imap4-seq-prefix
239 (setq elmo-imap4-seqno (+ 1 elmo-imap4-seqno)))))
240 (setq cmdstr (concat tag " "))
241 ;; (erase-buffer) No need.
242 (goto-char (point-min))
243 (if (elmo-imap4-response-bye-p elmo-imap4-current-response)
244 (signal 'elmo-imap4-bye-error
245 (list (elmo-imap4-response-error-text
246 elmo-imap4-current-response))))
247 (setq elmo-imap4-current-response nil)
248 (if elmo-imap4-parsing
249 (error "IMAP process is running. Please wait (or plug again.)"))
250 (setq elmo-imap4-parsing t)
251 (elmo-imap4-debug "<-(%s)- %s" tag command)
252 (while (setq token (car command-args))
253 (cond ((stringp token) ; formatted
254 (setq cmdstr (concat cmdstr token)))
255 ((listp token) ; unformatted
256 (setq kind (car token))
257 (cond ((eq kind 'atom)
258 (setq cmdstr (concat cmdstr (nth 1 token))))
262 (elmo-imap4-format-quoted (nth 1 token)))))
264 (setq cmdstr (concat cmdstr
265 (format "{%d}" (nth 2 token))))
266 (process-send-string process cmdstr)
267 (process-send-string process "\r\n")
269 (elmo-imap4-accept-continue-req session)
270 (cond ((stringp (nth 1 token))
271 (setq cmdstr (nth 1 token)))
272 ((bufferp (nth 1 token))
273 (with-current-buffer (nth 1 token)
277 (+ (point-min) (nth 2 token)))))
279 (error "Wrong argument for literal"))))
281 (error "Unknown token kind %s" kind))))
283 (error "Invalid argument")))
284 (setq command-args (cdr command-args)))
286 (process-send-string process cmdstr))
287 (process-send-string process "\r\n")
290 (defun elmo-imap4-send-string (session string)
291 "Send STRING to the SESSION."
292 (with-current-buffer (process-buffer
293 (elmo-network-session-process-internal session))
294 (setq elmo-imap4-current-response nil)
295 (goto-char (point-min))
296 (elmo-imap4-debug "<-- %s" string)
297 (process-send-string (elmo-network-session-process-internal session)
299 (process-send-string (elmo-network-session-process-internal session)
302 (defun elmo-imap4-read-response (session tag)
303 "Read parsed response from SESSION.
304 TAG is the tag of the command"
305 (with-current-buffer (process-buffer
306 (elmo-network-session-process-internal session))
307 (while (not (or (string= tag elmo-imap4-reached-tag)
308 (elmo-imap4-response-bye-p elmo-imap4-current-response)))
309 (when (memq (process-status
310 (elmo-network-session-process-internal session))
312 (accept-process-output (elmo-network-session-process-internal session)
314 (elmo-imap4-debug "=>%s" (prin1-to-string elmo-imap4-current-response))
315 (setq elmo-imap4-parsing nil)
316 elmo-imap4-current-response))
318 (defsubst elmo-imap4-read-untagged (process)
319 (with-current-buffer (process-buffer process)
320 (while (not elmo-imap4-current-response)
321 (accept-process-output process 1))
322 (elmo-imap4-debug "=>%s" (prin1-to-string elmo-imap4-current-response))
323 elmo-imap4-current-response))
325 (defun elmo-imap4-read-continue-req (session)
326 "Returns a text following to continue-req in SESSION.
327 If response is not `+' response, returns nil."
328 (elmo-imap4-response-value
329 (elmo-imap4-read-untagged
330 (elmo-network-session-process-internal session))
333 (defun elmo-imap4-accept-continue-req (session)
334 "Returns non-nil if `+' (continue-req) response is arrived in SESSION.
335 If response is not `+' response, cause an error."
338 (elmo-imap4-read-untagged
339 (elmo-network-session-process-internal session)))
340 (or (elmo-imap4-response-continue-req-p response)
341 (error "IMAP error: %s"
342 (or (elmo-imap4-response-error-text response)
343 "No continut-req from server.")))))
345 (defun elmo-imap4-read-ok (session tag)
346 "Returns non-nil if `OK' response of the command with TAG is arrived
347 in SESSION. If response is not `OK' response, returns nil."
348 (elmo-imap4-response-ok-p
349 (elmo-imap4-read-response session tag)))
351 (defun elmo-imap4-accept-ok (session tag)
352 "Accept only `OK' response from SESSION.
353 If response is not `OK' response, causes error with IMAP response text."
354 (let ((response (elmo-imap4-read-response session tag)))
355 (if (elmo-imap4-response-ok-p response)
357 (if (elmo-imap4-response-bye-p response)
358 (signal 'elmo-imap4-bye-error
359 (list (elmo-imap4-response-error-text response)))
360 (error "IMAP error: %s"
361 (or (elmo-imap4-response-error-text response)
362 "No `OK' response from server."))))))
365 (defun elmo-imap4-session-check (session)
366 (with-current-buffer (elmo-network-session-buffer session)
367 (setq elmo-imap4-fetch-callback nil)
368 (setq elmo-imap4-fetch-callback-data nil))
369 (elmo-imap4-send-command-wait session "check"))
371 (defun elmo-imap4-atom-p (string)
372 "Return t if STRING is an atom defined in rfc2060."
373 (if (string= string "")
376 (not (string-match elmo-imap4-non-atom-char-regex string)))))
378 (defun elmo-imap4-quotable-p (string)
379 "Return t if STRING can be formatted as a quoted defined in rfc2060."
381 (not (string-match elmo-imap4-non-text-char-regex string))))
383 (defun elmo-imap4-nil (string)
384 "Return a list represents the special atom \"NIL\" defined in rfc2060, \
386 Otherwise return nil."
390 (defun elmo-imap4-atom (string)
391 "Return a list represents STRING as an atom defined in rfc2060.
392 Return nil if STRING is not an atom. See `elmo-imap4-atom-p'."
393 (if (elmo-imap4-atom-p string)
394 (list 'atom string)))
396 (defun elmo-imap4-quoted (string)
397 "Return a list represents STRING as a quoted defined in rfc2060.
398 Return nil if STRING can not be formatted as a quoted. See `elmo-imap4-quotable-p'."
399 (if (elmo-imap4-quotable-p string)
400 (list 'quoted string)))
402 (defun elmo-imap4-literal-1 (string-or-buffer length)
403 "Internal function for `elmo-imap4-literal' and `elmo-imap4-buffer-literal'.
404 Return a list represents STRING-OR-BUFFER as a literal defined in rfc2060.
405 STRING-OR-BUFFER must be an encoded string or a single-byte string or a single-byte buffer.
406 LENGTH must be the number of octets for STRING-OR-BUFFER."
407 (list 'literal string-or-buffer length))
409 (defun elmo-imap4-literal (string)
410 "Return a list represents STRING as a literal defined in rfc2060.
411 STRING must be an encoded or a single-byte string."
412 (elmo-imap4-literal-1 string (length string)))
414 (defun elmo-imap4-buffer-literal (buffer)
415 "Return a list represents BUFFER as a literal defined in rfc2060.
416 BUFFER must be a single-byte buffer."
417 (elmo-imap4-literal-1 buffer (with-current-buffer buffer
420 (defun elmo-imap4-string-1 (string length)
421 "Internal function for `elmo-imap4-string' and `elmo-imap4-buffer-string'.
422 Return a list represents STRING as a string defined in rfc2060.
423 STRING must be an encoded or a single-byte string.
424 LENGTH must be the number of octets for STRING."
425 (or (elmo-imap4-quoted string)
426 (elmo-imap4-literal-1 string length)))
428 (defun elmo-imap4-string (string)
429 "Return a list represents STRING as a string defined in rfc2060.
430 STRING must be an encoded or a single-byte string."
431 (let ((length (length string)))
432 (if (< elmo-imap4-literal-threshold length)
433 (elmo-imap4-literal-1 string length)
434 (elmo-imap4-string-1 string length))))
436 (defun elmo-imap4-buffer-string (buffer)
437 "Return a list represents BUFFER as a string defined in rfc2060.
438 BUFFER must be a single-byte buffer."
439 (let ((length (with-current-buffer buffer
441 (if (< elmo-imap4-literal-threshold length)
442 (elmo-imap4-literal-1 buffer length)
443 (elmo-imap4-string-1 (with-current-buffer buffer
447 (defun elmo-imap4-astring-1 (string length)
448 "Internal function for `elmo-imap4-astring' and `elmo-imap4-buffer-astring'.
449 Return a list represents STRING as an astring defined in rfc2060.
450 STRING must be an encoded or a single-byte string.
451 LENGTH must be the number of octets for STRING."
452 (or (elmo-imap4-atom string)
453 (elmo-imap4-string-1 string length)))
455 (defun elmo-imap4-astring (string)
456 "Return a list represents STRING as an astring defined in rfc2060.
457 STRING must be an encoded or a single-byte string."
458 (let ((length (length string)))
459 (if (< elmo-imap4-literal-threshold length)
460 (elmo-imap4-literal-1 string length)
461 (elmo-imap4-astring-1 string length))))
463 (defun elmo-imap4-buffer-astring (buffer)
464 "Return a list represents BUFFER as an astring defined in rfc2060.
465 BUFFER must be a single-byte buffer."
466 (let ((length (with-current-buffer buffer
468 (if (< elmo-imap4-literal-threshold length)
469 (elmo-imap4-literal-1 buffer length)
470 (elmo-imap4-astring-1 (with-current-buffer buffer
474 (defun elmo-imap4-nstring (string)
475 "Return a list represents STRING as a nstring defined in rfc2060.
476 STRING must be an encoded or a single-byte string."
477 (or (elmo-imap4-nil string)
478 (elmo-imap4-string string)))
480 (defun elmo-imap4-buffer-nstring (buffer)
481 "Return a list represents BUFFER as a nstring defined in rfc2060.
482 BUFFER must be a single-byte buffer."
483 (or (elmo-imap4-nil buffer)
484 (elmo-imap4-buffer-string buffer)))
486 (defalias 'elmo-imap4-mailbox 'elmo-imap4-astring)
487 (defalias 'elmo-imap4-field-body 'elmo-imap4-astring)
488 (defalias 'elmo-imap4-userid 'elmo-imap4-astring)
489 (defalias 'elmo-imap4-password 'elmo-imap4-astring)
491 (defun elmo-imap4-format-quoted (string)
492 "Return STRING in a form of the quoted-string defined in rfc2060."
494 (std11-wrap-as-quoted-pairs string elmo-imap4-quoted-specials-list)
497 (defsubst elmo-imap4-response-get-selectable-mailbox-list (response)
501 (if (and (eq 'list (car entry))
502 (not (member "\\NoSelect" (nth 1 (nth 1 entry)))))
503 (car (nth 1 entry))))
507 (defun elmo-imap4-list-folders (spec &optional hierarchy)
508 (let* ((root (elmo-imap4-spec-mailbox spec))
509 (session (elmo-imap4-get-session spec))
512 (elmo-string-matched-assoc
514 (with-current-buffer (elmo-network-session-buffer session)
515 elmo-imap4-server-namespace)))
516 elmo-imap4-default-hierarchy-delimiter))
517 result append-serv type)
520 (not (string= root ""))
521 (not (string-match (concat "\\(.*\\)"
525 (setq root (concat root delim)))
526 (setq result (elmo-imap4-response-get-selectable-mailbox-list
527 (elmo-imap4-send-command-wait
529 (list "list " (elmo-imap4-mailbox root) " *"))))
530 (unless (string= (elmo-imap4-spec-username spec)
531 elmo-default-imap4-user)
532 (setq append-serv (concat ":" (elmo-imap4-spec-username spec))))
533 (unless (eq (elmo-imap4-spec-auth spec)
534 (or elmo-default-imap4-authenticate-type 'clear))
536 (concat append-serv "/" (symbol-name (elmo-imap4-spec-auth spec)))))
537 (unless (string= (elmo-imap4-spec-hostname spec)
538 elmo-default-imap4-server)
539 (setq append-serv (concat append-serv "@" (elmo-imap4-spec-hostname
541 (unless (eq (elmo-imap4-spec-port spec)
542 elmo-default-imap4-port)
543 (setq append-serv (concat append-serv ":"
545 (elmo-imap4-spec-port spec)))))
546 (setq type (elmo-imap4-spec-stream-type spec))
547 (unless (eq (elmo-network-stream-type-symbol type)
548 elmo-default-imap4-stream-type)
550 (setq append-serv (concat append-serv
551 (elmo-network-stream-type-spec-string
554 (let (folder folders ret)
555 (while (setq folders (car result))
558 (concat "^\\(" root "[^" delim "]" "+\\)" delim)
560 (setq folder (match-string 1 folders)))
563 (append ret (list (list
564 (concat "%" (elmo-imap4-decode-folder-string folder)
566 (eval append-serv)))))))
569 (mapcar '(lambda (fld)
572 (concat "^" (regexp-quote folder) delim)
576 (setq ret (append ret (list
577 (concat "%" (elmo-imap4-decode-folder-string folders)
579 (eval append-serv))))))
580 (setq result (cdr result))))
582 (mapcar (lambda (fld)
583 (concat "%" (elmo-imap4-decode-folder-string fld)
585 (eval append-serv))))
588 (defun elmo-imap4-folder-exists-p (spec)
589 (let ((session (elmo-imap4-get-session spec)))
591 (elmo-imap4-session-current-mailbox-internal session)
592 (elmo-imap4-spec-mailbox spec))
594 (elmo-imap4-session-select-mailbox
596 (elmo-imap4-spec-mailbox spec)
599 (defun elmo-imap4-folder-creatable-p (spec)
602 (defun elmo-imap4-create-folder-maybe (spec dummy)
603 (unless (elmo-imap4-folder-exists-p spec)
604 (elmo-imap4-create-folder spec)))
606 (defun elmo-imap4-create-folder (spec)
607 (elmo-imap4-send-command-wait
608 (elmo-imap4-get-session spec)
609 (list "create " (elmo-imap4-mailbox
610 (elmo-imap4-spec-mailbox spec)))))
612 (defun elmo-imap4-delete-folder (spec)
613 (let ((session (elmo-imap4-get-session spec))
615 (when (elmo-imap4-spec-mailbox spec)
616 (when (setq msgs (elmo-imap4-list-folder spec))
617 (elmo-imap4-delete-msgs spec msgs))
618 (elmo-imap4-send-command-wait session "close")
619 (elmo-imap4-send-command-wait
622 (elmo-imap4-mailbox (elmo-imap4-spec-mailbox spec)))))))
624 (defun elmo-imap4-rename-folder (old-spec new-spec)
625 (let ((session (elmo-imap4-get-session old-spec)))
626 (elmo-imap4-session-select-mailbox session
627 (elmo-imap4-spec-mailbox old-spec))
628 (elmo-imap4-send-command-wait session "close")
629 (elmo-imap4-send-command-wait
633 (elmo-imap4-spec-mailbox old-spec))
636 (elmo-imap4-spec-mailbox new-spec))))))
638 (defun elmo-imap4-max-of-folder (spec)
639 (let ((session (elmo-imap4-get-session spec))
640 (killed (and elmo-use-killed-list
641 (elmo-msgdb-killed-list-load
642 (elmo-msgdb-expand-path spec))))
644 (with-current-buffer (elmo-network-session-buffer session)
645 (setq elmo-imap4-status-callback nil)
646 (setq elmo-imap4-status-callback-data nil))
647 (setq status (elmo-imap4-response-value
648 (elmo-imap4-send-command-wait
652 (elmo-imap4-spec-mailbox spec))
653 " (uidnext messages)"))
656 (- (elmo-imap4-response-value status 'uidnext) 1)
659 (elmo-imap4-response-value status 'messages)
660 (elmo-msgdb-killed-list-length killed))
661 (elmo-imap4-response-value status 'messages)))))
663 (defun elmo-imap4-folder-diff (spec folder &optional number-list)
664 (if elmo-use-server-diff
665 (elmo-imap4-server-diff spec)
666 (elmo-generic-folder-diff spec folder number-list)))
668 (defun elmo-imap4-get-session (spec &optional if-exists)
669 (elmo-network-get-session
672 (elmo-imap4-spec-hostname spec)
673 (elmo-imap4-spec-port spec)
674 (elmo-imap4-spec-username spec)
675 (elmo-imap4-spec-auth spec)
676 (elmo-imap4-spec-stream-type spec)
679 (defun elmo-imap4-commit (spec)
680 (if (elmo-imap4-plugged-p spec)
681 (let ((session (elmo-imap4-get-session spec 'if-exists)))
684 (elmo-imap4-session-current-mailbox-internal session)
685 (elmo-imap4-spec-mailbox spec))
686 (if elmo-imap4-use-select-to-update-status
687 (elmo-imap4-session-select-mailbox
689 (elmo-imap4-spec-mailbox spec)
691 (elmo-imap4-session-check session)))))))
693 (defun elmo-imap4-session-select-mailbox (session mailbox
694 &optional force no-error)
695 "Select MAILBOX in SESSION.
696 If optional argument FORCE is non-nil, select mailbox even if current mailbox
698 If second optional argument NO-ERROR is non-nil, don't cause an error when
699 selecting folder was failed.
700 Returns response value if selecting folder succeed. "
703 (elmo-imap4-session-current-mailbox-internal session)
705 (let (response result)
708 (elmo-imap4-read-response
710 (elmo-imap4-send-command
714 (elmo-imap4-mailbox mailbox)))))
715 (if (setq result (elmo-imap4-response-ok-p response))
717 (elmo-imap4-session-set-current-mailbox-internal session mailbox)
718 (elmo-imap4-session-set-read-only-internal
720 (nth 1 (assq 'read-only (assq 'ok response)))))
721 (elmo-imap4-session-set-current-mailbox-internal session nil)
724 (elmo-imap4-response-error-text response)
725 (format "Select %s failed" mailbox))))))
726 (and result response))))
728 (defun elmo-imap4-check-validity (spec validity-file)
730 ;;;(elmo-imap4-send-command-wait
731 ;;;(elmo-imap4-get-session spec)
733 ;;; (elmo-imap4-mailbox
734 ;;; (elmo-imap4-spec-mailbox spec))
735 ;;; " (uidvalidity)")))
738 (defun elmo-imap4-sync-validity (spec validity-file)
742 (defun elmo-imap4-list (spec flag)
743 (let ((session (elmo-imap4-get-session spec)))
744 (elmo-imap4-session-select-mailbox session
745 (elmo-imap4-spec-mailbox spec))
746 (elmo-imap4-response-value
747 (elmo-imap4-send-command-wait
749 (format (if elmo-imap4-use-uid "uid search %s"
753 (defun elmo-imap4-list-folder (spec &optional nohide)
754 (let* ((killed (and elmo-use-killed-list
755 (elmo-msgdb-killed-list-load
756 (elmo-msgdb-expand-path spec))))
757 (max (elmo-msgdb-max-of-killed killed))
759 (setq numbers (elmo-imap4-list spec
762 (format "uid %d:*" (1+ max))
764 (elmo-living-messages numbers killed)))
766 (defun elmo-imap4-list-folder-unread (spec number-alist mark-alist
768 (if (and (elmo-imap4-plugged-p spec)
769 (elmo-imap4-use-flag-p spec))
770 (elmo-imap4-list spec "unseen")
771 (elmo-generic-list-folder-unread spec number-alist mark-alist
774 (defun elmo-imap4-list-folder-important (spec number-alist)
775 (if (and (elmo-imap4-plugged-p spec)
776 (elmo-imap4-use-flag-p spec))
777 (elmo-imap4-list spec "flagged")))
779 (defmacro elmo-imap4-detect-search-charset (string)
782 (detect-mime-charset-region (point-min) (point-max)))))
784 (defun elmo-imap4-search-internal-primitive (spec session filter from-msgs)
785 (let ((search-key (elmo-filter-key filter))
786 (imap-search-keys '("bcc" "body" "cc" "from" "subject" "to"))
789 ((string= "last" search-key)
790 (let ((numbers (or from-msgs (elmo-imap4-list-folder spec))))
791 (nthcdr (max (- (length numbers)
792 (string-to-int (elmo-filter-value filter)))
795 ((string= "first" search-key)
796 (let* ((numbers (or from-msgs (elmo-imap4-list-folder spec)))
797 (rest (nthcdr (string-to-int (elmo-filter-value filter) )
799 (mapcar '(lambda (x) (delete x numbers)) rest)
801 ((or (string= "since" search-key)
802 (string= "before" search-key))
803 (setq search-key (concat "sent" search-key))
804 (elmo-imap4-response-value
805 (elmo-imap4-send-command-wait session
807 (if elmo-imap4-use-uid
808 "uid search %s%s%s %s"
812 (if elmo-imap4-use-uid "uid ")
815 (elmo-imap4-make-number-set-list
819 (if (eq (elmo-filter-type filter)
823 (elmo-date-get-description
824 (elmo-date-get-datevec
825 (elmo-filter-value filter)))))
829 (if (eq (length (elmo-filter-value filter)) 0)
830 (setq charset 'us-ascii)
831 (elmo-imap4-detect-search-charset
832 (elmo-filter-value filter))))
833 (elmo-imap4-response-value
834 (elmo-imap4-send-command-wait session
836 (if elmo-imap4-use-uid "uid ")
840 (symbol-name charset))
844 (if elmo-imap4-use-uid "uid ")
847 (elmo-imap4-make-number-set-list
851 (if (eq (elmo-filter-type filter)
856 (elmo-filter-key filter)
860 (elmo-filter-key filter))
862 (encode-mime-charset-string
863 (elmo-filter-value filter) charset))))
866 (defun elmo-imap4-search-internal (spec session condition from-msgs)
870 (setq result (elmo-imap4-search-internal-primitive
871 spec session condition from-msgs)))
872 ((eq (car condition) 'and)
873 (setq result (elmo-imap4-search-internal spec session (nth 1 condition)
875 result (elmo-list-filter result
876 (elmo-imap4-search-internal
877 spec session (nth 2 condition)
879 ((eq (car condition) 'or)
880 (setq result (elmo-imap4-search-internal
881 spec session (nth 1 condition) from-msgs)
882 result (elmo-uniq-list
884 (elmo-imap4-search-internal
885 spec session (nth 2 condition) from-msgs)))
886 result (sort result '<))))))
889 (defun elmo-imap4-search (spec condition &optional from-msgs)
891 (let ((session (elmo-imap4-get-session spec)))
892 (elmo-imap4-session-select-mailbox
894 (elmo-imap4-spec-mailbox spec))
895 (elmo-imap4-search-internal spec session condition from-msgs))))
897 (defun elmo-imap4-use-flag-p (spec)
898 (not (string-match elmo-imap4-disuse-server-flag-mailbox-regexp
899 (elmo-imap4-spec-mailbox spec))))
903 ;; Emacs can parse dot symbol.
904 (defvar elmo-imap4-rfc822-size "RFC822\.SIZE")
905 (defvar elmo-imap4-rfc822-text "RFC822\.TEXT")
906 (defvar elmo-imap4-rfc822-header "RFC822\.HEADER")
907 (defvar elmo-imap4-rfc822-size "RFC822\.SIZE")
908 (defvar elmo-imap4-header-fields "HEADER\.FIELDS")
909 (defmacro elmo-imap4-replace-dot-symbols ()) ;; noop
910 (defalias 'elmo-imap4-fetch-read 'read)
914 ;; Cannot parse dot symbol.
915 (defvar elmo-imap4-rfc822-size "RFC822_SIZE")
916 (defvar elmo-imap4-header-fields "HEADER_FIELDS")
917 (defvar elmo-imap4-rfc822-size "RFC822_SIZE")
918 (defvar elmo-imap4-rfc822-text "RFC822_TEXT")
919 (defvar elmo-imap4-rfc822-header "RFC822_HEADER")
920 (defvar elmo-imap4-header-fields "HEADER_FIELDS")
921 (defun elmo-imap4-fetch-read (buffer)
922 (with-current-buffer buffer
925 (when (re-search-forward "[[ ]" nil t)
926 (goto-char (match-beginning 0))
927 (setq token (buffer-substring beg (point)))
928 (cond ((string= token "RFC822.SIZE")
929 (intern elmo-imap4-rfc822-size))
930 ((string= token "RFC822.HEADER")
931 (intern elmo-imap4-rfc822-header))
932 ((string= token "RFC822.TEXT")
933 (intern elmo-imap4-rfc822-text))
934 ((string= token "HEADER\.FIELDS")
935 (intern elmo-imap4-header-fields))
937 (elmo-read (current-buffer))))))))))
939 (defun elmo-imap4-make-number-set-list (msg-list &optional chop-length)
940 "Make RFC2060's message set specifier from MSG-LIST.
941 Returns a list of (NUMBER . SET-STRING).
942 SET-STRING is the message set specifier described in RFC2060.
943 NUMBER is contained message number in SET-STRING.
944 Every SET-STRING does not contain number of messages longer than CHOP-LENGTH.
945 If CHOP-LENGTH is not specified, message set is not chopped."
946 (let (count cont-list set-list)
947 (setq msg-list (sort (copy-sequence msg-list) '<))
952 (setq chop-length (length msg-list)))
953 (while (and (not (null msg-list))
954 (< count chop-length))
956 (elmo-number-set-append
957 cont-list (car msg-list)))
959 (setq msg-list (cdr msg-list)))
967 (format "%s:%s" (car x) (cdr x)))
973 (nreverse set-list)))
977 ;; read-mark -> "\\Seen"
978 ;; important -> "\\Flagged"
980 ;; (delete -> \\Deleted)
981 (defun elmo-imap4-mark-set-on-msgs (spec msgs mark &optional unmark no-expunge)
982 "SET flag of MSGS as MARK.
983 If optional argument UNMARK is non-nil, unmark."
984 (let ((session (elmo-imap4-get-session spec))
986 (elmo-imap4-session-select-mailbox session
987 (elmo-imap4-spec-mailbox spec))
988 (setq set-list (elmo-imap4-make-number-set-list msgs))
990 (with-current-buffer (elmo-network-session-buffer session)
991 (setq elmo-imap4-fetch-callback nil)
992 (setq elmo-imap4-fetch-callback-data nil))
993 (elmo-imap4-send-command-wait
996 (if elmo-imap4-use-uid
997 "uid store %s %sflags.silent (%s)"
998 "store %s %sflags.silent (%s)")
1003 (elmo-imap4-send-command-wait session "expunge")))
1006 (defun elmo-imap4-mark-as-important (spec msgs)
1007 (and (elmo-imap4-use-flag-p spec)
1008 (elmo-imap4-mark-set-on-msgs spec msgs "\\Flagged" nil 'no-expunge)))
1010 (defun elmo-imap4-mark-as-read (spec msgs)
1011 (and (elmo-imap4-use-flag-p spec)
1012 (elmo-imap4-mark-set-on-msgs spec msgs "\\Seen" nil 'no-expunge)))
1014 (defun elmo-imap4-unmark-important (spec msgs)
1015 (and (elmo-imap4-use-flag-p spec)
1016 (elmo-imap4-mark-set-on-msgs spec msgs "\\Flagged" 'unmark
1019 (defun elmo-imap4-mark-as-unread (spec msgs)
1020 (and (elmo-imap4-use-flag-p spec)
1021 (elmo-imap4-mark-set-on-msgs spec msgs "\\Seen" 'unmark 'no-expunge)))
1023 (defun elmo-imap4-delete-msgs (spec msgs)
1024 (elmo-imap4-mark-set-on-msgs spec msgs "\\Deleted"))
1026 (defun elmo-imap4-delete-msgs-no-expunge (spec msgs)
1027 (elmo-imap4-mark-set-on-msgs spec msgs "\\Deleted" nil 'no-expunge))
1029 (defun elmo-imap4-msgdb-create-as-numlist (spec numlist new-mark already-mark
1030 seen-mark important-mark
1032 "Create msgdb for SPEC for NUMLIST."
1033 (elmo-imap4-msgdb-create spec numlist new-mark already-mark
1034 seen-mark important-mark seen-list t))
1036 ;; Current buffer is process buffer.
1037 (defun elmo-imap4-fetch-callback (element app-data)
1038 (funcall elmo-imap4-fetch-callback
1040 (insert (or (elmo-imap4-response-bodydetail-text element)
1043 (goto-char (point-min))
1044 (while (search-forward "\r\n" nil t)
1045 (replace-match "\n"))
1046 (elmo-msgdb-create-overview-from-buffer
1047 (elmo-imap4-response-value element 'uid)
1048 (elmo-imap4-response-value element 'rfc822size)))
1049 (elmo-imap4-response-value element 'flags)
1055 ;; 0: new-mark 1: already-mark 2: seen-mark 3: important-mark
1057 ;; and result of use-flag-p.
1058 (defun elmo-imap4-fetch-callback-1 (entity flags app-data)
1059 "A msgdb entity callback function."
1060 (let* ((use-flag (cdr app-data))
1061 (app-data (car app-data))
1062 (seen (member (car entity) (nth 4 app-data)))
1064 (if (member "\\Flagged" flags)
1065 (elmo-msgdb-global-mark-set (car entity) (nth 3 app-data)))
1066 (setq mark (or (elmo-msgdb-global-mark-get (car entity))
1067 (if (elmo-cache-exists-p (car entity)) ;; XXX
1070 (member "\\Seen" flags)))
1075 (member "\\Seen" flags)))
1076 (if elmo-imap4-use-cache
1078 (nth 0 app-data)))))
1079 (setq elmo-imap4-current-msgdb
1081 elmo-imap4-current-msgdb
1083 (list (cons (elmo-msgdb-overview-entity-get-number entity)
1087 (list (elmo-msgdb-overview-entity-get-number entity)
1090 (defun elmo-imap4-msgdb-create (spec numlist &rest args)
1091 "Create msgdb for SPEC."
1093 (let ((session (elmo-imap4-get-session spec))
1096 '("Subject" "From" "To" "Cc" "Date"
1097 "Message-Id" "References" "In-Reply-To")
1098 elmo-msgdb-extra-fields))
1100 (length (length numlist))
1102 (setq rfc2060 (memq 'imap4rev1
1103 (elmo-imap4-session-capability-internal
1105 (message "Getting overview...")
1106 (elmo-imap4-session-select-mailbox session
1107 (elmo-imap4-spec-mailbox spec))
1108 (setq set-list (elmo-imap4-make-number-set-list
1110 elmo-imap4-overview-fetch-chop-length))
1112 (with-current-buffer (elmo-network-session-buffer session)
1113 (setq elmo-imap4-current-msgdb nil
1114 elmo-imap4-fetch-callback 'elmo-imap4-fetch-callback-1
1115 elmo-imap4-fetch-callback-data (cons args
1116 (elmo-imap4-use-flag-p
1119 (elmo-imap4-send-command-wait
1121 ;; get overview entity from IMAP4
1122 (format "%sfetch %s (%s rfc822.size flags)"
1123 (if elmo-imap4-use-uid "uid " "")
1124 (cdr (car set-list))
1126 (format "body.peek[header.fields %s]" headers)
1127 (format "%s" headers))))
1128 (when (> length elmo-display-progress-threshold)
1129 (setq total (+ total (car (car set-list))))
1130 (elmo-display-progress
1131 'elmo-imap4-msgdb-create "Getting overview..."
1132 (/ (* total 100) length)))
1133 (setq set-list (cdr set-list)))
1134 (message "Getting overview...done")
1135 elmo-imap4-current-msgdb))))
1137 (defun elmo-imap4-parse-capability (string)
1138 (if (string-match "^\\*\\(.*\\)$" string)
1140 (concat "(" (downcase (elmo-match-string 1 string)) ")"))))
1142 (defun elmo-imap4-clear-login (session)
1143 (let ((elmo-imap4-debug-inhibit-logging t))
1147 (elmo-imap4-send-command
1150 (elmo-imap4-userid (elmo-network-session-user-internal session))
1152 (elmo-imap4-password
1153 (elmo-get-passwd (elmo-network-session-password-key session))))))
1154 (signal 'elmo-authenticate-error '(elmo-imap4-clear-login)))))
1156 (defun elmo-imap4-auth-login (session)
1157 (let ((tag (elmo-imap4-send-command session "authenticate login"))
1158 (elmo-imap4-debug-inhibit-logging t))
1159 (or (elmo-imap4-read-continue-req session)
1160 (signal 'elmo-authenticate-error '(elmo-imap4-auth-login)))
1161 (elmo-imap4-send-string session
1162 (elmo-base64-encode-string
1163 (elmo-network-session-user-internal session)))
1164 (or (elmo-imap4-read-continue-req session)
1165 (signal 'elmo-authenticate-error '(elmo-imap4-auth-login)))
1166 (elmo-imap4-send-string session
1167 (elmo-base64-encode-string
1169 (elmo-network-session-password-key session))))
1170 (or (elmo-imap4-read-ok session tag)
1171 (signal 'elmo-authenticate-error '(elmo-imap4-auth-login)))
1172 (setq elmo-imap4-status 'auth)))
1175 elmo-network-initialize-session-buffer :after ((session
1176 elmo-imap4-session) buffer)
1177 (with-current-buffer buffer
1178 (mapcar 'make-variable-buffer-local elmo-imap4-local-variables)
1179 (setq elmo-imap4-seqno 0)
1180 (setq elmo-imap4-status 'initial)))
1182 (luna-define-method elmo-network-initialize-session ((session
1183 elmo-imap4-session))
1184 (let ((process (elmo-network-session-process-internal session)))
1185 (with-current-buffer (process-buffer process)
1186 ;; Skip garbage output from process before greeting.
1187 (while (and (memq (process-status process) '(open run))
1188 (goto-char (point-max))
1190 (not (elmo-imap4-parse-greeting)))
1191 (accept-process-output process 1))
1192 (set-process-filter process 'elmo-imap4-arrival-filter)
1193 (set-process-sentinel process 'elmo-imap4-sentinel)
1194 ;;; (while (and (memq (process-status process) '(open run))
1195 ;;; (eq elmo-imap4-status 'initial))
1196 ;;; (message "Waiting for server response...")
1197 ;;; (accept-process-output process 1))
1199 (unless (memq elmo-imap4-status '(nonauth auth))
1200 (signal 'elmo-open-error
1201 (list 'elmo-network-initialize-session)))
1202 (elmo-imap4-session-set-capability-internal
1204 (elmo-imap4-response-value
1205 (elmo-imap4-send-command-wait session "capability")
1207 (when (eq (elmo-network-stream-type-symbol
1208 (elmo-network-session-stream-type-internal session))
1211 (elmo-imap4-session-capability-internal session))
1212 (signal 'elmo-open-error
1213 '(elmo-imap4-starttls-error)))
1214 (elmo-imap4-send-command-wait session "starttls")
1215 (starttls-negotiate process)))))
1217 (luna-define-method elmo-network-authenticate-session ((session
1218 elmo-imap4-session))
1219 (with-current-buffer (process-buffer
1220 (elmo-network-session-process-internal session))
1221 (let* ((auth (elmo-network-session-auth-internal session))
1222 (auth (if (listp auth) auth (list auth))))
1223 (unless (or (eq elmo-imap4-status 'auth)
1226 ((eq 'clear (car auth))
1227 (elmo-imap4-clear-login session))
1228 ((eq 'login (car auth))
1229 (elmo-imap4-auth-login session))
1231 (let* ((elmo-imap4-debug-inhibit-logging t)
1236 (if (string-match "^auth=\\(.*\\)$"
1238 (match-string 1 (upcase (symbol-name cap)))))
1239 (elmo-imap4-session-capability-internal session))))
1241 (sasl-find-mechanism
1243 (mapcar '(lambda (cap) (upcase (symbol-name cap)))
1247 client name step response tag
1248 sasl-read-passphrase)
1250 (if (or elmo-imap4-force-login
1253 "There's no %s capability in server. continue?"
1254 (elmo-list-to-string
1255 (elmo-network-session-auth-internal session)))))
1256 (setq mechanism (sasl-find-mechanism
1258 (signal 'elmo-authenticate-error
1259 '(elmo-imap4-auth-no-mechanisms))))
1263 (elmo-network-session-user-internal session)
1265 (elmo-network-session-host-internal session)))
1266 ;;; (if elmo-imap4-auth-user-realm
1267 ;;; (sasl-client-set-property client 'realm elmo-imap4-auth-user-realm))
1268 (setq name (sasl-mechanism-name mechanism)
1269 step (sasl-next-step client nil))
1270 (elmo-network-session-set-auth-internal
1272 (intern (downcase name)))
1273 (setq sasl-read-passphrase
1277 (elmo-network-session-password-key session)))))
1279 (elmo-imap4-send-command
1281 (concat "AUTHENTICATE " name
1282 (and (sasl-step-data step)
1285 (elmo-base64-encode-string
1286 (sasl-step-data step)
1291 (elmo-imap4-read-untagged
1292 (elmo-network-session-process-internal session)))
1293 (if (elmo-imap4-response-ok-p response)
1294 (if (sasl-next-step client step)
1296 (signal 'elmo-authenticate-error
1298 (concat "elmo-imap4-auth-"
1300 ;; The authentication process is finished.
1302 (unless (elmo-imap4-response-continue-req-p response)
1303 ;; response is NO or BAD.
1304 (signal 'elmo-authenticate-error
1306 (concat "elmo-imap4-auth-"
1307 (downcase name))))))
1310 (elmo-base64-decode-string
1311 (elmo-imap4-response-value response 'continue-req)))
1312 (setq step (sasl-next-step client step))
1314 (elmo-imap4-send-string
1316 (if (sasl-step-data step)
1317 (elmo-base64-encode-string (sasl-step-data step)
1321 (luna-define-method elmo-network-setup-session ((session
1322 elmo-imap4-session))
1323 (with-current-buffer (elmo-network-session-buffer session)
1324 (when (memq 'namespace (elmo-imap4-session-capability-internal session))
1325 (setq elmo-imap4-server-namespace
1326 (elmo-imap4-response-value
1327 (elmo-imap4-send-command-wait session "namespace")
1330 (defun elmo-imap4-setup-send-buffer (string)
1331 (let ((tmp-buf (get-buffer-create " *elmo-imap4-setup-send-buffer*")))
1334 (set-buffer tmp-buf)
1336 (elmo-set-buffer-multibyte nil)
1338 (goto-char (point-min))
1339 (if (eq (re-search-forward "^$" nil t)
1342 (goto-char (point-min))
1343 (while (search-forward "\n" nil t)
1344 (replace-match "\r\n"))))
1347 (defun elmo-imap4-read-part (folder msg part)
1348 (let* ((spec (elmo-folder-get-spec folder))
1349 (session (elmo-imap4-get-session spec)))
1350 (elmo-imap4-session-select-mailbox session
1351 (elmo-imap4-spec-mailbox spec))
1352 (with-current-buffer (elmo-network-session-buffer session)
1353 (setq elmo-imap4-fetch-callback nil)
1354 (setq elmo-imap4-fetch-callback-data nil))
1355 (unless elmo-inhibit-display-retrieval-progress
1356 (setq elmo-imap4-display-literal-progress t))
1360 (elmo-imap4-response-bodydetail-text
1361 (elmo-imap4-response-value-all
1362 (elmo-imap4-send-command-wait session
1364 (if elmo-imap4-use-uid
1365 "uid fetch %s body.peek[%s]"
1366 "fetch %s body.peek[%s]")
1369 (setq elmo-imap4-display-literal-progress nil))
1370 (unless elmo-inhibit-display-retrieval-progress
1371 (elmo-display-progress 'elmo-imap4-display-literal-progress
1372 "" 100) ; remove progress bar.
1373 (message "Retrieving...done.")))))
1375 (defun elmo-imap4-prefetch-msg (spec msg outbuf)
1376 (elmo-imap4-read-msg spec msg outbuf nil 'unseen))
1378 (defun elmo-imap4-read-msg (spec msg outbuf
1379 &optional msgdb leave-seen-flag-untouched)
1380 (let ((session (elmo-imap4-get-session spec))
1382 (elmo-imap4-session-select-mailbox session
1383 (elmo-imap4-spec-mailbox spec))
1384 (with-current-buffer (elmo-network-session-buffer session)
1385 (setq elmo-imap4-fetch-callback nil)
1386 (setq elmo-imap4-fetch-callback-data nil))
1387 (unless elmo-inhibit-display-retrieval-progress
1388 (setq elmo-imap4-display-literal-progress t))
1391 (elmo-imap4-send-command-wait session
1393 (if elmo-imap4-use-uid
1394 "uid fetch %s body%s[]"
1395 "fetch %s body%s[]")
1397 (if leave-seen-flag-untouched
1399 (setq elmo-imap4-display-literal-progress nil))
1400 (unless elmo-inhibit-display-retrieval-progress
1401 (elmo-display-progress 'elmo-imap4-display-literal-progress
1402 "" 100) ; remove progress bar.
1403 (message "Retrieving...done."))
1404 (and (setq response (elmo-imap4-response-bodydetail-text
1405 (elmo-imap4-response-value-all
1407 (with-current-buffer outbuf
1410 (elmo-delete-cr-get-content-type)))))
1412 (defun elmo-imap4-setup-send-buffer-from-file (file)
1413 (let ((tmp-buf (get-buffer-create
1414 " *elmo-imap4-setup-send-buffer-from-file*")))
1417 (set-buffer tmp-buf)
1419 (as-binary-input-file
1420 (insert-file-contents file))
1421 (goto-char (point-min))
1422 (if (eq (re-search-forward "^$" nil t)
1425 (goto-char (point-min))
1426 (while (search-forward "\n" nil t)
1427 (replace-match "\r\n"))))
1430 (defun elmo-imap4-delete-msgids (spec msgids)
1431 "If actual message-id is matched, then delete it."
1432 (let ((message-ids msgids)
1434 (num (length msgids)))
1437 (message "Deleting message...%d/%d" i num)
1438 (elmo-imap4-delete-msg-by-id spec (car message-ids))
1439 (setq message-ids (cdr message-ids)))
1440 (elmo-imap4-send-command-wait (elmo-imap4-get-session spec) "expunge")))
1442 (defun elmo-imap4-delete-msg-by-id (spec msgid)
1443 (let ((session (elmo-imap4-get-session spec)))
1444 (elmo-imap4-session-select-mailbox session
1445 (elmo-imap4-spec-mailbox spec))
1446 (elmo-imap4-delete-msgs-no-expunge
1448 (elmo-imap4-response-value
1449 (elmo-imap4-send-command-wait session
1451 (if elmo-imap4-use-uid
1452 "uid search header message-id "
1453 "search header message-id ")
1454 (elmo-imap4-field-body msgid)))
1457 (defun elmo-imap4-append-msg-by-id (spec msgid)
1458 (let ((session (elmo-imap4-get-session spec))
1460 (elmo-imap4-session-select-mailbox session
1461 (elmo-imap4-spec-mailbox spec))
1462 (setq send-buf (elmo-imap4-setup-send-buffer-from-file
1463 (elmo-cache-get-path msgid)))
1465 (elmo-imap4-send-command-wait
1469 (elmo-imap4-mailbox (elmo-imap4-spec-mailbox spec))
1471 (elmo-imap4-buffer-literal send-buf)))
1472 (kill-buffer send-buf)))
1475 (defun elmo-imap4-append-msg (spec string &optional msg no-see)
1476 (let ((session (elmo-imap4-get-session spec))
1478 (elmo-imap4-session-select-mailbox session
1479 (elmo-imap4-spec-mailbox spec))
1480 (setq send-buf (elmo-imap4-setup-send-buffer string))
1482 (setq result (elmo-imap4-send-command-wait
1486 (elmo-imap4-mailbox (elmo-imap4-spec-mailbox spec))
1487 (if no-see " " " (\\Seen) ")
1488 (elmo-imap4-buffer-literal send-buf))))
1489 (kill-buffer send-buf))
1492 (defun elmo-imap4-copy-msgs (dst-spec
1493 msgs src-spec &optional expunge-it same-number)
1494 "Equivalence of hostname, username is assumed."
1495 (let ((session (elmo-imap4-get-session src-spec)))
1496 (elmo-imap4-session-select-mailbox session
1497 (elmo-imap4-spec-mailbox src-spec))
1499 (elmo-imap4-send-command-wait session
1502 (if elmo-imap4-use-uid
1507 (elmo-imap4-spec-mailbox dst-spec))))
1508 (setq msgs (cdr msgs)))
1510 (elmo-imap4-send-command-wait session "expunge"))
1513 (defun elmo-imap4-server-diff-async-callback-1 (status data)
1514 (funcall elmo-imap4-server-diff-async-callback
1515 (cons (elmo-imap4-response-value status 'unseen)
1516 (elmo-imap4-response-value status 'messages))
1519 (defun elmo-imap4-server-diff-async (spec)
1520 (let ((session (elmo-imap4-get-session spec)))
1522 ;; (elmo-imap4-commit spec)
1523 (with-current-buffer (elmo-network-session-buffer session)
1524 (setq elmo-imap4-status-callback
1525 'elmo-imap4-server-diff-async-callback-1)
1526 (setq elmo-imap4-status-callback-data
1527 elmo-imap4-server-diff-async-callback-data))
1528 (elmo-imap4-send-command session
1532 (elmo-imap4-spec-mailbox spec))
1533 " (unseen messages)"))))
1535 (defun elmo-imap4-server-diff (spec)
1537 (let ((session (elmo-imap4-get-session spec))
1540 ;;; (elmo-imap4-commit spec)
1541 (with-current-buffer (elmo-network-session-buffer session)
1542 (setq elmo-imap4-status-callback nil)
1543 (setq elmo-imap4-status-callback-data nil))
1545 (elmo-imap4-send-command-wait session
1549 (elmo-imap4-spec-mailbox spec))
1550 " (unseen messages)")))
1551 (setq response (elmo-imap4-response-value response 'status))
1552 (cons (elmo-imap4-response-value response 'unseen)
1553 (elmo-imap4-response-value response 'messages))))
1555 (defun elmo-imap4-use-cache-p (spec number)
1556 elmo-imap4-use-cache)
1558 (defun elmo-imap4-local-file-p (spec number)
1561 (defun elmo-imap4-port-label (spec)
1563 (if (elmo-imap4-spec-stream-type spec)
1564 (concat "!" (symbol-name
1565 (elmo-network-stream-type-symbol
1566 (elmo-imap4-spec-stream-type spec)))))))
1569 (defsubst elmo-imap4-portinfo (spec)
1570 (list (elmo-imap4-spec-hostname spec) (elmo-imap4-spec-port spec)))
1572 (defun elmo-imap4-plugged-p (spec)
1573 (apply 'elmo-plugged-p
1574 (append (elmo-imap4-portinfo spec)
1575 (list nil (quote (elmo-imap4-port-label spec))))))
1577 (defun elmo-imap4-set-plugged (spec plugged add)
1578 (apply 'elmo-set-plugged plugged
1579 (append (elmo-imap4-portinfo spec)
1580 (list nil nil (quote (elmo-imap4-port-label spec)) add))))
1582 (defalias 'elmo-imap4-sync-number-alist 'elmo-generic-sync-number-alist)
1586 (defvar elmo-imap4-server-eol "\r\n"
1587 "The EOL string sent from the server.")
1589 (defvar elmo-imap4-client-eol "\r\n"
1590 "The EOL string we send to the server.")
1592 (defun elmo-imap4-find-next-line ()
1593 "Return point at end of current line, taking into account literals.
1594 Return nil if no complete line has arrived."
1595 (when (re-search-forward (concat elmo-imap4-server-eol "\\|{\\([0-9]+\\)}"
1596 elmo-imap4-server-eol)
1598 (if (match-string 1)
1599 (if (< (point-max) (+ (point) (string-to-number (match-string 1))))
1601 (if (and elmo-imap4-display-literal-progress
1602 (> (string-to-number (match-string 1))
1603 (min elmo-display-retrieval-progress-threshold 100)))
1604 (elmo-display-progress
1605 'elmo-imap4-display-literal-progress
1606 (format "Retrieving (%d/%d bytes)..."
1607 (- (point-max) (point))
1608 (string-to-number (match-string 1)))
1609 (/ (- (point-max) (point))
1610 (/ (string-to-number (match-string 1)) 100))))
1612 (goto-char (+ (point) (string-to-number (match-string 1))))
1613 (elmo-imap4-find-next-line))
1616 (defun elmo-imap4-sentinel (process string)
1617 (delete-process process))
1619 (defun elmo-imap4-arrival-filter (proc string)
1620 "IMAP process filter."
1621 (when (buffer-live-p (process-buffer proc))
1622 (with-current-buffer (process-buffer proc)
1623 (elmo-imap4-debug "-> %s" string)
1624 (goto-char (point-max))
1627 (goto-char (point-min))
1628 (while (setq end (elmo-imap4-find-next-line))
1630 (narrow-to-region (point-min) end)
1631 (delete-backward-char (length elmo-imap4-server-eol))
1632 (goto-char (point-min))
1634 (cond ((eq elmo-imap4-status 'initial)
1635 (setq elmo-imap4-current-response
1637 (list 'greeting (elmo-imap4-parse-greeting)))))
1638 ((or (eq elmo-imap4-status 'auth)
1639 (eq elmo-imap4-status 'nonauth)
1640 (eq elmo-imap4-status 'selected)
1641 (eq elmo-imap4-status 'examine))
1642 (setq elmo-imap4-current-response
1644 (elmo-imap4-parse-response)
1645 elmo-imap4-current-response)))
1647 (message "Unknown state %s in arrival filter"
1648 elmo-imap4-status))))
1649 (delete-region (point-min) (point-max))))))))
1653 (defsubst elmo-imap4-forward ()
1654 (or (eobp) (forward-char 1)))
1656 (defsubst elmo-imap4-parse-number ()
1657 (when (looking-at "[0-9]+")
1659 (string-to-number (match-string 0))
1660 (goto-char (match-end 0)))))
1662 (defsubst elmo-imap4-parse-literal ()
1663 (when (looking-at "{\\([0-9]+\\)}\r\n")
1664 (let ((pos (match-end 0))
1665 (len (string-to-number (match-string 1))))
1666 (if (< (point-max) (+ pos len))
1668 (goto-char (+ pos len))
1669 (buffer-substring pos (+ pos len))))))
1670 ;;; (list ' pos (+ pos len))))))
1672 (defsubst elmo-imap4-parse-string ()
1673 (cond ((eq (char-after (point)) ?\")
1675 (let ((p (point)) (name ""))
1676 (skip-chars-forward "^\"\\\\")
1677 (setq name (buffer-substring p (point)))
1678 (while (eq (char-after (point)) ?\\)
1679 (setq p (1+ (point)))
1681 (skip-chars-forward "^\"\\\\")
1682 (setq name (concat name (buffer-substring p (point)))))
1685 ((eq (char-after (point)) ?{)
1686 (elmo-imap4-parse-literal))))
1688 (defsubst elmo-imap4-parse-nil ()
1689 (if (looking-at "NIL")
1690 (goto-char (match-end 0))))
1692 (defsubst elmo-imap4-parse-nstring ()
1693 (or (elmo-imap4-parse-string)
1694 (and (elmo-imap4-parse-nil)
1697 (defsubst elmo-imap4-parse-astring ()
1698 (or (elmo-imap4-parse-string)
1699 (buffer-substring (point)
1700 (if (re-search-forward "[(){ \r\n%*\"\\]" nil t)
1701 (goto-char (1- (match-end 0)))
1705 (defsubst elmo-imap4-parse-address ()
1707 (when (eq (char-after (point)) ?\()
1708 (elmo-imap4-forward)
1709 (setq address (vector (prog1 (elmo-imap4-parse-nstring)
1710 (elmo-imap4-forward))
1711 (prog1 (elmo-imap4-parse-nstring)
1712 (elmo-imap4-forward))
1713 (prog1 (elmo-imap4-parse-nstring)
1714 (elmo-imap4-forward))
1715 (elmo-imap4-parse-nstring)))
1716 (when (eq (char-after (point)) ?\))
1717 (elmo-imap4-forward)
1720 (defsubst elmo-imap4-parse-address-list ()
1721 (if (eq (char-after (point)) ?\()
1722 (let (address addresses)
1723 (elmo-imap4-forward)
1724 (while (and (not (eq (char-after (point)) ?\)))
1725 ;; next line for MS Exchange bug
1726 (progn (and (eq (char-after (point)) ? ) (elmo-imap4-forward)) t)
1727 (setq address (elmo-imap4-parse-address)))
1728 (setq addresses (cons address addresses)))
1729 (when (eq (char-after (point)) ?\))
1730 (elmo-imap4-forward)
1731 (nreverse addresses)))
1732 (assert (elmo-imap4-parse-nil))))
1734 (defsubst elmo-imap4-parse-mailbox ()
1735 (let ((mailbox (elmo-imap4-parse-astring)))
1736 (if (string-equal "INBOX" (upcase mailbox))
1740 (defun elmo-imap4-parse-greeting ()
1741 "Parse a IMAP greeting."
1742 (cond ((looking-at "\\* OK ")
1743 (setq elmo-imap4-status 'nonauth))
1744 ((looking-at "\\* PREAUTH ")
1745 (setq elmo-imap4-status 'auth))
1746 ((looking-at "\\* BYE ")
1747 (setq elmo-imap4-status 'closed))))
1749 (defun elmo-imap4-parse-response ()
1750 "Parse a IMAP command response."
1752 (case (setq token (elmo-read (current-buffer)))
1754 (skip-chars-forward " ")
1755 (list 'continue-req (buffer-substring (point) (point-max)))))
1756 (* (case (prog1 (setq token (elmo-read (current-buffer)))
1757 (elmo-imap4-forward))
1758 (OK (elmo-imap4-parse-resp-text-code))
1759 (NO (elmo-imap4-parse-resp-text-code))
1760 (BAD (elmo-imap4-parse-resp-text-code))
1761 (BYE (elmo-imap4-parse-bye))
1763 (elmo-imap4-parse-flag-list)))
1764 (LIST (list 'list (elmo-imap4-parse-data-list)))
1765 (LSUB (list 'lsub (elmo-imap4-parse-data-list)))
1768 (elmo-read (concat "("
1769 (buffer-substring (point) (point-max))
1771 (STATUS (elmo-imap4-parse-status))
1773 (NAMESPACE (elmo-imap4-parse-namespace))
1774 (CAPABILITY (list 'capability
1776 (concat "(" (downcase (buffer-substring
1777 (point) (point-max)))
1779 (ACL (elmo-imap4-parse-acl))
1780 (t (case (prog1 (elmo-read (current-buffer))
1781 (elmo-imap4-forward))
1782 (EXISTS (list 'exists token))
1783 (RECENT (list 'recent token))
1784 (EXPUNGE (list 'expunge token))
1785 (FETCH (elmo-imap4-parse-fetch token))
1786 (t (list 'garbage (buffer-string)))))))
1787 (t (if (not (string-match elmo-imap4-seq-prefix (symbol-name token)))
1788 (list 'garbage (buffer-string))
1789 (case (prog1 (elmo-read (current-buffer))
1790 (elmo-imap4-forward))
1792 (setq elmo-imap4-parsing nil)
1793 (setq token (symbol-name token))
1794 (elmo-unintern token)
1795 (elmo-imap4-debug "*%s* OK arrived" token)
1796 (setq elmo-imap4-reached-tag token)
1797 (list 'ok (elmo-imap4-parse-resp-text-code))))
1799 (setq elmo-imap4-parsing nil)
1800 (setq token (symbol-name token))
1801 (elmo-unintern token)
1802 (elmo-imap4-debug "*%s* NO arrived" token)
1803 (setq elmo-imap4-reached-tag token)
1805 (when (eq (char-after (point)) ?\[)
1806 (setq code (buffer-substring (point)
1807 (search-forward "]")))
1808 (elmo-imap4-forward))
1809 (setq text (buffer-substring (point) (point-max)))
1810 (list 'no (list code text)))))
1812 (setq elmo-imap4-parsing nil)
1813 (elmo-imap4-debug "*%s* BAD arrived" token)
1814 (setq token (symbol-name token))
1815 (elmo-unintern token)
1816 (setq elmo-imap4-reached-tag token)
1818 (when (eq (char-after (point)) ?\[)
1819 (setq code (buffer-substring (point)
1820 (search-forward "]")))
1821 (elmo-imap4-forward))
1822 (setq text (buffer-substring (point) (point-max)))
1823 (list 'bad (list code text)))))
1824 (t (list 'garbage (buffer-string)))))))))
1826 (defun elmo-imap4-parse-bye ()
1828 (when (eq (char-after (point)) ?\[)
1829 (setq code (buffer-substring (point)
1830 (search-forward "]")))
1831 (elmo-imap4-forward))
1832 (setq text (buffer-substring (point) (point-max)))
1833 (list 'bye (list code text))))
1835 (defun elmo-imap4-parse-text ()
1836 (goto-char (point-min))
1837 (when (search-forward "[" nil t)
1838 (search-forward "]")
1839 (elmo-imap4-forward))
1840 (list 'text (buffer-substring (point) (point-max))))
1842 (defun elmo-imap4-parse-resp-text-code ()
1843 (when (eq (char-after (point)) ?\[)
1844 (elmo-imap4-forward)
1845 (cond ((search-forward "PERMANENTFLAGS " nil t)
1846 (list 'permanentflags (elmo-imap4-parse-flag-list)))
1847 ((search-forward "UIDNEXT " nil t)
1848 (list 'uidnext (elmo-read (current-buffer))))
1849 ((search-forward "UNSEEN " nil t)
1850 (list 'unseen (elmo-read (current-buffer))))
1851 ((looking-at "UIDVALIDITY \\([0-9]+\\)")
1852 (list 'uidvalidity (match-string 1)))
1853 ((search-forward "READ-ONLY" nil t)
1854 (list 'read-only t))
1855 ((search-forward "READ-WRITE" nil t)
1856 (list 'read-write t))
1857 ((search-forward "NEWNAME " nil t)
1858 (let (oldname newname)
1859 (setq oldname (elmo-imap4-parse-string))
1860 (elmo-imap4-forward)
1861 (setq newname (elmo-imap4-parse-string))
1862 (list 'newname newname oldname)))
1863 ((search-forward "TRYCREATE" nil t)
1864 (list 'trycreate t))
1865 ((looking-at "APPENDUID \\([0-9]+\\) \\([0-9]+\\)")
1867 (list (match-string 1)
1868 (string-to-number (match-string 2)))))
1869 ((looking-at "COPYUID \\([0-9]+\\) \\([0-9,:]+\\) \\([0-9,:]+\\)")
1870 (list 'copyuid (list (match-string 1)
1873 ((search-forward "ALERT] " nil t)
1874 (message "IMAP server information: %s"
1875 (buffer-substring (point) (point-max))))
1876 (t (list 'unknown)))))
1878 (defun elmo-imap4-parse-data-list ()
1879 (let (flags delimiter mailbox)
1880 (setq flags (elmo-imap4-parse-flag-list))
1881 (when (looking-at " NIL\\| \"\\\\?\\(.\\)\"")
1882 (setq delimiter (match-string 1))
1883 (goto-char (1+ (match-end 0)))
1884 (when (setq mailbox (elmo-imap4-parse-mailbox))
1885 (list mailbox flags delimiter)))))
1887 (defsubst elmo-imap4-parse-header-list ()
1888 (when (eq (char-after (point)) ?\()
1890 (while (not (eq (char-after (point)) ?\)))
1891 (elmo-imap4-forward)
1892 (push (elmo-imap4-parse-astring) strlist))
1893 (elmo-imap4-forward)
1894 (nreverse strlist))))
1896 (defsubst elmo-imap4-parse-fetch-body-section ()
1898 (buffer-substring (point)
1900 (progn (re-search-forward "[] ]" nil t)
1902 (if (eq (char-before) ? )
1904 (mapconcat 'identity
1905 (cons section (elmo-imap4-parse-header-list)) " ")
1906 (search-forward "]" nil t))
1909 (defun elmo-imap4-parse-fetch (response)
1910 (when (eq (char-after (point)) ?\()
1912 (while (not (eq (char-after (point)) ?\)))
1913 (elmo-imap4-forward)
1914 (let ((token (elmo-imap4-fetch-read (current-buffer))))
1915 (elmo-imap4-forward)
1917 (cond ((eq token 'UID)
1918 (list 'uid (condition-case nil
1919 (elmo-read (current-buffer))
1922 (list 'flags (elmo-imap4-parse-flag-list)))
1923 ((eq token 'ENVELOPE)
1924 (list 'envelope (elmo-imap4-parse-envelope)))
1925 ((eq token 'INTERNALDATE)
1926 (list 'internaldate (elmo-imap4-parse-string)))
1928 (list 'rfc822 (elmo-imap4-parse-nstring)))
1929 ((eq token (intern elmo-imap4-rfc822-header))
1930 (list 'rfc822header (elmo-imap4-parse-nstring)))
1931 ((eq token (intern elmo-imap4-rfc822-text))
1932 (list 'rfc822text (elmo-imap4-parse-nstring)))
1933 ((eq token (intern elmo-imap4-rfc822-size))
1934 (list 'rfc822size (elmo-read (current-buffer))))
1936 (if (eq (char-before) ?\[)
1939 (upcase (elmo-imap4-parse-fetch-body-section))
1941 (eq (char-after (point)) ?<)
1942 (buffer-substring (1+ (point))
1944 (search-forward ">" nil t)
1946 (progn (elmo-imap4-forward)
1947 (elmo-imap4-parse-nstring)))
1948 (list 'body (elmo-imap4-parse-body))))
1949 ((eq token 'BODYSTRUCTURE)
1950 (list 'bodystructure (elmo-imap4-parse-body)))))
1951 (setq list (cons element list))))
1952 (and elmo-imap4-fetch-callback
1953 (elmo-imap4-fetch-callback list elmo-imap4-fetch-callback-data))
1954 (list 'fetch list))))
1956 (defun elmo-imap4-parse-status ()
1957 (let ((mailbox (elmo-imap4-parse-mailbox))
1959 (when (and mailbox (search-forward "(" nil t))
1960 (while (not (eq (char-after (point)) ?\)))
1963 (let ((token (elmo-read (current-buffer))))
1964 (cond ((eq token 'MESSAGES)
1965 (list 'messages (elmo-read (current-buffer))))
1967 (list 'recent (elmo-read (current-buffer))))
1968 ((eq token 'UIDNEXT)
1969 (list 'uidnext (elmo-read (current-buffer))))
1970 ((eq token 'UIDVALIDITY)
1971 (and (looking-at " \\([0-9]+\\)")
1972 (prog1 (list 'uidvalidity (match-string 1))
1973 (goto-char (match-end 1)))))
1975 (list 'unseen (elmo-read (current-buffer))))
1978 "Unknown status data %s in mailbox %s ignored"
1981 (and elmo-imap4-status-callback
1982 (funcall elmo-imap4-status-callback
1984 elmo-imap4-status-callback-data))
1985 (list 'status status)))
1988 (defmacro elmo-imap4-value (value)
1989 (` (if (eq (, value) 'NIL) nil
1992 (defmacro elmo-imap4-nth (pos list)
1993 (` (let ((value (nth (, pos) (, list))))
1994 (elmo-imap4-value value))))
1996 (defun elmo-imap4-parse-namespace ()
1999 (copy-sequence elmo-imap4-extra-namespace-alist)
2000 (elmo-imap4-parse-namespace-subr
2001 (elmo-read (concat "(" (buffer-substring
2002 (point) (point-max))
2005 (defun elmo-imap4-parse-namespace-subr (ns)
2006 (let (prefix delim namespace-alist default-delim)
2007 ;; 0: personal, 1: other, 2: shared
2009 (setq namespace-alist
2010 (nconc namespace-alist
2014 (setq prefix (elmo-imap4-nth 0 namespace)
2015 delim (elmo-imap4-nth 1 namespace))
2016 (if (and prefix delim
2018 (concat (regexp-quote delim) "\\'")
2020 (setq prefix (substring prefix 0
2021 (match-beginning 0))))
2022 (if (eq (length prefix) 0)
2023 (progn (setq default-delim delim) nil)
2026 (if (string= (downcase prefix) "inbox")
2027 "[Ii][Nn][Bb][Oo][Xx]"
2028 (regexp-quote prefix))
2031 (elmo-imap4-nth i ns))))))
2033 (setq namespace-alist
2034 (nconc namespace-alist
2035 (list (cons "^.*$" default-delim)))))
2038 (defun elmo-imap4-parse-acl ()
2039 (let ((mailbox (elmo-imap4-parse-mailbox))
2040 identifier rights acl)
2041 (while (eq (char-after (point)) ?\ )
2042 (elmo-imap4-forward)
2043 (setq identifier (elmo-imap4-parse-astring))
2044 (elmo-imap4-forward)
2045 (setq rights (elmo-imap4-parse-astring))
2046 (setq acl (append acl (list (cons identifier rights)))))
2047 (list 'acl acl mailbox)))
2049 (defun elmo-imap4-parse-flag-list ()
2050 (let ((str (buffer-substring (+ (point) 1)
2051 (progn (search-forward ")" nil t)
2053 (unless (eq (length str) 0)
2054 (split-string str))))
2056 (defun elmo-imap4-parse-envelope ()
2057 (when (eq (char-after (point)) ?\()
2058 (elmo-imap4-forward)
2059 (vector (prog1 (elmo-imap4-parse-nstring);; date
2060 (elmo-imap4-forward))
2061 (prog1 (elmo-imap4-parse-nstring);; subject
2062 (elmo-imap4-forward))
2063 (prog1 (elmo-imap4-parse-address-list);; from
2064 (elmo-imap4-forward))
2065 (prog1 (elmo-imap4-parse-address-list);; sender
2066 (elmo-imap4-forward))
2067 (prog1 (elmo-imap4-parse-address-list);; reply-to
2068 (elmo-imap4-forward))
2069 (prog1 (elmo-imap4-parse-address-list);; to
2070 (elmo-imap4-forward))
2071 (prog1 (elmo-imap4-parse-address-list);; cc
2072 (elmo-imap4-forward))
2073 (prog1 (elmo-imap4-parse-address-list);; bcc
2074 (elmo-imap4-forward))
2075 (prog1 (elmo-imap4-parse-nstring);; in-reply-to
2076 (elmo-imap4-forward))
2077 (prog1 (elmo-imap4-parse-nstring);; message-id
2078 (elmo-imap4-forward)))))
2080 (defsubst elmo-imap4-parse-string-list ()
2081 (cond ((eq (char-after (point)) ?\();; body-fld-param
2083 (elmo-imap4-forward)
2084 (while (setq str (elmo-imap4-parse-string))
2086 (elmo-imap4-forward))
2087 (nreverse strlist)))
2088 ((elmo-imap4-parse-nil)
2091 (defun elmo-imap4-parse-body-extension ()
2092 (if (eq (char-after (point)) ?\()
2094 (elmo-imap4-forward)
2095 (push (elmo-imap4-parse-body-extension) b-e)
2096 (while (eq (char-after (point)) ?\ )
2097 (elmo-imap4-forward)
2098 (push (elmo-imap4-parse-body-extension) b-e))
2099 (assert (eq (char-after (point)) ?\)))
2100 (elmo-imap4-forward)
2102 (or (elmo-imap4-parse-number)
2103 (elmo-imap4-parse-nstring))))
2105 (defsubst elmo-imap4-parse-body-ext ()
2107 (when (eq (char-after (point)) ?\ );; body-fld-dsp
2108 (elmo-imap4-forward)
2110 (if (eq (char-after (point)) ?\()
2112 (elmo-imap4-forward)
2113 (push (elmo-imap4-parse-string) dsp)
2114 (elmo-imap4-forward)
2115 (push (elmo-imap4-parse-string-list) dsp)
2116 (elmo-imap4-forward))
2117 (assert (elmo-imap4-parse-nil)))
2118 (push (nreverse dsp) ext))
2119 (when (eq (char-after (point)) ?\ );; body-fld-lang
2120 (elmo-imap4-forward)
2121 (if (eq (char-after (point)) ?\()
2122 (push (elmo-imap4-parse-string-list) ext)
2123 (push (elmo-imap4-parse-nstring) ext))
2124 (while (eq (char-after (point)) ?\ );; body-extension
2125 (elmo-imap4-forward)
2126 (setq ext (append (elmo-imap4-parse-body-extension) ext)))))
2129 (defun elmo-imap4-parse-body ()
2131 (when (eq (char-after (point)) ?\()
2132 (elmo-imap4-forward)
2133 (if (eq (char-after (point)) ?\()
2135 (while (and (eq (char-after (point)) ?\()
2136 (setq subbody (elmo-imap4-parse-body)))
2137 (push subbody body))
2138 (elmo-imap4-forward)
2139 (push (elmo-imap4-parse-string) body);; media-subtype
2140 (when (eq (char-after (point)) ?\ );; body-ext-mpart:
2141 (elmo-imap4-forward)
2142 (if (eq (char-after (point)) ?\();; body-fld-param
2143 (push (elmo-imap4-parse-string-list) body)
2144 (push (and (elmo-imap4-parse-nil) nil) body))
2146 (append (elmo-imap4-parse-body-ext) body)));; body-ext-...
2147 (assert (eq (char-after (point)) ?\)))
2148 (elmo-imap4-forward)
2151 (push (elmo-imap4-parse-string) body);; media-type
2152 (elmo-imap4-forward)
2153 (push (elmo-imap4-parse-string) body);; media-subtype
2154 (elmo-imap4-forward)
2155 ;; next line for Sun SIMS bug
2156 (and (eq (char-after (point)) ? ) (elmo-imap4-forward))
2157 (if (eq (char-after (point)) ?\();; body-fld-param
2158 (push (elmo-imap4-parse-string-list) body)
2159 (push (and (elmo-imap4-parse-nil) nil) body))
2160 (elmo-imap4-forward)
2161 (push (elmo-imap4-parse-nstring) body);; body-fld-id
2162 (elmo-imap4-forward)
2163 (push (elmo-imap4-parse-nstring) body);; body-fld-desc
2164 (elmo-imap4-forward)
2165 (push (elmo-imap4-parse-string) body);; body-fld-enc
2166 (elmo-imap4-forward)
2167 (push (elmo-imap4-parse-number) body);; body-fld-octets
2169 ;; ok, we're done parsing the required parts, what comes now is one
2172 ;; envelope (then we're parsing body-type-msg)
2173 ;; body-fld-lines (then we're parsing body-type-text)
2174 ;; body-ext-1part (then we're parsing body-type-basic)
2176 ;; the problem is that the two first are in turn optionally followed
2177 ;; by the third. So we parse the first two here (if there are any)...
2179 (when (eq (char-after (point)) ?\ )
2180 (elmo-imap4-forward)
2182 (cond ((eq (char-after (point)) ?\();; body-type-msg:
2183 (push (elmo-imap4-parse-envelope) body);; envelope
2184 (elmo-imap4-forward)
2185 (push (elmo-imap4-parse-body) body);; body
2186 (elmo-imap4-forward)
2187 (push (elmo-imap4-parse-number) body));; body-fld-lines
2188 ((setq lines (elmo-imap4-parse-number));; body-type-text:
2189 (push lines body));; body-fld-lines
2191 (backward-char)))));; no match...
2193 ;; ...and then parse the third one here...
2195 (when (eq (char-after (point)) ?\ );; body-ext-1part:
2196 (elmo-imap4-forward)
2197 (push (elmo-imap4-parse-nstring) body);; body-fld-md5
2199 (append (elmo-imap4-parse-body-ext) body)));; body-ext-1part..
2201 (assert (eq (char-after (point)) ?\)))
2202 (elmo-imap4-forward)
2206 (product-provide (provide 'elmo-imap4) (require 'elmo-version))
2208 ;;; elmo-imap4.el ends here