* elmo-imap4.el: Remove Nemacs hack, replace `elmo-read' with `read'.
[elisp/wanderlust.git] / elmo / elmo-util.el
index 2322005..2c59103 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)
 (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."
@@ -131,14 +125,15 @@ File content is encoded with MIME-CHARSET."
            (encode-mime-charset-region (point-min) (point-max) mime-charset))
          (as-binary-output-file
           (write-region (point-min) (point-max) filename nil 'no-msg)))
-      (message (format "%s is not writable." filename)))))
+      (message "%s is not writable." filename))))
 
 (defun elmo-object-save (filename object &optional mime-charset)
   "Save OBJECT to the file specified by FILENAME.
 Directory of the file is created if it doesn't exist.
 File content is encoded with MIME-CHARSET."
   (elmo-set-work-buf
-   (prin1 object (current-buffer))
+   (let (print-length print-level)
+     (prin1 object (current-buffer)))
 ;;;(princ "\n" (current-buffer))
    (elmo-save-buffer filename mime-charset)))
 
@@ -176,12 +171,15 @@ File content is encoded with MIME-CHARSET."
               (concat field "(2) Search by") default)
              ")"))
      ((string-match "Since\\|Before" field)
-      (concat (downcase field) ":"
-             (completing-read (format "Value for '%s': " field)
-                              (mapcar (function
-                                       (lambda (x)
-                                         (list (format "%s" (car x)))))
-                                      elmo-date-descriptions))))
+      (let ((default (format-time-string "%Y-%m-%d")))
+       (setq value (completing-read
+                    (format "Value for '%s' [%s]: " field default)
+                    (mapcar (function
+                             (lambda (x)
+                               (list (format "%s" (car x)))))
+                            elmo-date-descriptions)))
+       (concat (downcase field) ":"
+               (if (equal value "") default value))))
      (t
       (setq value (read-from-minibuffer (format "Value for '%s': " field)))
       (unless (string-match (concat "^" elmo-condition-atom-regexp "$")
@@ -206,7 +204,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 "| *")
@@ -260,6 +258,7 @@ Return value is a cons cell of (STRUCTURE . REST)"
 ;; time         ::= "yesterday" / "lastweek" / "lastmonth" / "lastyear" /
 ;;                   number SPACE* "daysago" /
 ;;                   number "-" month "-" number  ; ex. 10-May-2000
+;;                   number "-" number "-" number  ; ex. 2000-05-10
 ;; number       ::= [0-9]+
 ;; month        ::= "Jan" / "Feb" / "Mar" / "Apr" / "May" / "Jun" /
 ;;                  "Jul" / "Aug" / "Sep" / "Oct" / "Nov" / "Dec"
@@ -271,11 +270,12 @@ Return value is a cons cell of (STRUCTURE . REST)"
 (defun elmo-condition-parse-search-value ()
   (cond
    ((looking-at "\"")
-    (elmo-read (current-buffer)))
+    (read (current-buffer)))
    ((or (looking-at "yesterday") (looking-at "lastweek")
        (looking-at "lastmonth") (looking-at "lastyear")
        (looking-at "[0-9]+ *daysago")
        (looking-at "[0-9]+-[A-Za-z]+-[0-9]+")
+       (looking-at "[0-9]+-[0-9]+-[0-9]+")
        (looking-at "[0-9]+")
        (looking-at elmo-condition-atom-regexp))
     (prog1 (elmo-match-buffer 0)
@@ -336,17 +336,12 @@ Return value is a cons cell of (STRUCTURE . REST)"
   lst)
 
 (defun elmo-list-insert (list element after)
-  "Insert an ELEMENT to the LIST, just after AFTER."
-  (let ((li list)
-       (curn 0)
-       p pn)
-    (while li
-      (if (eq (car li) after)
-         (setq p li pn curn li nil)
-       (incf curn))
-      (setq li (cdr li)))
-    (if pn
-       (setcdr (nthcdr pn list) (cons element (cdr p)))
+  (let* ((match (memq after list))
+        (rest (and match (cdr (memq after list)))))
+    (if match
+       (progn
+         (setcdr match (list element))
+         (nconc list rest))
       (nconc list (list element)))))
 
 (defun elmo-string-partial-p (string)
@@ -396,19 +391,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)))
 
@@ -416,14 +411,15 @@ 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*"))
+         print-length print-level)
       (set-buffer tmp-buffer)
       (erase-buffer)
       (prin1 elmo-passwd-alist tmp-buffer)
@@ -432,11 +428,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 "%s is not writable." filename))
       (kill-buffer tmp-buffer))))
 
 (defun elmo-get-passwd (key)
@@ -470,19 +466,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."
@@ -549,12 +545,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)))
@@ -689,7 +685,8 @@ Return value is a cons cell of (STRUCTURE . REST)"
                (setq result (+ result (or (elmo-disk-usage (car files)) 0)))
                (setq files (cdr files)))
              result)
