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