1 ;;; elmo-imap4.el -- IMAP4 Interface for ELMO.
3 ;; Copyright 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
5 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
6 ;; Keywords: mail, net news
8 ;; This file is part of ELMO (Elisp Library for Message Orchestration).
10 ;; This program is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
15 ;; This program is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
28 ;; Origin of IMAP parser part is imap.el, included in Gnus.
30 ;; Copyright (C) 1998, 1999, 2000
31 ;; Free Software Foundation, Inc.
32 ;; Author: Simon Josefsson <jas@pdc.kth.se>
48 ;; silence byte compiler.
56 (defun-maybe sasl-cram-md5 (username passphrase challenge))
57 (defun-maybe sasl-digest-md5-digest-response
58 (digest-challenge username passwd serv-type host &optional realm))
59 (defun-maybe starttls-negotiate (a))
60 (defun-maybe elmo-generic-list-folder-unread (spec number-alist mark-alist unread-marks))
61 (defun-maybe elmo-generic-folder-diff (spec folder number-list))
62 (defsubst-maybe utf7-decode-string (string &optional imap) string))
64 (defvar elmo-imap4-use-lock t
65 "USE IMAP4 with locking process.")
67 ;;; internal variables
69 (defvar elmo-imap4-seq-prefix "elmo-imap4")
70 (defvar elmo-imap4-seqno 0)
71 (defvar elmo-imap4-use-uid t
72 "Use UID as message number.")
74 (defvar elmo-imap4-current-response nil)
75 (defvar elmo-imap4-status nil)
76 (defvar elmo-imap4-reached-tag "elmo-imap40")
78 ;;; buffer local variables
80 (defvar elmo-imap4-extra-namespace-alist
81 '(("^{.*/nntp}.*$" . ".")) ; Default is for UW's remote nntp mailbox...
82 "Extra namespace alist. A list of cons cell like: (REGEXP . DELIMITER) ")
83 (defvar elmo-imap4-default-hierarchy-delimiter "/")
85 (defvar elmo-imap4-server-capability nil)
86 (defvar elmo-imap4-server-namespace nil)
88 (defvar elmo-imap4-parsing nil) ; indicates parsing.
90 (defvar elmo-imap4-fetch-callback nil)
91 (defvar elmo-imap4-fetch-callback-data nil)
92 (defvar elmo-imap4-status-callback nil)
93 (defvar elmo-imap4-status-callback-data nil)
95 (defvar elmo-imap4-server-diff-async-callback nil)
96 (defvar elmo-imap4-server-diff-async-callback-data nil)
98 ;;; progress...(no use?)
99 (defvar elmo-imap4-count-progress nil)
100 (defvar elmo-imap4-count-progress-message nil)
101 (defvar elmo-imap4-progress-count nil)
103 ;;; XXX Temporal implementation
104 (defvar elmo-imap4-current-msgdb nil)
106 (defvar elmo-imap4-local-variables
108 elmo-imap4-current-response
111 elmo-imap4-reached-tag
112 elmo-imap4-count-progress
113 elmo-imap4-count-progress-message
114 elmo-imap4-progress-count
115 elmo-imap4-fetch-callback
116 elmo-imap4-fetch-callback-data
117 elmo-imap4-status-callback
118 elmo-imap4-status-callback-data
119 elmo-imap4-current-msgdb))
121 (defvar elmo-imap4-authenticator-alist
122 '((login elmo-imap4-auth-login)
123 (cram-md5 elmo-imap4-auth-cram-md5)
124 (digest-md5 elmo-imap4-auth-digest-md5)
125 (plain elmo-imap4-login))
126 "Definition of authenticators.")
130 (defconst elmo-imap4-quoted-specials-list '(?\\ ?\"))
132 (defconst elmo-imap4-non-atom-char-regex
134 (concat "[^" "]!#$&'+,./0-9:;<=>?@A-Z[^_`a-z|}~-" "]")))
136 (defconst elmo-imap4-non-text-char-regex
139 "]\x01-\x09\x0b\x0c\x0e-\x1f\x7f !\"#$%&'()*+,./0-9:;<=>?@A-Z[\\^_`a-z{|}~-"
142 (defconst elmo-imap4-literal-threshold 1024
143 "Limitation of characters that can be used in a quoted string.")
146 (defvar elmo-imap4-debug nil
147 "Non-nil forces IMAP4 folder as debug mode.
148 Debug information is inserted in the buffer \"*IMAP4 DEBUG*\"")
150 (defvar elmo-imap4-debug-inhibit-logging nil)
155 (luna-define-class elmo-imap4-session (elmo-network-session)
156 (capability current-mailbox read-only))
157 (luna-define-internal-accessors 'elmo-imap4-session))
161 (defsubst elmo-imap4-spec-mailbox (spec)
164 (defsubst elmo-imap4-spec-username (spec)
167 (defsubst elmo-imap4-spec-auth (spec)
170 (defsubst elmo-imap4-spec-hostname (spec)
173 (defsubst elmo-imap4-spec-port (spec)
176 (defsubst elmo-imap4-spec-stream-type (spec)
182 (defsubst elmo-imap4-debug (message &rest args)
184 (with-current-buffer (get-buffer-create "*IMAP4 DEBUG*")
185 (goto-char (point-max))
186 (if elmo-imap4-debug-inhibit-logging
187 (insert "NO LOGGING\n")
188 (insert (apply 'format message args) "\n")))))
192 (defmacro elmo-imap4-response-continue-req-p (response)
193 "Returns non-nil if RESPONSE is '+' response."
194 (` (assq 'continue-req (, response))))
196 (defmacro elmo-imap4-response-ok-p (response)
197 "Returns non-nil if RESPONSE is an 'OK' response."
198 (` (assq 'ok (, response))))
200 (defmacro elmo-imap4-response-bye-p (response)
201 "Returns non-nil if RESPONSE is an 'BYE' response."
202 (` (assq 'bye (, response))))
204 (defmacro elmo-imap4-response-value (response symbol)
205 "Get value of the SYMBOL from RESPONSE."
206 (` (nth 1 (assq (, symbol) (, response)))))
208 (defsubst elmo-imap4-response-value-all (response symbol)
209 "Get all value of the SYMBOL from RESPONSE."
212 (if (eq (car (car response)) symbol)
213 (setq matched (nconc matched (nth 1 (car response)))))
214 (setq response (cdr response)))
217 (defmacro elmo-imap4-response-error-text (response)
218 "Returns text of NO, BAD, BYE response."
219 (` (nth 1 (or (elmo-imap4-response-value (, response) 'no)
220 (elmo-imap4-response-value (, response) 'bad)
221 (elmo-imap4-response-value (, response) 'bye)))))
223 (defmacro elmo-imap4-response-bodydetail-text (response)
224 "Returns text of BODY[section]<partial>"
225 (` (nth 3 (assq 'bodydetail (, response)))))
227 ;;; Session commands.
229 ; (defun elmo-imap4-send-command-wait (session command)
230 ; "Send COMMAND to the SESSION and wait for response.
231 ; Returns RESPONSE (parsed lisp object) of IMAP session."
232 ; (elmo-imap4-read-response session
233 ; (elmo-imap4-send-command
237 (defun elmo-imap4-send-command-wait (session command)
238 "Send COMMAND to the SESSION.
239 Returns RESPONSE (parsed lisp object) of IMAP session.
240 If response is not `OK', causes error with IMAP response text."
241 (elmo-imap4-accept-ok session
242 (elmo-imap4-send-command
246 (defun elmo-imap4-send-command (session command)
247 "Send COMMAND to the SESSION.
248 Returns a TAG string which is assigned to the COMAND."
249 (let* ((command-args (if (listp command)
252 (process (elmo-network-session-process-internal session))
253 cmdstr tag token kind)
254 (with-current-buffer (process-buffer process)
255 (setq tag (concat elmo-imap4-seq-prefix
257 (setq elmo-imap4-seqno (+ 1 elmo-imap4-seqno)))))
258 (setq cmdstr (concat tag " "))
259 ;; (erase-buffer) No need.
260 (goto-char (point-min))
261 (if (elmo-imap4-response-bye-p elmo-imap4-current-response)
262 (signal 'elmo-imap4-bye-error
263 (list (elmo-imap4-response-error-text
264 elmo-imap4-current-response))))
265 (setq elmo-imap4-current-response nil)
266 (if elmo-imap4-parsing
267 (error "IMAP process is running. Please wait (or plug again.)"))
268 (setq elmo-imap4-parsing t)
269 (elmo-imap4-debug "<-(%s)- %s" tag command)
270 (while (setq token (car command-args))
271 (cond ((stringp token) ; formatted
272 (setq cmdstr (concat cmdstr token)))
273 ((listp token) ; unformatted
274 (setq kind (car token))
275 (cond ((eq kind 'atom)
276 (setq cmdstr (concat cmdstr (nth 1 token))))
280 (elmo-imap4-format-quoted (nth 1 token)))))
282 (setq cmdstr (concat cmdstr
283 (format "{%d}" (nth 2 token))))
284 (process-send-string process cmdstr)
285 (process-send-string process "\r\n")
287 (elmo-imap4-accept-continue-req session)
288 (cond ((stringp (nth 1 token))
289 (setq cmdstr (nth 1 token)))
290 ((bufferp (nth 1 token))
291 (with-current-buffer (nth 1 token)
295 (+ (point-min) (nth 2 token)))))
297 (error "Wrong argument for literal"))))
299 (error "Unknown token kind %s" kind))))
301 (error "Invalid argument")))
302 (setq command-args (cdr command-args)))
304 (process-send-string process cmdstr))
305 (process-send-string process "\r\n")
308 (defun elmo-imap4-send-string (session string)
309 "Send STRING to the SESSION."
310 (with-current-buffer (process-buffer
311 (elmo-network-session-process-internal session))
312 (setq elmo-imap4-current-response nil)
313 (goto-char (point-min))
314 (elmo-imap4-debug "<-- %s" string)
315 (process-send-string (elmo-network-session-process-internal session)
317 (process-send-string (elmo-network-session-process-internal session)
320 (defun elmo-imap4-read-response (session tag)
321 "Read parsed response from SESSION.
322 TAG is the tag of the command"
323 (with-current-buffer (process-buffer
324 (elmo-network-session-process-internal session))
325 (while (not (or (string= tag elmo-imap4-reached-tag)
326 (elmo-imap4-response-bye-p elmo-imap4-current-response)))
327 (when (memq (process-status
328 (elmo-network-session-process-internal session))
330 (accept-process-output (elmo-network-session-process-internal session)
332 (elmo-imap4-debug "=>%s" (prin1-to-string elmo-imap4-current-response))
333 (setq elmo-imap4-parsing nil)
334 elmo-imap4-current-response))
336 (defsubst elmo-imap4-read-untagged (process)
337 (with-current-buffer (process-buffer process)
338 (while (not elmo-imap4-current-response)
339 (accept-process-output process 1))
340 (elmo-imap4-debug "=>%s" (prin1-to-string elmo-imap4-current-response))
341 elmo-imap4-current-response))
343 (defun elmo-imap4-read-continue-req (session)
344 "Returns a text following to continue-req in SESSION.
345 If response is not `+' response, returns nil."
346 (elmo-imap4-response-value
347 (elmo-imap4-read-untagged
348 (elmo-network-session-process-internal session))
351 (defun elmo-imap4-accept-continue-req (session)
352 "Returns non-nil if `+' (continue-req) response is arrived in SESSION.
353 If response is not `+' response, cause an error."
356 (elmo-imap4-read-untagged
357 (elmo-network-session-process-internal session)))
358 (or (elmo-imap4-response-continue-req-p response)
359 (error "IMAP error: %s"
360 (or (elmo-imap4-response-error-text response)
361 "No continut-req from server.")))))
363 (defun elmo-imap4-read-ok (session tag)
364 "Returns non-nil if `OK' response of the command with TAG is arrived
365 in SESSION. If response is not `OK' response, returns nil."
366 (elmo-imap4-response-ok-p
367 (elmo-imap4-read-response session tag)))
369 (defun elmo-imap4-accept-ok (session tag)
370 "Accept only `OK' response from SESSION.
371 If response is not `OK' response, causes error with IMAP response text."
372 (let ((response (elmo-imap4-read-response session tag)))
373 (if (elmo-imap4-response-ok-p response)
375 (if (elmo-imap4-response-bye-p response)
376 (signal 'elmo-imap4-bye-error
377 (list (elmo-imap4-response-error-text response)))
378 (error "IMAP error: %s"
379 (or (elmo-imap4-response-error-text response)
380 "No `OK' response from server."))))))
383 (defun elmo-imap4-session-check (session)
384 (elmo-imap4-send-command-wait session "check"))
386 (defun elmo-imap4-atom-p (string)
387 "Return t if STRING is an atom defined in rfc2060."
388 (if (string= string "")
391 (not (string-match elmo-imap4-non-atom-char-regex string)))))
393 (defun elmo-imap4-quotable-p (string)
394 "Return t if STRING can be formatted as a quoted defined in rfc2060."
396 (not (string-match elmo-imap4-non-text-char-regex string))))
398 (defun elmo-imap4-nil (string)
399 "Return a list represents the special atom \"NIL\" defined in rfc2060, \
401 Otherwise return nil."
405 (defun elmo-imap4-atom (string)
406 "Return a list represents STRING as an atom defined in rfc2060.
407 Return nil if STRING is not an atom. See `elmo-imap4-atom-p'."
408 (if (elmo-imap4-atom-p string)
409 (list 'atom string)))
411 (defun elmo-imap4-quoted (string)
412 "Return a list represents STRING as a quoted defined in rfc2060.
413 Return nil if STRING can not be formatted as a quoted. See `elmo-imap4-quotable-p'."
414 (if (elmo-imap4-quotable-p string)
415 (list 'quoted string)))
417 (defun elmo-imap4-literal-1 (string-or-buffer length)
418 "Internal function for `elmo-imap4-literal' and `elmo-imap4-buffer-literal'.
419 Return a list represents STRING-OR-BUFFER as a literal defined in rfc2060.
420 STRING-OR-BUFFER must be an encoded string or a single-byte string or a single-byte buffer.
421 LENGTH must be the number of octets for STRING-OR-BUFFER."
422 (list 'literal string-or-buffer length))
424 (defun elmo-imap4-literal (string)
425 "Return a list represents STRING as a literal defined in rfc2060.
426 STRING must be an encoded or a single-byte string."
427 (elmo-imap4-literal-1 string (length string)))
429 (defun elmo-imap4-buffer-literal (buffer)
430 "Return a list represents BUFFER as a literal defined in rfc2060.
431 BUFFER must be a single-byte buffer."
432 (elmo-imap4-literal-1 buffer (with-current-buffer buffer
435 (defun elmo-imap4-string-1 (string length)
436 "Internal function for `elmo-imap4-string' and `elmo-imap4-buffer-string'.
437 Return a list represents STRING as a string defined in rfc2060.
438 STRING must be an encoded or a single-byte string.
439 LENGTH must be the number of octets for STRING."
440 (or (elmo-imap4-quoted string)
441 (elmo-imap4-literal-1 string length)))
443 (defun elmo-imap4-string (string)
444 "Return a list represents STRING as a string defined in rfc2060.
445 STRING must be an encoded or a single-byte string."
446 (let ((length (length string)))
447 (if (< elmo-imap4-literal-threshold length)
448 (elmo-imap4-literal-1 string length)
449 (elmo-imap4-string-1 string length))))
451 (defun elmo-imap4-buffer-string (buffer)
452 "Return a list represents BUFFER as a string defined in rfc2060.
453 BUFFER must be a single-byte buffer."
454 (let ((length (with-current-buffer buffer
456 (if (< elmo-imap4-literal-threshold length)
457 (elmo-imap4-literal-1 buffer length)
458 (elmo-imap4-string-1 (with-current-buffer buffer
462 (defun elmo-imap4-astring-1 (string length)
463 "Internal function for `elmo-imap4-astring' and `elmo-imap4-buffer-astring'.
464 Return a list represents STRING as an astring defined in rfc2060.
465 STRING must be an encoded or a single-byte string.
466 LENGTH must be the number of octets for STRING."
467 (or (elmo-imap4-atom string)
468 (elmo-imap4-string-1 string length)))
470 (defun elmo-imap4-astring (string)
471 "Return a list represents STRING as an astring defined in rfc2060.
472 STRING must be an encoded or a single-byte string."
473 (let ((length (length string)))
474 (if (< elmo-imap4-literal-threshold length)
475 (elmo-imap4-literal-1 string length)
476 (elmo-imap4-astring-1 string length))))
478 (defun elmo-imap4-buffer-astring (buffer)
479 "Return a list represents BUFFER as an astring defined in rfc2060.
480 BUFFER must be a single-byte buffer."
481 (let ((length (with-current-buffer buffer
483 (if (< elmo-imap4-literal-threshold length)
484 (elmo-imap4-literal-1 buffer length)
485 (elmo-imap4-astring-1 (with-current-buffer buffer
489 (defun elmo-imap4-nstring (string)
490 "Return a list represents STRING as a nstring defined in rfc2060.
491 STRING must be an encoded or a single-byte string."
492 (or (elmo-imap4-nil string)
493 (elmo-imap4-string string)))
495 (defun elmo-imap4-buffer-nstring (buffer)
496 "Return a list represents BUFFER as a nstring defined in rfc2060.
497 BUFFER must be a single-byte buffer."
498 (or (elmo-imap4-nil buffer)
499 (elmo-imap4-buffer-string buffer)))
501 (defalias 'elmo-imap4-mailbox 'elmo-imap4-astring)
502 (defalias 'elmo-imap4-field-body 'elmo-imap4-astring)
503 (defalias 'elmo-imap4-userid 'elmo-imap4-astring)
504 (defalias 'elmo-imap4-password 'elmo-imap4-astring)
506 (defun elmo-imap4-format-quoted (string)
507 "Return STRING in a form of the quoted-string defined in rfc2060."
509 (std11-wrap-as-quoted-pairs string elmo-imap4-quoted-specials-list)
512 (defsubst elmo-imap4-response-get-selectable-mailbox-list (response)
516 (if (and (eq 'list (car entry))
517 (not (member "\\NoSelect" (nth 1 (nth 1 entry)))))
518 (car (nth 1 entry))))
522 (defun elmo-imap4-list-folders (spec &optional hierarchy)
523 (let* ((root (elmo-imap4-spec-mailbox spec))
524 (session (elmo-imap4-get-session spec))
527 (elmo-string-matched-assoc
529 (with-current-buffer (elmo-network-session-buffer session)
530 elmo-imap4-server-namespace)))
531 elmo-imap4-default-hierarchy-delimiter))
532 result append-serv type)
535 (not (string= root ""))
536 (not (string-match (concat "\\(.*\\)"
540 (setq root (concat root delim)))
541 (setq result (elmo-imap4-response-get-selectable-mailbox-list
542 (elmo-imap4-send-command-wait
544 (list "list " (elmo-imap4-mailbox root) " *"))))
545 (unless (string= (elmo-imap4-spec-username spec)
546 elmo-default-imap4-user)
547 (setq append-serv (concat ":" (elmo-imap4-spec-username spec))))
548 (unless (string= (elmo-imap4-spec-hostname spec)
549 elmo-default-imap4-server)
550 (setq append-serv (concat append-serv "@" (elmo-imap4-spec-hostname
552 (unless (eq (elmo-imap4-spec-port spec)
553 elmo-default-imap4-port)
554 (setq append-serv (concat append-serv ":"
556 (elmo-imap4-spec-port spec)))))
557 (setq type (elmo-imap4-spec-stream-type spec))
558 (unless (eq (elmo-network-stream-type-symbol type)
559 elmo-default-imap4-stream-type)
561 (setq append-serv (concat append-serv
562 (elmo-network-stream-type-spec-string
564 (mapcar (lambda (fld)
565 (concat "%" (elmo-imap4-decode-folder-string fld)
567 (eval append-serv))))
570 (defun elmo-imap4-folder-exists-p (spec)
571 (let ((session (elmo-imap4-get-session spec)))
573 (elmo-imap4-session-current-mailbox-internal session)
574 (elmo-imap4-spec-mailbox spec))
576 (elmo-imap4-session-select-mailbox
578 (elmo-imap4-spec-mailbox spec)
581 (defun elmo-imap4-folder-creatable-p (spec)
584 (defun elmo-imap4-create-folder-maybe (spec dummy)
585 (unless (elmo-imap4-folder-exists-p spec)
586 (elmo-imap4-create-folder spec)))
588 (defun elmo-imap4-create-folder (spec)
589 (elmo-imap4-send-command-wait
590 (elmo-imap4-get-session spec)
591 (list "create " (elmo-imap4-mailbox
592 (elmo-imap4-spec-mailbox spec)))))
594 (defun elmo-imap4-delete-folder (spec)
595 (let ((session (elmo-imap4-get-session spec))
597 (when (elmo-imap4-spec-mailbox spec)
598 (when (setq msgs (elmo-imap4-list-folder spec))
599 (elmo-imap4-delete-msgs spec msgs))
600 ;; (elmo-imap4-send-command-wait session "close")
601 (elmo-imap4-send-command-wait
604 (elmo-imap4-mailbox (elmo-imap4-spec-mailbox spec)))))))
606 (defun elmo-imap4-rename-folder (old-spec new-spec)
607 ;;(elmo-imap4-send-command-wait session "close")
608 (elmo-imap4-send-command-wait
609 (elmo-imap4-get-session old-spec)
612 (elmo-imap4-spec-mailbox old-spec))
615 (elmo-imap4-spec-mailbox new-spec)))))
617 (defun elmo-imap4-max-of-folder (spec)
618 (let ((session (elmo-imap4-get-session spec))
619 (killed (and elmo-use-killed-list
620 (elmo-msgdb-killed-list-load
621 (elmo-msgdb-expand-path spec))))
623 (with-current-buffer (elmo-network-session-buffer session)
624 (setq elmo-imap4-status-callback nil)
625 (setq elmo-imap4-status-callback-data nil))
626 (setq status (elmo-imap4-response-value
627 (elmo-imap4-send-command-wait
631 (elmo-imap4-spec-mailbox spec))
632 " (uidnext messages)"))
635 (- (elmo-imap4-response-value status 'uidnext) 1)
638 (elmo-imap4-response-value status 'messages)
639 (elmo-msgdb-killed-list-length killed))
640 (elmo-imap4-response-value status 'messages)))))
642 (defun elmo-imap4-folder-diff (spec folder &optional number-list)
643 (if elmo-use-server-diff
644 (elmo-imap4-server-diff spec)
645 (elmo-generic-folder-diff spec folder number-list)))
647 (defun elmo-imap4-get-session (spec &optional if-exists)
648 (elmo-network-get-session
651 (elmo-imap4-spec-hostname spec)
652 (elmo-imap4-spec-port spec)
653 (elmo-imap4-spec-username spec)
654 (elmo-imap4-spec-auth spec)
655 (elmo-imap4-spec-stream-type spec)
658 (defun elmo-imap4-commit (spec)
659 (if (elmo-imap4-plugged-p spec)
660 (let ((session (elmo-imap4-get-session spec 'if-exists)))
663 (elmo-imap4-session-current-mailbox-internal session)
664 (elmo-imap4-spec-mailbox spec))
665 (if elmo-imap4-use-select-to-update-status
666 (elmo-imap4-session-select-mailbox
668 (elmo-imap4-spec-mailbox spec)
670 (elmo-imap4-session-check session)))))))
672 (defun elmo-imap4-session-select-mailbox (session mailbox
673 &optional force no-error)
674 "Select MAILBOX in SESSION.
675 If optional argument FORCE is non-nil, select mailbox even if current mailbox
677 If second optional argument NO-ERROR is non-nil, don't cause an error when
678 selecting folder was failed.
679 Returns t if selecting folder succeed. Otherwise, nil is returned."
682 (elmo-imap4-session-current-mailbox-internal session)
684 (let (response result)
687 (elmo-imap4-read-response
689 (elmo-imap4-send-command
693 (elmo-imap4-mailbox mailbox)))))
694 (if (setq result (elmo-imap4-response-ok-p response))
696 (elmo-imap4-session-set-current-mailbox-internal session mailbox)
697 (elmo-imap4-session-set-read-only-internal
699 (nth 1 (assq 'read-only (assq 'ok response)))))
700 (elmo-imap4-session-set-current-mailbox-internal session nil)
703 (elmo-imap4-response-error-text response)
704 (format "Select %s failed" mailbox))))))
707 (defun elmo-imap4-check-validity (spec validity-file)
709 ; (elmo-imap4-send-command-wait
710 ; (elmo-imap4-get-session spec)
712 ; (elmo-imap4-mailbox
713 ; (elmo-imap4-spec-mailbox spec))
714 ; " (uidvalidity)")))
717 (defun elmo-imap4-sync-validity (spec validity-file)
721 (defun elmo-imap4-list (spec flag)
722 (let ((session (elmo-imap4-get-session spec)))
723 (elmo-imap4-session-select-mailbox session
724 (elmo-imap4-spec-mailbox spec))
725 (elmo-imap4-response-value
726 (elmo-imap4-send-command-wait
728 (format (if elmo-imap4-use-uid "uid search %s"
732 (defun elmo-imap4-list-folder (spec)
733 (let ((killed (and elmo-use-killed-list
734 (elmo-msgdb-killed-list-load
735 (elmo-msgdb-expand-path spec))))
737 (setq numbers (elmo-imap4-list spec "all"))
738 (elmo-living-messages numbers killed)))
740 (defun elmo-imap4-list-folder-unread (spec number-alist mark-alist
742 (if (and (elmo-imap4-plugged-p spec)
743 (elmo-imap4-use-flag-p spec))
744 (elmo-imap4-list spec "unseen")
745 (elmo-generic-list-folder-unread spec number-alist mark-alist
748 (defun elmo-imap4-list-folder-important (spec number-alist)
749 (if (and (elmo-imap4-plugged-p spec)
750 (elmo-imap4-use-flag-p spec))
751 (elmo-imap4-list spec "flagged")))
753 (defmacro elmo-imap4-detect-search-charset (string)
756 (detect-mime-charset-region (point-min) (point-max)))))
758 (defun elmo-imap4-search-internal-primitive (spec session filter from-msgs)
759 (let ((search-key (elmo-filter-key filter))
760 (imap-search-keys '("bcc" "body" "cc" "from" "subject" "to"))
763 ((string= "last" search-key)
764 (let ((numbers (or from-msgs (elmo-imap4-list-folder spec))))
765 (nthcdr (max (- (length numbers)
766 (string-to-int (elmo-filter-value filter)))
769 ((string= "first" search-key)
770 (let* ((numbers (or from-msgs (elmo-imap4-list-folder spec)))
771 (rest (nthcdr (string-to-int (elmo-filter-value filter) )
773 (mapcar '(lambda (x) (delete x numbers)) rest)
775 ((or (string= "since" search-key)
776 (string= "before" search-key))
777 (setq search-key (concat "sent" search-key))
778 (elmo-imap4-response-value
779 (elmo-imap4-send-command-wait session
781 (if elmo-imap4-use-uid
782 "uid search %s%s%s %s"
786 (if elmo-imap4-use-uid "uid ")
789 (elmo-imap4-make-number-set-list
793 (if (eq (elmo-filter-type filter)
797 (elmo-date-get-description
798 (elmo-date-get-datevec
799 (elmo-filter-value filter)))))
803 (if (eq (length (elmo-filter-value filter)) 0)
804 (setq charset 'us-ascii)
805 (elmo-imap4-detect-search-charset
806 (elmo-filter-value filter))))
807 (elmo-imap4-response-value
808 (elmo-imap4-send-command-wait session
810 (if elmo-imap4-use-uid "uid ")
814 (symbol-name charset))
818 (if elmo-imap4-use-uid "uid ")
821 (elmo-imap4-make-number-set-list
825 (if (eq (elmo-filter-type filter)
830 (elmo-filter-key filter)
834 (elmo-filter-key filter))
836 (encode-mime-charset-string
837 (elmo-filter-value filter) charset))))
840 (defun elmo-imap4-search-internal (spec session condition from-msgs)
844 (setq result (elmo-imap4-search-internal-primitive
845 spec session condition from-msgs)))
846 ((eq (car condition) 'and)
847 (setq result (elmo-imap4-search-internal spec session (nth 1 condition)
849 result (elmo-list-filter result
850 (elmo-imap4-search-internal
851 spec session (nth 2 condition)
853 ((eq (car condition) 'or)
854 (setq result (elmo-imap4-search-internal
855 spec session (nth 1 condition) from-msgs)
856 result (elmo-uniq-list
858 (elmo-imap4-search-internal
859 spec session (nth 2 condition) from-msgs)))
860 result (sort result '<))))))
863 (defun elmo-imap4-search (spec condition &optional from-msgs)
865 (let ((session (elmo-imap4-get-session spec)))
866 (elmo-imap4-session-select-mailbox
868 (elmo-imap4-spec-mailbox spec))
869 (elmo-imap4-search-internal spec session condition from-msgs))))
871 (defun elmo-imap4-use-flag-p (spec)
872 (not (string-match elmo-imap4-disuse-server-flag-mailbox-regexp
873 (elmo-imap4-spec-mailbox spec))))
877 ;; Emacs can parse dot symbol.
878 (defvar elmo-imap4-rfc822-size "RFC822\.SIZE")
879 (defvar elmo-imap4-rfc822-text "RFC822\.TEXT")
880 (defvar elmo-imap4-rfc822-header "RFC822\.HEADER")
881 (defvar elmo-imap4-rfc822-size "RFC822\.SIZE")
882 (defvar elmo-imap4-header-fields "HEADER\.FIELDS")
883 (defmacro elmo-imap4-replace-dot-symbols ()) ;; noop
884 (defalias 'elmo-imap4-fetch-read 'read)
888 ;; Cannot parse dot symbol.
889 (defvar elmo-imap4-rfc822-size "RFC822_SIZE")
890 (defvar elmo-imap4-header-fields "HEADER_FIELDS")
891 (defvar elmo-imap4-rfc822-size "RFC822_SIZE")
892 (defvar elmo-imap4-rfc822-text "RFC822_TEXT")
893 (defvar elmo-imap4-rfc822-header "RFC822_HEADER")
894 (defvar elmo-imap4-header-fields "HEADER_FIELDS")
895 (defun elmo-imap4-fetch-read (buffer)
896 (with-current-buffer buffer
899 (when (re-search-forward "[[ ]" nil t)
900 (goto-char (match-beginning 0))
901 (setq token (buffer-substring beg (point)))
902 (cond ((string= token "RFC822.SIZE")
903 (intern elmo-imap4-rfc822-size))
904 ((string= token "RFC822.HEADER")
905 (intern elmo-imap4-rfc822-header))
906 ((string= token "RFC822.TEXT")
907 (intern elmo-imap4-rfc822-text))
908 ((string= token "HEADER\.FIELDS")
909 (intern elmo-imap4-header-fields))
911 (elmo-read (current-buffer))))))))))
913 (defun elmo-imap4-make-number-set-list (msg-list &optional chop-length)
914 "Make RFC2060's message set specifier from MSG-LIST.
915 Returns a list of (NUMBER . SET-STRING).
916 SET-STRING is the message set specifier described in RFC2060.
917 NUMBER is contained message number in SET-STRING.
918 Every SET-STRING does not contain number of messages longer than CHOP-LENGTH.
919 If CHOP-LENGTH is not specified, message set is not chopped."
920 (let (count cont-list set-list)
921 (setq msg-list (sort (copy-sequence msg-list) '<))
926 (setq chop-length (length msg-list)))
927 (while (and (not (null msg-list))
928 (< count chop-length))
930 (elmo-number-set-append
931 cont-list (car msg-list)))
933 (setq msg-list (cdr msg-list)))
941 (format "%s:%s" (car x) (cdr x)))
947 (nreverse set-list)))
951 ;; read-mark -> "\\Seen"
952 ;; important -> "\\Flagged"
954 ;; (delete -> \\Deleted)
955 (defun elmo-imap4-mark-set-on-msgs (spec msgs mark &optional unmark no-expunge)
956 "SET flag of MSGS as MARK.
957 If optional argument UNMARK is non-nil, unmark."
958 (let ((session (elmo-imap4-get-session spec))
960 (elmo-imap4-session-select-mailbox session
961 (elmo-imap4-spec-mailbox spec))
962 (setq set-list (elmo-imap4-make-number-set-list msgs))
964 (with-current-buffer (elmo-network-session-buffer session)
965 (setq elmo-imap4-fetch-callback nil)
966 (setq elmo-imap4-fetch-callback-data nil))
967 (elmo-imap4-send-command-wait
970 (if elmo-imap4-use-uid
971 "uid store %s %sflags.silent (%s)"
972 "store %s %sflags.silent (%s)")
977 (elmo-imap4-send-command-wait session "expunge")))
980 (defun elmo-imap4-mark-as-important (spec msgs)
981 (and (elmo-imap4-use-flag-p spec)
982 (elmo-imap4-mark-set-on-msgs spec msgs "\\Flagged" nil 'no-expunge)))
984 (defun elmo-imap4-mark-as-read (spec msgs)
985 (and (elmo-imap4-use-flag-p spec)
986 (elmo-imap4-mark-set-on-msgs spec msgs "\\Seen" nil 'no-expunge)))
988 (defun elmo-imap4-unmark-important (spec msgs)
989 (and (elmo-imap4-use-flag-p spec)
990 (elmo-imap4-mark-set-on-msgs spec msgs "\\Flagged" 'unmark
993 (defun elmo-imap4-mark-as-unread (spec msgs)
994 (and (elmo-imap4-use-flag-p spec)
995 (elmo-imap4-mark-set-on-msgs spec msgs "\\Seen" 'unmark 'no-expunge)))
997 (defun elmo-imap4-delete-msgs (spec msgs)
998 (elmo-imap4-mark-set-on-msgs spec msgs "\\Deleted"))
1000 (defun elmo-imap4-delete-msgs-no-expunge (spec msgs)
1001 (elmo-imap4-mark-set-on-msgs spec msgs "\\Deleted" nil 'no-expunge))
1003 (defun elmo-imap4-msgdb-create-as-numlist (spec numlist new-mark already-mark
1004 seen-mark important-mark
1006 "Create msgdb for SPEC for NUMLIST."
1007 (elmo-imap4-msgdb-create spec numlist new-mark already-mark
1008 seen-mark important-mark seen-list t))
1010 ;; Current buffer is process buffer.
1011 (defun elmo-imap4-fetch-callback (element app-data)
1012 (funcall elmo-imap4-fetch-callback
1014 (insert (or (elmo-imap4-response-bodydetail-text element)
1017 (goto-char (point-min))
1018 (while (search-forward "\r\n" nil t)
1019 (replace-match "\n"))
1020 (elmo-msgdb-create-overview-from-buffer
1021 (elmo-imap4-response-value element 'uid)
1022 (elmo-imap4-response-value element 'rfc822size)))
1023 (elmo-imap4-response-value element 'flags)
1028 ;; 0: new-mark 1: already-mark 2: seen-mark 3: important-mark
1029 ;; 4: seen-list 5: as-number
1030 (defun elmo-imap4-fetch-callback-1 (entity flags app-data)
1031 "A msgdb entity callback function."
1032 (let ((seen (member (car entity) (nth 4 app-data)))
1034 (if (member "\\Flagged" flags)
1035 (elmo-msgdb-global-mark-set (car entity) (nth 3 app-data)))
1036 (setq mark (or (elmo-msgdb-global-mark-get (car entity))
1037 (if (elmo-cache-exists-p (car entity)) ;; XXX
1038 (if (or (member "\\Seen" flags) seen)
1041 (if (or (member "\\Seen" flags) seen)
1042 (if elmo-imap4-use-cache
1044 (nth 0 app-data)))))
1045 (setq elmo-imap4-current-msgdb
1047 elmo-imap4-current-msgdb
1049 (list (cons (elmo-msgdb-overview-entity-get-number entity)
1053 (list (elmo-msgdb-overview-entity-get-number entity)
1056 (defun elmo-imap4-msgdb-create (spec numlist &rest args)
1057 "Create msgdb for SPEC."
1059 (let ((session (elmo-imap4-get-session spec))
1062 '("Subject" "From" "To" "Cc" "Date"
1063 "Message-Id" "References" "In-Reply-To")
1064 elmo-msgdb-extra-fields))
1066 (length (length numlist))
1068 (setq rfc2060 (memq 'imap4rev1
1069 (elmo-imap4-session-capability-internal
1071 (message "Getting overview...")
1072 (elmo-imap4-session-select-mailbox session
1073 (elmo-imap4-spec-mailbox spec))
1074 (setq set-list (elmo-imap4-make-number-set-list
1076 elmo-imap4-overview-fetch-chop-length))
1078 (with-current-buffer (elmo-network-session-buffer session)
1079 (setq elmo-imap4-current-msgdb nil
1080 elmo-imap4-fetch-callback 'elmo-imap4-fetch-callback-1
1081 elmo-imap4-fetch-callback-data args)
1083 (elmo-imap4-send-command-wait
1085 ;; get overview entity from IMAP4
1086 (format "%sfetch %s (%s rfc822.size flags)"
1087 (if elmo-imap4-use-uid "uid " "")
1088 (cdr (car set-list))
1090 (format "body.peek[header.fields %s]" headers)
1091 (format "%s" headers))))
1092 (when (> length elmo-display-progress-threshold)
1093 (setq total (+ total (car (car set-list))))
1094 (elmo-display-progress
1095 'elmo-imap4-msgdb-create "Getting overview..."
1096 (/ (* total 100) length)))
1097 (setq set-list (cdr set-list)))
1098 (message "Getting overview...done")
1099 elmo-imap4-current-msgdb))))
1101 (defun elmo-imap4-parse-capability (string)
1102 (if (string-match "^\\*\\(.*\\)$" string)
1104 (concat "(" (downcase (elmo-match-string 1 string)) ")"))))
1106 ;; Current buffer is process buffer.
1107 (defun elmo-imap4-auth-login (session)
1108 (let ((tag (elmo-imap4-send-command session "authenticate login"))
1109 (elmo-imap4-debug-inhibit-logging t))
1110 (or (elmo-imap4-read-continue-req session)
1111 (signal 'elmo-authenticate-error '(elmo-imap4-auth-login)))
1112 (elmo-imap4-send-string session
1113 (elmo-base64-encode-string
1114 (elmo-network-session-user-internal session)))
1115 (or (elmo-imap4-read-continue-req session)
1116 (signal 'elmo-authenticate-error '(elmo-imap4-auth-login)))
1117 (elmo-imap4-send-string session
1118 (elmo-base64-encode-string
1120 (elmo-network-session-password-key session))))
1121 (or (elmo-imap4-read-ok session tag)
1122 (signal 'elmo-authenticate-error '(elmo-imap4-auth-login)))
1123 (setq elmo-imap4-status 'auth)))
1125 (defun elmo-imap4-auth-cram-md5 (session)
1126 (let ((tag (elmo-imap4-send-command session "authenticate cram-md5"))
1127 (elmo-imap4-debug-inhibit-logging t)
1129 (or (setq response (elmo-imap4-read-continue-req session))
1130 (signal 'elmo-authenticate-error
1131 '(elmo-imap4-auth-cram-md5)))
1132 (elmo-imap4-send-string
1134 (elmo-base64-encode-string
1135 (sasl-cram-md5 (elmo-network-session-user-internal session)
1137 (elmo-network-session-password-key session))
1138 (elmo-base64-decode-string response))))
1139 (or (elmo-imap4-read-ok session tag)
1140 (signal 'elmo-authenticate-error '(elmo-imap4-auth-cram-md5)))))
1142 (defun elmo-imap4-auth-digest-md5 (session)
1143 (let ((tag (elmo-imap4-send-command session "authenticate digest-md5"))
1144 (elmo-imap4-debug-inhibit-logging t)
1146 (or (setq response (elmo-imap4-read-continue-req session))
1147 (signal 'elmo-authenticate-error '(elmo-imap4-auth-digest-md5)))
1148 (elmo-imap4-send-string
1150 (elmo-base64-encode-string
1151 (sasl-digest-md5-digest-response
1152 (elmo-base64-decode-string response)
1153 (elmo-network-session-user-internal session)
1154 (elmo-get-passwd (elmo-network-session-password-key session))
1156 (elmo-network-session-password-key session))
1158 (or (setq response (elmo-imap4-read-continue-req session))
1159 (signal 'elmo-authenticate-error '(elmo-imap4-auth-digest-md5)))
1160 (elmo-imap4-send-string session "")
1161 (or (elmo-imap4-read-ok session tag)
1162 (signal 'elmo-authenticate-error '(elmo-imap4-auth-digest-md5)))))
1164 (defun elmo-imap4-login (session)
1165 (let ((elmo-imap4-debug-inhibit-logging t))
1169 (elmo-imap4-send-command
1172 (elmo-imap4-userid (elmo-network-session-user-internal session))
1174 (elmo-imap4-password
1175 (elmo-get-passwd (elmo-network-session-password-key session))))))
1176 (signal 'elmo-authenticate-error '(login)))))
1179 elmo-network-initialize-session-buffer :after ((session
1180 elmo-imap4-session) buffer)
1181 (with-current-buffer buffer
1182 (mapcar 'make-variable-buffer-local elmo-imap4-local-variables)
1183 (setq elmo-imap4-seqno 0)
1184 (setq elmo-imap4-status 'initial)))
1186 (luna-define-method elmo-network-initialize-session ((session
1187 elmo-imap4-session))
1188 (let ((process (elmo-network-session-process-internal session))
1190 (with-current-buffer (process-buffer process)
1191 ;; Skip garbage output from process before greeting.
1192 (while (and (memq (process-status process) '(open run))
1193 (goto-char (point-max))
1195 (not (elmo-imap4-parse-greeting)))
1196 (accept-process-output process 1))
1197 (set-process-filter process 'elmo-imap4-arrival-filter)
1198 (set-process-sentinel process 'elmo-imap4-sentinel)
1199 ;; (while (and (memq (process-status process) '(open run))
1200 ;; (eq elmo-imap4-status 'initial))
1201 ;; (message "Waiting for server response...")
1202 ;; (accept-process-output process 1))
1204 (unless (memq elmo-imap4-status '(nonauth auth))
1205 (signal 'elmo-open-error
1206 (list 'elmo-network-initialize-session)))
1207 (elmo-imap4-session-set-capability-internal
1209 (elmo-imap4-response-value
1210 (elmo-imap4-send-command-wait session "capability")
1212 (when (eq (elmo-network-stream-type-symbol
1213 (elmo-network-session-stream-type-internal session))
1215 (or (memq 'starttls capability)
1216 (signal 'elmo-open-error
1217 '(elmo-network-initialize-session)))
1218 (elmo-imap4-send-command-wait session "starttls")
1219 (starttls-negotiate process)))))
1221 (luna-define-method elmo-network-authenticate-session ((session
1222 elmo-imap4-session))
1223 (with-current-buffer (process-buffer
1224 (elmo-network-session-process-internal session))
1225 (unless (eq elmo-imap4-status 'auth)
1226 (unless (or (not (elmo-network-session-auth-internal session))
1227 (eq (elmo-network-session-auth-internal session) 'plain)
1230 (elmo-network-session-auth-internal
1232 (elmo-imap4-session-capability-internal session))
1234 (elmo-network-session-auth-internal session)
1235 elmo-imap4-authenticator-alist)))
1236 (if (or elmo-imap4-force-login
1239 "There's no %s capability in server. continue?"
1240 (elmo-network-session-auth-internal session))))
1241 (elmo-network-session-set-auth-internal session nil)
1242 (signal 'elmo-open-error
1243 '(elmo-network-initialize-session))))
1244 (let ((authenticator
1245 (if (elmo-network-session-auth-internal session)
1247 (elmo-network-session-auth-internal session)
1248 elmo-imap4-authenticator-alist))
1249 'elmo-imap4-login)))
1250 (funcall authenticator session)))))
1252 (luna-define-method elmo-network-setup-session ((session
1253 elmo-imap4-session))
1254 (with-current-buffer (elmo-network-session-buffer session)
1255 (when (memq 'namespace (elmo-imap4-session-capability-internal session))
1256 (setq elmo-imap4-server-namespace
1257 (elmo-imap4-response-value
1258 (elmo-imap4-send-command-wait session "namespace")
1261 (defun elmo-imap4-setup-send-buffer (string)
1262 (let ((tmp-buf (get-buffer-create " *elmo-imap4-setup-send-buffer*")))
1265 (set-buffer tmp-buf)
1267 (elmo-set-buffer-multibyte nil)
1269 (goto-char (point-min))
1270 (if (eq (re-search-forward "^$" nil t)
1273 (goto-char (point-min))
1274 (while (search-forward "\n" nil t)
1275 (replace-match "\r\n"))))
1278 (defun elmo-imap4-read-part (folder msg part)
1279 (let* ((spec (elmo-folder-get-spec folder))
1280 (session (elmo-imap4-get-session spec)))
1281 (elmo-imap4-session-select-mailbox session
1282 (elmo-imap4-spec-mailbox spec))
1283 (with-current-buffer (elmo-network-session-buffer session)
1284 (setq elmo-imap4-fetch-callback nil)
1285 (setq elmo-imap4-fetch-callback-data nil))
1287 (elmo-imap4-response-bodydetail-text
1288 (elmo-imap4-response-value-all
1289 (elmo-imap4-send-command-wait session
1291 (if elmo-imap4-use-uid
1292 "uid fetch %s body.peek[%s]"
1293 "fetch %s body.peek[%s]")
1297 (defun elmo-imap4-prefetch-msg (spec msg outbuf)
1298 (elmo-imap4-read-msg spec msg outbuf 'unseen))
1300 (defun elmo-imap4-read-msg (spec msg outbuf
1301 &optional leave-seen-flag-untouched)
1302 (let ((session (elmo-imap4-get-session spec))
1304 (elmo-imap4-session-select-mailbox session
1305 (elmo-imap4-spec-mailbox spec))
1306 (with-current-buffer (elmo-network-session-buffer session)
1307 (setq elmo-imap4-fetch-callback nil)
1308 (setq elmo-imap4-fetch-callback-data nil))
1310 (elmo-imap4-send-command-wait session
1312 (if elmo-imap4-use-uid
1313 "uid fetch %s rfc822%s"
1314 "fetch %s rfc822%s")
1316 (if leave-seen-flag-untouched
1318 (and (setq response (elmo-imap4-response-value
1319 (elmo-imap4-response-value-all
1322 (with-current-buffer outbuf
1325 (elmo-delete-cr-get-content-type)))))
1327 (defun elmo-imap4-setup-send-buffer-from-file (file)
1328 (let ((tmp-buf (get-buffer-create
1329 " *elmo-imap4-setup-send-buffer-from-file*")))
1332 (set-buffer tmp-buf)
1334 (as-binary-input-file
1335 (insert-file-contents file))
1336 (goto-char (point-min))
1337 (if (eq (re-search-forward "^$" nil t)
1340 (goto-char (point-min))
1341 (while (search-forward "\n" nil t)
1342 (replace-match "\r\n"))))
1345 (defun elmo-imap4-delete-msgids (spec msgids)
1346 "If actual message-id is matched, then delete it."
1347 (let ((message-ids msgids)
1349 (num (length msgids)))
1352 (message "Deleting message...%d/%d" i num)
1353 (elmo-imap4-delete-msg-by-id spec (car message-ids))
1354 (setq message-ids (cdr message-ids)))
1355 (elmo-imap4-send-command-wait (elmo-imap4-get-session spec) "expunge")))
1357 (defun elmo-imap4-delete-msg-by-id (spec msgid)
1358 (let ((session (elmo-imap4-get-session spec)))
1359 (elmo-imap4-session-select-mailbox session
1360 (elmo-imap4-spec-mailbox spec))
1361 (elmo-imap4-delete-msgs-no-expunge
1363 (elmo-imap4-response-value
1364 (elmo-imap4-send-command-wait session
1366 (if elmo-imap4-use-uid
1367 "uid search header message-id "
1368 "search header message-id ")
1369 (elmo-imap4-field-body msgid)))
1372 (defun elmo-imap4-append-msg-by-id (spec msgid)
1373 (let ((session (elmo-imap4-get-session spec))
1375 (elmo-imap4-session-select-mailbox session
1376 (elmo-imap4-spec-mailbox spec))
1377 (setq send-buf (elmo-imap4-setup-send-buffer-from-file
1378 (elmo-cache-get-path msgid)))
1380 (elmo-imap4-send-command-wait
1384 (elmo-imap4-mailbox (elmo-imap4-spec-mailbox spec))
1386 (elmo-imap4-buffer-literal send-buf)))
1387 (kill-buffer send-buf)))
1390 (defun elmo-imap4-append-msg (spec string &optional msg no-see)
1391 (let ((session (elmo-imap4-get-session spec))
1393 (elmo-imap4-session-select-mailbox session
1394 (elmo-imap4-spec-mailbox spec))
1395 (setq send-buf (elmo-imap4-setup-send-buffer string))
1397 (elmo-imap4-send-command-wait
1401 (elmo-imap4-mailbox (elmo-imap4-spec-mailbox spec))
1402 (if no-see " " " (\\Seen) ")
1403 (elmo-imap4-buffer-literal send-buf)))
1404 (kill-buffer send-buf)))
1407 (defun elmo-imap4-copy-msgs (dst-spec
1408 msgs src-spec &optional expunge-it same-number)
1409 "Equivalence of hostname, username is assumed."
1410 (let ((session (elmo-imap4-get-session src-spec)))
1411 (elmo-imap4-session-select-mailbox session
1412 (elmo-imap4-spec-mailbox src-spec))
1414 (elmo-imap4-send-command-wait session
1417 (if elmo-imap4-use-uid
1422 (elmo-imap4-spec-mailbox dst-spec))))
1423 (setq msgs (cdr msgs)))
1425 (elmo-imap4-send-command-wait session "expunge"))
1428 (defun elmo-imap4-server-diff-async-callback-1 (status data)
1429 (funcall elmo-imap4-server-diff-async-callback
1430 (cons (elmo-imap4-response-value status 'unseen)
1431 (elmo-imap4-response-value status 'messages))
1434 (defun elmo-imap4-server-diff-async (spec)
1435 (let ((session (elmo-imap4-get-session spec)))
1437 ;; (elmo-imap4-commit spec)
1438 (with-current-buffer (elmo-network-session-buffer session)
1439 (setq elmo-imap4-status-callback
1440 'elmo-imap4-server-diff-async-callback-1)
1441 (setq elmo-imap4-status-callback-data
1442 elmo-imap4-server-diff-async-callback-data))
1443 (elmo-imap4-send-command session
1447 (elmo-imap4-spec-mailbox spec))
1448 " (unseen messages)"))))
1450 (defun elmo-imap4-server-diff (spec)
1452 (let ((session (elmo-imap4-get-session spec))
1455 ; (elmo-imap4-commit spec)
1456 (with-current-buffer (elmo-network-session-buffer session)
1457 (setq elmo-imap4-status-callback nil)
1458 (setq elmo-imap4-status-callback-data nil))
1460 (elmo-imap4-send-command-wait session
1464 (elmo-imap4-spec-mailbox spec))
1465 " (unseen messages)")))
1466 (setq response (elmo-imap4-response-value response 'status))
1467 (cons (elmo-imap4-response-value response 'unseen)
1468 (elmo-imap4-response-value response 'messages))))
1470 (defun elmo-imap4-use-cache-p (spec number)
1471 elmo-imap4-use-cache)
1473 (defun elmo-imap4-local-file-p (spec number)
1476 (defun elmo-imap4-port-label (spec)
1478 (if (elmo-imap4-spec-stream-type spec)
1479 (concat "!" (symbol-name
1480 (elmo-network-stream-type-symbol
1481 (elmo-imap4-spec-stream-type spec)))))))
1484 (defsubst elmo-imap4-portinfo (spec)
1485 (list (elmo-imap4-spec-hostname spec) (elmo-imap4-spec-port spec)))
1487 (defun elmo-imap4-plugged-p (spec)
1488 (apply 'elmo-plugged-p
1489 (append (elmo-imap4-portinfo spec)
1490 (list nil (quote (elmo-imap4-port-label spec))))))
1492 (defun elmo-imap4-set-plugged (spec plugged add)
1493 (apply 'elmo-set-plugged plugged
1494 (append (elmo-imap4-portinfo spec)
1495 (list nil nil (quote (elmo-imap4-port-label spec)) add))))
1497 (defalias 'elmo-imap4-sync-number-alist 'elmo-generic-sync-number-alist)
1501 (defvar elmo-imap4-server-eol "\r\n"
1502 "The EOL string sent from the server.")
1504 (defvar elmo-imap4-client-eol "\r\n"
1505 "The EOL string we send to the server.")
1507 (defvar elmo-imap4-status nil)
1508 (defvar elmo-imap4-reached-tag nil)
1510 (defun elmo-imap4-find-next-line ()
1511 "Return point at end of current line, taking into account literals.
1512 Return nil if no complete line has arrived."
1513 (when (re-search-forward (concat elmo-imap4-server-eol "\\|{\\([0-9]+\\)}"
1514 elmo-imap4-server-eol)
1516 (if (match-string 1)
1517 (if (< (point-max) (+ (point) (string-to-number (match-string 1))))
1519 (goto-char (+ (point) (string-to-number (match-string 1))))
1520 (elmo-imap4-find-next-line))
1523 (defun elmo-imap4-sentinel (process string)
1524 (delete-process process))
1526 (defun elmo-imap4-arrival-filter (proc string)
1527 "IMAP process filter."
1528 (with-current-buffer (process-buffer proc)
1529 (elmo-imap4-debug "-> %s" string)
1530 (goto-char (point-max))
1533 (goto-char (point-min))
1534 (while (setq end (elmo-imap4-find-next-line))
1536 (narrow-to-region (point-min) end)
1537 (delete-backward-char (length elmo-imap4-server-eol))
1538 (goto-char (point-min))
1540 (cond ((eq elmo-imap4-status 'initial)
1541 (setq elmo-imap4-current-response
1543 (list 'greeting (elmo-imap4-parse-greeting)))))
1544 ((or (eq elmo-imap4-status 'auth)
1545 (eq elmo-imap4-status 'nonauth)
1546 (eq elmo-imap4-status 'selected)
1547 (eq elmo-imap4-status 'examine))
1548 (setq elmo-imap4-current-response
1550 (elmo-imap4-parse-response)
1551 elmo-imap4-current-response)))
1553 (message "Unknown state %s in arrival filter"
1554 elmo-imap4-status))))
1555 (delete-region (point-min) (point-max)))))))
1559 (defsubst elmo-imap4-forward ()
1560 (or (eobp) (forward-char 1)))
1562 (defsubst elmo-imap4-parse-number ()
1563 (when (looking-at "[0-9]+")
1565 (string-to-number (match-string 0))
1566 (goto-char (match-end 0)))))
1568 (defsubst elmo-imap4-parse-literal ()
1569 (when (looking-at "{\\([0-9]+\\)}\r\n")
1570 (let ((pos (match-end 0))
1571 (len (string-to-number (match-string 1))))
1572 (if (< (point-max) (+ pos len))
1574 (goto-char (+ pos len))
1575 (buffer-substring pos (+ pos len))))))
1576 ;(list ' pos (+ pos len))))))
1578 (defsubst elmo-imap4-parse-string ()
1579 (cond ((eq (char-after (point)) ?\")
1581 (let ((p (point)) (name ""))
1582 (skip-chars-forward "^\"\\\\")
1583 (setq name (buffer-substring p (point)))
1584 (while (eq (char-after (point)) ?\\)
1585 (setq p (1+ (point)))
1587 (skip-chars-forward "^\"\\\\")
1588 (setq name (concat name (buffer-substring p (point)))))
1591 ((eq (char-after (point)) ?{)
1592 (elmo-imap4-parse-literal))))
1594 (defsubst elmo-imap4-parse-nil ()
1595 (if (looking-at "NIL")
1596 (goto-char (match-end 0))))
1598 (defsubst elmo-imap4-parse-nstring ()
1599 (or (elmo-imap4-parse-string)
1600 (and (elmo-imap4-parse-nil)
1603 (defsubst elmo-imap4-parse-astring ()
1604 (or (elmo-imap4-parse-string)
1605 (buffer-substring (point)
1606 (if (re-search-forward "[(){ \r\n%*\"\\]" nil t)
1607 (goto-char (1- (match-end 0)))
1611 (defsubst elmo-imap4-parse-address ()
1613 (when (eq (char-after (point)) ?\()
1614 (elmo-imap4-forward)
1615 (setq address (vector (prog1 (elmo-imap4-parse-nstring)
1616 (elmo-imap4-forward))
1617 (prog1 (elmo-imap4-parse-nstring)
1618 (elmo-imap4-forward))
1619 (prog1 (elmo-imap4-parse-nstring)
1620 (elmo-imap4-forward))
1621 (elmo-imap4-parse-nstring)))
1622 (when (eq (char-after (point)) ?\))
1623 (elmo-imap4-forward)
1626 (defsubst elmo-imap4-parse-address-list ()
1627 (if (eq (char-after (point)) ?\()
1628 (let (address addresses)
1629 (elmo-imap4-forward)
1630 (while (and (not (eq (char-after (point)) ?\)))
1631 ;; next line for MS Exchange bug
1632 (progn (and (eq (char-after (point)) ? ) (elmo-imap4-forward)) t)
1633 (setq address (elmo-imap4-parse-address)))
1634 (setq addresses (cons address addresses)))
1635 (when (eq (char-after (point)) ?\))
1636 (elmo-imap4-forward)
1637 (nreverse addresses)))
1638 (assert (elmo-imap4-parse-nil))))
1640 (defsubst elmo-imap4-parse-mailbox ()
1641 (let ((mailbox (elmo-imap4-parse-astring)))
1642 (if (string-equal "INBOX" (upcase mailbox))
1646 (defun elmo-imap4-parse-greeting ()
1647 "Parse a IMAP greeting."
1648 (cond ((looking-at "\\* OK ")
1649 (setq elmo-imap4-status 'nonauth))
1650 ((looking-at "\\* PREAUTH ")
1651 (setq elmo-imap4-status 'auth))
1652 ((looking-at "\\* BYE ")
1653 (setq elmo-imap4-status 'closed))))
1655 (defun elmo-imap4-parse-response ()
1656 "Parse a IMAP command response."
1658 (case (setq token (elmo-read (current-buffer)))
1660 (skip-chars-forward " ")
1661 (list 'continue-req (buffer-substring (point) (point-max)))))
1662 (* (case (prog1 (setq token (elmo-read (current-buffer)))
1663 (elmo-imap4-forward))
1664 (OK (elmo-imap4-parse-resp-text-code))
1665 (NO (elmo-imap4-parse-resp-text-code))
1666 (BAD (elmo-imap4-parse-resp-text-code))
1667 (BYE (elmo-imap4-parse-bye))
1669 (elmo-imap4-parse-flag-list)))
1670 (LIST (list 'list (elmo-imap4-parse-data-list)))
1671 (LSUB (list 'lsub (elmo-imap4-parse-data-list)))
1674 (elmo-read (concat "("
1675 (buffer-substring (point) (point-max))
1677 (STATUS (elmo-imap4-parse-status))
1679 (NAMESPACE (elmo-imap4-parse-namespace))
1680 (CAPABILITY (list 'capability
1682 (concat "(" (downcase (buffer-substring
1683 (point) (point-max)))
1685 (ACL (elmo-imap4-parse-acl))
1686 (t (case (prog1 (elmo-read (current-buffer))
1687 (elmo-imap4-forward))
1688 (EXISTS (list 'exists token))
1689 (RECENT (list 'recent token))
1690 (EXPUNGE (list 'expunge token))
1691 (FETCH (elmo-imap4-parse-fetch token))
1692 (t (list 'garbage (buffer-string)))))))
1693 (t (if (not (string-match elmo-imap4-seq-prefix (symbol-name token)))
1694 (list 'garbage (buffer-string))
1695 (case (prog1 (elmo-read (current-buffer))
1696 (elmo-imap4-forward))
1698 (setq elmo-imap4-parsing nil)
1699 (elmo-imap4-debug "*%s* OK arrived" token)
1700 (setq elmo-imap4-reached-tag token)
1701 (list 'ok (elmo-imap4-parse-resp-text-code))))
1703 (setq elmo-imap4-parsing nil)
1704 (elmo-imap4-debug "*%s* NO arrived" token)
1705 (setq elmo-imap4-reached-tag token)
1707 (when (eq (char-after (point)) ?\[)
1708 (setq code (buffer-substring (point)
1709 (search-forward "]")))
1710 (elmo-imap4-forward))
1711 (setq text (buffer-substring (point) (point-max)))
1712 (list 'no (list code text)))))
1714 (setq elmo-imap4-parsing nil)
1715 (elmo-imap4-debug "*%s* BAD arrived" token)
1716 (setq elmo-imap4-reached-tag token)
1718 (when (eq (char-after (point)) ?\[)
1719 (setq code (buffer-substring (point)
1720 (search-forward "]")))
1721 (elmo-imap4-forward))
1722 (setq text (buffer-substring (point) (point-max)))
1723 (list 'bad (list code text)))))
1724 (t (list 'garbage (buffer-string)))))))))
1726 (defun elmo-imap4-parse-bye ()
1728 (when (eq (char-after (point)) ?\[)
1729 (setq code (buffer-substring (point)
1730 (search-forward "]")))
1731 (elmo-imap4-forward))
1732 (setq text (buffer-substring (point) (point-max)))
1733 (list 'bye (list code text))))
1735 (defun elmo-imap4-parse-text ()
1736 (goto-char (point-min))
1737 (when (search-forward "[" nil t)
1738 (search-forward "]")
1739 (elmo-imap4-forward))
1740 (list 'text (buffer-substring (point) (point-max))))
1742 (defun elmo-imap4-parse-resp-text-code ()
1743 (when (eq (char-after (point)) ?\[)
1744 (elmo-imap4-forward)
1745 (cond ((search-forward "PERMANENTFLAGS " nil t)
1746 (list 'permanentflags (elmo-imap4-parse-flag-list)))
1747 ((search-forward "UIDNEXT " nil t)
1748 (list 'uidnext (elmo-read (current-buffer))))
1749 ((search-forward "UNSEEN " nil t)
1750 (list 'unseen (elmo-read (current-buffer))))
1751 ((looking-at "UIDVALIDITY \\([0-9]+\\)")
1752 (list 'uidvalidity (match-string 1)))
1753 ((search-forward "READ-ONLY" nil t)
1754 (list 'read-only t))
1755 ((search-forward "READ-WRITE" nil t)
1756 (list 'read-write t))
1757 ((search-forward "NEWNAME " nil t)
1758 (let (oldname newname)
1759 (setq oldname (elmo-imap4-parse-string))
1760 (elmo-imap4-forward)
1761 (setq newname (elmo-imap4-parse-string))
1762 (list 'newname newname oldname)))
1763 ((search-forward "TRYCREATE" nil t)
1764 (list 'trycreate t))
1765 ((looking-at "APPENDUID \\([0-9]+\\) \\([0-9]+\\)")
1767 (list (match-string 1)
1768 (string-to-number (match-string 2)))))
1769 ((looking-at "COPYUID \\([0-9]+\\) \\([0-9,:]+\\) \\([0-9,:]+\\)")
1770 (list 'copyuid (list (match-string 1)
1773 ((search-forward "ALERT] " nil t)
1774 (message "IMAP server information: %s"
1775 (buffer-substring (point) (point-max))))
1776 (t (list 'unknown)))))
1778 (defun elmo-imap4-parse-data-list ()
1779 (let (flags delimiter mailbox)
1780 (setq flags (elmo-imap4-parse-flag-list))
1781 (when (looking-at " NIL\\| \"\\\\?\\(.\\)\"")
1782 (setq delimiter (match-string 1))
1783 (goto-char (1+ (match-end 0)))
1784 (when (setq mailbox (elmo-imap4-parse-mailbox))
1785 (list mailbox flags delimiter)))))
1787 (defsubst elmo-imap4-parse-header-list ()
1788 (when (eq (char-after (point)) ?\()
1790 (while (not (eq (char-after (point)) ?\)))
1791 (elmo-imap4-forward)
1792 (push (elmo-imap4-parse-astring) strlist))
1793 (elmo-imap4-forward)
1794 (nreverse strlist))))
1796 (defsubst elmo-imap4-parse-fetch-body-section ()
1798 (buffer-substring (point)
1800 (progn (re-search-forward "[] ]" nil t)
1802 (if (eq (char-before) ? )
1804 (mapconcat 'identity
1805 (cons section (elmo-imap4-parse-header-list)) " ")
1806 (search-forward "]" nil t))
1809 (defun elmo-imap4-parse-fetch (response)
1810 (when (eq (char-after (point)) ?\()
1812 (while (not (eq (char-after (point)) ?\)))
1813 (elmo-imap4-forward)
1814 (let ((token (elmo-imap4-fetch-read (current-buffer))))
1815 (elmo-imap4-forward)
1817 (cond ((eq token 'UID)
1818 (list 'uid (condition-case nil
1819 (elmo-read (current-buffer))
1822 (list 'flags (elmo-imap4-parse-flag-list)))
1823 ((eq token 'ENVELOPE)
1824 (list 'envelope (elmo-imap4-parse-envelope)))
1825 ((eq token 'INTERNALDATE)
1826 (list 'internaldate (elmo-imap4-parse-string)))
1828 (list 'rfc822 (elmo-imap4-parse-nstring)))
1829 ((eq token (intern elmo-imap4-rfc822-header))
1830 (list 'rfc822header (elmo-imap4-parse-nstring)))
1831 ((eq token (intern elmo-imap4-rfc822-text))
1832 (list 'rfc822text (elmo-imap4-parse-nstring)))
1833 ((eq token (intern elmo-imap4-rfc822-size))
1834 (list 'rfc822size (elmo-read (current-buffer))))
1836 (if (eq (char-before) ?\[)
1839 (upcase (elmo-imap4-parse-fetch-body-section))
1841 (eq (char-after (point)) ?<)
1842 (buffer-substring (1+ (point))
1844 (search-forward ">" nil t)
1846 (progn (elmo-imap4-forward)
1847 (elmo-imap4-parse-nstring)))
1848 (list 'body (elmo-imap4-parse-body))))
1849 ((eq token 'BODYSTRUCTURE)
1850 (list 'bodystructure (elmo-imap4-parse-body)))))
1851 (setq list (cons element list))))
1852 (and elmo-imap4-fetch-callback
1853 (elmo-imap4-fetch-callback
1855 elmo-imap4-fetch-callback-data))
1856 (list 'fetch list))))
1858 (defun elmo-imap4-parse-status ()
1859 (let ((mailbox (elmo-imap4-parse-mailbox))
1861 (when (and mailbox (search-forward "(" nil t))
1862 (while (not (eq (char-after (point)) ?\)))
1865 (let ((token (elmo-read (current-buffer))))
1866 (cond ((eq token 'MESSAGES)
1867 (list 'messages (elmo-read (current-buffer))))
1869 (list 'recent (elmo-read (current-buffer))))
1870 ((eq token 'UIDNEXT)
1871 (list 'uidnext (elmo-read (current-buffer))))
1872 ((eq token 'UIDVALIDITY)
1873 (and (looking-at " \\([0-9]+\\)")
1874 (prog1 (list 'uidvalidity (match-string 1))
1875 (goto-char (match-end 1)))))
1877 (list 'unseen (elmo-read (current-buffer))))
1880 "Unknown status data %s in mailbox %s ignored"
1883 (and elmo-imap4-status-callback
1884 (funcall elmo-imap4-status-callback
1886 elmo-imap4-status-callback-data))
1887 (list 'status status)))
1890 (defmacro elmo-imap4-value (value)
1891 (` (if (eq (, value) 'NIL) nil
1894 (defmacro elmo-imap4-nth (pos list)
1895 (` (let ((value (nth (, pos) (, list))))
1896 (elmo-imap4-value value))))
1898 (defun elmo-imap4-parse-namespace ()
1901 (copy-sequence elmo-imap4-extra-namespace-alist)
1902 (elmo-imap4-parse-namespace-subr
1903 (elmo-read (concat "(" (buffer-substring
1904 (point) (point-max))
1907 (defun elmo-imap4-parse-namespace-subr (ns)
1908 (let (prefix delim namespace-alist default-delim)
1909 ;; 0: personal, 1: other, 2: shared
1911 (setq namespace-alist
1912 (nconc namespace-alist
1916 (setq prefix (elmo-imap4-nth 0 namespace)
1917 delim (elmo-imap4-nth 1 namespace))
1918 (if (and prefix delim
1920 (concat (regexp-quote delim) "\\'")
1922 (setq prefix (substring prefix 0
1923 (match-beginning 0))))
1924 (if (eq (length prefix) 0)
1925 (progn (setq default-delim delim) nil)
1928 (if (string= (downcase prefix) "inbox")
1929 "[Ii][Nn][Bb][Oo][Xx]"
1930 (regexp-quote prefix))
1933 (elmo-imap4-nth i ns))))))
1935 (setq namespace-alist
1936 (nconc namespace-alist
1937 (list (cons "^.*$" default-delim)))))
1940 (defun elmo-imap4-parse-acl ()
1941 (let ((mailbox (elmo-imap4-parse-mailbox))
1942 identifier rights acl)
1943 (while (eq (char-after (point)) ?\ )
1944 (elmo-imap4-forward)
1945 (setq identifier (elmo-imap4-parse-astring))
1946 (elmo-imap4-forward)
1947 (setq rights (elmo-imap4-parse-astring))
1948 (setq acl (append acl (list (cons identifier rights)))))
1949 (list 'acl acl mailbox)))
1951 (defun elmo-imap4-parse-flag-list ()
1952 (let ((str (buffer-substring (+ (point) 1)
1953 (progn (search-forward ")" nil t)
1955 (unless (eq (length str) 0)
1956 (split-string str))))
1958 (defun elmo-imap4-parse-envelope ()
1959 (when (eq (char-after (point)) ?\()
1960 (elmo-imap4-forward)
1961 (vector (prog1 (elmo-imap4-parse-nstring);; date
1962 (elmo-imap4-forward))
1963 (prog1 (elmo-imap4-parse-nstring);; subject
1964 (elmo-imap4-forward))
1965 (prog1 (elmo-imap4-parse-address-list);; from
1966 (elmo-imap4-forward))
1967 (prog1 (elmo-imap4-parse-address-list);; sender
1968 (elmo-imap4-forward))
1969 (prog1 (elmo-imap4-parse-address-list);; reply-to
1970 (elmo-imap4-forward))
1971 (prog1 (elmo-imap4-parse-address-list);; to
1972 (elmo-imap4-forward))
1973 (prog1 (elmo-imap4-parse-address-list);; cc
1974 (elmo-imap4-forward))
1975 (prog1 (elmo-imap4-parse-address-list);; bcc
1976 (elmo-imap4-forward))
1977 (prog1 (elmo-imap4-parse-nstring);; in-reply-to
1978 (elmo-imap4-forward))
1979 (prog1 (elmo-imap4-parse-nstring);; message-id
1980 (elmo-imap4-forward)))))
1982 (defsubst elmo-imap4-parse-string-list ()
1983 (cond ((eq (char-after (point)) ?\();; body-fld-param
1985 (elmo-imap4-forward)
1986 (while (setq str (elmo-imap4-parse-string))
1988 (elmo-imap4-forward))
1989 (nreverse strlist)))
1990 ((elmo-imap4-parse-nil)
1993 (defun elmo-imap4-parse-body-extension ()
1994 (if (eq (char-after (point)) ?\()
1996 (elmo-imap4-forward)
1997 (push (elmo-imap4-parse-body-extension) b-e)
1998 (while (eq (char-after (point)) ?\ )
1999 (elmo-imap4-forward)
2000 (push (elmo-imap4-parse-body-extension) b-e))
2001 (assert (eq (char-after (point)) ?\)))
2002 (elmo-imap4-forward)
2004 (or (elmo-imap4-parse-number)
2005 (elmo-imap4-parse-nstring))))
2007 (defsubst elmo-imap4-parse-body-ext ()
2009 (when (eq (char-after (point)) ?\ );; body-fld-dsp
2010 (elmo-imap4-forward)
2012 (if (eq (char-after (point)) ?\()
2014 (elmo-imap4-forward)
2015 (push (elmo-imap4-parse-string) dsp)
2016 (elmo-imap4-forward)
2017 (push (elmo-imap4-parse-string-list) dsp)
2018 (elmo-imap4-forward))
2019 (assert (elmo-imap4-parse-nil)))
2020 (push (nreverse dsp) ext))
2021 (when (eq (char-after (point)) ?\ );; body-fld-lang
2022 (elmo-imap4-forward)
2023 (if (eq (char-after (point)) ?\()
2024 (push (elmo-imap4-parse-string-list) ext)
2025 (push (elmo-imap4-parse-nstring) ext))
2026 (while (eq (char-after (point)) ?\ );; body-extension
2027 (elmo-imap4-forward)
2028 (setq ext (append (elmo-imap4-parse-body-extension) ext)))))
2031 (defun elmo-imap4-parse-body ()
2033 (when (eq (char-after (point)) ?\()
2034 (elmo-imap4-forward)
2035 (if (eq (char-after (point)) ?\()
2037 (while (and (eq (char-after (point)) ?\()
2038 (setq subbody (elmo-imap4-parse-body)))
2039 (push subbody body))
2040 (elmo-imap4-forward)
2041 (push (elmo-imap4-parse-string) body);; media-subtype
2042 (when (eq (char-after (point)) ?\ );; body-ext-mpart:
2043 (elmo-imap4-forward)
2044 (if (eq (char-after (point)) ?\();; body-fld-param
2045 (push (elmo-imap4-parse-string-list) body)
2046 (push (and (elmo-imap4-parse-nil) nil) body))
2048 (append (elmo-imap4-parse-body-ext) body)));; body-ext-...
2049 (assert (eq (char-after (point)) ?\)))
2050 (elmo-imap4-forward)
2053 (push (elmo-imap4-parse-string) body);; media-type
2054 (elmo-imap4-forward)
2055 (push (elmo-imap4-parse-string) body);; media-subtype
2056 (elmo-imap4-forward)
2057 ;; next line for Sun SIMS bug
2058 (and (eq (char-after (point)) ? ) (elmo-imap4-forward))
2059 (if (eq (char-after (point)) ?\();; body-fld-param
2060 (push (elmo-imap4-parse-string-list) body)
2061 (push (and (elmo-imap4-parse-nil) nil) body))
2062 (elmo-imap4-forward)
2063 (push (elmo-imap4-parse-nstring) body);; body-fld-id
2064 (elmo-imap4-forward)
2065 (push (elmo-imap4-parse-nstring) body);; body-fld-desc
2066 (elmo-imap4-forward)
2067 (push (elmo-imap4-parse-string) body);; body-fld-enc
2068 (elmo-imap4-forward)
2069 (push (elmo-imap4-parse-number) body);; body-fld-octets
2071 ;; ok, we're done parsing the required parts, what comes now is one
2074 ;; envelope (then we're parsing body-type-msg)
2075 ;; body-fld-lines (then we're parsing body-type-text)
2076 ;; body-ext-1part (then we're parsing body-type-basic)
2078 ;; the problem is that the two first are in turn optionally followed
2079 ;; by the third. So we parse the first two here (if there are any)...
2081 (when (eq (char-after (point)) ?\ )
2082 (elmo-imap4-forward)
2084 (cond ((eq (char-after (point)) ?\();; body-type-msg:
2085 (push (elmo-imap4-parse-envelope) body);; envelope
2086 (elmo-imap4-forward)
2087 (push (elmo-imap4-parse-body) body);; body
2088 (elmo-imap4-forward)
2089 (push (elmo-imap4-parse-number) body));; body-fld-lines
2090 ((setq lines (elmo-imap4-parse-number));; body-type-text:
2091 (push lines body));; body-fld-lines
2093 (backward-char)))));; no match...
2095 ;; ...and then parse the third one here...
2097 (when (eq (char-after (point)) ?\ );; body-ext-1part:
2098 (elmo-imap4-forward)
2099 (push (elmo-imap4-parse-nstring) body);; body-fld-md5
2101 (append (elmo-imap4-parse-body-ext) body)));; body-ext-1part..
2103 (assert (eq (char-after (point)) ?\)))
2104 (elmo-imap4-forward)
2108 (product-provide (provide 'elmo-imap4) (require 'elmo-version))
2110 ;;; elmo-imap4.el ends here