-         (float (nth 7 file-attr))))))
+         (float (nth 7 file-attr)))
+      0)))
 
 (defun elmo-get-last-accessed-time (path &optional dir)
   "Return the last accessed time of PATH."
@@ -711,14 +708,14 @@ Return value is a cons cell of (STRUCTURE . REST)"
     (setq last-modified (+ (* (nth 0 last-modified)
                              (float 65536)) (nth 1 last-modified)))))
 
-(defun elmo-make-directory (path)
+(defun elmo-make-directory (path &optional mode)
   "Create directory recursively."
   (let ((parent (directory-file-name (file-name-directory path))))
     (if (null (file-directory-p parent))
        (elmo-make-directory parent))
     (make-directory path)
-    (if (string= path (expand-file-name elmo-msgdb-dir))
-       (set-file-modes path (+ (* 64 7) (* 8 0) 0))))) ; chmod 0700
+    (set-file-modes path (or mode
+                            (+ (* 64 7) (* 8 0) 0))))) ; chmod 0700
 
 (defun elmo-delete-directory (path &optional no-hierarchy)
   "Delete directory recursively."
@@ -738,6 +735,18 @@ Return value is a cons cell of (STRUCTURE . REST)"
     (unless hierarchy
       (delete-directory path)))))
 
+(defun elmo-delete-match-files (path regexp &optional remove-if-empty)
+  "Delete directory files specified by PATH.
+If optional REMOVE-IF-EMPTY is non-nil, delete directory itself if
+the directory becomes empty after deletion."
+  (when (stringp path) ; nil is not permitted.
+    (dolist (file (directory-files path t regexp))
+      (delete-file file))
+    (if remove-if-empty
+       (ignore-errors 
+         (delete-directory path) ; should be removed if empty.
+         ))))
+
 (defun elmo-list-filter (l1 l2)
   "L1 is filter."
   (if (eq l1 t)
@@ -768,7 +777,7 @@ Return value is a cons cell of (STRUCTURE . REST)"
       (setq clist2 (delq (car list1) clist2))
       (setq list1 (cdr list1)))
     (if mes
-       (message (concat mes "done.")))
+       (message (concat mes "done")))
     (list clist1 clist2)))
 
 (defun elmo-list-bigger-diff (list1 list2 &optional mes)
@@ -799,6 +808,9 @@ Return value is a cons cell of (STRUCTURE . REST)"
        (setq l1 (cdr l1)))
       (cons diff1 (list l2)))))
 
+(defmacro elmo-filter-condition-p (filter)
+  `(or (vectorp ,filter) (consp ,filter)))
+
 (defmacro elmo-filter-type (filter)
   (` (aref (, filter) 0)))
 
@@ -822,29 +834,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)
@@ -877,7 +886,7 @@ Return value is a cons cell of (STRUCTURE . REST)"
                                              '("last" "first" "from"
                                                "subject" "to" "cc" "since"
                                                "before"))))))
+
 (defun elmo-buffer-field-condition-match (condition number number-list)
   (cond
    ((vectorp condition)
@@ -903,11 +912,15 @@ Return value is a cons cell of (STRUCTURE . REST)"
     (cond
      ((string= (elmo-filter-key condition) "last")
       (setq result (<= (length (memq number number-list))
-                      (string-to-int (elmo-filter-value condition)))))
+                      (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)))))
+                     (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))
@@ -917,8 +930,6 @@ Return value is a cons cell of (STRUCTURE . REST)"
        (setq result
             (elmo-buffer-field-primitive-condition-match
              condition number number-list)))))
