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