* elmo.el (elmo-message-fetch-with-cache-process): Fixed typo.
[elisp/wanderlust.git] / elmo / elmo-util.el
index 24ee64f..fe62464 100644 (file)
@@ -1,4 +1,4 @@
-;;; elmo-util.el -- Utilities for Elmo.
+;;; elmo-util.el --- Utilities for ELMO.
 
 ;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
 
 ;;
 
 ;;; Commentary:
-;; 
+;;
 
 ;;; Code:
-;; 
+;;
 
 (eval-when-compile (require 'cl))
 (require 'elmo-vars)
 (require 'elmo-date)
+(require 'mcharset)
+(require 'pces)
 (require 'std11)
 (require 'eword-decode)
 (require 'utf7)
 (defmacro elmo-set-buffer-multibyte (flag)
   "Set the multibyte flag of the current buffer to FLAG."
   (cond ((boundp 'MULE)
-         (list 'setq 'mc-flag flag))
-        ((featurep 'xemacs)
-         flag)
-        ((and (boundp 'emacs-major-version) (>= emacs-major-version 20))
-         (list 'set-buffer-multibyte flag))
-        (t
-         flag)))
+        (list 'setq 'mc-flag flag))
+       ((featurep 'xemacs)
+        flag)
+       ((and (boundp 'emacs-major-version) (>= emacs-major-version 20))
+        (list 'set-buffer-multibyte flag))
+       (t
+        flag)))
 
 (defvar elmo-work-buf-name " *elmo work*")
 (defvar elmo-temp-buf-name " *elmo temp*")
     (filename newname &optional ok-if-already-exists)
     (copy-file filename newname ok-if-already-exists t)))
 
-;; Nemacs's `read' is different.
-(static-if (fboundp 'nemacs-version)
-    (defun elmo-read (obj)
-      (prog1 (read obj)
-       (if (bufferp obj)
-           (or (bobp) (forward-char -1)))))
-  (defalias 'elmo-read 'read))
+(defalias 'elmo-read 'read)
 
 (defmacro elmo-set-work-buf (&rest body)
   "Execute BODY on work buffer.  Work buffer remains."
@@ -140,13 +136,6 @@ File content is encoded with MIME-CHARSET."
 ;;;(princ "\n" (current-buffer))
    (elmo-save-buffer filename mime-charset)))
 
-(defun elmo-get-network-stream-type (stream-type stream-type-alist)
-  (catch 'found
-    (while stream-type-alist
-      (if (eq (nth 1 (car stream-type-alist)) stream-type)
-         (throw 'found (car stream-type-alist)))
-      (setq stream-type-alist (cdr stream-type-alist)))))
-
 ;;; Search Condition
 
 (defconst elmo-condition-atom-regexp "[^/ \")|&]*")
@@ -166,7 +155,7 @@ File content is encoded with MIME-CHARSET."
                                   "Since" "Before" "ToCc"
                                   "!From" "!Subject" "!To" "!Cc" "!Body"
                                   "!Since" "!Before" "!ToCc")
-                                elmo-msgdb-extra-fields)) nil t))
+                                elmo-msgdb-extra-fields))))
         value)
     (setq field (if (string= field "")
                    (setq field default)
@@ -211,7 +200,7 @@ Return value is a cons cell of (STRUCTURE . REST)"
       (elmo-condition-parse-error)))
 
 ;; or-expr      ::= and-expr /
-;;                 and-expr "|" or-expr
+;;                 and-expr "|" or-expr
 (defun elmo-condition-parse-or-expr ()
   (let ((left (elmo-condition-parse-and-expr)))
     (if (looking-at "| *")
@@ -401,19 +390,19 @@ Return value is a cons cell of (STRUCTURE . REST)"
 (defun elmo-passwd-alist-load ()
   (save-excursion
     (let ((filename (expand-file-name elmo-passwd-alist-file-name
-                                      elmo-msgdb-dir))
-          (tmp-buffer (get-buffer-create " *elmo-passwd-alist-tmp*"))
-         insert-file-contents-pre-hook   ; To avoid autoconv-xmas...
-          insert-file-contents-post-hook
-          ret-val)
+                                     elmo-msgdb-directory))
+         (tmp-buffer (get-buffer-create " *elmo-passwd-alist-tmp*"))
+         insert-file-contents-pre-hook ; To avoid autoconv-xmas...
+         insert-file-contents-post-hook
+         ret-val)
       (if (not (file-readable-p filename))
-          ()
-        (set-buffer tmp-buffer)
-        (insert-file-contents filename)
-        (setq ret-val
-              (condition-case nil
-                  (read (current-buffer))
-                (error nil nil))))
+         ()
+       (set-buffer tmp-buffer)
+       (insert-file-contents filename)
+       (setq ret-val
+             (condition-case nil
+                 (read (current-buffer))
+               (error nil nil))))
       (kill-buffer tmp-buffer)
       ret-val)))
 
@@ -421,14 +410,14 @@ Return value is a cons cell of (STRUCTURE . REST)"
   "Clear password cache."
   (interactive)
   (setq elmo-passwd-alist nil))
-  
+
 (defun elmo-passwd-alist-save ()
   "Save password into file."
   (interactive)
   (save-excursion
     (let ((filename (expand-file-name elmo-passwd-alist-file-name
-                                      elmo-msgdb-dir))
-          (tmp-buffer (get-buffer-create " *elmo-passwd-alist-tmp*")))
+                                     elmo-msgdb-directory))
+         (tmp-buffer (get-buffer-create " *elmo-passwd-alist-tmp*")))
       (set-buffer tmp-buffer)
       (erase-buffer)
       (prin1 elmo-passwd-alist tmp-buffer)
@@ -437,11 +426,11 @@ Return value is a cons cell of (STRUCTURE . REST)"
 ;;;           (not (equal 384 (file-modes filename))))
 ;;;      (error "%s is not safe.chmod 600 %s!" filename filename))
       (if (file-writable-p filename)
-         (progn
-           (write-region (point-min) (point-max)
-                         filename nil 'no-msg)
-           (set-file-modes filename 384))
-        (message (format "%s is not writable." filename)))
+         (progn
+           (write-region (point-min) (point-max)
+                         filename nil 'no-msg)
+           (set-file-modes filename 384))
+       (message (format "%s is not writable." filename)))
       (kill-buffer tmp-buffer))))
 
 (defun elmo-get-passwd (key)
@@ -475,19 +464,19 @@ Return value is a cons cell of (STRUCTURE . REST)"
 
 (defmacro elmo-read-char-exclusive ()
   (cond ((featurep 'xemacs)
-         '(let ((table (quote ((backspace . ?\C-h) (delete . ?\C-?)
-                               (left . ?\C-h))))
-                event key)
-            (while (not
-                    (and
-                     (key-press-event-p (setq event (next-command-event)))
-                     (setq key (or (event-to-character event)
-                                   (cdr (assq (event-key event) table)))))))
-            key))
-        ((fboundp 'read-char-exclusive)
-         '(read-char-exclusive))
-        (t
-         '(read-char))))
+        '(let ((table (quote ((backspace . ?\C-h) (delete . ?\C-?)
+                              (left . ?\C-h))))
+               event key)
+           (while (not
+                   (and
+                    (key-press-event-p (setq event (next-command-event)))
+                    (setq key (or (event-to-character event)
+                                  (cdr (assq (event-key event) table)))))))
+           key))
+       ((fboundp 'read-char-exclusive)
+        '(read-char-exclusive))
+       (t
+        '(read-char))))
 
 (defun elmo-read-passwd (prompt &optional stars)
   "Read a single line of text from user without echoing, and return it."
@@ -554,12 +543,12 @@ Return value is a cons cell of (STRUCTURE . REST)"
            (setq tlist (cdr tlist)))
          (setq str
                (concat str ")")))
-      (setq str 
+      (setq str
            (if (symbolp tlist)
                (symbol-name tlist)
              tlist)))
     str))
