elmo/elmo-imap4.el

   1 ;;; elmo-imap4.el --- IMAP4 Interface for ELMO.
   2
   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>
   7
   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
  13
  14 ;; This file is part of ELMO (Elisp Library for Message Orchestration).
  15
  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)
  19 ;; any later version.
  20 ;;
  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.
  25 ;;
  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.
  30 ;;
  31
  32 ;;; Commentary:
  33 ;;
  34 ;; Origin of IMAP parser part is imap.el, included in Gnus.
  35 ;;
  36 ;;    Copyright (C) 1998, 1999, 2000
  37 ;;    Free Software Foundation, Inc.
  38 ;;    Author: Simon Josefsson <jas@pdc.kth.se>
  39 ;;
  40
  41 ;;; Code:
  42 (require 'elmo-vars)
  43 (require 'elmo-util)
  44 (require 'elmo-date)
  45 (require 'elmo-msgdb)
  46 (require 'elmo-cache)
  47 (require 'elmo)
  48 (require 'elmo-net)
  49 (require 'utf7)
  50 (require 'elmo-mime)
  51 (require 'time-stamp)
  52
  53 (eval-when-compile (require 'cl))
  54
  55 (defvar elmo-imap4-disuse-server-flag-mailbox-regexp "^#mh" ; UW imapd
  56   "Regexp to match IMAP4 mailbox names whose message flags on server should be ignored (For STATUS command).")
  57
  58 (defvar elmo-imap4-overview-fetch-chop-length 200
  59   "*Number of overviews to fetch in one request.")
  60
  61 ;; c.f. rfc2683 3.2.1.5 Long Command Lines
  62 ;;
  63 ;; "A client should limit the length of the command lines it generates
  64 ;;  to approximately 1000 octets (including all quoted strings but not
  65 ;;  including literals). If the client is unable to group things into
  66 ;;  ranges so that the command line is within that length, it should
  67 ;;  split the request into multiple commands. The client should use
  68 ;;  literals instead of long quoted strings, in order to keep the command
  69 ;;  length down.
  70 ;;  For its part, a server should allow for a command line of at least
  71 ;;  8000 octets. This provides plenty of leeway for accepting reasonable
  72 ;;  length commands from clients. The server should send a BAD response
  73 ;;  to a command that does not end within the server's maximum accepted
  74 ;;  command length. "
  75
  76 ;; To limit command line length, chop number set.
  77 (defvar elmo-imap4-number-set-chop-length 1000
  78   "*Number of messages to specify as a number-set argument for one request.")
  79
  80 (defvar elmo-imap4-force-login nil
  81   "*Non-nil forces to try 'login' if there is no 'auth' capability in imapd.")
  82
  83 (defvar elmo-imap4-use-select-to-update-status nil
  84   "*Some imapd have to send select command to update status.
  85 \(ex. UW imapd 4.5-BETA?\).  For these imapd, you must set this variable t.")
  86
  87 (defvar elmo-imap4-use-modified-utf7 nil
  88   "*Use mofidied UTF-7 (rfc2060) encoding for IMAP4 folder name.")
  89
  90 (defvar elmo-imap4-use-cache t
  91   "Use cache in imap4 folder.")
  92
  93 (defvar elmo-imap4-extra-namespace-alist
  94   '(("^\\({.*/nntp}\\).*$" . ".")) ; Default is for UW's remote nntp mailbox...
  95   "Extra namespace alist.
  96 A list of cons cell like: (REGEXP . DELIMITER).
  97 REGEXP should have a grouping for namespace prefix.")
  98
  99 (defvar elmo-imap4-disabled-extensions nil
 100   "List of server extensions that are disabled on the client side.")
 101
 102 ;;
 103 ;;; internal variables
 104 ;;
 105 (defvar elmo-imap4-seq-prefix "elmo-imap4")
 106 (defvar elmo-imap4-seqno 0)
 107 (defvar elmo-imap4-use-uid t
 108   "Use UID as message number.")
 109
 110 (defvar elmo-imap4-current-response nil)
 111 (defvar elmo-imap4-status nil)
 112 (defvar elmo-imap4-reached-tag "elmo-imap40")
 113
 114 ;;; buffer local variables
 115 (defvar elmo-imap4-default-hierarchy-delimiter "/")
 116
 117 (defvar elmo-imap4-server-capability nil)
 118 (defvar elmo-imap4-server-namespace nil)
 119
 120 (defvar elmo-imap4-parsing nil) ; indicates parsing.
 121
 122 (defvar elmo-imap4-fetch-callback nil)
 123 (defvar elmo-imap4-fetch-callback-data nil)
 124 (defvar elmo-imap4-status-callback nil)
 125 (defvar elmo-imap4-status-callback-data nil)
 126
 127 (defvar elmo-imap4-server-diff-async-callback nil)
 128 (defvar elmo-imap4-server-diff-async-callback-data nil)
 129
 130 ;;; progress...(no use?)
 131 (defvar elmo-imap4-count-progress nil)
 132 (defvar elmo-imap4-count-progress-message nil)
 133 (defvar elmo-imap4-progress-count nil)
 134
 135 ;;; XXX Temporal implementation
 136 (defvar elmo-imap4-current-msgdb nil)
 137 (defvar elmo-imap4-seen-messages nil)
 138
 139 (defvar elmo-imap4-local-variables
 140   '(elmo-imap4-status
 141     elmo-imap4-current-response
 142     elmo-imap4-seqno
 143     elmo-imap4-parsing
 144     elmo-imap4-reached-tag
 145     elmo-imap4-count-progress
 146     elmo-imap4-count-progress-message
 147     elmo-imap4-progress-count
 148     elmo-imap4-fetch-callback
 149     elmo-imap4-fetch-callback-data
 150     elmo-imap4-status-callback
 151     elmo-imap4-status-callback-data
 152     elmo-imap4-current-msgdb
 153     elmo-imap4-seen-messages))
 154
 155 ;;;;
 156
 157 (defconst elmo-imap4-quoted-specials-list '(?\\ ?\"))
 158
 159 (defconst elmo-imap4-non-atom-char-regex
 160   (eval-when-compile
 161     (concat "[^" "]!#$&'+,./0-9:;<=>?@A-Z[^_`a-z|}~-" "]")))
 162
 163 (defconst elmo-imap4-non-text-char-regex
 164   (eval-when-compile
 165     (concat "[^"
 166             "]\x01-\x09\x0b\x0c\x0e-\x1f\x7f !\"#$%&'()*+,./0-9:;<=>?@A-Z[\\^_`a-z{|}~-"
 167             "]")))
 168
 169 (defconst elmo-imap4-literal-threshold 1024
 170  "Limitation of characters that can be used in a quoted string.")
 171
 172 (defconst elmo-imap4-flag-specs '((important "\\Flagged")
 173                                   (read "\\Seen")
 174                                   (unread "\\Seen" 'remove)
 175                                   (answered "\\Answered")
 176                                   ;; draft-melnikov-imap-keywords-03.txt
 177                                   (forwarded "$Forwarded")
 178                                   (work "$Work")
 179                                   (personal "$Personal")
 180                                   (shouldreply "$ShouldReply")))
 181
 182 (defconst elmo-imap4-folder-name-syntax
 183   `(mailbox
 184     (?: [user "^[A-Za-z0-9]"] (?/ [auth ".+"]))
 185     ,@elmo-net-folder-name-syntax))
 186
 187 ;; For debugging.
 188 (defvar elmo-imap4-debug nil
 189   "Non-nil forces IMAP4 folder as debug mode.
 190 Debug information is inserted in the buffer \"*IMAP4 DEBUG*\"")
 191
 192 (defvar elmo-imap4-debug-inhibit-logging nil)
 193
 194 ;;; ELMO IMAP4 folder
 195 (eval-and-compile
 196   (luna-define-class elmo-imap4-folder (elmo-net-folder)
 197                      (mailbox))
 198   (luna-define-internal-accessors 'elmo-imap4-folder))
 199
 200 ;;; Session
 201 (eval-and-compile
 202   (luna-define-class elmo-imap4-session (elmo-network-session)
 203                      (capability current-mailbox read-only flags))
 204   (luna-define-internal-accessors 'elmo-imap4-session))
 205
 206 (defmacro elmo-imap4-session-capable-p (session capability)
 207   `(and (memq ,capability (elmo-imap4-session-capability-internal ,session))
 208         (not (memq ,capability elmo-imap4-disabled-extensions))))
 209
 210 ;;; MIME-ELMO-IMAP Location
 211 (eval-and-compile
 212   (luna-define-class mime-elmo-imap-location
 213                      (mime-imap-location)
 214                      (folder number rawbuf strategy))
 215   (luna-define-internal-accessors 'mime-elmo-imap-location))
 216
 217 ;;; Debug
 218 (defmacro elmo-imap4-debug (message &rest args)
 219   `(if elmo-imap4-debug
 220        (elmo-imap4-debug-1 ,message ,@args)))
 221
 222 (defun elmo-imap4-debug-1 (message &rest args)
 223   (with-current-buffer (get-buffer-create "*IMAP4 DEBUG*")
 224     (goto-char (point-max))
 225     (if elmo-imap4-debug-inhibit-logging
 226         (insert "NO LOGGING\n")
 227       (insert (apply 'format message args) "\n"))))
 228
 229 (defsubst elmo-imap4-decode-folder-string (string)
 230   (if elmo-imap4-use-modified-utf7
 231       (utf7-decode string 'imap)
 232     string))
 233
 234 (defsubst elmo-imap4-encode-folder-string (string)
 235   (if elmo-imap4-use-modified-utf7
 236       (utf7-encode string 'imap)
 237     string))
 238
 239 ;;; Response
 240
 241 (defmacro elmo-imap4-response-continue-req-p (response)
 242   "Returns non-nil if RESPONSE is '+' response."
 243   `(assq 'continue-req ,response))
 244
 245 (defmacro elmo-imap4-response-ok-p (response)
 246   "Returns non-nil if RESPONSE is an 'OK' response."
 247   `(assq 'ok ,response))
 248
 249 (defmacro elmo-imap4-response-bye-p (response)
 250   "Returns non-nil if RESPONSE is an 'BYE' response."
 251   `(assq 'bye ,response))
 252
 253 (defmacro elmo-imap4-response-garbage-p (response)
 254   "Returns non-nil if RESPONSE is an 'garbage' response."
 255   `(assq 'garbage ,response))
 256
 257 (defmacro elmo-imap4-response-value (response symbol)
 258   "Get value of the SYMBOL from RESPONSE."
 259   `(nth 1 (assq ,symbol ,response)))
 260
 261 (defsubst elmo-imap4-response-value-all (response symbol)
 262   "Get all value of the SYMBOL from RESPONSE."
 263   (let (matched)
 264     (while response
 265       (if (eq (car (car response)) symbol)
 266           (setq matched (nconc matched (nth 1 (car response)))))
 267       (setq response (cdr response)))
 268     matched))
 269
 270 (defmacro elmo-imap4-response-error-text (response)
 271   "Returns text of NO, BAD, BYE response."
 272   `(nth 1 (or (elmo-imap4-response-value ,response 'no)
 273               (elmo-imap4-response-value ,response 'bad)
 274               (elmo-imap4-response-value ,response 'bye))))
 275
 276 (defmacro elmo-imap4-response-bodydetail-text (response)
 277   "Returns text of BODY[section]<partial>."
 278   `(nth 3 (assq 'bodydetail ,response)))
 279
 280 ;;; Session commands.
 281
 282 ;;;(defun elmo-imap4-send-command-wait (session command)
 283 ;;;  "Send COMMAND to the SESSION and wait for response.
 284 ;;;Returns RESPONSE (parsed lisp object) of IMAP session."
 285 ;;;  (elmo-imap4-read-response session
 286 ;;;                         (elmo-imap4-send-command
 287 ;;;                          session
 288 ;;;                          command)))
 289
 290 (defun elmo-imap4-send-command-wait (session command)
 291   "Send COMMAND to the SESSION.
 292 Returns RESPONSE (parsed lisp object) of IMAP session.
 293 If response is not `OK', causes error with IMAP response text."
 294   (elmo-imap4-accept-ok session
 295                         (elmo-imap4-send-command
 296                          session
 297                          command)))
 298
 299 (defun elmo-imap4-send-command (session command)
 300   "Send COMMAND to the SESSION.
 301 Returns a TAG string which is assigned to the COMMAND."
 302   (let* ((command-args (if (listp command)
 303                            command
 304                          (list command)))
 305          (process (elmo-network-session-process-internal session))
 306          cmdstr tag token kind)
 307     (with-current-buffer (process-buffer process)
 308       (setq tag (concat elmo-imap4-seq-prefix
 309                         (number-to-string
 310                          (setq elmo-imap4-seqno (+ 1 elmo-imap4-seqno)))))
 311       (setq cmdstr (concat tag " "))
 312 ;;; No need.
 313 ;;;      (erase-buffer)
 314       (goto-char (point-min))
 315       (when (elmo-imap4-response-bye-p elmo-imap4-current-response)
 316         (elmo-imap4-process-bye session))
 317       (setq elmo-imap4-current-response nil)
 318       (when elmo-imap4-parsing
 319         (message "Waiting for IMAP response...")
 320         (accept-process-output (elmo-network-session-process-internal
 321                                 session))
 322         (message "Waiting for IMAP response...done"))
 323       (setq elmo-imap4-parsing t)
 324       (while (setq token (car command-args))
 325         (cond ((stringp token)   ; formatted
 326                (setq cmdstr (concat cmdstr token)))
 327               ((listp token)     ; unformatted
 328                (setq kind (car token))
 329                (cond ((eq kind 'atom)
 330                       (setq cmdstr (concat cmdstr (nth 1 token))))
 331                      ((eq kind 'quoted)
 332                       (setq cmdstr (concat
 333                                     cmdstr
 334                                     (elmo-imap4-format-quoted (nth 1 token)))))
 335                      ((eq kind 'literal)
 336                       (if (elmo-imap4-session-capable-p session 'literal+)
 337                           ;; rfc2088
 338                           (progn
 339                             (setq cmdstr (concat cmdstr
 340                                                  (format "{%d+}" (nth 2 token))
 341                                                  "\r\n"))
 342                             (process-send-string process cmdstr)
 343                             (setq cmdstr nil))
 344                         (setq cmdstr (concat cmdstr
 345                                              (format "{%d}" (nth 2 token))
 346                                              "\r\n"))
 347                         (process-send-string process cmdstr)
 348                         (setq cmdstr nil)
 349                         (elmo-imap4-accept-continue-req session))
 350                       (cond ((stringp (nth 1 token))
 351                              (setq cmdstr (nth 1 token)))
 352                             ((bufferp (nth 1 token))
 353                              (with-current-buffer (nth 1 token)
 354                                (process-send-region
 355                                 process
 356                                 (point-min)
 357                                 (+ (point-min) (nth 2 token)))))
 358                             (t
 359                              (error "Wrong argument for literal"))))
 360                      (t
 361                       (error "Unknown token kind %s" kind))))
 362               (t
 363                (error "Invalid argument")))
 364         (setq command-args (cdr command-args)))
 365       (elmo-imap4-debug "[%s] <- %s" (format-time-string "%T") cmdstr)
 366       (process-send-string process (concat cmdstr "\r\n"))
 367       tag)))
 368
 369 (defun elmo-imap4-send-string (session string)
 370   "Send STRING to the SESSION."
 371   (with-current-buffer (process-buffer
 372                         (elmo-network-session-process-internal session))
 373     (setq elmo-imap4-current-response nil)
 374     (goto-char (point-min))
 375     (elmo-imap4-debug "[%s] <-- %s" (format-time-string "%T") string)
 376     (process-send-string (elmo-network-session-process-internal session)
 377                          string)
 378     (process-send-string (elmo-network-session-process-internal session)
 379                          "\r\n")))
 380
 381 (defun elmo-imap4-read-response (session tag)
 382   "Read parsed response from SESSION.
 383 TAG is the tag of the command"
 384   (with-current-buffer (process-buffer
 385                         (elmo-network-session-process-internal session))
 386     (while (not (or (string= tag elmo-imap4-reached-tag)
 387                     (elmo-imap4-response-bye-p elmo-imap4-current-response)
 388                     (when (elmo-imap4-response-garbage-p
 389                            elmo-imap4-current-response)
 390                       (message "Garbage response: %s"
 391                                (elmo-imap4-response-value
 392                                 elmo-imap4-current-response
 393                                 'garbage))
 394                       t)))
 395       (when (memq (process-status
 396                    (elmo-network-session-process-internal session))
 397                   '(open run))
 398         (accept-process-output (elmo-network-session-process-internal session)
 399                                1)))
 400     (elmo-imap4-debug "[%s] => %s" (format-time-string "%T") (prin1-to-string elmo-imap4-current-response))
 401     (setq elmo-imap4-parsing nil)
 402     elmo-imap4-current-response))
 403
 404 (defsubst elmo-imap4-read-untagged (process)
 405   (with-current-buffer (process-buffer process)
 406     (while (not elmo-imap4-current-response)
 407       (accept-process-output process 1))
 408     (elmo-imap4-debug "[%s] =>%s" (format-time-string "%T") (prin1-to-string elmo-imap4-current-response))
 409     elmo-imap4-current-response))
 410
 411 (defun elmo-imap4-read-continue-req (session)
 412   "Returns a text following to continue-req in SESSION.
 413 If response is not `+' response, returns nil."
 414   (elmo-imap4-response-value
 415    (elmo-imap4-read-untagged
 416     (elmo-network-session-process-internal session))
 417    'continue-req))
 418
 419 (defun elmo-imap4-process-bye (session)
 420   (with-current-buffer (elmo-network-session-buffer session)
 421     (let ((r elmo-imap4-current-response))
 422       (setq elmo-imap4-current-response nil)
 423       (elmo-network-close-session session)
 424       (signal 'elmo-imap4-bye-error
 425               (list (concat (elmo-imap4-response-error-text r))
 426                     "Try Again")))))
 427
 428 (defun elmo-imap4-accept-continue-req (session)
 429   "Returns non-nil if `+' (continue-req) response is arrived in SESSION.
 430 If response is not `+' response, cause an error."
 431   (let (response)
 432     (setq response
 433           (elmo-imap4-read-untagged
 434            (elmo-network-session-process-internal session)))
 435     (or (elmo-imap4-response-continue-req-p response)
 436         (error "IMAP error: %s"
 437                (or (elmo-imap4-response-error-text response)
 438                    "No continut-req from server.")))))
 439
 440 (defun elmo-imap4-read-ok (session tag)
 441   "Returns non-nil if `OK' response of the command with TAG is arrived
 442 in SESSION. If response is not `OK' response, returns nil."
 443   (elmo-imap4-response-ok-p
 444    (elmo-imap4-read-response session tag)))
 445
 446 (defun elmo-imap4-accept-ok (session tag)
 447   "Accept only `OK' response from SESSION.
 448 If response is not `OK' response, causes error with IMAP response text."
 449   (let ((response (elmo-imap4-read-response session tag)))
 450     (if (elmo-imap4-response-ok-p response)
 451         response
 452       (if (elmo-imap4-response-bye-p response)
 453           (elmo-imap4-process-bye session)
 454         (error "IMAP error: %s"
 455                (or (elmo-imap4-response-error-text response)
 456                    "No `OK' response from server."))))))
 457
 458 ;;; MIME-ELMO-IMAP Location
 459 (luna-define-method mime-imap-location-section-body ((location
 460                                                       mime-elmo-imap-location)
 461                                                      section)
 462   (if (and (stringp section)
 463            (string= section "HEADER"))
 464       ;; Even in the section mode, header fields should be saved to the
 465       ;; raw buffer .
 466       (with-current-buffer (mime-elmo-imap-location-rawbuf-internal location)
 467         (erase-buffer)
 468         (elmo-message-fetch
 469          (mime-elmo-imap-location-folder-internal location)
 470          (mime-elmo-imap-location-number-internal location)
 471          (mime-elmo-imap-location-strategy-internal location)
 472          'unseen
 473          section)
 474         (buffer-string))
 475     (elmo-message-fetch-string
 476      (mime-elmo-imap-location-folder-internal location)
 477      (mime-elmo-imap-location-number-internal location)
 478      (mime-elmo-imap-location-strategy-internal location)
 479      'unseen
 480      section)))
 481
 482
 483 (luna-define-method mime-imap-location-bodystructure
 484   ((location mime-elmo-imap-location))
 485   (elmo-message-fetch-bodystructure
 486    (mime-elmo-imap-location-folder-internal location)
 487    (mime-elmo-imap-location-number-internal location)
 488    (mime-elmo-imap-location-strategy-internal location)))
 489
 490 (luna-define-method mime-imap-location-fetch-entity-p
 491   ((location mime-elmo-imap-location) entity)
 492   (or (not elmo-message-displaying) ; Fetching entity to save or force display.
 493       ;; cache exists
 494       (file-exists-p
 495        (expand-file-name
 496         (mmimap-entity-section (mime-entity-node-id-internal entity))
 497         (elmo-fetch-strategy-cache-path
 498          (mime-elmo-imap-location-strategy-internal location))))
 499       ;; not too large to fetch.
 500       (> elmo-message-fetch-threshold
 501          (or (mime-imap-entity-size-internal entity) 0))))
 502
 503 ;;;
 504
 505 (defun elmo-imap4-session-check (session)
 506   (with-current-buffer (elmo-network-session-buffer session)
 507     (setq elmo-imap4-fetch-callback nil)
 508     (setq elmo-imap4-fetch-callback-data nil))
 509   (elmo-imap4-send-command session "check"))
 510
 511 (defun elmo-imap4-atom-p (string)
 512   "Return t if STRING is an atom defined in rfc2060."
 513   (if (string= string "")
 514       nil
 515     (save-match-data
 516       (not (string-match elmo-imap4-non-atom-char-regex string)))))
 517
 518 (defun elmo-imap4-quotable-p (string)
 519   "Return t if STRING can be formatted as a quoted defined in rfc2060."
 520   (save-match-data
 521     (not (string-match elmo-imap4-non-text-char-regex string))))
 522
 523 (defun elmo-imap4-nil (string)
 524   "Return a list represents the special atom \"NIL\" defined in rfc2060, \
 525 if STRING is nil.
 526 Otherwise return nil."
 527   (if (eq string nil)
 528       (list 'atom "NIL")))
 529
 530 (defun elmo-imap4-atom (string)
 531   "Return a list represents STRING as an atom defined in rfc2060.
 532 Return nil if STRING is not an atom.  See `elmo-imap4-atom-p'."
 533   (if (elmo-imap4-atom-p string)
 534       (list 'atom string)))
 535
 536 (defun elmo-imap4-quoted (string)
 537   "Return a list represents STRING as a quoted defined in rfc2060.
 538 Return nil if STRING can not be formatted as a quoted.  See `elmo-imap4-quotable-p'."
 539   (if (elmo-imap4-quotable-p string)
 540       (list 'quoted string)))
 541
 542 (defun elmo-imap4-literal-1 (string-or-buffer length)
 543   "Internal function for `elmo-imap4-literal' and `elmo-imap4-buffer-literal'.
 544 Return a list represents STRING-OR-BUFFER as a literal defined in rfc2060.
 545 STRING-OR-BUFFER must be an encoded string or a single-byte string or a single-byte buffer.
 546 LENGTH must be the number of octets for STRING-OR-BUFFER."
 547   (list 'literal string-or-buffer length))
 548
 549 (defun elmo-imap4-literal (string)
 550   "Return a list represents STRING as a literal defined in rfc2060.
 551 STRING must be an encoded or a single-byte string."
 552   (elmo-imap4-literal-1 string (length string)))
 553
 554 (defun elmo-imap4-buffer-literal (buffer)
 555   "Return a list represents BUFFER as a literal defined in rfc2060.
 556 BUFFER must be a single-byte buffer."
 557   (elmo-imap4-literal-1 buffer (with-current-buffer buffer
 558                                  (buffer-size))))
 559
 560 (defun elmo-imap4-string-1 (string length)
 561   "Internal function for `elmo-imap4-string' and `elmo-imap4-buffer-string'.
 562 Return a list represents STRING as a string defined in rfc2060.
 563 STRING must be an encoded or a single-byte string.
 564 LENGTH must be the number of octets for STRING."
 565   (or (elmo-imap4-quoted string)
 566       (elmo-imap4-literal-1 string length)))
 567
 568 (defun elmo-imap4-string (string)
 569   "Return a list represents STRING as a string defined in rfc2060.
 570 STRING must be an encoded or a single-byte string."
 571   (let ((length (length string)))
 572     (if (< elmo-imap4-literal-threshold length)
 573         (elmo-imap4-literal-1 string length)
 574       (elmo-imap4-string-1 string length))))
 575
 576 (defun elmo-imap4-buffer-string (buffer)
 577   "Return a list represents BUFFER as a string defined in rfc2060.
 578 BUFFER must be a single-byte buffer."
 579   (let ((length (with-current-buffer buffer
 580                   (buffer-size))))
 581     (if (< elmo-imap4-literal-threshold length)
 582         (elmo-imap4-literal-1 buffer length)
 583       (elmo-imap4-string-1 (with-current-buffer buffer
 584                              (buffer-string))
 585                            length))))
 586
 587 (defun elmo-imap4-astring-1 (string length)
 588   "Internal function for `elmo-imap4-astring' and `elmo-imap4-buffer-astring'.
 589 Return a list represents STRING as an astring defined in rfc2060.
 590 STRING must be an encoded or a single-byte string.
 591 LENGTH must be the number of octets for STRING."
 592   (or (elmo-imap4-atom string)
 593       (elmo-imap4-string-1 string length)))
 594
 595 (defun elmo-imap4-astring (string)
 596   "Return a list represents STRING as an astring defined in rfc2060.
 597 STRING must be an encoded or a single-byte string."
 598   (let ((length (length string)))
 599     (if (< elmo-imap4-literal-threshold length)
 600         (elmo-imap4-literal-1 string length)
 601       (elmo-imap4-astring-1 string length))))
 602
 603 (defun elmo-imap4-buffer-astring (buffer)
 604   "Return a list represents BUFFER as an astring defined in rfc2060.
 605 BUFFER must be a single-byte buffer."
 606   (let ((length (with-current-buffer buffer
 607                   (buffer-size))))
 608     (if (< elmo-imap4-literal-threshold length)
 609         (elmo-imap4-literal-1 buffer length)
 610       (elmo-imap4-astring-1 (with-current-buffer buffer
 611                               (buffer-string))
 612                             length))))
 613
 614 (defun elmo-imap4-nstring (string)
 615   "Return a list represents STRING as a nstring defined in rfc2060.
 616 STRING must be an encoded or a single-byte string."
 617    (or (elmo-imap4-nil string)
 618        (elmo-imap4-string string)))
 619
 620 (defun elmo-imap4-buffer-nstring (buffer)
 621   "Return a list represents BUFFER as a nstring defined in rfc2060.
 622 BUFFER must be a single-byte buffer."
 623    (or (elmo-imap4-nil buffer)
 624        (elmo-imap4-buffer-string buffer)))
 625
 626 (defalias 'elmo-imap4-mailbox 'elmo-imap4-astring)
 627 (defalias 'elmo-imap4-field-body 'elmo-imap4-astring)
 628 (defalias 'elmo-imap4-userid 'elmo-imap4-astring)
 629 (defalias 'elmo-imap4-password 'elmo-imap4-astring)
 630
 631 (defun elmo-imap4-format-quoted (string)
 632   "Return STRING in a form of the quoted-string defined in rfc2060."
 633   (concat "\""
 634           (std11-wrap-as-quoted-pairs string elmo-imap4-quoted-specials-list)
 635           "\""))
 636
 637 (defsubst elmo-imap4-response-get-selectable-mailbox-list (response)
 638   (delq nil
 639         (mapcar
 640          (lambda (entry)
 641            (if (and (eq 'list (car entry))
 642                     (not (elmo-string-member-ignore-case "\\Noselect" (nth 1 (nth 1 entry)))))
 643                (car (nth 1 entry))))
 644          response)))
 645
 646 (luna-define-method elmo-message-fetch-bodystructure ((folder
 647                                                        elmo-imap4-folder)
 648                                                       number strategy)
 649   (if (elmo-fetch-strategy-use-cache strategy)
 650       (elmo-object-load
 651        (elmo-file-cache-expand-path
 652         (elmo-fetch-strategy-cache-path strategy)
 653         "bodystructure"))
 654     (let ((session (elmo-imap4-get-session folder))
 655           bodystructure)
 656       (elmo-imap4-session-select-mailbox
 657        session
 658        (elmo-imap4-folder-mailbox-internal folder))
 659       (with-current-buffer (elmo-network-session-buffer session)
 660         (setq elmo-imap4-fetch-callback nil)
 661         (setq elmo-imap4-fetch-callback-data nil))
 662       (prog1 (setq bodystructure
 663                    (elmo-imap4-response-value
 664                     (elmo-imap4-response-value
 665                      (elmo-imap4-send-command-wait
 666                       session
 667                       (format
 668                        (if elmo-imap4-use-uid
 669                            "uid fetch %s bodystructure"
 670                          "fetch %s bodystructure")
 671                        number))
 672                      'fetch)
 673                     'bodystructure))
 674         (when (elmo-fetch-strategy-save-cache strategy)
 675           (elmo-file-cache-delete
 676            (elmo-fetch-strategy-cache-path strategy))
 677           (elmo-object-save
 678            (elmo-file-cache-expand-path
 679             (elmo-fetch-strategy-cache-path strategy)
 680             "bodystructure")
 681            bodystructure))))))
 682
 683 ;;; Backend methods.
 684 (luna-define-method elmo-create-folder-plugged ((folder elmo-imap4-folder))
 685   (elmo-imap4-send-command-wait
 686    (elmo-imap4-get-session folder)
 687    (list "create " (elmo-imap4-mailbox
 688                     (elmo-imap4-folder-mailbox-internal folder)))))
 689
 690 (defun elmo-imap4-get-session (folder &optional if-exists)
 691   (elmo-network-get-session 'elmo-imap4-session
 692                             (concat
 693                              (if (elmo-folder-biff-internal folder)
 694                                  "BIFF-")
 695                              "IMAP")
 696                             folder if-exists))
 697
 698 (defun elmo-imap4-session-select-mailbox (session mailbox
 699                                                   &optional force no-error)
 700   "Select MAILBOX in SESSION.
 701 If optional argument FORCE is non-nil, select mailbox even if current mailbox
 702 is same as MAILBOX.
 703 If second optional argument NO-ERROR is non-nil, don't cause an error when
 704 selecting folder was failed.
 705 If NO-ERROR is 'notify-bye, only BYE response is reported as error.
 706 Returns response value if selecting folder succeed. "
 707   (when (or force
 708             (not (string=
 709                   (elmo-imap4-session-current-mailbox-internal session)
 710                   mailbox)))
 711     (let (response result)
 712       (unwind-protect
 713           (setq response
 714                 (elmo-imap4-read-response
 715                  session
 716                  (elmo-imap4-send-command
 717                   session
 718                   (list
 719                    "select "
 720                    (elmo-imap4-mailbox mailbox)))))
 721         (if (setq result (elmo-imap4-response-ok-p response))
 722             (progn
 723               (elmo-imap4-session-set-current-mailbox-internal session mailbox)
 724               (elmo-imap4-session-set-read-only-internal
 725                session
 726                (nth 1 (assq 'read-only (assq 'ok response))))
 727               (elmo-imap4-session-set-flags-internal
 728                session
 729                (nth 1 (or (assq 'permanentflags response)
 730                           (assq 'flags response)))))
 731           (elmo-imap4-session-set-current-mailbox-internal session nil)
 732           (if (and (eq no-error 'notify-bye)
 733                    (elmo-imap4-response-bye-p response))
 734               (elmo-imap4-process-bye session)
 735             (unless no-error
 736               (error "%s"
 737                      (or (elmo-imap4-response-error-text response)
 738                          (format "Select %s failed" mailbox)))))))
 739       (and result response))))
 740
 741 (defun elmo-imap4-check-validity (spec validity-file)
 742 ;;; Not used.
 743 ;;;(elmo-imap4-send-command-wait
 744 ;;;(elmo-imap4-get-session spec)
 745 ;;;(list "status "
 746 ;;;      (elmo-imap4-mailbox
 747 ;;;       (elmo-imap4-spec-mailbox spec))
 748 ;;;      " (uidvalidity)")))
 749   )
 750
 751 (defun elmo-imap4-sync-validity  (spec validity-file)
 752   ;; Not used.
 753   )
 754
 755 (defun elmo-imap4-elist (folder query tags)
 756   (let ((session (elmo-imap4-get-session folder)))
 757     (elmo-imap4-session-select-mailbox
 758      session
 759      (elmo-imap4-folder-mailbox-internal folder))
 760     (let ((answer (elmo-imap4-response-value
 761                    (elmo-imap4-send-command-wait
 762                     session query) 'esearch))
 763           tag result)
 764       (while answer
 765         (setq tag (intern (downcase (car answer))))
 766         (cond ((eq tag 'uid)
 767                nil)
 768               ((memq tag tags)
 769                (setq result
 770                      (append result
 771                              (if (eq tag 'all)
 772                                  (sort
 773                                   (elmo-number-set-to-number-list
 774                                    (mapcar #'(lambda (x)
 775                                                (let ((y (split-string x ":")))
 776                                                  (if (null (cdr y))
 777                                                      (string-to-number (car y))
 778                                                    (cons (string-to-number (car y))
 779                                                          (string-to-number (cadr y))))))
 780                                            (split-string (cadr answer) "\,"))) '<)
 781                                (string-to-number (cadr answer))))))
 782               (t nil))
 783         (setq answer (cdr answer)))
 784       result)))
 785
 786 (defun elmo-imap4-list (folder flag)
 787   (let ((session (elmo-imap4-get-session folder)))
 788     (elmo-imap4-session-select-mailbox
 789      session
 790      (elmo-imap4-folder-mailbox-internal folder))
 791     (if (elmo-imap4-session-capable-p session 'esearch)
 792         (elmo-imap4-elist folder
 793                           (concat (if elmo-imap4-use-uid "uid " "")
 794                                   "search return (all) " flag) '(all))
 795       (elmo-imap4-response-value
 796        (elmo-imap4-send-command-wait
 797         session
 798         (format (if elmo-imap4-use-uid "uid search %s"
 799                   "search %s") flag))
 800        'search))))
 801
 802 (defun elmo-imap4-session-flag-available-p (session flag)
 803   (case flag
 804     ((read unread) (elmo-string-member-ignore-case
 805                     "\\seen" (elmo-imap4-session-flags-internal session)))
 806     (important
 807      (elmo-string-member-ignore-case
 808       "\\flagged" (elmo-imap4-session-flags-internal session)))
 809     (digest
 810      (or (elmo-string-member-ignore-case
 811           "\\seen" (elmo-imap4-session-flags-internal session))
 812          (elmo-string-member-ignore-case
 813           "\\flagged" (elmo-imap4-session-flags-internal session))))
 814     (answered
 815      (elmo-string-member-ignore-case
 816       (concat "\\" (symbol-name flag))
 817       (elmo-imap4-session-flags-internal session)))
 818     (t
 819      (member "\\*" (elmo-imap4-session-flags-internal session)))))
 820
 821 (defun elmo-imap4-flag-to-imap-search-key (flag)
 822   (case flag
 823     (read "seen")
 824     (unread "unseen")
 825     (important "flagged")
 826     (answered "answered")
 827     (new "new")
 828     (t (concat
 829         "keyword "
 830         (or (car (cdr (assq flag elmo-imap4-flag-specs)))
 831             (symbol-name flag))))))
 832
 833 (defun elmo-imap4-flag-to-imap-criteria (flag)
 834   (case flag
 835     ((any digest)
 836      (let ((criteria "flagged")
 837            (global-flags (delq 'important (elmo-get-global-flags t t))))
 838        (dolist (flag (delete 'new
 839                              (delete 'cached
 840                                      (copy-sequence
 841                                       (case flag
 842                                         (any
 843                                          elmo-preserved-flags)
 844                                         (digest
 845                                          elmo-digest-flags))))))
 846          (setq criteria (concat "or "
 847                                 (elmo-imap4-flag-to-imap-search-key flag)
 848                                 " "
 849                                 criteria)))
 850        (while global-flags
 851          (setq criteria (concat "or keyword "
 852                                 (symbol-name (car global-flags))
 853                                 " "
 854                                 criteria))
 855          (setq global-flags (cdr global-flags)))
 856        criteria))
 857     (t
 858      (elmo-imap4-flag-to-imap-search-key flag))))
 859
 860 (defun elmo-imap4-folder-list-flagged (folder flag &optional type)
 861   "List flagged message numbers in the FOLDER.
 862 FLAG is one of the `unread', `read', `important', `answered',
 863 `any'.
 864 When optional argument TYPE is symbol 'unmatch, negate search
 865 condition."
 866   (let ((session (elmo-imap4-get-session folder))
 867         (criteria (concat (if (eq type 'unmatch) "not " "")
 868                           (elmo-imap4-flag-to-imap-criteria flag))))
 869     (if (elmo-imap4-session-flag-available-p session flag)
 870         (elmo-imap4-list folder criteria)
 871       ;; List flagged messages in the msgdb.
 872       (elmo-msgdb-list-flagged (elmo-folder-msgdb folder) flag))))
 873
 874 (defvar elmo-imap4-rfc822-size "RFC822\.SIZE")
 875 (defvar elmo-imap4-rfc822-text "RFC822\.TEXT")
 876 (defvar elmo-imap4-rfc822-header "RFC822\.HEADER")
 877 (defvar elmo-imap4-header-fields "HEADER\.FIELDS")
 878
 879 (defun elmo-imap4-make-number-set-list (msg-list &optional chop-length)
 880   "Make RFC2060's message set specifier from MSG-LIST.
 881 Returns a list of (NUMBER . SET-STRING).
 882 SET-STRING is the message set specifier described in RFC2060.
 883 NUMBER is contained message number in SET-STRING.
 884 Every SET-STRING does not contain number of messages longer than CHOP-LENGTH.
 885 If CHOP-LENGTH is not specified, message set is not chopped."
 886   (let (count cont-list set-list)
 887     (setq msg-list (sort (copy-sequence msg-list) '<))
 888     (while msg-list
 889       (setq cont-list nil)
 890       (setq count 0)
 891       (unless chop-length
 892         (setq chop-length (length msg-list)))
 893       (while (and (not (null msg-list))
 894                   (< count chop-length))
 895         (setq cont-list
 896               (elmo-number-set-append
 897                cont-list (car msg-list)))
 898         (incf count)
 899         (setq msg-list (cdr msg-list)))
 900       (setq set-list
 901             (cons
 902              (cons
 903               count
 904               (mapconcat
 905                (lambda (x)
 906                  (cond ((consp x)
 907                         (format "%s:%s" (car x) (cdr x)))
 908                        ((integerp x)
 909                         (number-to-string x))))
 910                cont-list
 911                ","))
 912              set-list)))
 913     (nreverse set-list)))
 914
 915 ;;
 916 ;; app-data:
 917 ;; cons of flag-table and folder structure
 918 (defsubst elmo-imap4-fetch-callback-1-subr (entity flags app-data)
 919   "A msgdb entity callback function."
 920   (let ((use-flag (elmo-folder-use-flag-p (cdr app-data)))
 921         (flag-table (car app-data))
 922         (msg-id (elmo-message-entity-field entity 'message-id))
 923         saved-flags flag-list)
 924 ;;;    (when (elmo-string-member-ignore-case "\\Flagged" flags)
 925 ;;;      (elmo-msgdb-global-mark-set msg-id elmo-msgdb-important-mark))
 926     (setq saved-flags (elmo-flag-table-get flag-table msg-id)
 927           flag-list
 928           (if use-flag
 929               (append
 930                (and (memq 'new saved-flags)
 931                     (not (elmo-string-member-ignore-case "\\Seen" flags))
 932                     '(new))
 933                (and (elmo-string-member-ignore-case "\\Flagged" flags)
 934                     '(important))
 935                (and (not (elmo-string-member-ignore-case "\\Seen" flags))
 936                     '(unread))
 937                (and (elmo-string-member-ignore-case "\\Answered" flags)
 938                     '(answered))
 939                (and (elmo-file-cache-exists-p msg-id)
 940                     '(cached)))
 941             saved-flags))
 942     (elmo-msgdb-append-entity elmo-imap4-current-msgdb
 943                               entity
 944                               flag-list)))
 945
 946 ;; Current buffer is process buffer.
 947 (defun elmo-imap4-fetch-callback-1 (element app-data)
 948   (let ((handler (elmo-msgdb-message-entity-handler elmo-imap4-current-msgdb)))
 949     (elmo-imap4-fetch-callback-1-subr
 950      (with-temp-buffer
 951        (insert (or (elmo-imap4-response-bodydetail-text element)
 952                    ""))
 953        ;; Replace all CRLF with LF.
 954        (elmo-delete-cr-buffer)
 955        (elmo-msgdb-create-message-entity-from-buffer
 956         handler
 957         (elmo-imap4-response-value element 'uid)
 958         :size (elmo-imap4-response-value element 'rfc822size)))
 959      (elmo-imap4-response-value element 'flags)
 960      app-data)
 961     (elmo-progress-notify 'elmo-folder-msgdb-create)))
 962
 963 (defun elmo-imap4-parse-capability (string)
 964   (if (string-match "^\\*\\(.*\\)$" string)
 965       (read
 966        (concat "(" (downcase (elmo-match-string 1 string)) ")"))))
 967
 968 (defun elmo-imap4-clear-login (session)
 969   (when (elmo-imap4-session-capable-p session 'logindisabled)
 970     (signal 'elmo-authenticate-error '(elmo-imap4-clear-login)))
 971   (let ((elmo-imap4-debug-inhibit-logging t))
 972     (or
 973      (elmo-imap4-read-ok
 974       session
 975       (elmo-imap4-send-command
 976        session
 977        (list "login "
 978              (elmo-imap4-userid (elmo-network-session-user-internal session))
 979              " "
 980              (elmo-imap4-password
 981               (elmo-get-passwd (elmo-network-session-password-key session))))))
 982      (signal 'elmo-authenticate-error '(elmo-imap4-clear-login)))))
 983
 984 (defun elmo-imap4-auth-login (session)
 985   (let ((tag (elmo-imap4-send-command session "authenticate login"))
 986         (elmo-imap4-debug-inhibit-logging t))
 987     (or (elmo-imap4-read-continue-req session)
 988         (signal 'elmo-authenticate-error '(elmo-imap4-auth-login)))
 989     (elmo-imap4-send-string session
 990                             (elmo-base64-encode-string
 991                              (elmo-network-session-user-internal session)))
 992     (or (elmo-imap4-read-continue-req session)
 993         (signal 'elmo-authenticate-error '(elmo-imap4-auth-login)))
 994     (elmo-imap4-send-string session
 995                             (elmo-base64-encode-string
 996                              (elmo-get-passwd
 997                               (elmo-network-session-password-key session))))
 998     (or (elmo-imap4-read-ok session tag)
 999         (signal 'elmo-authenticate-error '(elmo-imap4-auth-login)))
1000     (setq elmo-imap4-status 'auth)))
1001
1002 (luna-define-method
1003   elmo-network-initialize-session-buffer :after ((session
1004                                                   elmo-imap4-session) buffer)
1005   (with-current-buffer buffer
1006     (mapc 'make-variable-buffer-local elmo-imap4-local-variables)
1007     (setq elmo-imap4-seqno 0)
1008     (setq elmo-imap4-status 'initial)))
1009
1010 (luna-define-method elmo-network-initialize-session ((session
1011                                                       elmo-imap4-session))
1012   (let ((process (elmo-network-session-process-internal session)))
1013     (with-current-buffer (process-buffer process)
1014       ;; Skip garbage output from process before greeting.
1015       (while (and (memq (process-status process) '(open run))
1016                   (goto-char (point-max))
1017                   (or (/= (forward-line -1) 0)
1018                       (not (elmo-imap4-parse-greeting))))
1019         (accept-process-output process 1))
1020       (erase-buffer)
1021       (set-process-filter process 'elmo-imap4-arrival-filter)
1022       (set-process-sentinel process 'elmo-imap4-sentinel)
1023 ;;;      (while (and (memq (process-status process) '(open run))
1024 ;;;               (eq elmo-imap4-status 'initial))
1025 ;;;     (message "Waiting for server response...")
1026 ;;;     (accept-process-output process 1))
1027 ;;;      (message "")
1028       (unless (memq elmo-imap4-status '(nonauth auth))
1029         (signal 'elmo-open-error
1030                 (list 'elmo-network-initialize-session)))
1031       (elmo-imap4-session-set-capability-internal
1032        session
1033        (elmo-imap4-response-value
1034         (elmo-imap4-send-command-wait session "capability")
1035         'capability))
1036       (when (eq (elmo-network-stream-type-symbol
1037                  (elmo-network-session-stream-type-internal session))
1038                 'starttls)
1039         (or (elmo-imap4-session-capable-p session 'starttls)
1040             (signal 'elmo-open-error
1041                     '(elmo-imap4-starttls-error)))
1042         (elmo-imap4-send-command-wait session "starttls")
1043         (starttls-negotiate process)
1044         (elmo-imap4-session-set-capability-internal
1045          session
1046          (elmo-imap4-response-value
1047           (elmo-imap4-send-command-wait session "capability")
1048           'capability))))))
1049
1050 (luna-define-method elmo-network-authenticate-session ((session
1051                                                         elmo-imap4-session))
1052   (with-current-buffer (process-buffer
1053                         (elmo-network-session-process-internal session))
1054     (let* ((auth (elmo-network-session-auth-internal session))
1055            (auth (if (listp auth) auth (list auth))))
1056       (unless (or (eq elmo-imap4-status 'auth)
1057                   (null auth))
1058         (cond
1059          ((eq 'clear (car auth))
1060           (elmo-imap4-clear-login session))
1061          ((eq 'login (car auth))
1062           (elmo-imap4-auth-login session))
1063          (t
1064           (let* ((elmo-imap4-debug-inhibit-logging t)
1065                  (sasl-mechanisms
1066                   (delq nil
1067                         (mapcar
1068                          (lambda (cap)
1069                            (if (string-match "^auth=\\(.*\\)$"
1070                                              (symbol-name cap))
1071                                (match-string 1 (upcase (symbol-name cap)))))
1072                          (elmo-imap4-session-capability-internal session))))
1073                  (mechanism
1074                   (sasl-find-mechanism
1075                    (delq nil
1076                          (mapcar (lambda (cap) (upcase (symbol-name cap)))
1077                                  (if (listp auth)
1078                                      auth
1079                                    (list auth)))))) ;)
1080                  client name step response tag
1081                  sasl-read-passphrase)
1082             (unless mechanism
1083               (if (or elmo-imap4-force-login
1084                       (y-or-n-p
1085                        (format
1086                         "There's no %s capability in server. continue?"
1087                         (elmo-list-to-string
1088                          (elmo-network-session-auth-internal session)))))
1089                   (setq mechanism (sasl-find-mechanism
1090                                    sasl-mechanisms))
1091                 (signal 'elmo-authenticate-error
1092                         '(elmo-imap4-auth-no-mechanisms))))
1093             (setq client
1094                   (sasl-make-client
1095                    mechanism
1096                    (elmo-network-session-user-internal session)
1097                    "imap"
1098                    (elmo-network-session-server-internal session)))
1099 ;;;         (if elmo-imap4-auth-user-realm
1100 ;;;             (sasl-client-set-property client 'realm elmo-imap4-auth-user-realm))
1101             (setq name (sasl-mechanism-name mechanism)
1102                   step (sasl-next-step client nil))
1103             (elmo-network-session-set-auth-internal
1104              session
1105              (intern (downcase name)))
1106             (setq sasl-read-passphrase
1107                   (lambda (prompt)
1108                     (elmo-get-passwd
1109                      (elmo-network-session-password-key session))))
1110             (setq tag
1111                   (elmo-imap4-send-command
1112                    session
1113                    (concat "AUTHENTICATE " name
1114                            (and (sasl-step-data step)
1115                                 (concat
1116                                  " "
1117                                  (elmo-base64-encode-string
1118                                   (sasl-step-data step)
1119                                   'no-lin-break))))))
1120             (catch 'done
1121               (while t
1122                 (setq response
1123                       (elmo-imap4-read-untagged
1124                        (elmo-network-session-process-internal session)))
1125                 (if (elmo-imap4-response-ok-p response)
1126                     (if (sasl-next-step client step)
1127                         ;; Bogus server?
1128                         (signal 'elmo-authenticate-error
1129                                 (list (intern
1130                                        (concat "elmo-imap4-auth-"
1131                                                (downcase name)))))
1132                       ;; The authentication process is finished.
1133                       (throw 'done nil)))
1134                 (unless (elmo-imap4-response-continue-req-p response)
1135                   ;; response is NO or BAD.
1136                   (signal 'elmo-authenticate-error
1137                           (list (intern
1138                                  (concat "elmo-imap4-auth-"
1139                                          (downcase name))))))
1140                 (sasl-step-set-data
1141                  step
1142                  (elmo-base64-decode-string
1143                   (elmo-imap4-response-value response 'continue-req)))
1144                 (setq step (sasl-next-step client step))
1145                 (setq tag
1146                       (elmo-imap4-send-string
1147                        session
1148                        (if (sasl-step-data step)
1149                            (elmo-base64-encode-string (sasl-step-data step)
1150                                                       'no-line-break)
1151                          ""))))))))
1152 ;; Some servers return reduced capabilities when client asks for them
1153 ;; before login. It might be a good idea to ask them again, otherwise
1154 ;; we can miss some useful feature.
1155         (elmo-imap4-session-set-capability-internal
1156          session
1157          (elmo-imap4-response-value
1158           (elmo-imap4-send-command-wait session "capability")
1159           'capability))))))
1160
1161 (luna-define-method elmo-network-setup-session ((session
1162                                                  elmo-imap4-session))
1163   (with-current-buffer (elmo-network-session-buffer session)
1164     (when (elmo-imap4-session-capable-p session 'namespace)
1165       (setq elmo-imap4-server-namespace
1166             (elmo-imap4-response-value
1167              (elmo-imap4-send-command-wait session "namespace")
1168              'namespace)))))
1169
1170 (defun elmo-imap4-setup-send-buffer (&optional string)
1171   (let ((send-buf (get-buffer-create " *elmo-imap4-setup-send-buffer*"))
1172         (source-buf (unless string (current-buffer))))
1173     (save-excursion
1174       (save-match-data
1175         (set-buffer send-buf)
1176         (erase-buffer)
1177         (set-buffer-multibyte nil)
1178         (if string
1179             (insert string)
1180           (with-current-buffer source-buf
1181             (copy-to-buffer send-buf (point-min) (point-max))))
1182         (goto-char (point-min))
1183         (if (eq (re-search-forward "^$" nil t)
1184                 (point-max))
1185             (insert "\n"))
1186         (goto-char (point-min))
1187         (while (search-forward "\n" nil t)
1188           (replace-match "\r\n"))))
1189     send-buf))
1190
1191 (defun elmo-imap4-setup-send-buffer-from-file (file)
1192   (let ((tmp-buf (get-buffer-create
1193                   " *elmo-imap4-setup-send-buffer-from-file*")))
1194     (save-excursion
1195       (save-match-data
1196         (set-buffer tmp-buf)
1197         (erase-buffer)
1198         (as-binary-input-file
1199          (insert-file-contents file))
1200         (goto-char (point-min))
1201         (if (eq (re-search-forward "^$" nil t)
1202                 (point-max))
1203             (insert "\n"))
1204         (goto-char (point-min))
1205         (while (search-forward "\n" nil t)
1206           (replace-match "\r\n"))))
1207     tmp-buf))
1208
1209 (luna-define-method elmo-delete-message-safe ((folder elmo-imap4-folder)
1210                                               number msgid)
1211   (let ((session (elmo-imap4-get-session folder))
1212         candidates)
1213     (elmo-imap4-session-select-mailbox
1214      session
1215      (elmo-imap4-folder-mailbox-internal folder))
1216     (setq candidates
1217           (elmo-imap4-response-value
1218            (elmo-imap4-send-command-wait session
1219                                          (list
1220                                           (if elmo-imap4-use-uid
1221                                               "uid search header message-id "
1222                                             "search header message-id ")
1223                                           (elmo-imap4-field-body msgid)))
1224            'search))
1225     (if (memq number candidates)
1226         (elmo-folder-delete-messages folder (list number)))))
1227
1228 (defun elmo-imap4-server-diff-async-callback-1 (status data)
1229   (funcall elmo-imap4-server-diff-async-callback
1230            (list (elmo-imap4-response-value status 'recent)
1231                  (elmo-imap4-response-value status 'unseen)
1232                  (elmo-imap4-response-value status 'messages))
1233            data))
1234
1235 (defun elmo-imap4-server-diff-async (folder)
1236   (let ((session (elmo-imap4-get-session folder)))
1237     ;; We should `check' folder to obtain newest information here.
1238     ;; But since there's no asynchronous check mechanism in elmo yet,
1239     ;; checking is not done here.
1240     (with-current-buffer (elmo-network-session-buffer session)
1241       (setq elmo-imap4-status-callback
1242             'elmo-imap4-server-diff-async-callback-1)
1243       (setq elmo-imap4-status-callback-data
1244             elmo-imap4-server-diff-async-callback-data))
1245     (elmo-imap4-send-command session
1246                              (list
1247                               "status "
1248                               (elmo-imap4-mailbox
1249                                (elmo-imap4-folder-mailbox-internal folder))
1250                               " (recent unseen messages)"))))
1251
1252 (luna-define-method elmo-server-diff-async ((folder elmo-imap4-folder))
1253   (let ((session (elmo-imap4-get-session folder)))
1254 ;;;    ;; commit.
1255 ;;;    (elmo-imap4-commit spec)
1256     (with-current-buffer (elmo-network-session-buffer session)
1257       (setq elmo-imap4-status-callback
1258             'elmo-imap4-server-diff-async-callback-1)
1259       (setq elmo-imap4-status-callback-data
1260             elmo-imap4-server-diff-async-callback-data))
1261     (elmo-imap4-send-command session
1262                              (list
1263                               "status "
1264                               (elmo-imap4-mailbox
1265                                (elmo-imap4-folder-mailbox-internal folder))
1266                               " (recent unseen messages)"))))
1267
1268 ;;; IMAP parser.
1269
1270 (defvar elmo-imap4-server-eol "\r\n"
1271   "The EOL string sent from the server.")
1272
1273 (defvar elmo-imap4-client-eol "\r\n"
1274   "The EOL string we send to the server.")
1275
1276 (defvar elmo-imap4-literal-progress-reporter nil)
1277
1278 (defun elmo-imap4-find-next-line ()
1279   "Return point at end of current line, taking into account literals.
1280 Return nil if no complete line has arrived."
1281   (when (re-search-forward (concat elmo-imap4-server-eol "\\|{\\([0-9]+\\)}"
1282                                    elmo-imap4-server-eol)
1283                            nil t)
1284     (if (match-string 1)
1285         (if (< (point-max) (+ (point) (string-to-number (match-string 1))))
1286             (progn
1287               (when elmo-imap4-literal-progress-reporter
1288                 (elmo-progress-notify
1289                  'elmo-retrieve-message
1290                  :set (- (point-max) (point))
1291                  :total (string-to-number (match-string 1))))
1292               nil)
1293           (goto-char (+ (point) (string-to-number (match-string 1))))
1294           (elmo-imap4-find-next-line))
1295       (point))))
1296
1297 (defun elmo-imap4-sentinel (process string)
1298   (delete-process process))
1299
1300 (defun elmo-imap4-arrival-filter (proc string)
1301   "IMAP process filter."
1302   (when (buffer-live-p (process-buffer proc))
1303   (with-current-buffer (process-buffer proc)
1304     (goto-char (point-max))
1305     (insert string)
1306     (let (end)
1307       (goto-char (point-min))
1308       (while (setq end (elmo-imap4-find-next-line))
1309         (save-restriction
1310           (narrow-to-region (point-min) end)
1311           (delete-char (- (length elmo-imap4-server-eol)))
1312           (goto-char (point-min))
1313           (unwind-protect
1314               (case elmo-imap4-status
1315                 (initial
1316                  (setq elmo-imap4-current-response
1317                        (list
1318                         (list 'greeting (elmo-imap4-parse-greeting)))))
1319                 ((auth nonauth selected examine)
1320                  (setq elmo-imap4-current-response
1321                        (cons (elmo-imap4-parse-response)
1322                              elmo-imap4-current-response)))
1323                 (t
1324                  (message "Unknown state %s in arrival filter"
1325                           elmo-imap4-status)))
1326             (delete-region (point-min) (point-max)))))))))
1327
1328 ;; IMAP parser.
1329
1330 (defsubst elmo-imap4-forward ()
1331   (or (eobp) (forward-char 1)))
1332
1333 (defsubst elmo-imap4-parse-number ()
1334   (when (looking-at "[0-9]+")
1335     (prog1
1336         (string-to-number (match-string 0))
1337       (goto-char (match-end 0)))))
1338
1339 (defsubst elmo-imap4-parse-literal ()
1340   (when (looking-at "{\\([0-9]+\\)}\r\n")
1341     (let ((pos (match-end 0))
1342           (len (string-to-number (match-string 1))))
1343       (if (< (point-max) (+ pos len))
1344           nil
1345         (goto-char (+ pos len))
1346         (buffer-substring pos (+ pos len))))))
1347 ;;;     (list ' pos (+ pos len))))))
1348
1349 (defsubst elmo-imap4-parse-string ()
1350   (cond ((eq (char-after (point)) ?\")
1351          (forward-char 1)
1352          (let ((p (point)) (name ""))
1353            (skip-chars-forward "^\"\\\\")
1354            (setq name (buffer-substring p (point)))
1355            (while (eq (char-after (point)) ?\\)
1356              (setq p (1+ (point)))
1357              (forward-char 2)
1358              (skip-chars-forward "^\"\\\\")
1359              (setq name (concat name (buffer-substring p (point)))))
1360            (forward-char 1)
1361            name))
1362         ((eq (char-after (point)) ?{)
1363          (elmo-imap4-parse-literal))))
1364
1365 (defsubst elmo-imap4-parse-nil ()
1366   (if (looking-at "NIL")
1367       (goto-char (match-end 0))))
1368
1369 (defsubst elmo-imap4-parse-nstring ()
1370   (or (elmo-imap4-parse-string)
1371       (and (elmo-imap4-parse-nil)
1372            nil)))
1373
1374 (defsubst elmo-imap4-parse-astring ()
1375   (or (elmo-imap4-parse-string)
1376       (buffer-substring (point)
1377                         (if (re-search-forward "[(){ \r\n%*\"\\]" nil t)
1378                             (goto-char (1- (match-end 0)))
1379                           (end-of-line)
1380                           (point)))))
1381
1382 (defsubst elmo-imap4-parse-address ()
1383   (let (address)
1384     (when (eq (char-after (point)) ?\()
1385       (elmo-imap4-forward)
1386       (setq address (vector (prog1 (elmo-imap4-parse-nstring)
1387                               (elmo-imap4-forward))
1388                             (prog1 (elmo-imap4-parse-nstring)
1389                               (elmo-imap4-forward))
1390                             (prog1 (elmo-imap4-parse-nstring)
1391                               (elmo-imap4-forward))
1392                             (elmo-imap4-parse-nstring)))
1393       (when (eq (char-after (point)) ?\))
1394         (elmo-imap4-forward)
1395         address))))
1396
1397 (defsubst elmo-imap4-parse-address-list ()
1398   (if (eq (char-after (point)) ?\()
1399       (let (address addresses)
1400         (elmo-imap4-forward)
1401         (while (and (not (eq (char-after (point)) ?\)))
1402                     ;; next line for MS Exchange bug
1403                     (progn (and (eq (char-after (point)) (string-to-char " "))
1404                                 (elmo-imap4-forward)) t)
1405                     (setq address (elmo-imap4-parse-address)))
1406           (setq addresses (cons address addresses)))
1407         (when (eq (char-after (point)) ?\))
1408           (elmo-imap4-forward)
1409           (nreverse addresses)))
1410     (assert (elmo-imap4-parse-nil))))
1411
1412 (defsubst elmo-imap4-parse-mailbox ()
1413   (let ((mailbox (elmo-imap4-parse-astring)))
1414     (if (string-equal "INBOX" (upcase mailbox))
1415         "INBOX"
1416       mailbox)))
1417
1418 (defun elmo-imap4-parse-greeting ()
1419   "Parse a IMAP greeting."
1420   (cond ((looking-at "\\* OK ")
1421          (setq elmo-imap4-status 'nonauth))
1422         ((looking-at "\\* PREAUTH ")
1423          (setq elmo-imap4-status 'auth))
1424         ((looking-at "\\* BYE ")
1425          (setq elmo-imap4-status 'closed))))
1426
1427 (defun elmo-imap4-parse-response ()
1428   "Parse a IMAP command response."
1429   (elmo-imap4-debug "[%s] -> %s" (format-time-string "%T") (buffer-substring (point) (point-max)))
1430   (let (token)
1431     (case (setq token (read (current-buffer)))
1432       (+ (progn
1433            (skip-chars-forward " ")
1434            (list 'continue-req (buffer-substring (point) (point-max)))))
1435       (* (case (prog1 (setq token (read (current-buffer)))
1436                  (elmo-imap4-forward))
1437            (OK         (elmo-imap4-parse-resp-text-code))
1438            (NO         (elmo-imap4-parse-resp-text-code))
1439            (BAD        (elmo-imap4-parse-resp-text-code))
1440            (BYE        (elmo-imap4-parse-bye))
1441            (FLAGS      (list 'flags
1442                              (elmo-imap4-parse-flag-list)))
1443            (LIST       (list 'list (elmo-imap4-parse-data-list)))
1444            (LSUB       (list 'lsub (elmo-imap4-parse-data-list)))
1445            (SEARCH     (list
1446                         'search
1447                         (read (concat "("
1448                                       (buffer-substring (point) (point-max))
1449                                       ")"))))
1450            (ESEARCH     (list
1451                          'esearch
1452                          (cddr (split-string (buffer-substring (point) (point-max)) " "))))
1453            (STATUS     (elmo-imap4-parse-status))
1454            ;; Added
1455            (NAMESPACE  (elmo-imap4-parse-namespace))
1456            (CAPABILITY (list 'capability
1457                              (read
1458                               (concat "(" (downcase (buffer-substring
1459                                                      (point) (point-max)))
1460                                       ")"))))
1461            (ACL (elmo-imap4-parse-acl))
1462            (t       (case (prog1 (read (current-buffer))
1463                             (elmo-imap4-forward))
1464                       (EXISTS  (list 'exists token))
1465                       (RECENT  (list 'recent token))
1466                       (EXPUNGE (list 'expunge token))
1467                       (FETCH   (elmo-imap4-parse-fetch token))
1468                       (t       (list 'garbage (buffer-string)))))))
1469       (t (if (not (string-match elmo-imap4-seq-prefix (symbol-name token)))
1470              (list 'garbage (buffer-string))
1471            (case (prog1 (read (current-buffer))
1472                    (elmo-imap4-forward))
1473              (OK  (progn
1474                     (setq elmo-imap4-parsing nil)
1475                     (setq token (symbol-name token))
1476                     (elmo-unintern token)
1477                     (elmo-imap4-debug "*%s* OK arrived" token)
1478                     (setq elmo-imap4-reached-tag token)
1479                     (list 'ok (elmo-imap4-parse-resp-text-code))))
1480              (NO  (progn
1481                     (setq elmo-imap4-parsing nil)
1482                     (setq token (symbol-name token))
1483                     (elmo-unintern token)
1484                     (elmo-imap4-debug "*%s* NO arrived" token)
1485                     (setq elmo-imap4-reached-tag token)
1486                     (let (code text)
1487                       (when (eq (char-after (point)) ?\[)
1488                         (setq code (buffer-substring (point)
1489                                                      (search-forward "]")))
1490                         (elmo-imap4-forward))
1491                       (setq text (buffer-substring (point) (point-max)))
1492                       (list 'no (list code text)))))
1493              (BAD (progn
1494                     (setq elmo-imap4-parsing nil)
1495                     (elmo-imap4-debug "*%s* BAD arrived" token)
1496                     (setq token (symbol-name token))
1497                     (elmo-unintern token)
1498                     (setq elmo-imap4-reached-tag token)
1499                     (let (code text)
1500                       (when (eq (char-after (point)) ?\[)
1501                         (setq code (buffer-substring (point)
1502                                                      (search-forward "]")))
1503                         (elmo-imap4-forward))
1504                       (setq text (buffer-substring (point) (point-max)))
1505                       (list 'bad (list code text)))))
1506              (t   (list 'garbage (buffer-string)))))))))
1507
1508 (defun elmo-imap4-parse-bye ()
1509   (let (code text)
1510     (when (eq (char-after (point)) ?\[)
1511       (setq code (buffer-substring (point)
1512                                    (search-forward "]")))
1513       (elmo-imap4-forward))
1514     (setq text (buffer-substring (point) (point-max)))
1515     (list 'bye (list code text))))
1516
1517 (defun elmo-imap4-parse-text ()
1518   (goto-char (point-min))
1519   (when (search-forward "[" nil t)
1520     (search-forward "]")
1521     (elmo-imap4-forward))
1522   (list 'text (buffer-substring (point) (point-max))))
1523
1524 (defun elmo-imap4-parse-resp-text-code ()
1525   (when (eq (char-after (point)) ?\[)
1526     (elmo-imap4-forward)
1527     (cond ((search-forward "PERMANENTFLAGS " nil t)
1528            (list 'permanentflags (elmo-imap4-parse-flag-list)))
1529           ((search-forward "UIDNEXT " nil t)
1530            (list 'uidnext (read (current-buffer))))
1531           ((search-forward "UNSEEN " nil t)
1532            (list 'unseen (read (current-buffer))))
1533           ((looking-at "UIDVALIDITY \\([0-9]+\\)")
1534            (list 'uidvalidity (match-string 1)))
1535           ((search-forward "READ-ONLY" nil t)
1536            (list 'read-only t))
1537           ((search-forward "READ-WRITE" nil t)
1538            (list 'read-write t))
1539           ((search-forward "NEWNAME " nil t)
1540            (let (oldname newname)
1541              (setq oldname (elmo-imap4-parse-string))
1542              (elmo-imap4-forward)
1543              (setq newname (elmo-imap4-parse-string))
1544              (list 'newname newname oldname)))
1545           ((search-forward "TRYCREATE" nil t)
1546            (list 'trycreate t))
1547           ((looking-at "APPENDUID \\([0-9]+\\) \\([0-9]+\\)")
1548            (list 'appenduid
1549                  (list (match-string 1)
1550                        (string-to-number (match-string 2)))))
1551           ((looking-at "COPYUID \\([0-9]+\\) \\([0-9,:]+\\) \\([0-9,:]+\\)")
1552            (list 'copyuid (list (match-string 1)
1553                                 (match-string 2)
1554                                 (match-string 3))))
1555           ((search-forward "ALERT] " nil t)
1556            (message "IMAP server information: %s"
1557                     (buffer-substring (point) (point-max))))
1558           (t (list 'unknown)))))
1559
1560 (defun elmo-imap4-parse-data-list ()
1561   (let (flags delimiter mailbox)
1562     (setq flags (elmo-imap4-parse-flag-list))
1563     (when (looking-at " NIL\\| \"\\\\?\\(.\\)\"")
1564       (setq delimiter (match-string 1))
1565       (goto-char (1+ (match-end 0)))
1566       (when (setq mailbox (elmo-imap4-parse-mailbox))
1567         (list mailbox flags delimiter)))))
1568
1569 (defsubst elmo-imap4-parse-header-list ()
1570   (when (eq (char-after (point)) ?\()
1571     (let (strlist)
1572       (while (not (eq (char-after (point)) ?\)))
1573         (elmo-imap4-forward)
1574         (push (elmo-imap4-parse-astring) strlist))
1575       (elmo-imap4-forward)
1576       (nreverse strlist))))
1577
1578 (defsubst elmo-imap4-parse-fetch-body-section ()
1579   (let ((section
1580          (buffer-substring (point)
1581                            (1-
1582                             (progn (re-search-forward "[] ]" nil t)
1583                                    (point))))))
1584     (if (eq (char-before) (string-to-char " "))
1585         (prog1
1586             (mapconcat 'identity
1587                        (cons section (elmo-imap4-parse-header-list)) " ")
1588           (search-forward "]" nil t))
1589       section)))
1590
1591 (defun elmo-imap4-parse-fetch (response)
1592   (when (eq (char-after (point)) ?\()
1593     (let (element list)
1594       (while (not (eq (char-after (point)) ?\)))
1595         (elmo-imap4-forward)
1596         (let ((token (read (current-buffer))))
1597           (elmo-imap4-forward)
1598           (setq element
1599                 (cond ((eq token 'UID)
1600                        (list 'uid (condition-case nil
1601                                       (read (current-buffer))
1602                                     (error nil))))
1603                       ((eq token 'FLAGS)
1604                        (list 'flags (elmo-imap4-parse-flag-list)))
1605                       ((eq token 'ENVELOPE)
1606                        (list 'envelope (elmo-imap4-parse-envelope)))
1607                       ((eq token 'INTERNALDATE)
1608                        (list 'internaldate (elmo-imap4-parse-string)))
1609                       ((eq token 'RFC822)
1610                        (list 'rfc822 (elmo-imap4-parse-nstring)))
1611                       ((eq token (intern elmo-imap4-rfc822-header))
1612                        (list 'rfc822header (elmo-imap4-parse-nstring)))
1613                       ((eq token (intern elmo-imap4-rfc822-text))
1614                        (list 'rfc822text (elmo-imap4-parse-nstring)))
1615                       ((eq token (intern elmo-imap4-rfc822-size))
1616                        (list 'rfc822size (read (current-buffer))))
1617                       ((eq token 'BODY)
1618                        (if (eq (char-before) ?\[)
1619                            (list
1620                             'bodydetail
1621                             (upcase (elmo-imap4-parse-fetch-body-section))
1622                             (and
1623                              (eq (char-after (point)) ?<)
1624                              (buffer-substring (1+ (point))
1625                                                (progn
1626                                                  (search-forward ">" nil t)
1627                                                  (point))))
1628                             (progn (elmo-imap4-forward)
1629                                    (elmo-imap4-parse-nstring)))
1630                          (list 'body (elmo-imap4-parse-body))))
1631                       ((eq token 'BODYSTRUCTURE)
1632                        (list 'bodystructure (elmo-imap4-parse-body)))))
1633           (setq list (cons element list))))
1634       (and elmo-imap4-fetch-callback
1635            (funcall elmo-imap4-fetch-callback
1636                     list elmo-imap4-fetch-callback-data))
1637       (list 'fetch list))))
1638
1639 (defun elmo-imap4-parse-status ()
1640   (let ((mailbox (elmo-imap4-parse-mailbox))
1641         status)
1642     (when (and mailbox (search-forward "(" nil t))
1643       (while (not (eq (char-after (point)) ?\)))
1644         (setq status
1645               (cons
1646                (let ((token (read (current-buffer))))
1647                  (case (intern (upcase (symbol-name token)))
1648                    (MESSAGES
1649                     (list 'messages (read (current-buffer))))
1650                    (RECENT
1651                     (list 'recent (read (current-buffer))))
1652                    (UIDNEXT
1653                     (list 'uidnext (read (current-buffer))))
1654                    (UIDVALIDITY
1655                     (and (looking-at " \\([0-9]+\\)")
1656                          (prog1 (list 'uidvalidity (match-string 1))
1657                            (goto-char (match-end 1)))))
1658                    (UNSEEN
1659                     (list 'unseen (read (current-buffer))))
1660                    (t
1661                     (message
1662                      "Unknown status data %s in mailbox %s ignored"
1663                      token mailbox))))
1664                status))
1665         (skip-chars-forward " ")))
1666     (and elmo-imap4-status-callback
1667          (funcall elmo-imap4-status-callback
1668                   status
1669                   elmo-imap4-status-callback-data))
1670     (list 'status status)))
1671
1672
1673 (defmacro elmo-imap4-value (value)
1674   `(if (eq ,value 'NIL)
1675        nil
1676      ,value))
1677
1678 (defmacro elmo-imap4-nth (pos list)
1679   `(let ((value (nth ,pos ,list)))
1680      (elmo-imap4-value value)))
1681
1682 (defun elmo-imap4-parse-namespace ()
1683   (list 'namespace
1684         (nconc
1685          (copy-sequence elmo-imap4-extra-namespace-alist)
1686          (elmo-imap4-parse-namespace-subr
1687           (read (concat "(" (buffer-substring
1688                              (point) (point-max))
1689                         ")"))))))
1690
1691 (defun elmo-imap4-parse-namespace-subr (ns)
1692   (let (prefix delim namespace-alist default-delim)
1693     ;; 0: personal, 1: other, 2: shared
1694     (dotimes (i 3)
1695       (setq namespace-alist
1696             (nconc namespace-alist
1697                    (delq nil
1698                          (mapcar
1699                           (lambda (namespace)
1700                             (setq prefix (elmo-imap4-nth 0 namespace)
1701                                   delim (elmo-imap4-nth 1 namespace))
1702                             (if (and prefix delim
1703                                      (string-match
1704                                       (concat (regexp-quote delim) "\\'")
1705                                       prefix))
1706                                 (setq prefix (substring prefix 0
1707                                                         (match-beginning 0))))
1708                             (if (eq (length prefix) 0)
1709                                 (progn (setq default-delim delim) nil)
1710                               (cons
1711                                (concat "^\\("
1712                                        (if (string= (downcase prefix) "inbox")
1713                                            "[Ii][Nn][Bb][Oo][Xx]"
1714                                          (regexp-quote prefix))
1715                                        "\\).*$")
1716                                delim)))
1717                           (elmo-imap4-nth i ns))))))
1718     (if default-delim
1719         (setq namespace-alist
1720               (nconc namespace-alist
1721                      (list (cons "^.*$" default-delim)))))
1722     namespace-alist))
1723
1724 (defun elmo-imap4-parse-acl ()
1725   (let ((mailbox (elmo-imap4-parse-mailbox))
1726         identifier rights acl)
1727     (while (eq (char-after (point)) (string-to-char " "))
1728       (elmo-imap4-forward)
1729       (setq identifier (elmo-imap4-parse-astring))
1730       (elmo-imap4-forward)
1731       (setq rights (elmo-imap4-parse-astring))
1732       (setq acl (append acl (list (cons identifier rights)))))
1733     (list 'acl acl mailbox)))
1734
1735 (defun elmo-imap4-parse-flag-list ()
1736   (let ((str (buffer-substring (+ (point) 1)
1737                                (progn (search-forward ")" nil t)
1738                                       (- (point) 1)))))
1739     (unless (eq (length str) 0)
1740       (split-string str))))
1741
1742 (defun elmo-imap4-parse-envelope ()
1743   (when (eq (char-after (point)) ?\()
1744     (elmo-imap4-forward)
1745     (vector (prog1 (elmo-imap4-parse-nstring);; date
1746               (elmo-imap4-forward))
1747             (prog1 (elmo-imap4-parse-nstring);; subject
1748               (elmo-imap4-forward))
1749             (prog1 (elmo-imap4-parse-address-list);; from
1750               (elmo-imap4-forward))
1751             (prog1 (elmo-imap4-parse-address-list);; sender
1752               (elmo-imap4-forward))
1753             (prog1 (elmo-imap4-parse-address-list);; reply-to
1754               (elmo-imap4-forward))
1755             (prog1 (elmo-imap4-parse-address-list);; to
1756               (elmo-imap4-forward))
1757             (prog1 (elmo-imap4-parse-address-list);; cc
1758               (elmo-imap4-forward))
1759             (prog1 (elmo-imap4-parse-address-list);; bcc
1760               (elmo-imap4-forward))
1761             (prog1 (elmo-imap4-parse-nstring);; in-reply-to
1762               (elmo-imap4-forward))
1763             (prog1 (elmo-imap4-parse-nstring);; message-id
1764               (elmo-imap4-forward)))))
1765
1766 (defsubst elmo-imap4-parse-string-list ()
1767   (cond ((eq (char-after (point)) ?\();; body-fld-param
1768          (let (strlist str)
1769            (elmo-imap4-forward)
1770            (while (setq str (elmo-imap4-parse-string))
1771              (push str strlist)
1772              (elmo-imap4-forward))
1773            (nreverse strlist)))
1774         ((elmo-imap4-parse-nil)
1775          nil)))
1776
1777 (defun elmo-imap4-parse-body-extension ()
1778   (if (eq (char-after (point)) ?\()
1779       (let (b-e)
1780         (elmo-imap4-forward)
1781         (push (elmo-imap4-parse-body-extension) b-e)
1782         (while (eq (char-after (point)) (string-to-char " "))
1783           (elmo-imap4-forward)
1784           (push (elmo-imap4-parse-body-extension) b-e))
1785         (assert (eq (char-after (point)) ?\)))
1786         (elmo-imap4-forward)
1787         (nreverse b-e))
1788     (or (elmo-imap4-parse-number)
1789         (elmo-imap4-parse-nstring))))
1790
1791 (defsubst elmo-imap4-parse-body-ext ()
1792   (let (ext)
1793     (when (eq (char-after (point)) (string-to-char " ")) ; body-fld-dsp
1794       (elmo-imap4-forward)
1795       (let (dsp)
1796         (if (eq (char-after (point)) ?\()
1797             (progn
1798               (elmo-imap4-forward)
1799               (push (elmo-imap4-parse-string) dsp)
1800               (elmo-imap4-forward)
1801               (push (elmo-imap4-parse-string-list) dsp)
1802               (elmo-imap4-forward))
1803           (assert (elmo-imap4-parse-nil)))
1804         (push (nreverse dsp) ext))
1805       (when (eq (char-after (point)) (string-to-char " ")) ; body-fld-lang
1806         (elmo-imap4-forward)
1807         (if (eq (char-after (point)) ?\()
1808             (push (elmo-imap4-parse-string-list) ext)
1809           (push (elmo-imap4-parse-nstring) ext))
1810         (while (eq (char-after (point)) (string-to-char " "));; body-extension
1811           (elmo-imap4-forward)
1812           (setq ext (append (elmo-imap4-parse-body-extension) ext)))))
1813     ext))
1814
1815 (defun elmo-imap4-parse-body ()
1816   (let (body)
1817     (when (eq (char-after (point)) ?\()
1818       (elmo-imap4-forward)
1819       (if (eq (char-after (point)) ?\()
1820           (let (subbody)
1821             (while (and (eq (char-after (point)) ?\()
1822                         (setq subbody (elmo-imap4-parse-body)))
1823               (push subbody body))
1824             (elmo-imap4-forward)
1825             (push (elmo-imap4-parse-string) body);; media-subtype
1826             (when (eq (char-after (point)) (string-to-char " ")) ; body-ext-mpart:
1827               (elmo-imap4-forward)
1828               (if (eq (char-after (point)) ?\();; body-fld-param
1829                   (push (elmo-imap4-parse-string-list) body)
1830                 (push (and (elmo-imap4-parse-nil) nil) body))
1831               (setq body
1832                     (append (elmo-imap4-parse-body-ext) body)));; body-ext-...
1833             (assert (eq (char-after (point)) ?\)))
1834             (elmo-imap4-forward)
1835             (nreverse body))
1836
1837         (push (elmo-imap4-parse-string) body);; media-type
1838         (elmo-imap4-forward)
1839         (push (elmo-imap4-parse-string) body);; media-subtype
1840         (elmo-imap4-forward)
1841         ;; next line for Sun SIMS bug
1842         (and (eq (char-after (point)) (string-to-char " "))
1843              (elmo-imap4-forward))
1844         (if (eq (char-after (point)) ?\();; body-fld-param
1845             (push (elmo-imap4-parse-string-list) body)
1846           (push (and (elmo-imap4-parse-nil) nil) body))
1847         (elmo-imap4-forward)
1848         (push (elmo-imap4-parse-nstring) body);; body-fld-id
1849         (elmo-imap4-forward)
1850         (push (elmo-imap4-parse-nstring) body);; body-fld-desc
1851         (elmo-imap4-forward)
1852         (push (elmo-imap4-parse-string) body);; body-fld-enc
1853         (elmo-imap4-forward)
1854         (push (elmo-imap4-parse-number) body);; body-fld-octets
1855
1856         ;; ok, we're done parsing the required parts, what comes now is one
1857         ;; of three things:
1858         ;;
1859         ;; envelope       (then we're parsing body-type-msg)
1860         ;; body-fld-lines (then we're parsing body-type-text)
1861         ;; body-ext-1part (then we're parsing body-type-basic)
1862         ;;
1863         ;; the problem is that the two first are in turn optionally followed
1864         ;; by the third.  So we parse the first two here (if there are any)...
1865
1866         (when (eq (char-after (point)) (string-to-char " "))
1867           (elmo-imap4-forward)
1868           (let (lines)
1869             (cond ((eq (char-after (point)) ?\();; body-type-msg:
1870                    (push (elmo-imap4-parse-envelope) body);; envelope
1871                    (elmo-imap4-forward)
1872                    (push (elmo-imap4-parse-body) body);; body
1873                    (elmo-imap4-forward)
1874                    (push (elmo-imap4-parse-number) body));; body-fld-lines
1875                   ((setq lines (elmo-imap4-parse-number));; body-type-text:
1876                    (push lines body));; body-fld-lines
1877                   (t
1878                    (backward-char)))));; no match...
1879
1880         ;; ...and then parse the third one here...
1881
1882         (when (eq (char-after (point)) (string-to-char " ")) ; body-ext-1part:
1883           (elmo-imap4-forward)
1884           (push (elmo-imap4-parse-nstring) body);; body-fld-md5
1885           (setq body
1886                 (append (elmo-imap4-parse-body-ext) body)));; body-ext-1part..
1887
1888         (assert (eq (char-after (point)) ?\)))
1889         (elmo-imap4-forward)
1890         (nreverse body)))))
1891
1892 (luna-define-method elmo-folder-initialize ((folder elmo-imap4-folder) name)
1893   (let ((default-user   elmo-imap4-default-user)
1894         (default-server elmo-imap4-default-server)
1895         (default-port   elmo-imap4-default-port)
1896         (elmo-network-stream-type-alist
1897          (if elmo-imap4-stream-type-alist
1898              (append elmo-imap4-stream-type-alist
1899                      elmo-network-stream-type-alist)
1900            elmo-network-stream-type-alist))
1901         tokens)
1902     (when (string-match "\\(.*\\)@\\(.*\\)" default-server)
1903       ;; case: imap4-default-server is specified like
1904       ;; "hoge%imap.server@gateway".
1905       (setq default-user (elmo-match-string 1 default-server))
1906       (setq default-server (elmo-match-string 2 default-server)))
1907     (setq tokens (car (elmo-parse-separated-tokens
1908                        name
1909                        elmo-imap4-folder-name-syntax)))
1910     ;; mailbox
1911     (elmo-imap4-folder-set-mailbox-internal folder
1912                                             (elmo-imap4-encode-folder-string
1913                                              (cdr (assq 'mailbox tokens))))
1914     ;; user
1915     (elmo-net-folder-set-user-internal folder
1916                                        (or (cdr (assq 'user tokens))
1917                                            default-user))
1918     ;; auth
1919     (elmo-net-folder-set-auth-internal
1920      folder
1921      (let ((auth (cdr (assq 'auth tokens))))
1922        (or (and auth (intern auth))
1923            elmo-imap4-default-authenticate-type
1924            'clear)))
1925     ;; network
1926     (elmo-net-folder-set-parameters
1927      folder
1928      tokens
1929      (list :server      default-server
1930            :port        default-port
1931            :stream-type
1932            (elmo-get-network-stream-type elmo-imap4-default-stream-type)))
1933     folder))
1934
1935 ;;; ELMO IMAP4 folder
1936 (luna-define-method elmo-folder-expand-msgdb-path ((folder
1937                                                     elmo-imap4-folder))
1938   (convert-standard-filename
1939    (let ((mailbox (elmo-imap4-folder-mailbox-internal folder)))
1940      (if (string= "inbox" (downcase mailbox))
1941          (setq mailbox "inbox"))
1942      (if (eq (string-to-char mailbox) ?/)
1943          (setq mailbox (substring mailbox 1 (length mailbox))))
1944      ;; don't use expand-file-name (e.g. %~/something)
1945      (concat
1946       (expand-file-name
1947        (or (elmo-net-folder-user-internal folder) "nobody")
1948        (expand-file-name (or (elmo-net-folder-server-internal folder)
1949                              "nowhere")
1950                          (expand-file-name
1951                           "imap"
1952                           elmo-msgdb-directory)))
1953       "/" mailbox))))
1954
1955 (luna-define-method elmo-folder-status-plugged ((folder
1956                                                  elmo-imap4-folder))
1957   (elmo-imap4-folder-status-plugged folder))
1958
1959 (defun elmo-imap4-folder-status-plugged (folder)
1960   (let ((session (elmo-imap4-get-session folder))
1961         (killed (elmo-msgdb-killed-list-load
1962                  (elmo-folder-msgdb-path folder)))
1963         status)
1964     (with-current-buffer (elmo-network-session-buffer session)
1965       (setq elmo-imap4-status-callback nil)
1966       (setq elmo-imap4-status-callback-data nil))
1967     (setq status (elmo-imap4-response-value
1968                   (elmo-imap4-send-command-wait
1969                    session
1970                    (list "status "
1971                          (elmo-imap4-mailbox
1972                           (elmo-imap4-folder-mailbox-internal folder))
1973                          " (uidnext messages)"))
1974                   'status))
1975     (cons
1976      (- (elmo-imap4-response-value status 'uidnext) 1)
1977      (if killed
1978          (-
1979           (elmo-imap4-response-value status 'messages)
1980           (elmo-msgdb-killed-list-length killed))
1981        (elmo-imap4-response-value status 'messages)))))
1982
1983 (defun elmo-imap4-folder-list-range (folder min max)
1984   (elmo-imap4-list
1985    folder
1986    (concat
1987     (let ((killed (elmo-folder-killed-list-internal folder)))
1988       (if (and killed
1989                (eq (length killed) 1)
1990                (consp (car killed))
1991                (eq (car (car killed)) 1))
1992           ;; What about elmo-imap4-use-uid?
1993           (format "uid %d:%s" (cdr (car killed)) max)
1994         (format "uid %s:%s" min max)))
1995     " undeleted")))
1996
1997 (luna-define-method elmo-folder-list-messages-plugged
1998   ((folder elmo-imap4-folder) &optional enable-killed)
1999   (let* ((old (elmo-msgdb-list-messages (elmo-folder-msgdb folder)))
2000          (new (elmo-imap4-folder-list-range
2001                folder (1+ (or (elmo-folder-get-info-max folder) 0)) "*"))
2002          (united-old-new (elmo-union old new)))
2003     (if (= (length united-old-new) (or (elmo-folder-get-info-length folder) 0))
2004         united-old-new
2005       (elmo-union new
2006                   (elmo-imap4-folder-list-range
2007                    folder
2008                    1 (1+ (or (elmo-folder-get-info-max folder) 0)))))))
2009
2010 (luna-define-method elmo-folder-list-flagged-plugged
2011   ((folder elmo-imap4-folder) flag)
2012   (elmo-imap4-folder-list-flagged folder flag))
2013
2014 (luna-define-method elmo-folder-use-flag-p ((folder elmo-imap4-folder))
2015   (not (string-match elmo-imap4-disuse-server-flag-mailbox-regexp
2016                      (elmo-imap4-folder-mailbox-internal folder))))
2017
2018 (luna-define-method elmo-folder-list-subfolders ((folder elmo-imap4-folder)
2019                                                  &optional one-level)
2020   (let* ((root (elmo-imap4-folder-mailbox-internal folder))
2021          (session (elmo-imap4-get-session folder))
2022          (prefix (elmo-folder-prefix-internal folder))
2023          (namespace-assoc
2024                   (elmo-string-matched-assoc
2025                    root
2026                    (with-current-buffer (elmo-network-session-buffer session)
2027                      elmo-imap4-server-namespace)))
2028          (delim (or (cdr namespace-assoc)
2029                  elmo-imap4-default-hierarchy-delimiter))
2030          ;; Append delimiter when root with namespace.
2031          (root-nodelim root)
2032          (root (if (and namespace-assoc
2033                         (match-end 1)
2034                         (string= (substring root (match-end 1))
2035                                  ""))
2036                    (concat root delim)
2037                  root))
2038          result append-serv type)
2039     (setq result (elmo-imap4-response-get-selectable-mailbox-list
2040                   (elmo-imap4-send-command-wait
2041                    session
2042                    (list "list " (elmo-imap4-mailbox root) " *"))))
2043     ;; The response of Courier-imap doesn't contain a specified folder itself.
2044     (unless (member root result)
2045       (setq result
2046             (append result
2047                     (elmo-imap4-response-get-selectable-mailbox-list
2048                      (elmo-imap4-send-command-wait
2049                       session
2050                       (list "list \"\" " (elmo-imap4-mailbox
2051                                           root-nodelim)))))))
2052     (when (or (not (string= (elmo-net-folder-user-internal folder)
2053                             elmo-imap4-default-user))
2054               (not (eq (elmo-net-folder-auth-internal folder)
2055                        (or elmo-imap4-default-authenticate-type 'clear))))
2056       (setq append-serv (concat ":"
2057                                 (elmo-quote-syntactical-element
2058                                  (elmo-net-folder-user-internal folder)
2059                                  'user elmo-imap4-folder-name-syntax))))
2060     (unless (eq (elmo-net-folder-auth-internal folder)
2061                 (or elmo-imap4-default-authenticate-type 'clear))
2062       (setq append-serv
2063             (concat append-serv "/"
2064                     (symbol-name (elmo-net-folder-auth-internal folder)))))
2065     (unless (string= (elmo-net-folder-server-internal folder)
2066                      elmo-imap4-default-server)
2067       (setq append-serv (concat append-serv "@"
2068                                 (elmo-net-folder-server-internal folder))))
2069     (unless (eq (elmo-net-folder-port-internal folder) elmo-imap4-default-port)
2070       (setq append-serv (concat append-serv ":"
2071                                 (number-to-string
2072                                  (elmo-net-folder-port-internal folder)))))
2073     (setq type (elmo-net-folder-stream-type-internal folder))
2074     (unless (eq (elmo-network-stream-type-symbol type)
2075                 elmo-imap4-default-stream-type)
2076       (if type
2077           (setq append-serv (concat append-serv
2078                                     (elmo-network-stream-type-spec-string
2079                                      type)))))
2080     (if one-level
2081         (let ((re-delim (regexp-quote delim))
2082               (case-fold-search nil)
2083               folder ret has-child-p)
2084           ;; Append delimiter
2085           (when (and root
2086                      (not (string= root ""))
2087                      (not (string-match
2088                            (concat "\\(.*\\)" re-delim "\\'")
2089                            root)))
2090             (setq root (concat root delim)))
2091           (while (setq folder (car result))
2092             (setq has-child-p
2093                   (when (string-match
2094                          (concat "^\\(" (regexp-quote root) "[^" re-delim "]" "+\\)"
2095                                  re-delim)
2096                          folder)
2097                     (setq folder (match-string 1 folder))))
2098             (setq result (delq
2099                           nil
2100                           (mapcar (lambda (fld)
2101                                     (if (string-match
2102                                          (concat "^" (regexp-quote folder)
2103                                                  "\\(" re-delim "\\|\\'\\)")
2104                                          fld)
2105                                         (progn (setq has-child-p t) nil)
2106                                       fld))
2107                                   (cdr result)))
2108                   folder (concat prefix
2109                                  (elmo-quote-syntactical-element
2110                                   (elmo-imap4-decode-folder-string folder)
2111                                   'mailbox elmo-imap4-folder-name-syntax)
2112                                  (and append-serv
2113                                       (eval append-serv)))
2114                   ret (append ret (if has-child-p
2115                                       (list (list folder))
2116                                     (list folder)))))
2117           ret)
2118       (mapcar (lambda (fld)
2119                 (concat prefix
2120                         (elmo-quote-syntactical-element
2121                          (elmo-imap4-decode-folder-string fld)
2122                          'mailbox elmo-imap4-folder-name-syntax)
2123                         (and append-serv
2124                              (eval append-serv))))
2125               result))))
2126
2127 (luna-define-method elmo-folder-exists-p-plugged ((folder elmo-imap4-folder))
2128   (let ((session (elmo-imap4-get-session folder)))
2129     (if (string=
2130          (elmo-imap4-session-current-mailbox-internal session)
2131          (elmo-imap4-folder-mailbox-internal folder))
2132         t
2133       (elmo-imap4-session-select-mailbox
2134        session
2135        (elmo-imap4-folder-mailbox-internal folder)
2136        'force 'notify-bye))))
2137
2138 (luna-define-method elmo-folder-creatable-p ((folder elmo-imap4-folder))
2139   t)
2140
2141 (luna-define-method elmo-folder-writable-p ((folder elmo-imap4-folder))
2142   t)
2143
2144 (luna-define-method elmo-folder-delete ((folder elmo-imap4-folder))
2145   (let* ((exists (elmo-folder-exists-p folder))
2146          (msgs (and exists
2147                     (elmo-folder-list-messages folder))))
2148     (when (yes-or-no-p (format "%sDelete msgdb and substance of \"%s\"? "
2149                                (if (> (length msgs) 0)
2150                                    (format "%d msg(s) exists. " (length msgs))
2151                                  "")
2152                                (elmo-folder-name-internal folder)))
2153       (let ((session (elmo-imap4-get-session folder)))
2154         (when (elmo-imap4-folder-mailbox-internal folder)
2155           (when msgs (elmo-folder-delete-messages-internal folder msgs))
2156           ;; close selected mailbox except one with \Noselect attribute
2157           (when exists
2158             (elmo-imap4-send-command-wait session "close"))
2159           (elmo-imap4-send-command-wait
2160            session
2161            (list "delete "
2162                  (elmo-imap4-mailbox
2163                   (elmo-imap4-folder-mailbox-internal folder)))))
2164         (elmo-imap4-session-set-current-mailbox-internal session nil))
2165       (elmo-msgdb-delete-path folder)
2166       t)))
2167
2168 (luna-define-method elmo-folder-rename-internal ((folder elmo-imap4-folder)
2169                                                  new-folder)
2170   (let ((session (elmo-imap4-get-session folder)))
2171     ;; make sure the folder is selected.
2172     (elmo-imap4-session-select-mailbox session
2173                                        (elmo-imap4-folder-mailbox-internal
2174                                         folder))
2175     (elmo-imap4-send-command-wait session "close")
2176     (elmo-imap4-send-command-wait
2177      session
2178      (list "rename "
2179            (elmo-imap4-mailbox
2180             (elmo-imap4-folder-mailbox-internal folder))
2181            " "
2182            (elmo-imap4-mailbox
2183             (elmo-imap4-folder-mailbox-internal new-folder))))
2184     (elmo-imap4-session-set-current-mailbox-internal
2185      session (elmo-imap4-folder-mailbox-internal new-folder))))
2186
2187 (defun elmo-imap4-copy-messages (src-folder dst-folder numbers)
2188   (let ((session (elmo-imap4-get-session src-folder))
2189         (set-list (elmo-imap4-make-number-set-list
2190                    numbers
2191                    elmo-imap4-number-set-chop-length))
2192         succeeds)
2193     (elmo-imap4-session-select-mailbox session
2194                                        (elmo-imap4-folder-mailbox-internal
2195                                         src-folder))
2196     (while set-list
2197       (if (elmo-imap4-send-command-wait session
2198                                         (list
2199                                          (format
2200                                           (if elmo-imap4-use-uid
2201                                               "uid copy %s "
2202                                             "copy %s ")
2203                                           (cdr (car set-list)))
2204                                          (elmo-imap4-mailbox
2205                                           (elmo-imap4-folder-mailbox-internal
2206                                            dst-folder))))
2207           (setq succeeds (append succeeds numbers)))
2208       (setq set-list (cdr set-list)))
2209     succeeds))
2210
2211 (defun elmo-imap4-set-flag (folder numbers flag &optional remove)
2212   "Set flag on messages.
2213 FOLDER is the ELMO folder structure.
2214 NUMBERS is the message numbers to be flagged.
2215 FLAG is the flag name.
2216 If optional argument REMOVE is non-nil, remove FLAG."
2217   (let ((session (elmo-imap4-get-session folder))
2218         response set-list)
2219     (elmo-imap4-session-select-mailbox session
2220                                        (elmo-imap4-folder-mailbox-internal
2221                                         folder))
2222     (when (or (elmo-string-member-ignore-case
2223                flag
2224                (elmo-imap4-session-flags-internal session))
2225               (member "\\*" (elmo-imap4-session-flags-internal session))
2226               (string= flag "\\Deleted")) ; XXX Humm..
2227       (setq set-list (elmo-imap4-make-number-set-list
2228                       numbers
2229                       elmo-imap4-number-set-chop-length))
2230       (while set-list
2231         (with-current-buffer (elmo-network-session-buffer session)
2232           (setq elmo-imap4-fetch-callback nil)
2233           (setq elmo-imap4-fetch-callback-data nil))
2234         (unless (elmo-imap4-response-ok-p
2235                  (elmo-imap4-send-command-wait
2236                   session
2237                   (format
2238                    (if elmo-imap4-use-uid
2239                        "uid store %s %sflags.silent (%s)"
2240                      "store %s %sflags.silent (%s)")
2241                    (cdr (car set-list))
2242                    (if remove "-" "+")
2243                    flag)))
2244           (setq response 'fail))
2245         (setq set-list (cdr set-list)))
2246       (not (eq response 'fail)))))
2247
2248 (luna-define-method elmo-folder-delete-messages-plugged
2249   ((folder elmo-imap4-folder) numbers)
2250   (let ((session (elmo-imap4-get-session folder))
2251         (expunge
2252          (or (null (elmo-imap4-list folder "deleted"))
2253              (y-or-n-p
2254               "There's hidden deleted messages, expunge anyway?"))))
2255     (elmo-imap4-session-select-mailbox
2256      session
2257      (elmo-imap4-folder-mailbox-internal folder))
2258     (unless (elmo-imap4-set-flag folder numbers "\\Deleted")
2259       (error "Failed to set deleted flag"))
2260     (when expunge
2261       (elmo-imap4-send-command session "expunge"))
2262     t))
2263
2264 (defun elmo-imap4-detect-search-charset (string)
2265   (with-temp-buffer
2266     (insert string)
2267     (detect-mime-charset-region (point-min) (point-max))))
2268
2269 (defun elmo-imap4-search-internal-primitive (folder session filter from-msgs)
2270   (let ((search-key (elmo-filter-key filter))
2271         (imap-search-keys '("bcc" "body" "cc" "from" "subject" "to"
2272                             "larger" "smaller" "flag"))
2273         (total 0)
2274         (length (length from-msgs))
2275         charset set-list end results)
2276     (cond
2277      ((string= "last" search-key)
2278       (let ((numbers (or from-msgs (elmo-folder-list-messages folder))))
2279         (nthcdr (max (- (length numbers)
2280                         (string-to-number (elmo-filter-value filter)))
2281                      0)
2282                 numbers)))
2283      ((string= "first" search-key)
2284       (let* ((numbers (or from-msgs (elmo-folder-list-messages folder)))
2285              (rest (nthcdr (string-to-number (elmo-filter-value filter) )
2286                            numbers)))
2287         (mapc (lambda (x) (delete x numbers)) rest)
2288         numbers))
2289      ((string= "flag" search-key)
2290       (elmo-imap4-folder-list-flagged
2291        folder (intern (elmo-filter-value filter)) (elmo-filter-type filter)))
2292      ((or (string= "since" search-key)
2293           (string= "before" search-key))
2294       (setq search-key (concat "sent" search-key)
2295             set-list (elmo-imap4-make-number-set-list
2296                       from-msgs
2297                       elmo-imap4-number-set-chop-length)
2298             end nil)
2299       (while (not end)
2300         (setq results
2301               (append
2302                results
2303                (elmo-imap4-response-value
2304                 (elmo-imap4-send-command-wait
2305                  session
2306                  (format
2307                   (if elmo-imap4-use-uid
2308                       "uid search %s%s%s %s"
2309                     "search %s%s%s %s")
2310                   (if from-msgs
2311                       (concat
2312                        (if elmo-imap4-use-uid "uid ")
2313                        (cdr (car set-list))
2314                        " ")
2315                     "")
2316                   (if (eq (elmo-filter-type filter)
2317                           'unmatch)
2318                       "not " "")
2319                   search-key
2320                   (elmo-date-get-description
2321                    (elmo-date-get-datevec
2322                     (elmo-filter-value filter)))))
2323                 'search)))
2324         (setq set-list (cdr set-list)
2325               end (null set-list)))
2326       results)
2327      (t
2328       (setq charset
2329             (if (eq (length (elmo-filter-value filter)) 0)
2330                 (setq charset 'us-ascii)
2331               (elmo-imap4-detect-search-charset
2332                (elmo-filter-value filter)))
2333             set-list (elmo-imap4-make-number-set-list
2334                       from-msgs
2335                       elmo-imap4-number-set-chop-length)
2336             end nil)
2337       (while (not end)
2338         (setq results
2339               (append
2340                results
2341                (elmo-imap4-response-value
2342                 (elmo-imap4-send-command-wait
2343                  session
2344                  (list
2345                   (if elmo-imap4-use-uid "uid ")
2346                   "search "
2347                   "CHARSET "
2348                   (elmo-imap4-astring
2349                    (symbol-name charset))
2350                   " "
2351                   (if from-msgs
2352                       (concat
2353                        (if elmo-imap4-use-uid "uid ")
2354                        (cdr (car set-list))
2355                        " ")
2356                     "")
2357                   (if (eq (elmo-filter-type filter)
2358                           'unmatch)
2359                       "not " "")
2360                   (format "%s%s "
2361                           (if (member
2362                                (elmo-filter-key filter)
2363                                imap-search-keys)
2364                               ""
2365                             "header ")
2366                           (elmo-filter-key filter))
2367                   (elmo-imap4-astring
2368                    (encode-mime-charset-string
2369                     (elmo-filter-value filter) charset))))
2370                 'search)))
2371         (setq set-list (cdr set-list)
2372               end (null set-list)))
2373       results))))
2374
2375 (defun elmo-imap4-search-internal (folder session condition from-msgs)
2376   (let (result)
2377     (cond
2378      ((vectorp condition)
2379       (setq result (elmo-imap4-search-internal-primitive
2380                     folder session condition from-msgs)))
2381      ((eq (car condition) 'and)
2382       (setq result (elmo-imap4-search-internal folder session (nth 1 condition)
2383                                                from-msgs)
2384             result (elmo-list-filter result
2385                                      (elmo-imap4-search-internal
2386                                       folder session (nth 2 condition)
2387                                       from-msgs))))
2388      ((eq (car condition) 'or)
2389       (setq result (elmo-imap4-search-internal
2390                     folder session (nth 1 condition) from-msgs)
2391             result (elmo-uniq-list
2392                     (nconc result
2393                            (elmo-imap4-search-internal
2394                             folder session (nth 2 condition) from-msgs)))
2395             result (sort result '<))))))
2396
2397 (luna-define-method elmo-folder-search :around ((folder elmo-imap4-folder)
2398                                                 condition &optional numbers)
2399   (if (elmo-folder-plugged-p folder)
2400       (save-excursion
2401         (let ((session (elmo-imap4-get-session folder))
2402               ret)
2403           (message "Searching...")
2404           (elmo-imap4-session-select-mailbox
2405            session
2406            (elmo-imap4-folder-mailbox-internal folder))
2407           (setq ret (elmo-imap4-search-internal folder session condition numbers))
2408           (message "Searching...done")
2409           ret))
2410     (luna-call-next-method)))
2411
2412 (luna-define-method elmo-folder-msgdb-create-plugged
2413   ((folder elmo-imap4-folder) numbers flag-table)
2414   (when numbers
2415     (let ((session (elmo-imap4-get-session folder))
2416           (headers
2417            (elmo-uniq-list
2418             (append
2419              '("Subject" "From" "To" "Cc" "Date"
2420                "Message-Id" "References" "In-Reply-To")
2421              (mapcar #'capitalize (elmo-msgdb-extra-fields 'non-virtual)))))
2422           (total 0)
2423           print-length print-depth
2424           rfc2060 set-list)
2425       (setq rfc2060 (elmo-imap4-session-capable-p session 'imap4rev1))
2426       (elmo-with-progress-display (elmo-folder-msgdb-create (length numbers))
2427           "Creating msgdb"
2428         (elmo-imap4-session-select-mailbox
2429          session (elmo-imap4-folder-mailbox-internal folder))
2430         (setq set-list (elmo-imap4-make-number-set-list
2431                         numbers
2432                         elmo-imap4-overview-fetch-chop-length))
2433         ;; Setup callback.
2434         (with-current-buffer (elmo-network-session-buffer session)
2435           (setq elmo-imap4-current-msgdb (elmo-make-msgdb)
2436                 elmo-imap4-seen-messages nil
2437                 elmo-imap4-fetch-callback 'elmo-imap4-fetch-callback-1
2438                 elmo-imap4-fetch-callback-data (cons flag-table folder))
2439           (while set-list
2440             (elmo-imap4-send-command-wait
2441              session
2442              ;; get overview entity from IMAP4
2443              (format "%sfetch %s (%s rfc822.size flags)"
2444                      (if elmo-imap4-use-uid "uid " "")
2445                      (cdr (car set-list))
2446                      (if rfc2060
2447                          (format "body.peek[header.fields %s]" headers)
2448                        (format "%s" headers))))
2449             (setq set-list (cdr set-list)))
2450           (when elmo-imap4-seen-messages
2451             (elmo-imap4-set-flag folder elmo-imap4-seen-messages "\\Seen"))
2452           ;; cannot setup the global flag while retrieval.
2453           (dolist (number (elmo-msgdb-list-messages elmo-imap4-current-msgdb))
2454             (elmo-global-flags-set (elmo-msgdb-flags elmo-imap4-current-msgdb
2455                                                      number)
2456                                    folder number
2457                                    (elmo-message-entity-field
2458                                     (elmo-msgdb-message-entity
2459                                      elmo-imap4-current-msgdb number)
2460                                     'message-id)))
2461           elmo-imap4-current-msgdb)))))
2462
2463 (luna-define-method elmo-folder-set-flag-plugged ((folder elmo-imap4-folder)
2464                                                   numbers flag)
2465   (let ((spec (cdr (assq flag elmo-imap4-flag-specs))))
2466     (elmo-imap4-set-flag folder numbers (or (car spec)
2467                                             (capitalize (symbol-name flag)))
2468                          (nth 1 spec))))
2469
2470 (luna-define-method elmo-folder-unset-flag-plugged ((folder elmo-imap4-folder)
2471                                                     numbers flag)
2472   (let ((spec (cdr (assq flag elmo-imap4-flag-specs))))
2473     (elmo-imap4-set-flag folder numbers (or (car spec)
2474                                             (capitalize (symbol-name flag)))
2475                          (not (nth 1 spec)))))
2476
2477 (luna-define-method elmo-message-use-cache-p ((folder elmo-imap4-folder)
2478                                               number)
2479   elmo-imap4-use-cache)
2480
2481 (luna-define-method elmo-folder-message-appendable-p ((folder elmo-imap4-folder))
2482   (if (elmo-folder-plugged-p folder)
2483       (not (elmo-imap4-session-read-only-internal
2484             (elmo-imap4-get-session folder)))
2485     elmo-enable-disconnected-operation)) ; offline refile.
2486
2487 (luna-define-method elmo-folder-check-plugged ((folder elmo-imap4-folder))
2488   (let ((session (elmo-imap4-get-session folder 'if-exists)))
2489     (when session
2490       (if (string=
2491            (elmo-imap4-session-current-mailbox-internal session)
2492            (elmo-imap4-folder-mailbox-internal folder))
2493           (if elmo-imap4-use-select-to-update-status
2494               (elmo-imap4-session-select-mailbox
2495                session
2496                (elmo-imap4-folder-mailbox-internal folder)
2497                'force)
2498             (elmo-imap4-session-check session))))))
2499
2500 (defsubst elmo-imap4-folder-diff-plugged (folder)
2501   (let ((session (elmo-imap4-get-session folder))
2502         messages new unread response killed uidnext)
2503 ;;;    (elmo-imap4-commit spec)
2504     (with-current-buffer (elmo-network-session-buffer session)
2505       (setq elmo-imap4-status-callback nil)
2506       (setq elmo-imap4-status-callback-data nil))
2507     (if elmo-imap4-use-select-to-update-status
2508         (elmo-imap4-session-select-mailbox
2509          session
2510          (elmo-imap4-folder-mailbox-internal folder)))
2511     (setq response
2512           (elmo-imap4-send-command-wait session
2513                                         (list
2514                                          "status "
2515                                          (elmo-imap4-mailbox
2516                                           (elmo-imap4-folder-mailbox-internal
2517                                            folder))
2518                                          " (recent unseen messages uidnext)")))
2519     (setq response (elmo-imap4-response-value response 'status))
2520     (setq messages (elmo-imap4-response-value response 'messages))
2521     (setq uidnext (elmo-imap4-response-value response 'uidnext))
2522     (setq killed (elmo-msgdb-killed-list-load (elmo-folder-msgdb-path folder)))
2523     ;;
2524     (when killed
2525       (when (and (consp (car killed))
2526                  (eq (car (car killed)) 1))
2527         (setq messages (- uidnext (cdr (car killed)) 1)))
2528       (setq messages (- messages
2529                         (elmo-msgdb-killed-list-length (cdr killed)))))
2530     (setq new (elmo-imap4-response-value response 'recent)
2531           unread (elmo-imap4-response-value response 'unseen))
2532     (if (< unread new) (setq new unread))
2533     (list new unread messages)))
2534
2535 (luna-define-method elmo-folder-diff-plugged ((folder elmo-imap4-folder))
2536   (elmo-imap4-folder-diff-plugged folder))
2537
2538 (luna-define-method elmo-folder-diff-async ((folder elmo-imap4-folder))
2539   (setq elmo-imap4-server-diff-async-callback
2540         elmo-folder-diff-async-callback)
2541   (setq elmo-imap4-server-diff-async-callback-data
2542         elmo-folder-diff-async-callback-data)
2543   (elmo-imap4-server-diff-async folder))
2544
2545 (luna-define-method elmo-folder-open :around ((folder elmo-imap4-folder)
2546                                               &optional load-msgdb)
2547   (if (elmo-folder-plugged-p folder)
2548       (let (session mailbox msgdb result response tag)
2549         (condition-case err
2550             (progn
2551               (setq session (elmo-imap4-get-session folder)
2552                     mailbox (elmo-imap4-folder-mailbox-internal folder)
2553                     tag (elmo-imap4-send-command session
2554                                                  (list "select "
2555                                                        (elmo-imap4-mailbox
2556                                                         mailbox))))
2557               (message "Selecting %s..."
2558                        (elmo-folder-name-internal folder))
2559               (if load-msgdb
2560                   (setq msgdb (elmo-folder-msgdb-load folder 'silent)))
2561               (elmo-folder-set-killed-list-internal
2562                folder
2563                (elmo-msgdb-killed-list-load (elmo-folder-msgdb-path folder)))
2564               (if (setq result (elmo-imap4-response-ok-p
2565                                 (setq response
2566                                       (elmo-imap4-read-response session tag))))
2567                   (progn
2568                     (let ((exists (assq 'exists response))) ; update message count,
2569                       (when exists                          ; so merge update can go
2570                         (elmo-folder-set-info-hashtb folder nil (cadr exists))))
2571                     (elmo-imap4-session-set-current-mailbox-internal
2572                      session mailbox)
2573                     (elmo-imap4-session-set-read-only-internal
2574                      session
2575                      (nth 1 (assq 'read-only (assq 'ok response))))
2576                     (elmo-imap4-session-set-flags-internal
2577                      session
2578                      (nth 1 (or (assq 'permanentflags response)
2579                                 (assq 'flags response)))))
2580                 (elmo-imap4-session-set-current-mailbox-internal session nil)
2581                 (if (elmo-imap4-response-bye-p response)
2582                     (elmo-imap4-process-bye session)
2583                   (error "%s"
2584                          (or (elmo-imap4-response-error-text response)
2585                              (format "Select %s failed" mailbox)))))
2586               (message "Selecting %s...done"
2587                        (elmo-folder-name-internal folder))
2588               (elmo-folder-set-msgdb-internal
2589                folder msgdb))
2590           (quit
2591            (if (elmo-imap4-response-ok-p response)
2592                (elmo-imap4-session-set-current-mailbox-internal
2593                 session mailbox)
2594              (and session
2595                   (elmo-imap4-session-set-current-mailbox-internal
2596                    session nil))))
2597           (error
2598            (if (elmo-imap4-response-ok-p response)
2599                (elmo-imap4-session-set-current-mailbox-internal
2600                 session mailbox)
2601              (and session
2602                   (elmo-imap4-session-set-current-mailbox-internal
2603                    session nil))))))
2604     (luna-call-next-method)))
2605
2606 ;; elmo-folder-open-internal: do nothing.
2607
2608 (luna-define-method elmo-find-fetch-strategy ((folder elmo-imap4-folder) number
2609                                               &optional
2610                                               ignore-cache
2611                                               require-entireness)
2612   (let ((entity (elmo-message-entity folder number)))
2613     (if (null entity)
2614         (elmo-make-fetch-strategy 'entire)
2615       (let* ((size (elmo-message-entity-field entity 'size))
2616              (message-id (elmo-message-entity-field entity 'message-id))
2617              (cache-file (elmo-file-cache-get message-id))
2618              (use-cache (and (not ignore-cache)
2619                              (elmo-message-use-cache-p folder number)
2620                              (if require-entireness
2621                                  (eq (elmo-file-cache-status cache-file)
2622                                      'entire)
2623                                (elmo-file-cache-status cache-file)))))
2624         (elmo-make-fetch-strategy
2625          (if use-cache
2626              (elmo-file-cache-status cache-file)
2627            (if (and (not require-entireness)
2628                     elmo-message-fetch-threshold
2629                     (integerp size)
2630                     (>= size elmo-message-fetch-threshold)
2631                     (or (not elmo-message-fetch-confirm)
2632                         (not (prog1
2633                                  (y-or-n-p
2634                                   (format
2635                                    "Fetch entire message at once? (%dbytes)"
2636                                    size))
2637                                (message "")))))
2638                'section
2639              'entire))
2640          use-cache
2641          (elmo-message-use-cache-p folder number)
2642          (elmo-file-cache-path cache-file))))))
2643
2644 (luna-define-method elmo-folder-create-plugged ((folder elmo-imap4-folder))
2645   (elmo-imap4-send-command-wait
2646    (elmo-imap4-get-session folder)
2647    (list "create "
2648          (elmo-imap4-mailbox
2649           (elmo-imap4-folder-mailbox-internal folder)))))
2650
2651 (defun elmo-imap4-flags-to-imap (flags)
2652   "Convert FLAGS to the IMAP flag string."
2653   (let ((imap-flag (if (not (memq 'unread flags)) "\\Seen")))
2654     (dolist (flag flags)
2655       (unless (memq flag '(new read unread cached))
2656         (setq imap-flag
2657               (concat imap-flag
2658                       (if imap-flag " ")
2659                       (or (car (cdr (assq flag elmo-imap4-flag-specs)))
2660                           (capitalize (symbol-name flag)))))))
2661     imap-flag))
2662
2663 (luna-define-method elmo-folder-append-buffer
2664   ((folder elmo-imap4-folder) &optional flags number)
2665   (if (elmo-folder-plugged-p folder)
2666       (let ((session (elmo-imap4-get-session folder))
2667             send-buffer result)
2668         (elmo-imap4-session-select-mailbox session
2669                                            (elmo-imap4-folder-mailbox-internal
2670                                             folder))
2671         (setq send-buffer (elmo-imap4-setup-send-buffer))
2672         (unwind-protect
2673             (setq result
2674                   (elmo-imap4-send-command-wait
2675                    session
2676                    (list
2677                     "append "
2678                     (elmo-imap4-mailbox (elmo-imap4-folder-mailbox-internal
2679                                          folder))
2680                     (if (and flags (elmo-folder-use-flag-p folder))
2681                         (concat " (" (elmo-imap4-flags-to-imap flags) ") ")
2682                       " () ")
2683                     (elmo-imap4-buffer-literal send-buffer))))
2684           (kill-buffer send-buffer))
2685         (when result
2686           (elmo-folder-preserve-flags
2687            folder (elmo-msgdb-get-message-id-from-buffer) flags))
2688         result)
2689     ;; Unplugged
2690     (if elmo-enable-disconnected-operation
2691         (elmo-folder-append-buffer-dop folder flags number)
2692       (error "Unplugged"))))
2693
2694 (eval-when-compile
2695   (defmacro elmo-imap4-identical-system-p (folder1 folder2)
2696     "Return t if FOLDER1 and FOLDER2 are in the same IMAP4 system."
2697     `(and (string= (elmo-net-folder-server-internal ,folder1)
2698                    (elmo-net-folder-server-internal ,folder2))
2699           (eq (elmo-net-folder-port-internal ,folder1)
2700               (elmo-net-folder-port-internal ,folder2))
2701           (string= (elmo-net-folder-user-internal ,folder1)
2702                    (elmo-net-folder-user-internal ,folder2)))))
2703
2704 (luna-define-method elmo-folder-next-message-number-plugged
2705   ((folder elmo-imap4-folder))
2706   (let ((session (elmo-imap4-get-session folder))
2707         messages new unread response killed uidnext)
2708     (with-current-buffer (elmo-network-session-buffer session)
2709       (setq elmo-imap4-status-callback nil)
2710       (setq elmo-imap4-status-callback-data nil))
2711     (if elmo-imap4-use-select-to-update-status
2712         (elmo-imap4-session-select-mailbox
2713          session
2714          (elmo-imap4-folder-mailbox-internal folder)))
2715     (setq response
2716           (elmo-imap4-send-command-wait session
2717                                         (list
2718                                          "status "
2719                                          (elmo-imap4-mailbox
2720                                           (elmo-imap4-folder-mailbox-internal
2721                                            folder))
2722                                          " (uidnext)"))
2723           response (elmo-imap4-response-value response 'status))
2724     (elmo-imap4-response-value response 'uidnext)))
2725
2726 (defun elmo-folder-append-messages-imap4-imap4 (dst-folder
2727                                                 src-folder
2728                                                 numbers
2729                                                 same-number)
2730   (if (and (elmo-imap4-identical-system-p dst-folder src-folder)
2731            (elmo-folder-plugged-p dst-folder))
2732       ;; Plugged
2733       (prog1
2734           (elmo-imap4-copy-messages src-folder dst-folder numbers)
2735         (elmo-progress-notify 'elmo-folder-move-messages (length numbers)))
2736     (elmo-folder-append-messages dst-folder src-folder numbers same-number
2737                                  'elmo-folder-append-messages-imap4-imap4)))
2738
2739 (luna-define-method elmo-message-deletable-p ((folder elmo-imap4-folder)
2740                                               number)
2741   (if (elmo-folder-plugged-p folder)
2742       (not (elmo-imap4-session-read-only-internal
2743             (elmo-imap4-get-session folder)))
2744     elmo-enable-disconnected-operation)) ; offline refile.
2745
2746 ;;;(luna-define-method elmo-message-fetch-unplugged
2747 ;;;  ((folder elmo-imap4-folder)
2748 ;;;   number strategy  &optional section outbuf unseen)
2749 ;;;  (error "%d%s is not cached." number (if section
2750 ;;;                                       (format "(%s)" section)
2751 ;;;                                     "")))
2752
2753 (defsubst elmo-imap4-message-fetch (folder number strategy
2754                                            section outbuf unseen)
2755   (let ((session (elmo-imap4-get-session folder))
2756         response)
2757     (elmo-imap4-session-select-mailbox session
2758                                        (elmo-imap4-folder-mailbox-internal
2759                                         folder))
2760     (with-current-buffer (elmo-network-session-buffer session)
2761       (setq elmo-imap4-fetch-callback nil)
2762       (setq elmo-imap4-fetch-callback-data nil))
2763     (elmo-with-progress-display (elmo-retrieve-message
2764                                  (elmo-message-field folder number :size)
2765                                  elmo-imap4-literal-progress-reporter)
2766         "Retrieving"
2767       (setq response
2768             (elmo-imap4-send-command-wait session
2769                                           (format
2770                                            (if elmo-imap4-use-uid
2771                                                "uid fetch %s body%s[%s]"
2772                                              "fetch %s body%s[%s]")
2773                                            number
2774                                            (if unseen ".peek" "")
2775                                            (or section "")))))
2776     (if (setq response (elmo-imap4-response-bodydetail-text
2777                         (elmo-imap4-response-value-all
2778                          response 'fetch)))
2779         (with-current-buffer outbuf
2780           (erase-buffer)
2781           (insert response)
2782           (elmo-delete-cr-buffer)
2783           t))))
2784
2785 (luna-define-method elmo-message-fetch-plugged ((folder elmo-imap4-folder)
2786                                                 number strategy
2787                                                 &optional section
2788                                                 outbuf unseen)
2789   (when elmo-imap4-set-seen-flag-explicitly
2790     (elmo-imap4-set-flag folder (list number) "\\Seen"))
2791   (elmo-imap4-message-fetch folder number strategy section outbuf unseen))
2792
2793 (luna-define-method elmo-message-fetch-field ((folder elmo-imap4-folder)
2794                                               number field)
2795   (let ((session (elmo-imap4-get-session folder)))
2796     (elmo-imap4-session-select-mailbox session
2797                                        (elmo-imap4-folder-mailbox-internal
2798                                         folder))
2799     (with-current-buffer (elmo-network-session-buffer session)
2800       (setq elmo-imap4-fetch-callback nil)
2801       (setq elmo-imap4-fetch-callback-data nil))
2802     (with-temp-buffer
2803       (insert
2804        (elmo-imap4-response-bodydetail-text
2805         (elmo-imap4-response-value
2806          (elmo-imap4-send-command-wait session
2807                                        (concat
2808                                         (if elmo-imap4-use-uid
2809                                             "uid ")
2810                                         (format
2811                                          "fetch %s (body.peek[header.fields (%s)])"
2812                                          number field)))
2813          'fetch)))
2814       (elmo-delete-cr-buffer)
2815       (goto-char (point-min))
2816       (std11-field-body (symbol-name field)))))
2817
2818 (luna-define-method elmo-folder-search-requires-msgdb-p ((folder
2819                                                           elmo-imap4-folder)
2820                                                          condition)
2821   nil)
2822
2823 (autoload 'elmo-global-flags-set "elmo-flag")
2824 (autoload 'elmo-get-global-flags "elmo-flag")
2825
2826 (require 'product)
2827 (product-provide (provide 'elmo-imap4) (require 'elmo-version))
2828
2829 ;;; elmo-imap4.el ends here