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