-    (if (eq (elmo-filter-type condition) 'unmatch)
-       (setq result (not result)))
     result))
 
 (defun elmo-file-field-condition-match (file condition number number-list)
@@ -938,9 +949,10 @@ Return value is a cons cell of (STRUCTURE . REST)"
         file (nth 2 condition) number number-list)))))
 
 (defmacro elmo-get-hash-val (string hashtable)
-  (let ((sym (list 'intern-soft string hashtable)))
-    (list 'if (list 'boundp sym)
-       (list 'symbol-value sym))))
+  `(and (stringp ,string)
+       (let ((sym (intern-soft ,string ,hashtable)))
+         (if (boundp sym)
+             (symbol-value sym)))))
 
 (defmacro elmo-set-hash-val (string value hashtable)
   (list 'set (list 'intern string hashtable) value))
@@ -959,10 +971,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))
@@ -976,15 +988,16 @@ Emacs 19.28 or earlier does not have `unintern'."
 
 (defsubst elmo-mime-string (string)
   "Normalize MIME encoded STRING."
-    (and string
-        (let (str)
-          (elmo-set-work-buf
-           (elmo-set-buffer-multibyte default-enable-multibyte-characters)
-           (setq str (eword-decode-string
-                      (decode-mime-charset-string string elmo-mime-charset)))
-           (setq str (encode-mime-charset-string str elmo-mime-charset))
-           (elmo-set-buffer-multibyte nil)
-           str))))
+  (and string
+       (elmo-set-work-buf
+       (elmo-set-buffer-multibyte default-enable-multibyte-characters)
+       (setq string
+             (encode-mime-charset-string
+              (eword-decode-and-unfold-unstructured-field-body
+               string)
+              elmo-mime-charset))
+       (elmo-set-buffer-multibyte nil)
+       string)))
 
 (defsubst elmo-collect-field (beg end downcase-field-name)
   (save-excursion
@@ -1066,7 +1079,7 @@ 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 &otional ok-if-already-exists)
+(defsubst elmo-copy-file (src dst &optional ok-if-already-exists)
   (condition-case err
       (elmo-add-name-to-file src dst ok-if-already-exists)
     (error (copy-file src dst ok-if-already-exists t))))
@@ -1089,13 +1102,15 @@ Emacs 19.28 or earlier does not have `unintern'."
       (setq lst (cdr lst)))
     result))
 
-(defun elmo-list-delete (list1 list2)
+(defun elmo-list-delete (list1 list2 &optional delete-function)
   "Delete by side effect any occurrences equal to elements of LIST1 from LIST2.
 Return the modified LIST2.  Deletion is done with `delete'.
 Write `(setq foo (elmo-list-delete bar foo))' to be sure of changing
-the value of `foo'."
+the value of `foo'.
+If optional DELETE-FUNCTION is speficied, it is used as delete procedure."
+  (setq delete-function (or delete-function 'delete))
   (while list1
-    (setq list2 (delete (car list1) list2))
+    (setq list2 (funcall delete-function (car list1) list2))
     (setq list1 (cdr list1)))
   list2)
 
@@ -1126,9 +1141,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))
@@ -1181,7 +1195,9 @@ the value of `foo'."
 (defun elmo-progress-clear (label)
   (let ((counter (assq label elmo-progress-counter-alist)))
     (when counter
-      (elmo-display-progress label "" 100)
+      (elmo-display-progress label
+                            (elmo-progress-counter-format counter)
+                            100)
       (setq elmo-progress-counter-alist
            (delq counter elmo-progress-counter-alist)))))
 
@@ -1230,7 +1246,7 @@ the value of `foo'."
 (defmacro elmo-string (string)
   "STRING without text property."
   (` (let ((obj (copy-sequence (, string))))
-       (set-text-properties 0 (length obj) nil obj)
+       (and obj (set-text-properties 0 (length obj) nil obj))
        obj)))
 
 (defun elmo-flatten (list-of-list)
@@ -1347,6 +1363,39 @@ But if optional argument AUTO is non-nil, DEFAULT is returned."
       (setq alist (cdr alist)))
     matches))
 
+(defun elmo-expand-newtext (newtext original)
+  (let ((len (length newtext))
+       (pos 0)
+       c expanded beg N did-expand)
+    (while (< pos len)
+      (setq beg pos)
+      (while (and (< pos len)
+                 (not (= (aref newtext pos) ?\\)))
+       (setq pos (1+ pos)))
+      (unless (= beg pos)
+       (push (substring newtext beg pos) expanded))
+      (when (< pos len)
+       ;; We hit a \; expand it.
+       (setq did-expand t
+             pos (1+ pos)
+             c (aref newtext pos))
+       (if (not (or (= c ?\&)
+                    (and (>= c ?1)
+                         (<= c ?9))))
+           ;; \ followed by some character we don't expand.
+           (push (char-to-string c) expanded)
+         ;; \& or \N
+         (if (= c ?\&)
+             (setq N 0)
+           (setq N (- c ?0)))
+         (when (match-beginning N)
+           (push (substring original (match-beginning N) (match-end N))
+                 expanded))))
+      (setq pos (1+ pos)))
+    (if did-expand
+       (apply (function concat) (nreverse expanded))
+      newtext)))
+
 ;;; Folder parser utils.
 (defun elmo-parse-token (string &optional seps)
   "Parse atom from STRING using SEPS as a string of separator char list."
@@ -1513,9 +1562,52 @@ 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)))
 