+
 
 (defun elmo-plug-on-by-servers (alist &optional servers)
   (let ((server-list (or servers elmo-plug-on-servers)))
@@ -722,7 +711,7 @@ Return value is a cons cell of (STRUCTURE . REST)"
     (if (null (file-directory-p parent))
        (elmo-make-directory parent))
     (make-directory path)
-    (if (string= path (expand-file-name elmo-msgdb-dir))
+    (if (string= path (expand-file-name elmo-msgdb-directory))
        (set-file-modes path (+ (* 64 7) (* 8 0) 0))))) ; chmod 0700
 
 (defun elmo-delete-directory (path &optional no-hierarchy)
@@ -827,29 +816,26 @@ Return value is a cons cell of (STRUCTURE . REST)"
                         (length (memq number number-list)))
                      (string-to-int (elmo-filter-value condition)))))
      ((string= (elmo-filter-key condition) "since")
-      (let ((date (elmo-date-get-datevec (elmo-filter-value condition))))
+      (let ((field-date (elmo-date-make-sortable-string
+                        (timezone-fix-time
+                         (std11-field-body "date")
+                         (current-time-zone) nil)))
+           (specified-date (elmo-date-make-sortable-string
+                            (elmo-date-get-datevec
+                             (elmo-filter-value condition)))))
        (setq result
-             (string<
-              (timezone-make-sortable-date (aref date 0)
-                                           (aref date 1)
-                                           (aref date 2)
-                                           (timezone-make-time-string
-                                            (aref date 3)
-                                            (aref date 4)
-                                            (aref date 5)))
-              (timezone-make-date-sortable (std11-field-body "date"))))))
+             (or (string= field-date specified-date)
+                 (string< specified-date field-date)))))
      ((string= (elmo-filter-key condition) "before")
-      (let ((date (elmo-date-get-datevec (elmo-filter-value condition))))
-       (setq result
-             (string<
-              (timezone-make-date-sortable (std11-field-body "date"))
-              (timezone-make-sortable-date (aref date 0)
-                                           (aref date 1)
-                                           (aref date 2)
-                                           (timezone-make-time-string
-                                            (aref date 3)
-                                            (aref date 4)
-                                            (aref date 5)))))))
+      (setq result
+           (string<
+            (elmo-date-make-sortable-string
+             (timezone-fix-time
+              (std11-field-body "date")
+              (current-time-zone) nil))
+            (elmo-date-make-sortable-string
+             (elmo-date-get-datevec
+              (elmo-filter-value condition))))))
      ((string= (elmo-filter-key condition) "body")
       (and (re-search-forward "^$" nil t)         ; goto body
           (setq result (search-forward (elmo-filter-value condition)
@@ -864,19 +850,24 @@ Return value is a cons cell of (STRUCTURE . REST)"
        (setq result (not result)))
     result))
 
-(defun elmo-condition-find-key-internal (condition key)
+(defun elmo-condition-in-msgdb-p-internal (condition fields)
   (cond
    ((vectorp condition)
-    (if (string= (elmo-filter-key condition) key)
+    (if (not (member (elmo-filter-key condition) fields))
        (throw 'found t)))
    ((or (eq (car condition) 'and)
        (eq (car condition) 'or))
-    (elmo-condition-find-key-internal (nth 1 condition) key)
-    (elmo-condition-find-key-internal (nth 2 condition) key))))
-
-(defun elmo-condition-find-key (condition key)
-  (catch 'found
-    (elmo-condition-find-key-internal condition key)))
+    (elmo-condition-in-msgdb-p-internal (nth 1 condition) fields)
+    (elmo-condition-in-msgdb-p-internal (nth 2 condition) fields))))
+
+(defun elmo-condition-in-msgdb-p (condition)
+  (not (catch 'found
+        (elmo-condition-in-msgdb-p-internal condition
+                                            (append
+                                             elmo-msgdb-extra-fields
+                                             '("last" "first" "from"
+                                               "subject" "to" "cc" "since"
+                                               "before"))))))
 
 (defun elmo-buffer-field-condition-match (condition number number-list)
   (cond
@@ -894,13 +885,50 @@ Return value is a cons cell of (STRUCTURE . REST)"
        (elmo-buffer-field-condition-match
         (nth 2 condition) number number-list)))))
 
-(defsubst elmo-file-field-condition-match (file condition number number-list)
-  (elmo-set-work-buf
-   (as-binary-input-file (insert-file-contents file))
-   (elmo-set-buffer-multibyte default-enable-multibyte-characters)
-   ;; Should consider charset?
-   (decode-mime-charset-region (point-min)(point-max) elmo-mime-charset)
-   (elmo-buffer-field-condition-match condition number number-list)))
+(defsubst elmo-file-field-primitive-condition-match (file
+                                                    condition
+                                                    number
+                                                    number-list)
+  (let (result)
+    (goto-char (point-min))
+    (cond
+     ((string= (elmo-filter-key condition) "last")
+      (setq result (<= (length (memq number number-list))
+                      (string-to-int (elmo-filter-value condition))))
+      (if (eq (elmo-filter-type condition) 'unmatch)
+         (setq result (not result))))
+     ((string= (elmo-filter-key condition) "first")
+      (setq result (< (- (length number-list)
+                        (length (memq number number-list)))
+                     (string-to-int (elmo-filter-value condition))))
+      (if (eq (elmo-filter-type condition) 'unmatch)
+         (setq result (not result))))
+     (t
+      (elmo-set-work-buf
+       (as-binary-input-file (insert-file-contents file))
+       (elmo-set-buffer-multibyte default-enable-multibyte-characters)
+       ;; Should consider charset?
+       (decode-mime-charset-region (point-min)(point-max) elmo-mime-charset)
+       (setq result
+            (elmo-buffer-field-primitive-condition-match
+             condition number number-list)))))
+    result))
+
+(defun elmo-file-field-condition-match (file condition number number-list)
+  (cond
+   ((vectorp condition)
+    (elmo-file-field-primitive-condition-match
+     file condition number number-list))
+   ((eq (car condition) 'and)
+    (and (elmo-file-field-condition-match
+         file (nth 1 condition) number number-list)
+        (elmo-file-field-condition-match
+         file (nth 2 condition) number number-list)))
+   ((eq (car condition) 'or)
+    (or (elmo-file-field-condition-match
+        file (nth 1 condition) number number-list)
+       (elmo-file-field-condition-match
+        file (nth 2 condition) number number-list)))))
 
 (defmacro elmo-get-hash-val (string hashtable)
   (let ((sym (list 'intern-soft string hashtable)))
@@ -924,10 +952,10 @@ Emacs 19.28 or earlier does not have `unintern'."
 (defun elmo-make-hash (&optional hashsize)
   "Make a new hash table which have HASHSIZE size."
   (make-vector
-   (if hashsize 
+   (if hashsize
        (max
        ;; Prime numbers as lengths tend to result in good
-       ;; hashing; lengths one less than a power of two are 
+       ;; hashing; lengths one less than a power of two are
        ;; also good.
        (min
         (let ((i 1))
@@ -1031,10 +1059,10 @@ Emacs 19.28 or earlier does not have `unintern'."
       (setq filename (substring filename (+ (match-end 0) 1))))
     (concat result filename)))
 
-(defsubst elmo-copy-file (src dst)
+(defsubst elmo-copy-file (src dst &optional ok-if-already-exists)
   (condition-case err
-      (elmo-add-name-to-file src dst t)
-    (error (copy-file src dst t))))
+      (elmo-add-name-to-file src dst ok-if-already-exists)
+    (error (copy-file src dst ok-if-already-exists t))))
 
 (defsubst elmo-buffer-exists-p (buffer)
   (if (bufferp buffer)
@@ -1091,9 +1119,8 @@ the value of `foo'."
        (setq err-mes (concat err-mes (format
                                       (if (stringp (car errobj))
                                           "%s"
-                                        (if (boundp 'nemacs-version)
-                                            "%s"
-                                          "%S")) (car errobj))))
+                                        "%S")
+                                      (car errobj))))
        (setq errobj (cdr errobj))
        (if errobj (setq err-mes (concat err-mes (if first ": " ", "))))
        (setq first nil))
@@ -1123,6 +1150,54 @@ the value of `foo'."
           (apply (function message) (concat format " %d%%")
                  (nconc args (list value)))))))
 
+(defvar elmo-progress-counter-alist nil)
+
+(defmacro elmo-progress-counter-value (counter)
+  (` (aref (cdr (, counter)) 0)))
+
+(defmacro elmo-progress-counter-all-value (counter)
+  (` (aref (cdr (, counter)) 1)))
+
+(defmacro elmo-progress-counter-format (counter)
+  (` (aref (cdr (, counter)) 2)))
+
+(defmacro elmo-progress-counter-set-value (counter value)
+  (` (aset (cdr (, counter)) 0 (, value))))
+
+(defun elmo-progress-set (label all-value &optional format)
+  (unless (assq label elmo-progress-counter-alist)
+    (setq elmo-progress-counter-alist
+         (cons (cons label (vector 0 all-value (or format "")))
+               elmo-progress-counter-alist))))
+
+(defun elmo-progress-clear (label)
+  (let ((counter (assq label elmo-progress-counter-alist)))
+    (when counter
+      (elmo-display-progress label
+                            (elmo-progress-counter-format counter)
+                            100)
+      (setq elmo-progress-counter-alist
+           (delq counter elmo-progress-counter-alist)))))
+
+(defun elmo-progress-notify (label &optional value op &rest args)
+  (let ((counter (assq label elmo-progress-counter-alist)))
+    (when counter
+      (let* ((value (or value 1))
+            (cur-value (elmo-progress-counter-value counter))
+            (all-value (elmo-progress-counter-all-value counter))
+            (new-value (if (eq op 'set) value (+ cur-value value)))
+            (cur-rate (/ (* cur-value 100) all-value))
+            (new-rate (/ (* new-value 100) all-value)))
+       (elmo-progress-counter-set-value counter new-value)
+       (unless (= cur-rate new-rate)
+         (apply 'elmo-display-progress
+                label
+                (elmo-progress-counter-format counter)
+                new-rate
+                args))
+       (when (>= new-rate 100)
+         (elmo-progress-clear label))))))
+
 (defun elmo-time-expire (before-time diff-time)
   (let* ((current (current-time))
         (rest (when (< (nth 1 current) (nth 1 before-time))
@@ -1138,6 +1213,14 @@ the value of `foo'."
     (defalias 'elmo-field-body 'std11-fetch-field) ;;no narrow-to-region
   (defalias 'elmo-field-body 'std11-field-body))
 
+(defun elmo-address-quote-specials (word)
+  "Make quoted string of WORD if needed."
+  (let ((lal (std11-lexical-analyze word)))
+    (if (or (assq 'specials lal)
+           (assq 'domain-literal lal))
+       (prin1-to-string word)
+      word)))
+
 (defmacro elmo-string (string)
   "STRING without text property."
   (` (let ((obj (copy-sequence (, string))))
@@ -1227,6 +1310,16 @@ But if optional argument AUTO is non-nil, DEFAULT is returned."
            (throw 'loop a))
        (setq alist (cdr alist))))))
 
+(defun elmo-string-assoc-all (key alist)
+  (let (matches)
+    (while alist
+      (if (string= key (car (car alist)))
+         (setq matches
+               (cons (car alist)
+                     matches)))
+      (setq alist (cdr alist)))
+    matches))
+
 (defun elmo-string-rassoc (key alist)
   (let (a)
     (catch 'loop
@@ -1248,8 +1341,44 @@ But if optional argument AUTO is non-nil, DEFAULT is returned."
       (setq alist (cdr alist)))
     matches))
 
+;;; Folder parser utils.
+(defun elmo-parse-token (string &optional seps)
+  "Parse atom from STRING using SEPS as a string of separator char list."
+  (let ((len (length string))
+       (seps (and seps (string-to-char-list seps)))
+       (i 0)
+       (sep nil)
+       content c in)
+    (if (eq len 0)
+       (cons "" "")
+      (while (and (< i len) (or in (null sep)))
+       (setq c (aref string i))
+       (cond
+        ((and in (eq c ?\\))
+         (setq i (1+ i)
+               content (cons (aref string i) content)
+               i (1+ i)))
+        ((eq c ?\")
+         (setq in (not in)
+               i (1+ i)))
+        (in (setq content (cons c content)
+                  i (1+ i)))
+        ((memq c seps)
+         (setq sep c))
+        (t (setq content (cons c content)
+                 i (1+ i)))))
+      (if in (error "Parse error in quoted"))
+      (cons (if (null content) "" (char-list-to-string (nreverse content)))
+           (substring string i)))))
+
+(defun elmo-parse-prefixed-element (prefix string &optional seps)
+  (if (and (not (eq (length string) 0))
+          (eq (aref string 0) prefix))
+      (elmo-parse-token (substring string 1) seps)
+    (cons "" string)))
+
 ;;; Number set defined by OKAZAKI Tetsurou <okazaki@be.to>
-;; 
+;;
 ;; number          ::= [0-9]+
 ;; beg             ::= number
 ;; end             ::= number
@@ -1326,33 +1455,51 @@ NUMBER-SET is altered."
   :type 'regexp
   :group 'elmo)
 
-(defun elmo-list-subdirectories (directory file one-level)
-  (let ((root (zerop (length file)))
+(defun elmo-list-subdirectories-1 (basedir curdir one-level)
+  (let ((root (zerop (length curdir)))
        (w32-get-true-file-link-count t) ; for Meadow
-       files attr dirs dir)
-    (setq files (directory-files (setq dir (expand-file-name file directory))))
-    (while files
-      (if (and (not (string-match elmo-list-subdirectories-ignore-regexp
-                                 (car files)))
-              (car (setq attr (file-attributes (expand-file-name 
-                                                (car files) dir)))))
-         (if (and (not one-level)
-                  (and elmo-have-link-count (< 2 (nth 1 attr))))
-             (setq dirs
-                   (nconc dirs
-                          (elmo-list-subdirectories
-                           directory
-                           (concat file
-                                   (and (not root) elmo-path-sep)
-                                   (car files))
-                           one-level)))
+       attr dirs dir)
+    (catch 'done
+      (dolist (file (directory-files (setq dir (expand-file-name curdir basedir))))
+       (when (and (not (string-match
+                        elmo-list-subdirectories-ignore-regexp
+                        file))
+                  (car (setq attr (file-attributes
+                                   (expand-file-name file dir)))))
+         (when (eq one-level 'check) (throw 'done t))
+         (let ((relpath
+                (concat curdir (and (not root) elmo-path-sep) file))
+               subdirs)
            (setq dirs (nconc dirs
-                             (list
-                              (concat file
-                                      (and (not root) elmo-path-sep)
-                                      (car files)))))))
-      (setq files (cdr files)))
-    (nconc (and (not root) (list file)) dirs)))
+                             (if (if elmo-have-link-count (< 2 (nth 1 attr))
+                                   (setq subdirs
+                                         (elmo-list-subdirectories-1
+                                          basedir
+                                          relpath
+                                          (if one-level 'check))))
+                                 (if one-level
+                                     (list (list relpath))
+                                   (cons relpath
+                                         (or subdirs
+                                             (elmo-list-subdirectories-1
+                                              basedir
+                                              relpath
+                                              nil))))
+                               (list relpath)))))))
+      dirs)))
+
+(defun elmo-list-subdirectories (directory file one-level)
+  (let ((subdirs (elmo-list-subdirectories-1 directory file one-level)))
+    (if (zerop (length file))
+       subdirs
+      (cons file subdirs))))
+
+(defun elmo-mapcar-list-of-list (func list-of-list)
+  (mapcar
+   (lambda (x)
+     (cond ((listp x) (elmo-mapcar-list-of-list func x))
+          (t (funcall func x))))
+   list-of-list))
 
 (defun elmo-parse (string regexp &optional matchn)
   (or matchn (setq matchn 1))
@@ -1360,10 +1507,27 @@ NUMBER-SET is altered."
     (store-match-data nil)
     (while (string-match regexp string (match-end 0))
       (setq list (cons (substring string (match-beginning matchn)
-                                  (match-end matchn)) list)))
+                                 (match-end matchn)) list)))
     (nreverse list)))
 
 ;;; File cache.
+(defmacro elmo-make-file-cache (path status)
+  "PATH is the cache file name.
+STATUS is one of 'section, 'entire or nil.
+ nil means no cache exists.
+'section means partial section cache exists.
+'entire means entire cache exists.
+If the cache is partial file-cache, TYPE is 'partial."
+  (` (cons (, path) (, status))))
+
+(defmacro elmo-file-cache-path (file-cache)
+  "Returns the file path of the FILE-CACHE."
+  (` (car (, file-cache))))
+
+(defmacro elmo-file-cache-status (file-cache)
+  "Returns the status of the FILE-CACHE."
+  (` (cdr (, file-cache))))
+
 (defsubst elmo-cache-to-msgid (filename)
   (concat "<" (elmo-recover-string-from-filename filename) ">"))
 
@@ -1384,15 +1548,13 @@ If optional argument SECTION is specified, partial cache path is returned."
   (if (setq msgid (elmo-msgid-to-cache msgid))
       (expand-file-name
        (if section
-          (format "%s/%s/%s/%s/%s"
-                  elmo-msgdb-dir
-                  elmo-cache-dirname
+          (format "%s/%s/%s/%s"
+                  elmo-cache-directory
                   (elmo-cache-get-path-subr msgid)
                   msgid
                   section)
-        (format "%s/%s/%s/%s"
-                elmo-msgdb-dir
-                elmo-cache-dirname
+        (format "%s/%s/%s"
+                elmo-cache-directory
                 (elmo-cache-get-path-subr msgid)
                 msgid)))))
 
@@ -1420,43 +1582,54 @@ SECTION is the section string."
   (elmo-file-cache-status (elmo-file-cache-get msgid)))
 
 (defun elmo-file-cache-save (cache-path section)
-  "Save current buffer as cache on PATH."
-  (let ((path (if section (expand-file-name section cache-path) cache-path))
-       files dir)
-    (if (and (null section)
-            (file-directory-p path))
-       (progn
-         (setq files (directory-files path t "^[^\\.]"))
-         (while files
-           (delete-file (car files))
-           (setq files (cdr files)))
-         (delete-directory path))
-      (if (and section
-              (not (file-directory-p cache-path)))
-         (delete-file cache-path)))
-    (when path
-      (setq dir (directory-file-name (file-name-directory path)))
-      (if (not (file-exists-p dir))
-         (elmo-make-directory dir))
-      (write-region-as-binary (point-min) (point-max)
-                             path nil 'no-msg))))
-
-(defmacro elmo-make-file-cache (path status)
-  "PATH is the cache file name.
-STATUS is one of 'section, 'entire or nil.
- nil means no cache exists.
-'section means partial section cache exists.
-'entire means entire cache exists.
-If the cache is partial file-cache, TYPE is 'partial."
-  (` (cons (, path) (, status))))
-
-(defmacro elmo-file-cache-path (file-cache)
-  "Returns the file path of the FILE-CACHE."
-  (` (car (, file-cache))))
-
-(defmacro elmo-file-cache-status (file-cache)
-  "Returns the status of the FILE-CACHE."
-  (` (cdr (, file-cache))))
+  "Save current buffer as cache on PATH.
+Return t if cache is saved successfully."
+  (condition-case nil
+      (let ((path (if section (expand-file-name section cache-path)
+                   cache-path))
+           files dir)
+       (if (and (null section)
+                (file-directory-p path))
+           (progn
+             (setq files (directory-files path t "^[^\\.]"))
+             (while files
+               (delete-file (car files))
+               (setq files (cdr files)))
+             (delete-directory path))
+         (if (and section
+                  (not (file-directory-p cache-path)))
+             (delete-file cache-path)))
+       (when path
+         (setq dir (directory-file-name (file-name-directory path)))
+         (if (not (file-exists-p dir))
+             (elmo-make-directory dir))
+         (write-region-as-binary (point-min) (point-max)
+                                 path nil 'no-msg)
+         t))
+    ;; ignore error
+    (error)))
+
+(defun elmo-file-cache-load (cache-path section)
+  "Load cache on PATH into the current buffer.
+Return t if cache is loaded successfully."
+  (condition-case nil
+      (let (cache-file)
+       (when (and cache-path
+                  (if (elmo-cache-path-section-p cache-path)
+                      section
+                    (null section))
+                  (setq cache-file (elmo-file-cache-expand-path
+                                    cache-path
+                                    section))
+                  (file-exists-p cache-file))
+         (insert-file-contents-as-binary cache-file)
+         t))
+    ;; igore error
+    (error)))
+
+(defun elmo-cache-path-section-p (path)
+  "Return non-nil when PATH is `section' cache path."
+  (file-directory-p path))
 
 (defun elmo-file-cache-get (msgid &optional section)
   "Returns the current file-cache object associated with MSGID.
@@ -1466,7 +1639,7 @@ associated with SECTION."
   (if msgid
       (let ((path (elmo-cache-get-path msgid)))
        (if (and path (file-exists-p path))
-           (if (file-directory-p path)
+           (if (elmo-cache-path-section-p path)
                (if section
                    (if (file-exists-p (setq path (expand-file-name
                                                   section path)))
@@ -1521,8 +1694,7 @@ If KBYTES is kilo bytes (This value must be float)."
        total beginning)
     (message "Checking disk usage...")
     (setq total (/ (elmo-disk-usage
-                   (expand-file-name
-                    elmo-cache-dirname elmo-msgdb-dir)) Kbytes))
+                   elmo-cache-directory) Kbytes))
     (setq beginning total)
     (message "Checking disk usage...done")
     (let ((cfl (elmo-cache-get-sorted-cache-file-list))
@@ -1570,7 +1742,7 @@ If KBYTES is kilo bytes (This value must be float)."
 
 (defun elmo-cache-get-sorted-cache-file-list ()
   (let ((dirs (directory-files
-              (expand-file-name elmo-cache-dirname elmo-msgdb-dir)
+              elmo-cache-directory
               t "^[^\\.]"))
        (i 0) num
        elist
@@ -1606,7 +1778,7 @@ If KBYTES is kilo bytes (This value must be float)."
                               elmo-cache-expire-default-age)))
                 (int-to-string elmo-cache-expire-default-age)))
        (dirs (directory-files
-              (expand-file-name elmo-cache-dirname elmo-msgdb-dir)
+              elmo-cache-directory
               t "^[^\\.]"))
        (count 0)
        curtime)
@@ -1631,9 +1803,10 @@ If KBYTES is kilo bytes (This value must be float)."
 ;;;
 ;; msgid to path.
 (defun elmo-msgid-to-cache (msgid)
-  (when (and msgid
-            (string-match "<\\(.+\\)>$" msgid))
-    (elmo-replace-string-as-filename (elmo-match-string 1 msgid))))
+  (save-match-data
+    (when (and msgid
+              (string-match "<\\(.+\\)>$" msgid))
+      (elmo-replace-string-as-filename (elmo-match-string 1 msgid)))))
 
 (defun elmo-cache-get-path (msgid &optional folder number)
   "Get path for cache file associated with MSGID, FOLDER, and NUMBER."
@@ -1649,8 +1822,7 @@ If KBYTES is kilo bytes (This value must be float)."
          (format "%s/%s"
                  (elmo-cache-get-path-subr msgid)
                  msgid))
-       (expand-file-name elmo-cache-dirname
-                         elmo-msgdb-dir)))))
+       elmo-cache-directory))))
 
 ;;;
 ;; Warnings.
@@ -1666,7 +1838,11 @@ If KBYTES is kilo bytes (This value must be float)."
   (display-buffer elmo-warning-buffer-name))
 
 (defvar elmo-obsolete-variable-alist nil)
-(defvar elmo-obsolete-variable-show-warnings nil)
+
+(defcustom elmo-obsolete-variable-show-warnings t
+  "Show warning window if obsolete variable is treated."
+  :type 'boolean
+  :group 'elmo)
 
 (defun elmo-define-obsolete-variable (obsolete var)
   "Define obsolete variable.
@@ -1684,7 +1860,10 @@ Definition is stored in `elmo-obsolete-variable-alist'."
   "Resque obsolete variable OBSOLETE as VAR.
 If `elmo-obsolete-variable-show-warnings' is non-nil, show warning message."
   (when (boundp obsolete)
-    (set var (symbol-value obsolete))
+    (static-if (and (fboundp 'defvaralias)
+                   (subrp (symbol-function 'defvaralias)))
+       (defvaralias var obsolete)
+      (set var (symbol-value obsolete)))
     (if elmo-obsolete-variable-show-warnings
        (elmo-warning (format "%s is obsolete. Use %s instead."
                              (symbol-name obsolete)
@@ -1699,6 +1878,21 @@ If ALIST is nil, `elmo-obsolete-variable-alist' is used."
     (elmo-resque-obsolete-variable (cdr pair)
                                   (car pair))))
 
+;;; Queue.
+(defvar elmo-dop-queue-filename "queue"
+  "*Disconnected operation queue is saved in this file.")
+
+(defun elmo-dop-queue-load ()
+  (setq elmo-dop-queue
+       (elmo-object-load
+        (expand-file-name elmo-dop-queue-filename
+                          elmo-msgdb-directory))))
+
+(defun elmo-dop-queue-save ()
+  (elmo-object-save
+   (expand-file-name elmo-dop-queue-filename
+                    elmo-msgdb-directory)
+   elmo-dop-queue))
 
 (require 'product)
 (product-provide (provide 'elmo-util) (require 'elmo-version))