elmo/elmo-imap4.el

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