+;;;
+;; parsistent mark handling
+;; (for global!)
+;; (FIXME: this should be treated in the msgdb.)
+
+(defvar elmo-msgdb-global-mark-alist nil)
+
+(defun elmo-msgdb-global-mark-delete (msgid)
+  (let* ((path (expand-file-name
+               elmo-msgdb-global-mark-filename
+               elmo-msgdb-directory))
+        (malist (or elmo-msgdb-global-mark-alist
+                    (setq elmo-msgdb-global-mark-alist
+                          (elmo-object-load path))))
+        match)
+    (when (setq match (assoc msgid malist))
+      (setq elmo-msgdb-global-mark-alist
+           (delete match elmo-msgdb-global-mark-alist))
+      (elmo-object-save path elmo-msgdb-global-mark-alist))))
+
+(defun elmo-msgdb-global-mark-set (msgid mark)
+  (let* ((path (expand-file-name
+               elmo-msgdb-global-mark-filename
+               elmo-msgdb-directory))
+        (malist (or elmo-msgdb-global-mark-alist
+                    (setq elmo-msgdb-global-mark-alist
+                          (elmo-object-load path))))
+        match)
+    (if (setq match (assoc msgid malist))
+       (setcdr match mark)
+      (setq elmo-msgdb-global-mark-alist
+           (nconc elmo-msgdb-global-mark-alist
+                  (list (cons msgid mark)))))
+    (elmo-object-save path elmo-msgdb-global-mark-alist)))
+
+(defun elmo-msgdb-global-mark-get (msgid)
+  (cdr (assoc msgid (or elmo-msgdb-global-mark-alist
+                       (setq elmo-msgdb-global-mark-alist
+                             (elmo-object-load
+                              (expand-file-name
+                               elmo-msgdb-global-mark-filename
+                               elmo-msgdb-directory)))))))
+
 ;;; File cache.
 (defmacro elmo-make-file-cache (path status)
   "PATH is the cache file name.
@@ -1554,15 +1646,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)))))
 
@@ -1574,16 +1664,16 @@ SECTION is the section string."
 
 (defun elmo-file-cache-delete (path)
   "Delete a cache on PATH."
-  (let (files)
+  (unless (elmo-msgdb-global-mark-get
+          (elmo-cache-to-msgid (file-name-nondirectory path)))
     (when (file-exists-p path)
       (if (file-directory-p path)
          (progn
-           (setq files (directory-files path t "^[^\\.]"))
-           (while files
-             (delete-file (car files))
-             (setq files (cdr files)))
+           (dolist (file (directory-files path t "^[^\\.]"))
+             (delete-file file))
            (delete-directory path))
-       (delete-file path)))))
+       (delete-file path))
+      t)))
 
 (defun elmo-file-cache-exists-p (msgid)
   "Returns 'section or 'entire if a cache which corresponds to MSGID exists."
@@ -1617,6 +1707,24 @@ Return t if cache is saved successfully."
     ;; 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))
@@ -1684,8 +1792,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))
@@ -1733,7 +1840,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
@@ -1769,7 +1876,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)
@@ -1813,24 +1920,30 @@ 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.
 
-(defconst elmo-warning-buffer-name "*elmo warning*")
-
-(defun elmo-warning (&rest args)
-  "Display a warning, making warning message by passing all args to `insert'."
-  (with-current-buffer (get-buffer-create elmo-warning-buffer-name)
-    (goto-char (point-max))
-    (apply 'insert (append args '("\n")))
-    (recenter 1))
-  (display-buffer elmo-warning-buffer-name))
+(static-if (fboundp 'display-warning)
+    (defmacro elmo-warning (&rest args)
+      "Display a warning with `elmo' group."
+      `(display-warning 'elmo (format ,@args)))
+  (defconst elmo-warning-buffer-name "*elmo warning*")
+  (defun elmo-warning (&rest args)
+    "Display a warning. ARGS are passed to `format'."
+    (with-current-buffer (get-buffer-create elmo-warning-buffer-name)
+      (goto-char (point-max))
+      (funcall 'insert (apply 'format (append args '("\n"))))
+      (ignore-errors (recenter 1))
+      (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.
@@ -1853,9 +1966,9 @@ If `elmo-obsolete-variable-show-warnings' is non-nil, show warning message."
        (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)
-                             (symbol-name var))))))
+       (elmo-warning "%s is obsolete. Use %s instead."
+                     (symbol-name obsolete)
+                     (symbol-name var)))))
 
 (defun elmo-resque-obsolete-variables (&optional alist)
   "Resque obsolete variables in ALIST.
@@ -1874,12 +1987,12 @@ If ALIST is nil, `elmo-obsolete-variable-alist' is used."
   (setq elmo-dop-queue
        (elmo-object-load
         (expand-file-name elmo-dop-queue-filename
-                          elmo-msgdb-dir))))
+                          elmo-msgdb-directory))))
 
 (defun elmo-dop-queue-save ()
   (elmo-object-save
    (expand-file-name elmo-dop-queue-filename
-                    elmo-msgdb-dir)
+                    elmo-msgdb-directory)
    elmo-dop-queue))
 
 (require 'product)