;;; cmail-simap4.el --- cmail interface to simap4 driver (using simap4)

;; Author: Takeshi Morishima (tm@onepost.net)
;; Keywords: mail
;; Created at: Sat Feb 26 15:39:56 JST 2000

;; This file is part of cmail (a mail utility for GNU Emacs)

;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2, or (at
;; your option) any later version.

;; This program is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; This is a cmail option feature module for simap4.el. Please see
;; README.imap4 in doc/ directory in the cmail distribution for more
;; detail.

;; Mailbox/Folder name translation and usage convention
;; ----------------------------------------------------
;; cmail mainline convention.
;; ==========================
;;
;; cmail folder file (ffile): Used for a cmail folder file to save
;; folder information.  It is represented by the client OS specific
;; file system naming convention, and may differ OS by OS.  With OS
;; specific convention, it provides folder file format attributes.  It
;; will be normalized by an assoc list when fetching cmail folder
;; attributes.  Normalized folder attribute assoc list looks like
;; this:
;; 
;;   (cmail-folder-attr ("INBOX"
;;                       (file-name "INBOX")
;;                       (type normal)
;;                       (format 1)))
;;
;; A folder that has type of normal and format of 1 contains messages
;; within the folder file and has summary index at the begining of the
;; folder.
;;
;; cmail-folder (cfolder): Used for a cmail folder name, presented to
;; the user through cmail user interfaces and folders mode. When
;; required a pattern matching to folder names, for example, this name
;; representation is used.  Philosophy is to try to keep this to be as
;; same as cmail folder file name, but this could be differnt if file
;; system does not allow cmail folder name convention.
;;
;; A cmail-folder could be virtual folder where no corresponding cmail
;; folder file exists.  A virtual folder is on-memory only folder
;; which does not have a corresponding cmail folder file.
;; Historically, when cmail folder name starts with slash ('/')
;; character, it is a virtual folder.  Alternatively it could be
;; checked by an attribute extention of (ftype virtual).
;;
;; Generally, a cmail-folder is represented as either or mixture of
;; UNIX file system convention where slash ('/') character is used to
;; separate folder directory or USENET news group convention where dot
;; ('.') character is used to separate folder groups.  In the UNIX
;; file system convention, it is not allowed to contain messages in a
;; directory name.  For example, FOLDER-DIR/ cannot contain messages.
;; The USENET news group convention allows the group folder to contain
;; messages. For example, GROUP and GROUP.FOLDER can both contain
;; message.  It is case sensitive by default, unless specific rule is
;; applied in some special folder systems such as simap4.
;;
;; simap4 convention.
;; ==================
;;
;; imap4-spec (or spec): Specification of a server.  There may be
;; multiple specs for a server, as long as server-dir is different.
;;
;; mailbox (or mbox): Used for an IMAP4 server mailbox representation,
;; exchanged through IMAP4 connection. modified [UTF-7] encoded name.
;;
;; topdir: Identification of an imap4 server spec.  Translated to
;; client server-dir.  It is part of the cmail-folder name. (Not
;; exactly a part of the cmail folder file name.  In most cases,
;; however, both filename and topdir name are the same.)
;;
;; client box (cbox): A part of cmail folder name that will be
;; translated to a mailbox and a client box file, and is part of
;; cmail-folder (topdir removed).  Mailbox filters will be compared
;; against this part.  It may not be direct encoded name of mailbox,
;; cmail folder naming convention (which is TBD) is used.
;;
;; virtual-client-box (or vcbox): Similar to the client-box but it
;; does not have a corresponding mailbox on the server.  It is used to
;; put together result of search for multiple mailboxes, thus each
;; message contains mailbox information as well. The message text is
;; fetched from a corresponding mailbox for the message, based on the
;; per-message mailbox information.  (imap4-type vcbox) extention is
;; used to specify this type.  The virtual client box is not a virtual
;; folder.  A cmail folder file could exist even for a virtual client
;; box.
;;
;; cmail-folder (cfolder) for simap4: For simap4, a cmail folder file
;; name consists of topdir at the beginning, and either virtual client
;; box as the rest of the cmail folder string.
;;
;; 
;; NOTE: The following are used as a concept only, and handled by
;; main-line cmail folder handling.  cmail-simap4.el will not handle
;; these directly.
;;
;; topdir-file-name: It is a top directory corresponding to a topdir,
;; represented by the client directory file system name.
;;
;; client-box-file-name (or cbox-fname): An OS specific file name
;; representation corresponding to client box.
;;
;; virtual-client-box-file-name (or vcbox-fname): An OS specific file
;; name representation corresponding to virtual client box.
;;


;;; Code:

;;;------------------------------------------------------------------------
;;; dependency check
(eval-and-compile
  ;; specify compat level and last known latest version of simap4.el
  (defconst *cmail-simap4-compat-level "1")
  (defconst *cmail-simap4-latest "1.2")
  (defconst *cmail-simap4-url "http://cmail.sourcforge.jp/")
  ;; load simap4 and check the version. stop with error.
  (condition-case nil
      (require 'simap4)
    (error (error (format "
  !! cannot load simap4.el: a compatibility level of %s is
  !! required. (latest known simap4.el in this level is version %s)
  !! To find a compatible version of simap4.el, follow the URL below.
  !! <%s>.
  !! When compile you can ignore the error if you do not use imap4."
			  *cmail-simap4-compat-level
			  *cmail-simap4-latest *cmail-simap4-url))))
  (if (not (equal simap4-compat-level *cmail-simap4-compat-level))
      (progn
	(error (format "
  !! imcompatible simap4.el: a compatibility level of %s is
  !! required. (latest known simap4.el in this level is version %s)
  !! The simap4.el version found is %s, compat level %s. To find a
  !! compatible version of simap4.el, follow the URL below.
  !! <%s>.
  !! When compile, you can ignore the error if you do not use imap4."
		       *cmail-simap4-compat-level *cmail-simap4-latest
		       simap4-version simap4-compat-level
		       *cmail-simap4-url)))))

(require 'cmail-use-simap4)
(require 'cmail)
(require 'cmail-vars)

;;;------------------------------------------------------------------------
;;; local-global variables
(defvar *cmail-simap4-noremote-p nil)
(defvar *cmail-simap4-sync-delete-commit t) ;; remove when becomes stable.
(defvar *cmail-simap4-init-sync-done nil) ;; list specs init sync is done.

;;;------------------------------------------------------------------------
;;; account database access
(defsubst cmail-simap4-servers-1_2-format-version (imap4-spec)
  (elt imap4-spec 0))

(defsubst cmail-simap4-servers-1_2-inactive-p (imap4-spec)
  (elt imap4-spec 1))

(defsubst cmail-simap4-servers-1_2-server (imap4-spec)
  (elt imap4-spec 2))

(defsubst cmail-simap4-servers-1_2-userid (imap4-spec)
  (elt imap4-spec 3))

(defsubst cmail-simap4-servers-1_2-topdir (imap4-spec)
  (elt imap4-spec 4))

(defsubst cmail-simap4-servers-1_2-virtual-folder-p (imap4-spec)
  (elt imap4-spec 5))

(defsubst cmail-simap4-servers-1_2-folders-to-hide (imap4-spec)
  (elt imap4-spec 6))

(defsubst cmail-simap4-servers-1_2-draft (imap4-spec)
  (elt imap4-spec 7))

(defsubst cmail-simap4-servers-1_2-cffile (imap4-spec)
  (elt imap4-spec 8))

(defsubst cmail-simap4-servers-1_2-initsync (imap4-spec)
  (elt imap4-spec 9))

(defsubst cmail-simap4-servers-1_2-syncmode (imap4-spec)
  (elt imap4-spec 10))

(defsubst cmail-simap4-servers-1_2-flagsync (imap4-spec)
  (elt imap4-spec 11))

(defsubst cmail-simap4-servers-1_2-syncmbox (imap4-spec)
  (elt imap4-spec 12))

(defsubst cmail-simap4-servers-1_2-search-mboxes-regexp (imap4-spec)
  (elt imap4-spec 13))

(defsubst cmail-simap4-servers-1_2-fetchmode (imap4-spec)
  (elt imap4-spec 14))

(defsubst cmail-simap4-servers-1_2-Smsg (imap4-spec)
  (elt imap4-spec 15))

(defsubst cmail-simap4-servers-1_2-Spart (imap4-spec)
  (elt imap4-spec 16))

(defsubst cmail-simap4-servers-1_2-Tconn (imap4-spec)
  (elt imap4-spec 17))

(defsubst cmail-simap4-servers-1_2-Tresp (imap4-spec)
  (elt imap4-spec 18))

(defsubst cmail-simap4-fetchmode (imap4-spec)
  "Returns fetch mode according to configuration. If default the
result is different depending on whether virtual folder is used."
  (let ((mode (cmail-simap4-servers-1_2-fetchmode imap4-spec)))
    (cond
     ((eq mode 'unspecified) cmail-simap4-fetch-mode)
     ((and (eq mode 'default)
	   (cmail-simap4-servers-1_2-virtual-folder-p imap4-spec))
      'headers-only)
     ((eq mode 'default) cmail-simap4-fetch-mode)
     (t mode))))

(defun cmail-simap4-topdir (imap4-spec)
  (if (equal (cmail-simap4-servers-1_2-topdir imap4-spec) "")
      (concat
       (cmail-simap4-servers-1_2-userid imap4-spec)
       "@"
       (cmail-simap4-servers-1_2-server imap4-spec))
    (cmail-simap4-servers-1_2-topdir imap4-spec)))

(defun cmail-simap4-get-active-imap4-specs ()
  (let ((simap4-servers cmail-simap4-servers)
	proto-spec res)
    (while simap4-servers
      (setq proto-spec (car simap4-servers))
      (setq simap4-servers (cdr simap4-servers))
      (cond
       ((equal (cmail-simap4-servers-1_2-format-version proto-spec) "1.2")
	(if (null (elt proto-spec 1))
	    (setq res (cons proto-spec res))))))
    (nreverse res)))

(defun cmail-simap4-get-spec-by-cmail-folder (cmail-folder)
  (if (string-match "^\\([^/]+\\)\\(/\\(.+\\)\\|/\\|\\)$" cmail-folder)
      (cmail-simap4-get-spec-by-topdir (match-string 1 cmail-folder))))

(defun cmail-simap4-get-spec-by-topdir (topdir)
  (let ((imap4-specs cmail-simap4-servers))
    (catch 'spec-by-topdir
      (while imap4-specs
	(if (equal (cmail-simap4-topdir (car imap4-specs)) topdir)
	    (throw 'spec-by-topdir (car imap4-specs)))
	(setq imap4-specs (cdr imap4-specs))))))

(defun cmail-simap4-extract-mbox (cmail-folder)
  (if (and (cmail-simap4-get-spec-by-cmail-folder cmail-folder)
	   (string-match "^\\([^/]+\\)\\(/\\(.+\\)\\|/\\|\\)$" cmail-folder))
      (let ((mailbox (or (match-string 3 cmail-folder) "")))
	(if (string-match "[ \t\n]" mailbox)
	    (prin1-to-string mailbox)
	  mailbox))))

(defun cmail-simap4-cmail-folder (imap4-spec mailbox)
  (concat (cmail-simap4-topdir imap4-spec) "/"
	  (cmail-simap4-client-box mailbox)))

(defun cmail-simap4-client-box (mailbox)
  "Not completed yet. Need modified [UTF-7] decoding and other string
normalization."
  mailbox)

(defun cmail-simap4-folder-p (cmail-folder)
  (cmail-simap4-get-spec-by-cmail-folder cmail-folder))

(defsubst cmail-simap4-inbox-p (cmail-folder)
  (and (cmail-simap4-folder-p cmail-folder)
       (string-match "/INBOX$" cmail-folder)))

(defun cmail-simap4-virtual-client-box-p (cbox)
  (equal cbox "+SEARCH-RESULT"))

(defun cmail-simap4-extract-client-box-part (cmail-folder)
  (let ((mailbox (cmail-simap4-extract-mbox cmail-folder)))
    (if (stringp mailbox)
	(cmail-simap4-client-box mailbox)
      "")))


;;;------------------------------------------------------------------------
;;; folder synchronization
(setq cmail-folders-update-function 'cmail-simap4-sync-folders)

(defvar *cmail-simap-full-sync-p nil)
(defun cmail-simap4-sync-all-folders ()
  (interactive)
  (let ((*cmail-simap-full-sync-p t))
    (cmail-folders-get-newmail)))

(defun cmail-simap4-sync-folders ()
  "IMAP4 サーバディレクトリを査走して IMAP folder を作成する"
  (interactive)
  (cmail-simap4-log "sync-folders: started %s"
		    (format-time-string "%Y-%m-%d %T %z" (current-time)))
  (let* ((imap4-specs (cmail-simap4-get-active-imap4-specs))
	 (tmp-specs imap4-specs)
	 server-dir server-files mboxes updated-folders
	 imap4-spec sync-mode flag-sync)

    ;; sync only the server for the current dirctory. search for
    ;; matching dir, and adjust imap4-specs.
    (while tmp-specs
      (if (string-match
	   (concat "^"
		   (regexp-quote
		    (cmail-simap4-servers-1_2-topdir (car tmp-specs)))
		   "/")
	   *cmail-folders-current-dir)
	  (progn
	    (setq imap4-specs (list (car tmp-specs)))
	    (setq tmp-specs nil))
	(setq tmp-specs (cdr tmp-specs))))
    
    ;; go through imap4 servers and synchronize.
    (while imap4-specs
      (setq imap4-spec (car imap4-specs))
      (setq imap4-specs (cdr imap4-specs))
      
      ;; setup sync modes
      (if (memq imap4-spec *cmail-simap4-init-sync-done)
	  (setq sync-mode (cmail-simap4-servers-1_2-syncmode imap4-spec))
	;; init sync
	(setq sync-mode (cmail-simap4-servers-1_2-initsync imap4-spec))
	(if (eq sync-mode 'default)
	    (if (cmail-simap4-servers-1_2-virtual-folder-p imap4-spec)
		(setq sync-mode 'full-sync)
	      (setq sync-mode 'quick-scan))))
      
      ;; setup flag sync flag
      (setq flag-sync (cmail-simap4-servers-1_2-flagsync imap4-spec))
      (if *cmail-simap-full-sync-p (setq flag-sync t))
      (if (eq sync-mode 'full-sync) (setq flag-sync t))

      ;; list maiboxes to synchronize.
      (setq mboxes (cmail-simap4-fetch-on-server-mbox-list imap4-spec))
      
      ;; walk through all folders and synchronize.
      (while mboxes
	(if (or (and *cmail-simap-full-sync-p
		     ;; if spec-mbox-only is specified, there may be a
		     ;; lot of folders, not downloaded yet, so don't
		     ;; do full sync even if force mode is used. (flag
		     ;; will be updated instead.) Need better solution
		     ;; on how to show not downloaded folders.
		     (not (eq sync-mode 'spec-mbox-only)))
		(eq sync-mode 'full-sync)
		(eq sync-mode 'quick-scan)
		(and (eq sync-mode 'spec-mbox-only)
		     (cmail-simap4-sync-box-p imap4-spec (car mboxes))))
	    (progn
	      (condition-case nil
		  (let ((cmail-folder (cmail-simap4-cmail-folder
				       imap4-spec (car mboxes))))
		    (cmail-message-resource1 'cmail-simap4-msg-1 cmail-folder)
		    (cmail-get-folder cmail-folder)
		    (if (cmail-simap4-sync-folder1 cmail-folder flag-sync)
			(setq updated-folders
			      (cons cmail-folder updated-folders)))
		    ;; update folders cache entry, and redisplay folders list.
		    (cmail-folders-update-cache-entry cmail-folder)
		    (if (not (cmail-simap4-servers-1_2-virtual-folder-p
			      imap4-spec))
			(progn
			  ;; if not virtual folder based, save folder file
			  ;; and close it for now.
			  (cmail-save-folder cmail-folder)
			  (cmail-dismiss-folder cmail-folder))))
		(error nil))))
	(setq mboxes (cdr mboxes)))
      
      ;; if init sync, remember it is already done.
      (if (not (eq imap4-spec *cmail-simap4-init-sync-done))
	  ;; initial sync is done for this server.
	  (progn
	    (setq *cmail-simap4-init-sync-done
		  (cons imap4-spec *cmail-simap4-init-sync-done)))))
    
    (cmail-simap4-log "sync-folders: finished %s"
		      (format-time-string "%Y-%m-%d %T %z" (current-time)))
    updated-folders))

(defun cmail-simap4-sync-box-p (imap4-spec mailbox)
  (let ((sync-list (cmail-simap4-servers-1_2-syncmbox imap4-spec))
	(client-box (cmail-simap4-client-box mailbox)))
    (catch 'sync-box-p
      (while sync-list
	(cond
	 ((and (string-match "^regexp: \\(.+\\)$" (car sync-list))
	       (string-match (match-string 1 (car sync-list)) client-box))
	  (throw 'sync-box-p t))
	 ((string-match (concat "^" (regexp-quote (car sync-list)) "$")
			client-box)
	  (throw 'sync-box-p t)))
	(setq sync-list (cdr sync-list))))))

(defun cmail-simap4-fetch-on-server-mbox-list (imap4-spec)
  (let* ((topdir (cmail-simap4-topdir imap4-spec))
	 (obj (cmail-simap4-get-object topdir))
	 job list-result res mailbox dir-list cmail-folder)
    (if (and obj (simap4-list obj "\"\"" "*"))
	(progn
	  (setq job (simap4-get-last-job obj))
	  (if job
	      (progn
		(setq list-result (simap4-job-get-resp-list job))
		(while list-result
		  (if (not (member "\\Noselect" (elt (car list-result) 0)))
		      (progn
			(setq mailbox (elt (car list-result) 2))
			(setq res (cons mailbox res))))
		  (setq list-result (cdr list-result)))
		(setq dir-list (cmail-simap4-list-folder-dirs res))
		(while res
		  (setq mailbox (car res))
		  (if (and (not (member mailbox dir-list))
			   (not (cmail-simap4-hide-box-p imap4-spec mailbox)))
		      (setq list-result (cons mailbox list-result)))
		  (setq res (cdr res)))))))
    (sort list-result 'string<)))

(defun cmail-simap4-list-folder-dirs (mailboxes)
  (let (dirlist res)
    (while mailboxes
      (setq dirlist (append
		     dirlist
		     (cmail-simap4-list-folder-dirs1 
		      (cmail-simap4-list-folder-dirs2 (car mailboxes)))))
      (setq mailboxes (cdr mailboxes)))
    (while dirlist
      (setq res (cons (car dirlist) res))
      (setq dirlist (delete (car dirlist) (cdr dirlist))))
    res))

(defun cmail-simap4-list-folder-dirs1 (dirlist)
  (and dirlist
       (cons (mapconcat '(lambda (arg) arg) dirlist "/")
	     (cmail-simap4-list-folder-dirs1 (cdr dirlist)))))
      
(defun cmail-simap4-list-folder-dirs2 (mailbox)
  (if (string-match "^\\([^/]+\\)/\\(.*\\)$" mailbox)
      (cons (match-string 1 mailbox)
	    (cmail-simap4-list-folder-dirs2 (match-string 2 mailbox)))))

(defun cmail-simap4-hide-box-p (imap4-spec mailbox)
  (let ((hide-list (cmail-simap4-servers-1_2-folders-to-hide imap4-spec))
	(client-box (cmail-simap4-client-box mailbox)))
    (catch 'hide-box-p
      (while hide-list
	(cond
	 ((and (string-match "^regexp: \\(.+\\)$" (car hide-list))
	       (string-match (match-string 1 (car hide-list)) client-box))
	  (throw 'hide-box-p t))
	 ((string-match (concat "^" (regexp-quote (car hide-list)) "$")
			client-box)
	  (throw 'hide-box-p t)))
	(setq hide-list (cdr hide-list))))))

(defun cmail-simap4-sync-folder (&optional folder)
  (interactive)
  ;; NOTE: This is an interactive function and controls behavior of
  ;; the sychronization. Actual synchronization is done by function
  ;; cmail-simap4-sync-folder1. Internal simap4 functions should not
  ;; call this function directly. Use cmail-simap4-sync-folder1.
  (let ((cmail-folder (or folder cmail-current-folder))
	newget-p)
    (if (cmail-simap4-virtual-client-box-p
	 (cmail-simap4-extract-client-box-part cmail-folder))
	(cmail-error-resource 'cmail-simap4-msg-47)
      (if (and cmail-folder
	       (cmail-simap4-get-spec-by-cmail-folder cmail-folder))
	  (save-excursion
	    (setq newget-p
		  (cmail-simap4-sync-folder1 cmail-folder
					   'sync-mflags 'verbose))
	    (if (interactive-p)
		(cmail-make-summary folder))))
      newget-p)))

(defun cmail-simap4-sync-folder1 (cmail-folder &optional sync-mflags verbose)
  (cmail-simap4-log "sync-folder: (%s) started %s" cmail-folder
		    (format-time-string "%Y-%m-%d %T %z"
					(current-time)))
  (let* ((obj (cmail-simap4-get-object cmail-folder))
	 (mailbox (cmail-simap4-extract-mbox cmail-folder))
	 server-uids job page-list uids new+st-uids newget-p
	 skip-sync-p flag-assoc uidnext-server uidnext-client)
    (if obj
	(progn
	  (if verbose (cmail-message-resource 'cmail-simap4-msg-2))
	  ;; first retrieve uidnext number of the mailbox if flag sync
	  ;; is not needed.
	  (if (simap4-status obj mailbox "(uidnext)")
	      (progn
		(setq job (simap4-get-last-job obj))
		(setq uidnext-server
		      (cdr (assoc 'uidnext
				  (simap4-job-get-resp-status job))))
		(setq uidnext-client
		      (cmail-simap4-get-uidnext cmail-folder))))
	  ;; don't sync if flag sync is not needed and uidnext matches.
	  (if (or sync-mflags
		  (not (integerp uidnext-client))
		  (not (integerp uidnext-server))
		  (not (= uidnext-client uidnext-server)))
	      (progn
		;; fetch the latest undeleted and locally-stored uid list
		;; for the folder from the server.
		(setq new+st-uids (cmail-simap4-sync-folder-uids
				   obj cmail-folder))
		(if (aref new+st-uids 0)
		    (progn
		      (setq newget-p t)
		      (cmail-simap4-fetch-new-msgs cmail-folder
						   (aref new+st-uids 0))
		      (if (and sync-mflags verbose)
			  (cmail-message-resource 'cmail-simap4-msg-3)))
		  (if verbose
		      (if sync-mflags
			  (cmail-message-resource 'cmail-simap4-msg-4)
			(cmail-message-resource 'cmail-simap4-msg-24))))
		(if sync-mflags
		    (progn
		      ;; retrieves flags list if there are message(s)
		      ;; on the server
		      (if (aref new+st-uids 1)
			  (let ((flags-list (aref new+st-uids 1))
				fetch-list cnt (get-list (aref new+st-uids 1)))
			    ;; make an assoc list with key as uid and value
			    ;; as flag list for easy search
			    (while (and get-list (null skip-sync-p))
			      ;; Need to use small number and iterate to get
			      ;; full flags list since MS Exchange server
			      ;; seems to have a bug with a large size of
			      ;; the get uid list.
			      (setq fetch-list nil)
			      (setq cnt 0)
			      (while (and get-list (< cnt 50))
				(setq fetch-list 
				      (cons (car get-list) fetch-list))
				(setq get-list (cdr get-list))
				(setq cnt (1+ cnt)))
			      (setq uids
				    (mapconcat
				     (function int-to-string) fetch-list
				     ","))
			      (simap4-fetch obj uids "FLAGS UID" 'uids)
			      (setq job (simap4-get-last-job obj))
			      (if (and job
				       (setq
					flags-list
					(simap4-job-get-resp-fetch job)))
				  (while flags-list
				    (setq
				     flag-assoc
				     (cons
				      (cons
				       (cdr (assoc 'uid (car flags-list)))
				       (cdr (assoc 'flags (car flags-list))))
				      flag-assoc))
				    (setq flags-list (cdr flags-list)))
				;; better not to sycnchronize if failed.
				(setq skip-sync-p t)))))
		      
		      (if (not skip-sync-p)
			  (let ((index 1))
			    ;; step through each message in the folder and
			    ;; update status if necessary
			    (cmail-get-folder cmail-folder)
			    (cmail-rebuild-index)
			    (setq page-list (cdr *cmail-pagelist))
			    (setq server-uids (aref new+st-uids 1))
			    (while page-list
			      (goto-char (car page-list))
			      (setq page-list (cdr page-list))
			      (setq server-uids
				    (cmail-simap4-sync-status
			       obj cmail-folder index server-uids
			       flag-assoc (aref new+st-uids 2)))
			      (setq index (1+ index)))
			    (cmail-sync-header)
			    (if verbose (cmail-message-resource
					 'cmail-simap4-msg-5)))
			(if verbose (cmail-message-resource
				     'cmail-simap4-msg-6)))
		      (simap4-trim-buffer obj)))
		(if (integerp uidnext-server)
		    (cmail-simap4-set-uidnext
		     cmail-folder uidnext-server)))
	    (if verbose (cmail-message-resource 'cmail-simap4-msg-24))))
      ;; if obj is nil, error with "No connection to the server"
      (if verbose (cmail-error-resource 'cmail-simap4-msg-18)))

    (cmail-simap4-log "sync-folder: (%s) finished %s" cmail-folder
		      (format-time-string "%Y-%m-%d %T %z"
					  (current-time)))
    newget-p))

(defun cmail-simap4-sync-folder-uids (obj cmail-folder)
  "Returns a cons with car being a list of new uids to be fetched, and
with cdr being a list of flag list returned from FETCH for FLAGS."
  (let (undel-uids del-uids new-uids local-uids current-uids job)
    ;; In order to obtain the latest folder status, issue a noop
    ;; command. Then checkout uids for all messages not marked
    ;; \Deleted on ther server. Deleted messages on the server are not
    ;; of interest for the sychronization purpose. Next, collect all
    ;; uids for all the messages in the corresponding local cmail
    ;; folder. The new messages to be fetched from the server are the
    ;; ones missing on the local copy. The status flags to be fetched
    ;; are for the messages with the new messages and all local
    ;; messages (for possible updates.)
    (simap4-noop obj)
    (simap4-search obj "undeleted" 'uid)
    (setq job (simap4-get-last-job obj))
    (if job
	(progn
	  (setq undel-uids (simap4-job-get-resp-search job))
	  (simap4-search obj "deleted" 'uid)
	  (setq job (simap4-get-last-job obj))
	  (if job
	      (progn
		(setq del-uids (simap4-job-get-resp-search job))
		;; make a copy as new-uids will be modified by delq.
		(setq new-uids (apply 'list undel-uids))
		(setq current-uids (cmail-simap4-collect-uids cmail-folder))
		(while (and current-uids new-uids)
		  (if (not (memq (car current-uids) (cdr current-uids)))
		      (setq local-uids (cons (car current-uids) local-uids)))
		  (setq new-uids (delq (car current-uids) new-uids))
		  (setq current-uids (cdr current-uids)))
		(if new-uids
		    (cmail-simap4-log
		     "sync-folder-uids: %s, local=%s server=%s"
		     cmail-folder local-uids (append undel-uids del-uids)))
		(let ((res (make-vector 3 nil)))
		  (aset res 0 new-uids)
		  (aset res 1 undel-uids)
		  (aset res 2 del-uids)
		  res)))))))

(defun cmail-simap4-collect-uids (cmail-folder)
  ;; TODO: For now, I give up to use a cache to get the stability
  ;; asap, but this is the part we can use a cache to speed up things.
  (let (page-list uid uid-list res (page-num 1))
    (cmail-get-folder cmail-folder)
    (cmail-rebuild-index)
    (setq page-list (cdr *cmail-pagelist))
    (while page-list
      (goto-char (car page-list))
      (setq uid (cdr (assoc 'uid
			    (cmail-safe-read
			     (cmail-get-field-values "X-cmail-imap4")))))
      (if (integerp uid)
	  (setq uid-list (cons uid uid-list))
	(cmail-simap4-log "collect-uids: %s, uid=%s, page-num=%d"
			  cmail-folder uid page-num))
      (setq page-list (cdr page-list))
      (setq page-num (1+ page-num)))
    (if uid-list
	(progn
	  (sort uid-list '>)
	  (setq res (cons (car uid-list) res))
	  (while uid-list
	    (or (eq (car res) (car uid-list))
		(setq res (cons (car uid-list) res)))
	    (setq uid-list (cdr uid-list)))))
    res))

(defun cmail-simap4-sync-status (obj cmail-folder page server-uids
				     flags-assoc del-uids)
  ;; Current folder must be cmail-folder, and point must be the
  ;; beginning of the message to be manipulated.
  (if (= (point) (cmail-page-max))
      ;; skip if this is an empty (already deleted) message.
      nil
    (let* ((imap-field (cmail-get-field-values "X-cmail-imap4"))
	   (data-items (cmail-safe-read imap-field))
	   (uid (cdr (assoc 'uid (and (listp data-items) data-items))))
	   (flags (cdr (assoc uid flags-assoc)))
	   (*cmail-simap4-noremote-p t) status-mark add-del-list
	   add-list del-list)
      (if (and imap-field (null data-items))
	  (progn
	    (cmail-simap4-log
	     "sync-status: (bad data) %s, uid=%s, page-num=%d field=[%s]"
	     cmail-folder uid page imap-field)
	    (setq status-mark (cmail-set-mail-status "Deleted"))
	  (apply 'cmail-put-mark page
		 (append status-mark (list cmail-folder))))
	(cond
	 ;; message is on the server and flag has been obtained.
	 ;; TODO: off-line update synchronization.
	 ((and (integerp uid) (member uid server-uids))
	  (setq add-del-list (cmail-simap4-get-add-del-status-list flags))
	  (setq add-list (car add-del-list))
	  (setq del-list (cdr add-del-list))
	  (save-excursion
	    ;; note, cmail-set-mail-status requires the point to be at
	    ;; the beginning of the message.
	    (setq status-mark (cmail-set-mail-status add-list del-list))
	    (apply 'cmail-put-mark page
		   (append status-mark (list cmail-folder))))
	  (setq server-uids (delq uid server-uids)))
	 
	 ;; The message is on the server but marked deleted, there fore
	 ;; flags have not been obtained. Flags other than Deleted are
	 ;; not synched in this case. (for Faster processing.)
	 ((and (integerp uid) (member uid del-uids))
	  (setq status-mark (cmail-set-mail-status "Deleted"))
	  (apply 'cmail-put-mark page (append status-mark (list cmail-folder)))
	  (cmail-simap4-log
	   "sync-status: (del member) %s, uid=%d, page-num=%d field=[%s]"
	   cmail-folder uid page imap-field)
	  (setq server-uids (delq uid server-uids)))
	 ;; Not on the server any longer
	 ((and (integerp uid) (not (member uid server-uids)))
	  (if *cmail-simap4-sync-delete-commit
	      (save-excursion
		(cmail-delete-mail page 'no-echo))
	    (setq status-mark (cmail-set-mail-status "Deleted"))
	    (apply 'cmail-put-mark page
		   (append status-mark (list cmail-folder))))
	  (cmail-simap4-log
	   "sync-status: (not on server) %s, uid=%d, page-num=%d field=[%s]"
	   cmail-folder uid page imap-field))
	 ;; not on the server and page is not imap4
	 (t 
	  (cmail-simap4-log
	   "sync-status: (uid not int) %s, uid=%s, page-num=%d field=[%s]"
	   cmail-folder uid page imap-field)
	  (setq status-mark (cmail-set-mail-status "Deleted"))
	  (apply 'cmail-put-mark page status-mark))
	 ((null data-items)
	  (setq status-mark (cmail-set-mail-status "Deleted"))
	  (apply 'cmail-put-mark page status-mark))))))
  server-uids)

(defun cmail-simap4-get-add-del-status-list (flags)
  (let (add-list del-list)
    (if (member "\\Seen" flags)
	(progn
	  (setq add-list (cons "Active" add-list))
	  (setq del-list (cons "Unread" del-list)))
      (setq del-list (cons "Active" del-list))
      (setq add-list (cons "Unread" add-list)))
    (if (member "\\Deleted" flags)
	(setq add-list (cons "Deleted" add-list))
      (setq del-list (cons "Deleted" del-list)))
    (if (member "\\Answered" flags)
	(setq add-list (cons "Replied" add-list))
      (setq del-list (cons "Replied" del-list)))
    (if (member "Forwarded" flags)
	(setq add-list (cons "Forwarded" add-list))
      (setq del-list (cons "Forwarded" del-list)))
    (if (member "Hold" flags)
	(setq add-list (cons "Hold" add-list))
      (setq del-list (cons "Hold" del-list)))
    (if (member "Bookmarked" flags)
	(setq add-list (cons "Bookmarked" add-list))
      (setq del-list (cons "Bookmarked" del-list)))
    (cons add-list del-list)))

;;------------------------------------------------------------------------
;; virtual folder check
(setq cmail-virtual-folder-check-function 'cmail-simap4-virtual-folder-p)

(defun cmail-simap4-virtual-folder-p (cmail-folder)
  (let ((imap4-spec (cmail-simap4-get-spec-by-cmail-folder cmail-folder)))
    (and imap4-spec
	 (or (cmail-simap4-servers-1_2-virtual-folder-p imap4-spec)
	     (let ((cbox (cmail-simap4-extract-client-box-part
			  cmail-folder)))
	       (and (stringp cbox) (string-match "^\+.*" cbox)))))))

;;;------------------------------------------------------------------------
;;; Get new messages hook
(setq cmail-summary-message-fetch-function 'cmail-simap4-get-new-messages)

(defun cmail-simap4-get-new-messages ()
  (if (cmail-simap4-folder-p cmail-current-folder)
      (if (cmail-simap4-virtual-client-box-p
	   (cmail-simap4-extract-client-box-part cmail-current-folder))
	  (cmail-error-resource 'cmail-simap4-msg-48)
	(if (functionp 'online-expire-cache)
	    (let ((spec (cmail-simap4-get-spec-by-cmail-folder
			 cmail-current-folder)))
	      (online-expire-cache (cmail-simap4-servers-1_2-server spec))))
	(if (cmail-simap4-sync-folder1 cmail-current-folder nil 'verbose)
	    (cmail-make-summary cmail-current-folder))
	t)))

(defun cmail-simap4-fetch-new-msgs (cmail-folder new-uids)
  (let* ((imap4-spec (cmail-simap4-get-spec-by-cmail-folder cmail-folder))
	 (fetchmode (cmail-simap4-fetchmode imap4-spec))
	 (obj (cmail-simap4-get-object cmail-folder))
	 (msg-count 0)
	 uids data-items uid header text size message messages num-msgs
	 job body dl-status beg flags)
    (if (and new-uids obj)
	(progn
	  (setq num-msgs (length new-uids))
	  (cmail-message-resource1 'cmail-simap4-msg-7 num-msgs)
	  (setq uids (mapconcat (function int-to-string) new-uids ","))
	  (cond ((or (eq fetchmode 'headers-only)
		     (eq fetchmode 'headers-only-lc))
		 (simap4-fetch obj uids "FLAGS RFC822.HEADER RFC822.SIZE"
			       'uids)
		 (setq job (simap4-get-last-job obj))
		 (if job (setq messages (simap4-job-get-resp-fetch job))))
		((eq fetchmode 'partial-download)
		 (simap4-fetch
		  obj uids "FLAGS RFC822.HEADER RFC822.SIZE BODYSTRUCTURE"
		  'uids)
		 (setq job (simap4-get-last-job obj))
		 (if job (setq messages (simap4-job-get-resp-fetch job))))
		(t
		 (simap4-fetch
		  obj uids "FLAGS RFC822.HEADER RFC822.SIZE RFC822.TEXT"
		  'uids)
		 (setq job (simap4-get-last-job obj))
		 (if job (setq messages (simap4-job-get-resp-fetch job)))))
	  (with-temp-buffer
	    (erase-buffer)
	    (while messages
	      (setq message (car messages))
	      (setq messages (cdr messages))
	      (setq header (cdr (assoc 'rfc822-header message)))
	      (setq flags (cdr (assoc 'flags message)))
	      (setq uid (cdr (assoc 'uid message)))
	      (if (and uid header)
		  (progn
		    (setq size (cdr (assoc 'rfc822-size message)))
		    (setq msg-count (1+ msg-count))
		    (cond
		     ((or (eq fetchmode 'headers-only)
			  (eq fetchmode 'headers-only-lc))
		      (setq dl-status 'none))
		     ((eq fetchmode 'partial-download)
		      (setq dl-status 'partial))
		     (t (setq dl-status 'full)))
		    (setq data-items (list (cons 'dl-status dl-status)
					   (cons 'uid uid)
					   (cons 'size size)))
		    (insert "\001\001\001\001\n")
		    (setq beg (point))
		    (insert (format "X-cmail-status: %s\n"
				    (cmail-simap4-initialize-status flags)))
		    (insert (concat "X-cmail-imap4: "
				    (prin1-to-string data-items) "\n"))
		    (simap4-insert-bstr header)
		    (cond
		     ((or (eq fetchmode 'headers-only)
			  (eq fetchmode 'headers-only-lc))
		      (insert "[**CMAIL** Downloaded headers only.]\n"))
		     ((and (eq fetchmode 'partial-download)
			   (setq body (cdr (assoc 'bodystructure message))))
		      (message (cmail-format-resource
				'cmail-simap4-msg-25 msg-count num-msgs))
		      (save-restriction
			(narrow-to-region beg (point))
			(cmail-simap4-insert-partial-body
			 imap4-spec obj uid body)))
		     ((setq text (cdr (assoc 'rfc822-text message)))
		      (simap4-insert-bstr text))
		     (t
		      (insert "[**CMAIL** Error in fetched data.]\n"))))))
	    (while (re-search-backward "\r$" nil t)
	      (replace-match ""))
	    (cmail-message-resource1 'cmail-simap4-msg-26 msg-count)
	    (cmail-get-articles-from-newmail
	     (current-buffer) cmail-folder))
	  (simap4-trim-buffer obj)))
    msg-count))

(defun cmail-simap4-initialize-status (flags)
  (let* ((add-del-list (cmail-simap4-get-add-del-status-list flags))
	 (add-list (car add-del-list))
	 (del-list (cdr add-del-list)))
    (mapconcat '(lambda (x) x)
	       (cmail-set-mail-status1 "" add-list del-list) ",")))

;;;------------------------------------------------------------------------
;;; show content - dynamic download
(setq cmail-content-supply-function 'cmail-simap4-supply-body)

(defvar *cmail-simap4-force-full-download nil)
(defvar *cmail-simap4-force-partial-download nil)
(defun cmail-simap4-force-read-content (arg)
  (interactive "P")
  (let ((page (cmail-get-page-number-from-summary))
	*cmail-simap4-force-full-download
	*cmail-simap4-force-partial-download)
    (if arg
	(setq *cmail-simap4-force-partial-download t)
      (setq *cmail-simap4-force-full-download t))
    (cmail-show-contents page)))

(defconst *cmail-simap4-mail-buffer " *cmail-simap4-mail*")
(defvar *cmail-simap4-msg-cache-list nil)
(defun cmail-simap4-get-msg-cache (idstr)
  (let ((mcache (get-buffer (concat *cmail-simap4-mail-buffer idstr))))
    (if mcache
	(progn
	  ;; reorder as recently accessed
	  (setq *cmail-simap4-msg-cache-list
		(cons mcache
		      (delq mcache *cmail-simap4-msg-cache-list)))
	  mcache))))

(defun cmail-simap4-add-msg-cache (idstr)
  (or (cmail-simap4-get-msg-cache idstr)
      (let ((num-cache (if (or (not (integerp cmail-simap4-num-msg-cache))
			       (<= cmail-simap4-num-msg-cache 1))
			   1
			 cmail-simap4-num-msg-cache))
	    (mcache (get-buffer-create
		     (concat *cmail-simap4-mail-buffer idstr))))
	(setq *cmail-simap4-msg-cache-list
	      (cons mcache *cmail-simap4-msg-cache-list))
	(let* ((tail (nthcdr (- num-cache 1)
			     *cmail-simap4-msg-cache-list))
	       (rem (cdr-safe tail)))
	  (if tail
	      (progn
		(setcdr tail nil)
		(if rem
		    (while rem
		      (if (buffer-live-p (car rem))
			  (kill-buffer (car rem)))
		      (setq rem (cdr rem)))))))
	mcache)))

(defun cmail-simap4-clear-msg-cache ()
  (while *cmail-simap4-msg-cache-list
    (if (buffer-live-p (car *cmail-simap4-msg-cache-list))
	(kill-buffer (car *cmail-simap4-msg-cache-list)))
    (setq *cmail-simap4-msg-cache-list
	  (cdr *cmail-simap4-msg-cache-list))))

(defun cmail-simap4-supply-body ()
  "Read the body text for the message from the IMAP4 server into
current buffer according to the current download mode.  If cache can
be used, make a cache the current buffer, and load new content when
needed."
  (let* ((imap4-spec
	  (cmail-simap4-get-spec-by-cmail-folder cmail-current-folder))
	 (data-items (cmail-safe-read
		      (cmail-get-field-values "X-cmail-imap4")))
	 (size (cdr (assoc 'size data-items)))
	 (mailbox (or (cdr (assoc 'mbox (and (listp data-items) data-items)))
		      (cmail-simap4-extract-mbox cmail-current-folder)))
	 (uid (cdr (assoc 'uid (and (listp data-items) data-items))))
	 (old-buf (current-buffer))
	 (beg (point-min))
	 (end (point-max))
	 (load-content t)
	 mcache idstr)
    (if (null imap4-spec) nil
      (if (eq (cmail-simap4-fetchmode imap4-spec) 'headers-only)
	  (progn
	    ;; For headers-only mode, find a cache buffer for the
	    ;; message first.
	    (if uid
		(setq idstr (concat (cmail-simap4-topdir imap4-spec)
				    "/" mailbox "/"
				    "[" (int-to-string uid) "]"))
	      (if idstr
		  (setq idstr (cmail-get-field-values "Message-Id")))
	      (if idstr (setq idstr "")))
	    
	    ;; if mcache is valid and no explicit load request made,
	    ;; try to use it.
	    (setq mcache (cmail-simap4-get-msg-cache idstr))
	    (if (or (null mcache)
		    *cmail-simap4-force-partial-download
		    *cmail-simap4-force-full-download)
		;; create a new cache, load content, or renew the cache
		(progn
		  (if mcache
		      (set-buffer mcache)
		    (set-buffer
		     (get-buffer-create (cmail-simap4-add-msg-cache idstr))))
		  (setq major-mode 'cmail-folder-mode)
		  (if (eq (current-buffer) (get-buffer cmail-current-folder))
		      (error "ERROR!")
		    (erase-buffer)
		    (cmail-insert-buffer-substring old-buf beg end)))
	      ;; set current buffer to the cache previously loaded.
	      (set-buffer mcache)
	      (setq load-content nil))))
      
      ;; if the reason for show content is for forwarding, check if
      ;; contnet is already downloaded in full (into either folder or
      ;; cache buffer), and if not, schedule to perform full download.
      (if (eq *cmail-show-content-reason 'forward)
	  (progn
	    (goto-char (point-min))
	    (setq data-items (cmail-safe-read
			      (cmail-get-field-values
			       "X-cmail-imap4")))
	    (if (not (eq (cdr-safe
			  (assoc 'dl-status data-items))
			 'full))
		(setq load-content t))))
      
      (if load-content
	  (let ((*cmail-simap4-force-full-download
		 (or (eq *cmail-show-content-reason 'forward)
		     *cmail-simap4-force-full-download)))
	    (cmail-simap4-supply-body1
	     imap4-spec data-items size mailbox uid))))))
  
(defun cmail-simap4-supply-body1 (imap4-spec data-items size mailbox uid)
  "Read the body text for the message from the IMAP4 server into
current buffer according to the current download mode."
  (let (obj job msg res body)
    (if (and imap4-spec (integerp uid) (integerp size))
	(progn
	  (cond (*cmail-simap4-force-full-download
		 (setq obj (cmail-simap4-get-object-by-spec-mbox imap4-spec
								 mailbox))
		 (if obj
		     (progn
		       (if (cmail-simap4-download-full-body obj uid size)
			   (progn
			     (cmail-simap4-update-dl-status 'full data-items)
			     (simap4-trim-buffer obj))
			 (cmail-message-resource 'cmail-simap4-msg-27)))))
		
		((and
		  (or *cmail-simap4-force-partial-download
		      (and (or
			    (null (assoc 'dl-status data-items))
			    (eq (cdr (assoc 'dl-status data-items)) 'none))
			   (integerp
			    (cmail-simap4-servers-1_2-Smsg imap4-spec))
			   (> size
			      (cmail-simap4-servers-1_2-Smsg imap4-spec))))
		  (progn
		    (setq obj 
			  (cmail-simap4-get-object-by-spec-mbox imap4-spec
								mailbox))
		    (if obj
			(progn
			  (simap4-fetch obj uid "BODYSTRUCTURE" 'uids)
			  (setq job (simap4-get-last-job obj))
			  (if job
			      (setq res (simap4-job-get-resp-fetch job)))
			  (if (consp res)
			      (setq body (cdr (assoc 'bodystructure
						     (car res)))))))))
		 (cmail-simap4-insert-partial-body imap4-spec obj uid body)
		 (cmail-simap4-update-dl-status 'partial data-items)
		 (simap4-trim-buffer obj))
		((or
		  (null (assoc 'dl-status data-items))
		  (eq (cdr (assoc 'dl-status data-items)) 'none))
		 (setq obj (cmail-simap4-get-object-by-spec-mbox imap4-spec
								 mailbox))
		 (if obj
		     (if (cmail-simap4-download-full-body obj uid size)
			 (progn
			   (cmail-simap4-update-dl-status 'full data-items)
			   (simap4-trim-buffer obj))
		       (cmail-message-resource 'cmail-simap4-msg-27)))))
	  ))))
		
(defun cmail-simap4-update-dl-status (dl-status data-items)
  (goto-char (point-min))
  (re-search-forward "^$" nil t)
  (if (re-search-backward "^X-cmail-imap4:.*\n" nil t)
      (let ((dl-status-entry (assoc 'dl-status data-items)))
	(if dl-status-entry
	    (setcdr dl-status-entry dl-status)
	  (setq data-items (cons (cons 'dl-status dl-status) data-items)))
	(goto-char (point-min))
	(replace-match "")
	(insert (format "X-cmail-imap4: %s\n"
			(prin1-to-string data-items))))))

(defun cmail-simap4-download-full-body (obj uid &optional size)
  (let (msg job res)
    ;; reset progress report
    (if (functionp 'simap4-reset-progress)
	(simap4-reset-progress obj size))
    ;; do full download
    (simap4-fetch obj uid "RFC822.TEXT" 'uids)
    (setq job (simap4-get-last-job obj))
    (if job
	(progn
	  (setq msg (simap4-job-get-resp-fetch job))
	  (setq body (cdr (assoc 'rfc822-text (car msg))))
	  (setq uid (cdr (assoc 'uid (car msg))))
	  (if body
	      (condition-case nil
		  (let (beg)
		    (cmail-simap4-delete-body)
		    (setq beg (point))
		    (simap4-insert-bstr body)
		    (while (re-search-backward "\r$" beg t)
		      (replace-match ""))
		    (setq res t))))))
    ;; reset progress report
    (if (functionp 'simap4-reset-progress)
	(simap4-reset-progress obj nil))
    res))

;;; No intention to strictly follow the mime standard. these functions
;;; will be re-visited. Idea is to avoid a large download, but to show
;;; human readable text messages as much as possible.
(defun cmail-simap4-insert-partial-body (spec obj uid body-list)
  (cmail-simap4-delete-body)
  (cmail-simap4-insert-partial-body1
   spec nil obj uid body-list (cmail-simap4-servers-1_2-Smsg spec))
  (insert "\n"))

(defun cmail-simap4-insert-partial-body1 (spec lvl obj uid body-list remsize)
  (if (not (listp (car body-list)))
      ;; non-multipart message.
      (cmail-simap4-insert-no-multipart spec lvl obj uid body-list remsize)
    ;; multipart-message.
    (let ((body-list-tmp body-list)
	  parts subtype param-list delimiter)
      ;; skip the nested body content
      (while (and body-list-tmp (listp (car body-list-tmp)))
	(setq parts (cons (car body-list-tmp) parts))
	(setq body-list-tmp (cdr body-list-tmp)))
      ;; get subtype and boundary delimiter
      (if (stringp (car body-list-tmp))
	  (progn
	    (setq subtype (downcase (car body-list-tmp)))
	    (setq param-list (car (cdr body-list-tmp)))
	    (if (and (stringp (car param-list))
		     (string= (downcase (car param-list)) "boundary"))
		(setq delimiter (car (cdr param-list))))))
      (if (stringp delimiter)
	  (cmail-simap4-insert-multipart spec lvl obj uid
					 delimiter
					 (nreverse parts)
					 remsize)
	(insert "[**CMAIL*** Malfunctioned Multipart Format.]\n")
	0))))

(defun cmail-simap4-insert-no-multipart (spec lvl obj uid body-list remsize)
  (cond
   ((and (equal (downcase (elt body-list 0)) "text")
	 (equal (downcase (elt body-list 1)) "plain")
	 (equal (downcase (elt body-list 5)) "7bit"))
    (let (dl-size (size (min remsize (cmail-simap4-servers-1_2-Spart spec))))
      (if (> (elt body-list 6) size)
	  (cmail-simap4-insert-truncation-warning))
      (setq dl-size
	    (cmail-simap4-insert-text-part1 spec (cons 1 lvl) obj uid size))
      (max 0 (- remsize dl-size))))
   ((and (equal (downcase (elt body-list 0)) "message")
	 (equal (downcase (elt body-list 1)) "rfc822"))
    (cmail-simap4-insert-message-part1
     spec (cons 1 lvl) obj uid body-list remsize))
   (t
    ;; This is the case when non-text content type is in the message
    ;; body and is not multipart. Forget about saving downloading,
    ;; just download full text, because the header part already
    ;; downloaded and mime format will likely broken apart.
    (cmail-simap4-insert-part-full-body lvl obj uid remsize))))

(defun cmail-simap4-insert-multipart (spec lvl obj uid delimiter parts remsize)
  (let ((subpart 1))
    (while parts
      (insert (format "--%s\n" delimiter))
      (if (listp (car (car parts)))
	  (setq remsize
		(cmail-simap4-insert-partial-body1
		 spec (cons subpart lvl) obj uid (car (car parts)) remsize))
	(setq remsize (cmail-simap4-insert-multipart1
		       spec (cons subpart lvl) obj uid (car parts) remsize)))
      (setq parts (cdr parts))
      (setq subpart (1+ subpart)))
    remsize))

(defun cmail-simap4-insert-multipart1 (spec lvl obj uid part remsize)
  (cond ((and (equal (downcase (elt part 0)) "text")
	      (equal (downcase (elt part 1)) "plain")
	      (equal (downcase (elt part 5)) "7bit"))
	 (cmail-simap4-insert-text-part spec lvl obj uid part remsize))
	((and (equal (downcase (elt part 0)) "message")
	      (equal (downcase (elt part 1)) "rfc822")
	      (equal (downcase (elt part 5)) "7bit"))
	 (cmail-simap4-insert-message-part spec lvl obj uid part remsize))
	(t
	 (cmail-simap4-insert-dummy-part part)
	 remsize)))

(defun cmail-simap4-insert-text-part (spec lvl obj uid part remsize)
  ;; insert header
  (insert (format "Content-type: text/%s; charset=%s\n"
		  (elt part 1) (elt (elt part 2) 1)))
  (insert (format "Content-Transfer-Encoding: %s\n\n" (elt part 5)))
  (let ((size (min remsize (cmail-simap4-servers-1_2-Spart spec))))
    (if (> (elt part 6) size) (cmail-simap4-insert-truncation-warning))
    (setq size (cmail-simap4-insert-text-part1 spec lvl obj uid size))
    (max 0 (- remsize size))))

(defun cmail-simap4-insert-text-part1 (spec lvl obj uid dl-size)
  ;; fetch content text
  (let (job msg section)
    (setq section (mapconcat (function int-to-string) (reverse lvl) "."))
    (simap4-fetch obj uid (format "BODY.PEEK[%s]<0.%d>"
				  section dl-size) 'uid)
    (setq job (simap4-get-last-job obj))
    (if job
	(progn
	  (setq msg (simap4-job-get-resp-fetch job))
	  (setq body (cdr (cdr (assoc 'body+ (car msg)))))
	  (if (cmail-bufstr-p body)
	      (let ((beg (point)))
		(simap4-insert-bstr body)
		(while (re-search-backward "\r$" beg t)
		  (replace-match ""))
		(goto-char (point-max))
		(if (not (bolp)) 
		    (progn
		      ;; A hack. this assumes eol does not appear in
		      ;; a multibyte coded text.
		      (re-search-backward "\n" nil t)
		      (delete-region (1+ (point)) (point-max))
		      (forward-char 1)))
		(insert "\n"))
	    (insert "[**CMAIL** Error in fetched data.]\n"))
	  dl-size)
      (insert "[**CMAIL** Error fetching body content.]\n")
      0)))

(defun cmail-simap4-insert-message-part (spec lvl obj uid part remsize)
  (insert "Content-type: message/rfc822\n\n")
  (cmail-simap4-insert-message-part1 spec lvl obj uid part remsize))

(defun cmail-simap4-insert-message-part1 (spec lvl obj uid part remsize)
  ;; insert header
  (let (job msg section)
    (setq section (mapconcat (function int-to-string) (reverse lvl) "."))
    (simap4-fetch obj uid (format "BODY[%s.HEADER]" section) 'uid)
    (setq job (simap4-get-last-job obj))
    (if job
	(progn
	  (setq msg (simap4-job-get-resp-fetch job))
	  (setq body (cdr (cdr (assoc 'body+ (car msg)))))
	  (if (cmail-bufstr-p body)
	      (let ((beg (point)))
		(simap4-insert-bstr body)
		(while (re-search-backward "\r$" beg t)
		  (replace-match ""))
		(goto-char (point-max))
		(cmail-simap4-insert-partial-body1
		 spec lvl obj uid (elt part 8) remsize))
	    (insert "[**CMAIL** Error in fetched data.]\n")
	    0))
      (insert "[**CMAIL** Error fetching body content.]\n")
      0)))

(defun cmail-simap4-insert-part-full-body (lvl obj uid dl-size)
  ;; fetch content text
  (let (job msg section)
    (setq section (mapconcat (function int-to-string) (reverse lvl) "."))
    (if (zerop (length section))
	(setq section "TEXT")
      (setq section (concat section ".TEXT")))
    (simap4-fetch obj uid (format "BODY[%s]" section) 'uid)
    (setq job (simap4-get-last-job obj))
    (if job
	(progn
	  (setq msg (simap4-job-get-resp-fetch job))
	  (setq body (cdr (cdr (assoc 'body+ (car msg)))))
	  (if (cmail-bufstr-p body)
	      (let ((beg (point)))
		(simap4-insert-bstr body)
		(insert "\n")
		(while (re-search-backward "\r$" beg t)
		  (replace-match ""))
		(goto-char (point-max)))
	    (insert "[**CMAIL** Error in fetched data.]\n"))))
    0))

(defun cmail-simap4-insert-dummy-part (part)
  (insert "Content-type: text/plain; charset=us-ascii\n")
  (insert "Content-transfer-encoding: 7bit\n\n")
  (insert (format "[**CMAIL** Not downloaded. (%s/%s)]\n"
		  (elt part 0) (elt part 1)))
  (insert "[**CMAIL** Use C-c SPC to download message.]\n\n"))

(defun cmail-simap4-insert-truncation-warning ()
  (insert "[**CMAIL** Content of this part is truncated.]\n")
  (insert "[**CMAIL** Use C-c SPC to download full message.]\n\n"))

;; The message must be narrowd before calling this function.
(defun cmail-simap4-delete-body ()
  (goto-char (point-min))
  (while (and (not (eq (point) (point-max))) (not (looking-at "^$")))
    (forward-line 1))
  (if (eq (point) (point-max))
      (insert "\n")
    (forward-line 1))
  (delete-region (point) (point-max)))

;;;------------------------------------------------------------------------
;;; message status
(setq cmail-message-status-function 'cmail-simap4-message-status)

(defun cmail-simap4-message-status (status-string)
  (if *cmail-simap4-noremote-p
      nil
    (let* ((imap4-spec
	    (cmail-simap4-get-spec-by-cmail-folder cmail-current-folder))
	   (data-items (cmail-safe-read
			(cmail-get-field-values "X-cmail-imap4")))
	   (uid (cdr (assoc 'uid (and (listp data-items) data-items))))
	   (mbox (cdr (assoc 'mbox (and (listp data-items) data-items))))
	   status add-flags del-flags obj msg)
      (if (and imap4-spec uid)
	  (progn
	    (if mbox
		(setq obj (cmail-simap4-get-object-by-spec-mbox
			   imap4-spec mbox))
	      (setq obj (cmail-simap4-get-object cmail-current-folder)))
	    (if obj
		(let ((flag-seen-p
		       (or (cmail-simap4-permanentflag-p obj "\\Seen")
			   (cmail-simap4-sessionflag-p obj "\\Seen")))
		      (flag-deleted-p
		       (or (cmail-simap4-permanentflag-p obj "\\Deleted")
			   (cmail-simap4-sessionflag-p obj "\\Deleted")))
		      (flag-answered-p
		       (or (cmail-simap4-permanentflag-p obj "\\Answered")
			   (cmail-simap4-sessionflag-p obj "\\Answered")))
		      (flag-user-p
		       (cmail-simap4-permanentflag-p obj "\\*")))
		  (if flag-seen-p
		      (if (string-match "Unread" status-string)
			  (setq del-flags '("\\Seen"))
			(setq add-flags '("\\Seen"))))
		  (if flag-deleted-p
		      (if (string-match "Deleted" status-string)
			  (setq add-flags (cons "\\Deleted" add-flags))
			(setq del-flags (cons "\\Deleted" del-flags))))
		  (if flag-answered-p
		      (if (string-match "Replied" status-string)
			  (setq add-flags (cons "\\Answered" add-flags))
			(setq del-flags (cons "\\Answered" del-flags))))
		  (if flag-user-p
		      (if (string-match "Hold" status-string)
			  (setq add-flags (cons "Hold" add-flags))
			(setq del-flags (cons "Hold" del-flags))))
		  (if flag-user-p
		      (if (string-match "Forwarded" status-string)
			  (setq add-flags (cons "Forwarded" add-flags))
			(setq del-flags (cons "Forwarded" del-flags))))
		  (if flag-user-p
		      (if (string-match "Bookmarked" status-string)
			  (setq add-flags (cons "Bookmarked" add-flags))
			(setq del-flags (cons "Bookmarked" del-flags))))
		  ;; update flags on the server
		  (cmail-simap4-message-status1 add-flags del-flags
						obj uid))))))))

(defun cmail-simap4-message-status1 (add-flags del-flags obj uid)
  (let (flag)
    (if add-flags
	(progn
	  (setq flag (concat "+FLAGS ("
			     (mapconcat (lambda (x) x) add-flags " ") ")"))
	  (simap4-store obj uid flag 'uids 'no-callback)))
    (if del-flags
	(progn
	  (setq flag (concat "-FLAGS ("
			     (mapconcat (lambda (x) x) del-flags " ") ")"))
	  (simap4-store obj uid flag 'uids 'no-callback)))))

(defun cmail-simap4-status-to-flags (obj status-string)
  (let ((status-string-list (split-string status-string ","))
	(flag-seen-p (or (cmail-simap4-permanentflag-p obj "\\Seen")
			 (cmail-simap4-sessionflag-p obj "\\Seen")))
	(flag-deleted-p (or (cmail-simap4-permanentflag-p obj "\\Deleted")
			    (cmail-simap4-sessionflag-p obj "\\Deleted")))
	(flag-answered-p (or (cmail-simap4-permanentflag-p obj "\\Answered")
			     (cmail-simap4-sessionflag-p obj "\\Answered")))
	(flag-user-p (cmail-simap4-permanentflag-p obj "\\*"))
	res status unseen-p)
    (while status-string-list
      (setq status (car status-string-list))
      (setq status-string-list (cdr status-string-list))
      (cond
       ((string= status "Unread")
	(setq unseen-p t))
       ((and flag-seen-p (string= status "Active"))
	(setq res (cons "\\Seen" res)))
       ((and flag-deleted-p (string= status "Deleted"))
	(setq res (cons "\\Deleted" res)))
       ((and flag-answered-p (string= status "Replied"))
	(setq res (cons "\\Answered" res)))
       ;; user defined flags supported.
       ((and flag-user-p (string= status "Bookmarked"))
	(setq res (cons "Bookmarked" res)))
       ((and flag-user-p (string= status "Forwarded"))
	(setq res (cons "Forwarded" res)))
       ((and flag-user-p (string= status "Hold"))
	(setq res (cons "Hold" res)))
       ))
    (if (and flag-seen-p (null unseen-p))
	(setq res (cons "\\Seen" res)))
    res))

(defun cmail-simap4-permanentflag-p (obj flag)
  "Non-nil when a mailbox is currently selected, and supports user
flags."
  (if (simap4-get-selected-mailbox obj)
      (let ((status (simap4-get-selected-mailbox-attr obj)))
	(and status
	     (member flag (car (cdr (assoc 'permanentflags
					   (assoc 'resp-ok status)
					   ))))))
    (cmail-error-resource 'cmail-simap4-msg-28)))

(defun cmail-simap4-sessionflag-p (obj flag)
  "Non-nil when a mailbox is currently selected, and supports user
flags."
  (if (simap4-get-selected-mailbox obj)
      (let ((status (simap4-get-selected-mailbox-attr obj)))
	(and status
	     (member flag (cdr (assoc 'resp-flags status)))))
    (cmail-error-resource 'cmail-simap4-msg-28)))


;;;------------------------------------------------------------------------
;;; delete message
(setq cmail-message-delete-function 'cmail-simap4-delete-message)

(defun cmail-simap4-delete-message ()
  (if *cmail-simap4-noremote-p
      nil
    (let* ((imap4-spec
	    (cmail-simap4-get-spec-by-cmail-folder cmail-current-folder))
	   (data-items (cmail-safe-read
			(cmail-get-field-values "X-cmail-imap4")))
	   (uid (cdr (assoc 'uid (and (listp data-items) data-items))))
	   (mbox (cdr (assoc 'mbox (and (listp data-items) data-items))))
	   obj msg)
      (if (and imap4-spec uid)
	  (progn
	    (if mbox
		(setq obj (cmail-simap4-get-object-by-spec-mbox
			   imap4-spec mbox))
	      (setq obj (cmail-simap4-get-object cmail-current-folder)))
	    (if obj
		(simap4-store obj uid "+FLAGS (\\Deleted)"
			      'uids 'no-callback)))))))

;;; commit the deletion
(setq cmail-message-expunge-function 'cmail-simap4-expunge-messages)

(defun cmail-simap4-expunge-messages (folder)
  (let ((obj (cmail-simap4-get-object folder)))
    (if obj (simap4-expunge obj))))

;;;------------------------------------------------------------------------
;;; copy message
(setq cmail-message-copy-function 'cmail-simap4-copy-message)

(defun cmail-simap4-copy-message (source target confirmp)
  "This function performs a copy for imap4. This function must be
called arrived buffer is set as the current buffer."
  (let* ((source-topdir (cmail-simap4-topdir
			 (cmail-simap4-get-spec-by-cmail-folder source)))
	 (target-spec (cmail-simap4-get-spec-by-cmail-folder target))
	 (target-topdir (cmail-simap4-topdir target-spec))
	 (data-items (cmail-safe-read
		      (cmail-get-field-values "X-cmail-imap4")))
	 (uid-assoc (assoc 'uid (and (listp data-items) data-items)))
	 (uid (cdr uid-assoc))
	 (mailbox (cmail-simap4-extract-mbox target))
	 (source-status (cmail-get-field-values "X-cmail-status"))
	 flags obj job msg-id bstr fetch-resp body size seq-new seq-old)

    ;; probaby can support sometime later
    (if (or (cmail-simap4-virtual-client-box-p
	     (cmail-simap4-extract-client-box-part source))
	    (cmail-simap4-virtual-client-box-p
	     (cmail-simap4-extract-client-box-part target)))
	(cmail-error-resource 'cmail-simap4-msg-47))
    
    ;; copy method depends on combination of source and target location
    (cond (;; server to server copy, on the same server.
	   ;; update the x-cmail-simap4 control header.
	   (and (stringp source-topdir)
		(integerp uid)
		(stringp target-topdir)
		(string= source-topdir target-topdir))
	   
	   ;; Check if the target exists, create it if does not.
	   (setq obj (cmail-simap4-get-object target))
	   (if (null obj)
	       (progn
		 (setq obj (cmail-simap4-get-object
			    target 'create confirmp))
		 (if (null obj)
		     (cmail-error-resource 'cmail-simap4-msg-10))))
	   
	   ;; Assuming there is no other activity background. This
	   ;; is a BIG assumption, but most cases it should work.
	   (setq seq-old (cmail-simap4-last-seq obj mailbox))

	   ;; do copy.
	   (setq obj (cmail-simap4-get-object source))
	   (if (null obj)
	       (cmail-error-resource 'cmail-simap4-msg-8))
	   (or (simap4-copy obj uid (cmail-simap4-extract-mbox target) 'uid)
	       (cmail-error-resource 'cmail-simap4-msg-9))
	     
	   ;; find which one just copied and find uid for it.
	   (setq seq-new (cmail-simap4-last-seq obj mailbox))
	   (if (not (and seq-new seq-old (= (- seq-new seq-old) 1)))
	       (progn
		 (setcdr uid-assoc 'unknown)
		 (cmail-message-resource1 'cmail-simap4-msg-11 1)
		 (sit-for 5))
	     (progn
	       (setq obj (cmail-simap4-get-object target))
	       (simap4-fetch obj (int-to-string seq-new) "UID")
	       (setq job (simap4-get-last-job obj))
	       (if (and job
			(simap4-result-ok-p job)
			(setq fetch-resp
			      (car (simap4-job-get-resp-fetch job)))
			(setq uid (cdr (assoc 'uid fetch-resp))))
		   (if (integerp uid) (setcdr uid-assoc uid)))))
	   (goto-char (point-min))
	   (cmail-delete-field "X-cmail-imap4")
	   (insert (format "X-cmail-imap4: %s\n"
			   (prin1-to-string data-items))))
	  
	  ;; server to local copy. download all contents if not done yet.
	  ;; strip out the x-cmail-simap4 control header.
	  ((and (stringp source-topdir)
		(integerp uid)
		(null target-topdir))
	   (if (not (eq (cdr (assoc 'dl-status data-items)) 'full))
	       (progn
		 (setq obj (cmail-simap4-get-object source))
		 (if obj
		     (progn
		       (setq size (cdr (assoc 'size data-items)))
		       (if (cmail-simap4-download-full-body obj uid size)
			   (simap4-trim-buffer obj)
			 (cmail-error-resource 'cmail-simap4-msg-27))))))
	   (goto-char (point-min))
	   (cmail-delete-field "X-cmail-imap4"))
	  
	  ;; local to server copy
	  ((and (null source-topdir)
		(stringp target-topdir))
	   (cmail-simap4-cleanup-header)
	   (setq bstr (simap4-make-bstr (current-buffer)
					(point-min) (point-max)))
	   
	   ;; Check if the target exists, create it if does not.
	   (setq obj (cmail-simap4-get-object target))
	   (if (null obj)
	       (progn
		 (setq obj (cmail-simap4-get-object
			    target 'create confirmp))
		 (if (null obj)
		     (cmail-error-resource 'cmail-simap4-msg-10))))

	   ;; Assuming there is no other activity background. This
	   ;; is a BIG assumption, but most case should work.
	   (setq seq-old (cmail-simap4-last-seq obj mailbox))
	   
	   (setq obj (cmail-simap4-get-object target))
	   (if obj
	       (progn
		 ;; Perform copy
		 (setq flags
		       (cmail-simap4-status-to-flags obj source-status))
		 (simap4-append obj mailbox bstr flags)
		 (setq job (simap4-get-last-job obj))
		 (if (not (and job (simap4-result-ok-p job)))
		     (cmail-error-resource 'cmail-simap4-msg-10))
		 (goto-char (point-min))
		 (insert (concat "X-cmail-status: " source-status "\n"))
		 
		 ;; find which one just appended.
		 (setq seq-new (cmail-simap4-last-seq obj mailbox))
		 (if (not (and seq-new seq-old (= (- seq-new seq-old) 1)))
		     (progn
		       (cmail-message-resource1 'cmail-simap4-msg-11 1)
		       (sit-for 5))
		   
		   ;; update local copy with latest server property
		   (simap4-fetch obj (int-to-string seq-new)
				 "UID RFC822.SIZE BODYSTRUCTURE")
		   (setq job (simap4-get-last-job obj))
		   (if (and job
			    (simap4-result-ok-p job)
			    (setq fetch-resp
				  (car (simap4-job-get-resp-fetch job)))
			    (setq uid (cdr (assoc 'uid fetch-resp)))
			    (setq body
				  (cdr (assoc 'bodystructure fetch-resp)))
			    (setq size
				  (cdr (assoc 'rfc822-size fetch-resp))))
		       (progn
			 (setq data-items (list (cons 'uid uid)
						(cons 'bodystruct body)
						(cons 'size size)))
			 (goto-char (point-min))
			 (forward-line 1)
			 (insert (format "X-cmail-imap4: %s\n"
					 (prin1-to-string data-items)))
			 (cmail-simap4-update-dl-status 'full data-items))
		     (cmail-message-resource1 'cmail-simap4-msg-11 2)
		     (sit-for 5))))))
	  
	  ;; local to local copy - ignore
	  ((and (null source-topdir) (null target-topdir)))

	  ;; maybe no imap4 cache data with this message. skip for now.
	  ((not (integerp uid))
	   (cmail-error-resource 'cmail-simap4-msg-12))

	  ;; other combination cannot be processed with this version.
	  (t (cmail-error-resource 'cmail-simap4-msg-13))
	  )))

(defun cmail-simap4-last-seq (obj mailbox)
  (let (select-res job)
    (if (simap4-selected-p obj)
	(simap4-close obj))
    (setq select-res (simap4-select obj mailbox))
    (if (eq select-res 'newly-selected)
	(let ((job (simap4-get-last-job obj)))
	  (simap4-job-get-resp-exists job)))))

(defun cmail-simap4-cleanup-header ()
  (save-excursion
    (save-restriction
      (let ((case-fold-search t))
	(cmail-narrow-to-head)
	(goto-char (point-min))
	(if (re-search-forward "^from " nil t)
	    (progn
	      (forward-line 1)
	      (delete-region (point-min) (point))))
	(cmail-delete-field "X-cmail-status")
	(cmail-delete-field "X-cmail-imap4")))))

;;;------------------------------------------------------------------------
;;; open mailbox
(setq cmail-mailbox-open-function 'cmail-simap4-open-mailbox)

(defun cmail-simap4-open-mailbox (cmail-folder confirmp)
  (let ((imap4-spec (cmail-simap4-get-spec-by-cmail-folder cmail-folder)))
    (if imap4-spec
	(progn
	  (if (cmail-simap4-virtual-client-box-p
	       (cmail-simap4-extract-client-box-part cmail-folder))
	      nil
	    (cmail-simap4-get-object cmail-folder 'create confirmp))))))

(defun cmail-simap4-open-folder-hook ()
  (if (cmail-simap4-virtual-folder-p *cmail-folder-name)
      ;; set folder to be volatile so deleting the buffer
      ;; is not confirmed by default.
      (setq *cmail-volatile-folder-p t)))

;;; get simap4 object. open if closed. corresponding mailbox will be
;;; selected.
(defvar *cmail-simap4-servers nil)
(defun cmail-simap4-get-object (cmail-folder &optional createp confirmp)
  (let ((imap4-spec (cmail-simap4-get-spec-by-cmail-folder cmail-folder))
	(mailbox (cmail-simap4-extract-mbox cmail-folder)))
    (if (cmail-simap4-virtual-client-box-p
	 (cmail-simap4-extract-client-box-part cmail-folder))
	nil
      (cmail-simap4-get-object-by-spec-mbox imap4-spec mailbox
					    createp confirmp))))
  
(defun cmail-simap4-get-object-by-spec-mbox (imap4-spec
					     mailbox
					     &optional createp confirmp)
  (let (server logname password options obj select-res)
    (if imap4-spec
	(progn
	  (setq server (cmail-simap4-servers-1_2-server imap4-spec))
	  (setq logname (cmail-simap4-servers-1_2-userid imap4-spec))
	  (setq password (cmail-lookup-password 'imap4 server logname))
	  (if (or (null password) (string= password ""))
	      (progn
		(setq password
		      (cmail-prompt-for-password server logname "IMAP4"))
		(cmail-save-password 'imap4 server logname password)))
	  (if (assoc (cmail-simap4-topdir imap4-spec)
		     *cmail-simap4-servers)
	      (setq obj (cdr (assoc (cmail-simap4-topdir imap4-spec)
				    *cmail-simap4-servers)))
	    (setq obj (simap4-object-create "cmail" server logname password))
	    (simap4-set-use-prog-disp obj t)
	    (simap4-set-calc-throughput obj t)
	    (simap4-set-connection-timeout
	     obj (cmail-simap4-servers-1_2-Tconn imap4-spec))
	    (simap4-set-command-timeout
	     obj (cmail-simap4-servers-1_2-Tresp imap4-spec))
	    (setq *cmail-simap4-servers
		  (cons (cons (cmail-simap4-topdir imap4-spec) obj)
			*cmail-simap4-servers)))
	  (if (not (simap4-connected-p obj))
	      (simap4-connect obj))
	  (if (simap4-connected-p obj)
	      (progn
		(if (not (simap4-authenticated-p obj))
		    (progn
		      (simap4-set-password obj password)
		      (simap4-login obj)))
		(if (not (simap4-authenticated-p obj))
		    (progn
		      (cmail-save-password 'imap4 server logname "")
		      (message (cmail-format-resource 'cmail-simap4-msg-14
						      logname server))
		      (sit-for 5)
		      nil)
		  (if (string= mailbox "")
		      (progn
			(if (simap4-selected-p obj)
			    (simap4-close obj))
			obj)
		    (setq select-res (simap4-select obj mailbox))
		    (if (eq select-res 'already-selected)
			;; return obj as successful
			obj
		      (if (eq select-res 'newly-selected)
			  (let* ((job (simap4-get-last-job obj))
				 (res (simap4-job-get-resp-ok job))
				 (uv (car (cdr (assoc 'uidvalidity res))))
				 (cmail-folder (cmail-simap4-cmail-folder
						imap4-spec mailbox)))
			    (cond
			     ((null (cmail-simap4-get-uidvalidity
				     cmail-folder))
			      ;; if no uidvalidity locally stored, let's
			      ;; assume it is ok. But we need store the
			      ;; current uidvalidty value in the cache.
			      (cmail-simap4-set-uidvalidity
			       cmail-folder uv))
			     ((not (equal uv (cmail-simap4-get-uidvalidity
					      cmail-folder)))
			      ;; cmail-folder is invalid. remove local
			      ;; folder here. (Don't delete the mbox
			      ;; on the server.), select it again and
			      ;; update uidvalidity.
			      (let ((*cmail-simap4-noremote-p t))
				(cmail-kill-folder cmail-folder 'force)
				(cmail-get-folder cmail-folder)
				(cmail-simap4-set-uidvalidity cmail-folder
							      uv))))
			    ;; return obj as successful
			    obj)
			(if (and (null select-res) createp)
			    (progn
			      (if (or (null confirmp)
				      (yes-or-no-p
				       (cmail-format-resource1
					'cmail-simap4-msg-22 mailbox)))
				  (if (simap4-create obj mailbox)
				      (if (simap4-select obj mailbox)
					  (let* 
					      ((job (simap4-get-last-job obj))
					       (res (simap4-job-get-resp-ok
						     job))
					       (uv (car 
						    (cdr
						     (assoc 'uidvalidity
							    res))))
					       (cmail-folder
						(cmail-simap4-cmail-folder
						 imap4-spec mailbox)))
					    (if (stringp uv)
						(cmail-simap4-set-uidvalidity
						 cmail-folder uv))
					    ;; return obj as successful
					    obj)
					(cmail-error-resource1
					 'cmail-simap4-msg-15 mailbox))
				    (cmail-error-resource1
				     'cmail-simap4-msg-16 mailbox))
				(cmail-message-resource1
				 'cmail-simap4-msg-23 mailbox)
				(sit-for 5)
				nil))
			  )))))))))))

;;;------------------------------------------------------------------------
;;; delete mailbox
(setq cmail-mailbox-delete-function 'cmail-simap4-delete-mailbox)

(defun cmail-simap4-delete-mailbox (cmail-folder)
  (if (or *cmail-simap4-noremote-p
	  (cmail-simap4-virtual-client-box-p
	   (cmail-simap4-extract-client-box-part cmail-folder)))
      nil
    (if (cmail-simap4-get-spec-by-cmail-folder cmail-folder)
	(let ((obj (cmail-simap4-get-object cmail-folder))
	      (mailbox (cmail-simap4-extract-mbox cmail-folder)))
	  (if obj
	      (progn
		(if (simap4-selected-p obj)
		    (simap4-close obj))
		(if (simap4-delete obj mailbox)
		    (cmail-simap4-delete-mailbox-cache cmail-folder)
		  (cmail-error-resource 'cmail-simap4-msg-17)))
	    (setq obj (cmail-simap4-get-object 
		       (cmail-simap4-topdir 
			(cmail-simap4-get-spec-by-cmail-folder
			 cmail-folder))))
	    (if (null obj)
		(cmail-error-resource 'cmail-simap4-msg-18)
	      nil)))
      ;; if cmail-folder is not an imap4 folder, do nothing
      )))

;;;------------------------------------------------------------------------
;;; rename mailbox
(setq cmail-mailbox-rename-function 'cmail-simap4-rename-mailbox)

(defun cmail-simap4-rename-mailbox (cmail-folder1 cmail-folder2)
  (let ((spec1 (cmail-simap4-get-spec-by-cmail-folder cmail-folder1))
	(mailbox1 (cmail-simap4-extract-mbox cmail-folder1))
	(spec2 (cmail-simap4-get-spec-by-cmail-folder cmail-folder2))
	(mailbox2 (cmail-simap4-extract-mbox cmail-folder2))
	obj)

    (if (or (cmail-simap4-virtual-client-box-p
	     (cmail-simap4-extract-client-box-part cmail-folder1))
	    (cmail-simap4-virtual-client-box-p
	     (cmail-simap4-extract-client-box-part cmail-folder2)))
	(cmail-error-resource 'cmail-simap4-msg-48))

    (if (or spec1 spec2)
	(if (and spec1 spec2 (eq spec1 spec2))
	    (progn
	      (setq obj (cmail-simap4-get-object cmail-folder1))
	      (if obj
		  (progn
		    (if (simap4-selected-p obj)
			(simap4-close obj))
		    (if (not (simap4-rename obj mailbox1 mailbox2))
			(cmail-error-resource 'cmail-simap4-msg-19)
		      (cmail-simap4-delete-mailbox-cache cmail-folder1)
		      (cmail-simap4-get-object cmail-folder2)
		      ;; A success. continue to rename local folders.
		      ))))
	  (cmail-error-resource 'cmail-simap4-msg-20))
      ;; if both folders are local, do nothing.
      )))

;;;------------------------------------------------------------------------
;;; copy mailbox
(setq cmail-mailbox-copy-function 'cmail-simap4-copy-mailbox)

(defun cmail-simap4-copy-mailbox (cmail-folder1 cmail-folder2)
  (let ((spec1 (cmail-simap4-get-spec-by-cmail-folder cmail-folder1))
	(spec2 (cmail-simap4-get-spec-by-cmail-folder cmail-folder2))
	obj)
    (cond ((and (or spec1 spec2) 
		(or (not (and spec1 spec2)) (eq spec1 spec2)))
	   (cmail-simap4-copy-mailbox1 cmail-folder1 cmail-folder2)
	   t)
	  ((and spec1 spec2 (not (eq spec1 spec2)))
	   (cmail-error-resource 'cmail-simap4-msg-21))
	  (t nil))))

(defun cmail-simap4-copy-mailbox1 (cmail-folder1 cmail-folder2)
  (error "IMAP4: Folder copy operation not supported yet."))

;;;------------------------------------------------------------------------
;;; search mailbox
(setq cmail-mailbox-search-function 'cmail-simap4-search-mailbox)

(defun cmail-simap4-search-mailbox (cmail-folder)
  (error "IMAP4: Folder search operation not supported yet."))

;;;------------------------------------------------------------------------
;;; search folders
(setq cmail-folders-search-function 'cmail-simap4-search-folders)

(defun cmail-simap4-search-folders ()
  (error "IMAP4: Multiple folders search operation not supported yet."))

(defun cmail-simap4-search ()
  (interactive)
  (let ((found 0) (num-folder 0) total dest (dest-count 0) cmail-folder
	search-criteria	imap4-spec search-box-regexp search-mboxes)

    (cond
     ((and (string= (buffer-name (current-buffer)) *cmail-folders-buffer)
	   (setq cmail-folder (cmail-folders-get-current-folder)))
      (setq imap4-spec
	    (cmail-simap4-get-spec-by-cmail-folder cmail-folder)))
     ((string= (buffer-name (current-buffer)) *cmail-summary-buffer)
      (setq imap4-spec (cmail-simap4-get-spec-by-cmail-folder
			cmail-current-folder))))
    (if (null imap4-spec)
	(cmail-error-resource 'cmail-simap4-msg-44)
      (setq search-criteria (cmail-simap4-construct-search-criteria))
      (if (null search-criteria)
	  (cmail-error-resource 'cmail-simap4-msg-33))
      (setq search-box-regexp
	    (cmail-simap4-construct-search-mboxes imap4-spec))
      (setq dest (concat (cmail-simap4-topdir imap4-spec) "/+SEARCH-RESULT"))
      (cmail-kill-folder dest t)
      (setq search-mboxes
	    (cmail-simap4-list-searchboxes imap4-spec search-box-regexp))
      (setq total (length search-mboxes))
      (while search-mboxes
	(setq num-folder (1+ num-folder))
	(setq found (cmail-simap4-search-it imap4-spec (car search-mboxes)
					    search-criteria
					    dest found 
					    num-folder total))
	(setq search-mboxes (cdr search-mboxes)))

      (if (zerop found)
	  (cmail-message-resource 'cmail-simap4-msg-42)
	(cmail-visit-folder dest)
	(cmail-message-resource1 'cmail-simap4-msg-43 found))
      )))

(defun cmail-simap4-list-searchboxes (imap4-spec search-box-regexp)
  (let ((search-list (cmail-simap4-fetch-on-server-mbox-list imap4-spec))
	res)
    (while search-list
      (if (string-match search-box-regexp
			(cmail-simap4-client-box (car search-list)))
	  (setq res (cons (car search-list) res)))
      (setq search-list (cdr search-list)))
    (nreverse res)))

(defun cmail-simap4-search-it (imap4-spec
			       mailbox criteria dest found num-folder
			       total)
  "Search one mailbox and display progress."
  (let ((found-in-box 0) found-uids job
	(obj (cmail-simap4-get-object-by-spec-mbox imap4-spec mailbox)))
    (if (null obj)
	(cmail-message-resource1 'cmail-simap4-msg-46 mailbox)
      (simap4-search obj criteria 'uid)
      (setq job (simap4-get-last-job obj))
      (if job
	  (cond
	   ((string= (simap4-job-get-result-code job) "ok")
	    (setq found-uids (simap4-job-get-resp-search job))
	    (setq found-in-box (length found-uids))
	    (if (eq found-in-box 0)
		nil
	      (setq found (+ found found-in-box))
	      (message (cmail-format-resource
			'cmail-simap4-msg-41
			found num-folder total
			(cmail-simap4-cmail-folder imap4-spec mailbox)))
	      (cmail-simap4-fetch-msgs obj imap4-spec mailbox
				       found-uids dest)))
	   ((string= (simap4-job-get-result-code job) "no")
	    (cmail-error-resource 'cmail-simap4-msg-45))
	   ((string= (simap4-job-get-result-code job) "bad")
	    (cmail-error-resource 'cmail-simap4-msg-28)))))
    found))

(defun cmail-simap4-fetch-msgs (obj imap4-spec mailbox uids dest)
  "Download header part of messages in the mailbox that have been
found."
  (let (job message messages header flags uid size dl-status data-items beg)
    (if (null obj)
	nil
      (setq uids (mapconcat (function int-to-string) uids ","))
      (simap4-fetch obj uids "FLAGS RFC822.HEADER RFC822.SIZE" 'uids)
      (setq job (simap4-get-last-job obj))
      (if job (setq messages (simap4-job-get-resp-fetch job)))
      (with-temp-buffer
	(erase-buffer)
	(while messages
	  (setq message (car messages))
	  (setq messages (cdr messages))
	  (setq header (cdr (assoc 'rfc822-header message)))
	  (setq flags (cdr (assoc 'flags message)))
	  (setq uid (cdr (assoc 'uid message)))
	  (if (and uid header)
	      (progn
		(setq size (cdr (assoc 'rfc822-size message)))
		(setq dl-status 'none)
		(setq data-items (list (cons 'dl-status dl-status)
				       (cons 'uid uid)
				       (cons 'size size)
				       (cons 'mbox mailbox)))
		(insert "\001\001\001\001\n")
		(setq beg (point))
		(insert (format "X-cmail-status: %s\n"
				(cmail-simap4-initialize-status flags)))
		(insert (concat "X-cmail-imap4: "
				(prin1-to-string data-items) "\n"))
		(simap4-insert-bstr header)
	      (insert "[**CMAIL** Downloaded headers only.]\n"))))
	(while (re-search-backward "\r$" nil t) (replace-match ""))
	(cmail-get-articles-from-newmail (current-buffer) dest))
      (simap4-trim-buffer obj))))

(defconst cmail-simap4-search-key-verification-list
  '("TEXT" "FROM" "SUBJECT" "KEYWORD" "HEADER" "FLAG" "TO" "CC" "BODY"))

(defvar cmail-simap4-search-string-init-history nil)
(defvar *cmail-simap4-search-string-history
  cmail-simap4-search-string-init-history)
(defvar *cmail-simap4-header-field-history nil)

(defun cmail-simap4-construct-search-criteria ()
  "Construct search criteria in a form that can be passed to imap
server.  Only one criterion, search by text for now."
  (let (res (key-list cmail-simap4-search-key-list))
    (while key-list
      (if (not (member (car key-list)
		       cmail-simap4-search-key-verification-list))
	  (progn
	    (cmail-message-resource1 'cmail-simap4-msg-34 (car key-list))
	    (sit-for 3))
	(setq res (cmail-simap4-prompt-for-search-string (car key-list)))
	(if res (setq key-list nil)))
      (setq key-list (cdr key-list)))
    res))

(defun cmail-simap4-prompt-for-search-string (search-key-str)
  (cond
   ((string= "KEYWORD" search-key-str)
    (cmail-simap4-prompt-for-keyword search-key-str))
   ((string= "FLAG" search-key-str)
    (cmail-simap4-prompt-for-flag search-key-str))
   ((string= "HEADER" search-key-str)
    (cmail-simap4-prompt-for-header search-key-str))
   (t
    (cmail-simap4-prompt-for-default search-key-str))))

(defconst *cmail-simap4-valid-keywords
  '("Bookmarked" "Forwarded" "Hold"))
(defvar *cmail-simap4-keyword-search-history nil)
(defun cmail-simap4-prompt-for-keyword (search-key-str)
  (let (keyword field table)
    (setq table (mapcar 'list *cmail-simap4-valid-keywords))
    (setq keyword (completing-read
		   (cmail-get-resource 'cmail-simap4-msg-35)
		   table nil t nil
		   '*cmail-simap4-keyword-search-history))
    (if (string= keyword "")
	nil
      (concat "KEYWORD " keyword))))

(defconst *cmail-simap4-valid-flags
  '("ANSWERED" "DELETED" "DRAFT" "FLAGGED"
    "NEW" "OLD" "RECENT" "SEEN" "UNANSWERED"
    "UNDELETED" "UNDRAFT" "UNFLAGGED" "UNSEEN"))
(defvar *cmail-simap4-flag-search-history nil)
(defun cmail-simap4-prompt-for-flag (search-key-str)
  (let (flag field table)
    (setq table (mapcar 'list *cmail-simap4-valid-flags))
    (setq flag (completing-read
		(cmail-get-resource 'cmail-simap4-msg-36)
		table nil t nil
		'*cmail-simap4-flag-search-history))
    (if (string= flag "")
	nil
      flag)))

(defun cmail-simap4-prompt-for-header (search-key-str)
  (let (sstr field)
    (setq field (read-string
		 (cmail-format-resource 'cmail-simap4-msg-31)
		 nil '*cmail-simap4-header-field-history))
    (if (string= field "")
	nil
      (setq sstr (read-string
		  (cmail-format-resource
		   'cmail-simap4-msg-32 field)
		  nil '*cmail-simap4-search-string-history))
      (if (string= sstr "")
	  (cmail-error-resource 'cmail-simap4-msg-33)
	(concat "CHARSET iso-2022-jp HEADER " field " "
		(prin1-to-string
		 (encode-coding-string
		  sstr *cmail-primary-coding-system)))))))

(defun cmail-simap4-prompt-for-default (search-key-str)
  (let (sstr field)
    (setq sstr (read-string
		(cmail-format-resource
		 'cmail-simap4-msg-30 search-key-str)
		nil '*cmail-simap4-search-string-history))
    (if (string= sstr "")
	nil
      (concat "CHARSET iso-2022-jp " search-key-str " "
	      (prin1-to-string
	       (encode-coding-string
		sstr *cmail-primary-coding-system))))))

(defun cmail-simap4-construct-search-mboxes (imap4-spec)
  "Get regexp for mailboxes to be searched based on current folder."
  (let ((hist-sym-name (concat "*cmail-simap4-search-mboxes-history-"
				 (cmail-simap4-topdir imap4-spec)))
	mb-regexp hist-sym)
    (and imap4-spec
	 (progn
	   (setq mb-regexp
		 (cmail-simap4-servers-1_2-search-mboxes-regexp
		  imap4-spec))
	   (setq hist-sym (intern hist-sym-name))
	   (if (not (boundp hist-sym))
	       (set hist-sym nil))
	   (read-string
	    (cmail-format-resource 'cmail-simap4-msg-40 mb-regexp)
	    nil hist-sym)))))

;;;------------------------------------------------------------------------
;;; quit session
(defun cmail-simap4-quit ()
  (setq *cmail-simap4-init-sync-done nil)
  (cmail-simap4-clear-msg-cache)
  (while *cmail-simap4-servers
    (simap4-object-delete (cdr (car *cmail-simap4-servers)))
    (setq *cmail-simap4-servers (cdr *cmail-simap4-servers))))
(add-hook 'cmail-quit-hook 'cmail-simap4-quit)

;;------------------------------------------------------------------------
;; mailbox property cache
;; 
;; *cmail-simap4-mailbox-cache-alist is a three level of association
;; list that consists of server-dir as a key for the first level, and
;; the server representation of mailbox as a key for the second level,
;; and any keys for data retrieval for the third level.
;; 

(defvar *cmail-simap4-mailbox-cache-alist '(dummy))
(defun cmail-simap4-cache-file (spec)
  (let* ((topdir (and spec (cmail-simap4-topdir spec))))
    (and (stringp topdir)
	 (expand-file-name (concat topdir "/.cmail-imap4-cache.eld")
			   cmail-path))))

(defun cmail-simap4-get-cache (spec-or-folder)
  (let* ((spec (if (stringp spec-or-folder)
		   (cmail-simap4-get-spec-by-cmail-folder spec-or-folder)
		 spec-or-folder))
	 (topdir (and spec (cmail-simap4-topdir spec)))
	 (entry (and (stringp topdir)
		     (assoc topdir *cmail-simap4-mailbox-cache-alist)))
	 (cache (cmail-simap4-cache-file spec)))
    (if (and (null entry) (stringp cache))
	(if (file-readable-p cache)
	    (progn
	      (with-temp-buffer
		(erase-buffer)
		(insert-file-contents cache)
		(goto-char (point-min))
		(setq entry
		      (condition-case nil
			  (read (current-buffer)) (error nil)))
		(if (and entry (equal (car entry) topdir))
		    (nconc *cmail-simap4-mailbox-cache-alist
			   (list entry))
		  (setq entry (list topdir))
		  (nconc *cmail-simap4-mailbox-cache-alist
			 (list entry)))))
	  (setq entry (list topdir))
	  (nconc *cmail-simap4-mailbox-cache-alist
		 (list entry))))
    entry))

(defun cmail-simap4-save-cache (spec-or-folder)
  (let* ((spec (if (stringp spec-or-folder)
		   (cmail-simap4-get-spec-by-cmail-folder spec-or-folder)
		 spec-or-folder))
	 (topdir (and spec (cmail-simap4-topdir spec)))
	 (entry (and (stringp topdir)
		     (assoc topdir *cmail-simap4-mailbox-cache-alist)))
	 (cache (cmail-simap4-cache-file spec)))
    (if (and entry
	     (not (cmail-simap4-servers-1_2-virtual-folder-p spec)))
	(progn
	  (with-temp-buffer
	    (erase-buffer)
	    (insert (prin1-to-string entry))
	    (write-region (point-min) (point-max) cache nil 'nomsg))))))

(defun cmail-simap4-get-uidnext (cmail-folder)
  (cmail-simap4-get-cache-value cmail-folder 'uidnext))

(defun cmail-simap4-get-uidvalidity (cmail-folder)
  (cmail-simap4-get-cache-value cmail-folder 'uidvalidity))

(defun cmail-simap4-set-uidnext (cmail-folder value)
  (cmail-simap4-set-cache-value cmail-folder 'uidnext value))

(defun cmail-simap4-set-uidvalidity (cmail-folder value)
  (cmail-simap4-set-cache-value cmail-folder 'uidvalidity value))

(defun cmail-simap4-get-cache-value (cmail-folder key)
  (let* ((entry (cmail-simap4-get-cache cmail-folder))
	 (mailbox (cmail-simap4-extract-mbox cmail-folder))
	 (mbox-prop (assoc mailbox entry)))
    (cdr (assoc key mbox-prop))))

(defun cmail-simap4-set-cache-value (cmail-folder key value)
  (let* ((entry (cmail-simap4-get-cache cmail-folder))
	 (mailbox (cmail-simap4-extract-mbox cmail-folder))
	 (mbox-prop (assoc mailbox entry))
	 (assoc-entry (assoc key mbox-prop))
	 (modified-p t))
    (if (or (null entry) (not (stringp mailbox)))
	(error (format "IMAP4: Not an imap4 folder:%s:" cmail-folder))
      (if (or (stringp value) (integerp value))
	  (if (null mbox-prop)
	      (progn
		(setq mbox-prop
		      (list mailbox (cons key value)))
		(nconc entry (list mbox-prop)))
	    (if (null assoc-entry)
		(nconc mbox-prop
		       (list (cons key value)))
	      (if (equal (cdr assoc-entry) value)
		  (setq modified-p nil)
		(setcdr assoc-entry value))))
	(if (and (null value) mbox-prop assoc-entry)
	    (delq assoc-entry mbox-prop)))
      (if modified-p
	  (cmail-simap4-save-cache cmail-folder)))))

(defun cmail-simap4-delete-mailbox-cache (cmail-folder)
  (let* ((entry (cmail-simap4-get-cache cmail-folder))
	 (mailbox (cmail-simap4-extract-mbox cmail-folder))
	 (mbox-prop (assoc mailbox entry))
	 (modified-p t))
    (if (or (null entry) (not (stringp mailbox)))
	(error (format "IMAP4: Not an imap4 folder:%s:" cmail-folder))
      (if mbox-prop
	  (progn
	    (delq mbox-prop entry)
	    (cmail-simap4-save-cache cmail-folder))))))


;;------------------------------------------------------------------------
;; message resources
(defconst *cmail-simap4-msg-lang '("Japanese" t))
(defun cmail-simap4-msg (tag &rest list)
  (let ((lang *cmail-simap4-msg-lang) alist)
    (while (and list lang)
      (setq alist (cons (cons (car lang) (car list)) alist))
      (setq list (cdr list))
      (setq lang (cdr lang)))
    (cmail-add-resource (cons tag alist))
    t))

(mapcar
 '(lambda (list) (apply 'cmail-simap4-msg list))
 '((cmail-simap4-msg-1
    "IMAP4: フォルダ %s を同期しています."
    "IMAP4: Synchronizing Folder %s")
   (cmail-simap4-msg-2
    "IMAP4: 同期状態を確認しています."
    "IMAP4: Checking sync status")
   (cmail-simap4-msg-3
    "IMAP4: フラグを更新しています."
    "IMAP4: Updating flags.")
   (cmail-simap4-msg-4
    "IMAP4: 取得するべきメールはありません. フラグを更新しています."
    "IMAP4: No messages. Updating flags.")
   (cmail-simap4-msg-5
    "IMAP4: フォルダ同期が終了しました."
    "IMAP4: Folder synchronization done.")
   (cmail-simap4-msg-6
    "IMAP4: エラーのため同期をスキップしました."
    "IMAP4: Sync skipped due to an error.")
   (cmail-simap4-msg-7
    "IMAP4: %d 個のキャッシュにないメッセージを取得します. ヘッダ取得中."
    "IMAP4: %d non cached messages to be retrieved. Retrieving header info.")
   (cmail-simap4-msg-8
    "IMAP4: サーバに接続していないためコピーできません."
    "IMAP4: copy failed due to no imap4 connection.")
   (cmail-simap4-msg-9
    "IMAP4: サーバがエラーを返してきたためコピーできません."
    "IMAP4: copy failed - server returned an error.")
   (cmail-simap4-msg-10
    "IMAP4: サーバにメッセージを追加できませんでした."
    "IMAP4: Error appending message to the server.")
   (cmail-simap4-msg-11
    "IMAP4: ローカルコピーのステータスが更新できませんでした. [%d]"
    "IMAP4: Error updating status on local copy [%d]")
   (cmail-simap4-msg-12
    "IMAP4: サーバ内コピーのための UID がみつかりません."
    "IMAP4: cannot copy - no UID for server-server copy")
   (cmail-simap4-msg-13
    "IMAP4: コピー先フォルダがサポートしているものではありません."
    "IMAP4: cannot copy - unsupported target folder.")
   (cmail-simap4-msg-14
    "IMAP4: 認証に失敗しました (%0;s@%1;s)"
    "IMAP4: Not authenticated (%0;s@%1;s)")
   (cmail-simap4-msg-15
    "IMAP4: サーバ上のフォルダ %s を選択できませんでした."
    "IMAP4: cannot select mailbox %s")
   (cmail-simap4-msg-16
    "IMAP4: サーバ上にフォルダ %s が作成できませんでした."
    "IMAP4: cannot create mailbox %s")
   (cmail-simap4-msg-17
    "IMAP4: サーバ上のフォルダの削除に失敗しました."
    "IMAP4: Mailbox deletion failed.")
   (cmail-simap4-msg-18
    "IMAP4: サーバに接続できません."
    "IMAP4: Cannot connect server.")
   (cmail-simap4-msg-19
    "IMAP4: サーバ上で名前変更に失敗しました."
    "IMAP4: Rename on server failed.")
   (cmail-simap4-msg-20
    "IMAP4: 異なるストレージ間でフォルダの名前変更はできません."
    "IMAP4: Rename prohibited between servers/local mailboxes.")
   (cmail-simap4-msg-21
    "IMAP4: サーバ間のフォルダのコピーはサポートしていません."
    "IMAP4: Server to Server mailbox copy not supported.")
   (cmail-simap4-msg-22
    "IMAP4: サーバ上にフォルダ %s を作成しますか "
    "IMAP4: Create folder %s on the server ")
   (cmail-simap4-msg-23
    "IMAP4: フォルダ %s は作成しませんでした。"
    "IMAP4: Folder %s is not created.")
   (cmail-simap4-msg-24
    "IMAP4: 取得するべきメールはありません."
    "IMAP4: No messages.")
   (cmail-simap4-msg-25
    "IMAP4: [%0;d/%1;d] - メッセージを取得中です. "
    "IMAP4: [%0;d/%1;d] - retrieving message body.")
   (cmail-simap4-msg-26
    "IMAP4: %d メッセージを取得しました. フォルダの処理中です."
    "IMAP4: %d messages retrieved - processing the folder.")
   (cmail-simap4-msg-27
    "IMAP4: メッセージのダウンロードを中断しました. "
    "IMAP4: Aborted message downloading.")
   (cmail-simap4-msg-28
    "IMAP4: バグと思われる(ありえない)状況でエラーが発生しました。"
    "IMAP4: Encountered an error which should not occur (probably a bug).")
   (cmail-simap4-msg-30
    "IMAP4: 検索文字列 (%0;s): "
    "IMAP4: Search String (%0;s): ")
   (cmail-simap4-msg-31
    "IMAP4: ヘッダ検索 (HEADER) 検索対象フィールド: "
    "IMAP4: Header Search (HEADER) Search field: ")
   (cmail-simap4-msg-32
    "IMAP4: ヘッダ(%0;s)の検索文字列: "
    "IMAP4: Header(%0;s) Search String: ")
   (cmail-simap4-msg-33
    "IMAP4: 入力が不完全なため検索を中止しました。"
    "IMAP4: Quit search due to imcomplete search string input.")
   (cmail-simap4-msg-34
    "IMAP4: cmail-simap4-search-key-list に無効の検索キー[%s]があります。"
    "IMAP4: cmail-simap4-search-key-list contains an invalid search key [%s].")
   (cmail-simap4-msg-35
    "IMAP4: キーワード検索: "
    "IMAP4: Search by keyword: ")
   (cmail-simap4-msg-36
    "IMAP4: フラグ検索: "
    "IMAP4: Search by flag: ")
   (cmail-simap4-msg-40
    "IMAP4: 対象フォルダフィルタ/正規表現 (%0;s): "
    "IMAP4: Folders filter regexp (%0;s): ")
   (cmail-simap4-msg-41
    "IMAP4: %0;d メッセージがみつかりました (%1;d/%2;d) [%3;s] を検索中."
    "IMAP4: %0;d msgs found. (%1;d/%2;d folders) Searching [%3;s].")
   (cmail-simap4-msg-42
    "IMAP4: 条件にあうメッセージはみつかりませんでした."
    "IMAP4: No message for the search criteria was found.")
   (cmail-simap4-msg-43
    "IMAP4: %d メッセージがみつかりました."
    "IMAP4: %d msgs found.")
   (cmail-simap4-msg-44
    "IMAP4: 現在 imap4 のフォルダまたはディレクトリにいません。"
    "IMAP4: You are not currently in an imap4 folder or directory.")
   (cmail-simap4-msg-45
    "IMAP4: サーバが検索の条件を受け付けませんでした。"
    "IMAP4: Server rejected the search criteria.")
   (cmail-simap4-msg-46
    "IMAP4: サーバ上のメールボックスが開けません。[%s]はスキップします。"
    "IMAP4: Cannot open mailbox on the server. Skipping mbox [%s]")
   (cmail-simap4-msg-47
    "IMAP4: 仮想クライアントフォルダはサポートしていません。"
    "IMAP4: No support for client box.")
   (cmail-simap4-msg-48
    "IMAP4: 仮想クライアントフォルダでは実行できません。"
    "IMAP4: Command not available for a client box.")
   (cmail-simap4-msg-49
    "IMAP4: 転送メッセージが全部取り込まれてません。ダウンロードしますか? "
    "IMAP4: The message to be forwarded not fetched completely. Download? ")
   ))

;;------------------------------------------------------------------------
;; debug
(defvar *cmail-simap4-log-buffer nil)
(defvar cmail-simap4-log nil)
(defun cmail-simap4-log (fmt &rest args)
  (if cmail-simap4-log
      (save-excursion
	(if (or (null *cmail-simap4-log-buffer)
		(not (bufferp *cmail-simap4-log-buffer))
		(not (buffer-live-p *cmail-simap4-log-buffer)))
	    (setq *cmail-simap4-log-buffer
		  (get-buffer-create "*cmail-simap-debug*")))
	(set-buffer *cmail-simap4-log-buffer)
	(goto-char (point-max))
	(insert-before-markers (apply 'format (cons fmt args)))
	(insert-before-markers "\n"))))

(provide 'cmail-simap4)
