X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Felmo-util.el;h=0f3a5b22a793b4d67e5d68a48cc9771676fb1bfb;hb=707bdddbcbc93ae6557dceb3ff8eec1e7342acfe;hp=c30b9ffa6e1348c49a50327b653438dd1e05332c;hpb=0df7fd7001c4416173822d5ec0871e78e9484c79;p=elisp%2Fwanderlust.git

diff --git a/elmo/elmo-util.el b/elmo/elmo-util.el
index c30b9ff..0f3a5b2 100644
--- a/elmo/elmo-util.el
+++ b/elmo/elmo-util.el
@@ -130,7 +130,8 @@ File content is encoded with MIME-CHARSET."
 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)))
 
@@ -148,7 +149,7 @@ File content is encoded with MIME-CHARSET."
 		 (format "%s (%s): " prompt default)
 		 (mapcar 'list
 			 (append '("AND" "OR"
-				   "Last" "First"
+				   "Last" "First" "Flag"
 				   "From" "Subject" "To" "Cc" "Body"
 				   "Since" "Before" "ToCc"
 				   "!From" "!Subject" "!To" "!Cc" "!Body"
@@ -177,6 +178,15 @@ File content is encoded with MIME-CHARSET."
 			     elmo-date-descriptions)))
 	(concat (downcase field) ":"
 		(if (equal value "") default value))))
+     ((string= field "Flag")
+      (setq value (completing-read
+		   (format "Value for '%s': " field)
+		   (mapcar 'list
+			   '("unread" "important" "answered" "digest" "any"))))
+      (unless (string-match (concat "^" elmo-condition-atom-regexp "$")
+			    value)
+	(setq value (prin1-to-string value)))
+      (concat (downcase field) ":" value))
      (t
       (setq value (read-from-minibuffer (format "Value for '%s': " field)))
       (unless (string-match (concat "^" elmo-condition-atom-regexp "$")
@@ -232,7 +242,7 @@ Return value is a cons cell of (STRUCTURE . REST)"
       (goto-char (match-end 0))))
 ;; search-key   ::= [A-Za-z-]+
 ;;                 ;; "since" / "before" / "last" / "first" /
-;;                 ;; "body" / field-name
+;;                 ;; "body" / "mark" / field-name
    ((looking-at "\\(!\\)? *\\([A-Za-z-]+\\) *: *")
     (goto-char (match-end 0))
     (let ((search-key (vector
@@ -415,7 +425,8 @@ Return value is a cons cell of (STRUCTURE . REST)"
   (save-excursion
     (let ((filename (expand-file-name elmo-passwd-alist-file-name
 				      elmo-msgdb-directory))
-	  (tmp-buffer (get-buffer-create " *elmo-passwd-alist-tmp*")))
+	  (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)
@@ -744,14 +755,8 @@ the directory becomes empty after deletion."
 	  ))))
 
 (defun elmo-list-filter (l1 l2)
-  "L1 is filter."
-  (if (eq l1 t)
-      ;; t means filter all.
-      nil
-    (if l1
-	(elmo-delete-if (lambda (x) (not (memq x l1))) l2)
-      ;; filter is nil
-      l2)))
+  "Rerurn a list from L2 in which each element is a member of L1."
+  (elmo-delete-if (lambda (x) (not (memq x l1))) l2))
 
 (defsubst elmo-list-delete-if-smaller (list number)
   (let ((ret-val (copy-sequence list)))
@@ -763,7 +768,7 @@ the directory becomes empty after deletion."
 
 (defun elmo-list-diff (list1 list2 &optional mes)
   (if mes
-      (message mes))
+      (message "%s" mes))
   (let ((clist1 (copy-sequence list1))
 	(clist2 (copy-sequence list2)))
     (while list2
@@ -773,7 +778,7 @@ the directory becomes empty after deletion."
       (setq clist2 (delq (car list1) clist2))
       (setq list1 (cdr list1)))
     (if mes
-	(message (concat mes "done.")))
+	(message "%sdone" mes))
     (list clist1 clist2)))
 
 (defun elmo-list-bigger-diff (list1 list2 &optional mes)
@@ -946,6 +951,7 @@ the directory becomes empty after deletion."
 
 (defmacro elmo-get-hash-val (string hashtable)
   `(and (stringp ,string)
+	,hashtable
 	(let ((sym (intern-soft ,string ,hashtable)))
 	  (if (boundp sym)
 	      (symbol-value sym)))))
@@ -1216,6 +1222,23 @@ If optional DELETE-FUNCTION is speficied, it is used as delete procedure."
 	(when (>= new-rate 100)
 	  (elmo-progress-clear label))))))
 
+(put 'elmo-with-progress-display 'lisp-indent-function '2)
+(def-edebug-spec elmo-with-progress-display
+  (form (symbolp form &rest form) &rest form))
+
+(defmacro elmo-with-progress-display (condition spec &rest body)
+  "Evaluate BODY with progress gauge if CONDITION is non-nil.
+SPEC is a list as followed (LABEL MAX-VALUE [FORMAT])."
+  (let ((label (car spec))
+	(max-value (cadr spec))
+	(fmt (caddr spec)))
+    `(unwind-protect
+	 (progn
+	   (when ,condition
+	     (elmo-progress-set (quote ,label) ,max-value ,fmt))
+	   ,@body)
+       (elmo-progress-clear (quote ,label)))))
+
 (defun elmo-time-expire (before-time diff-time)
   (let* ((current (current-time))
 	 (rest (when (< (nth 1 current) (nth 1 before-time))
@@ -1262,7 +1285,6 @@ But if optional argument AUTO is non-nil, DEFAULT is returned."
     (y-or-n-p prompt)))
 
 (defun elmo-string-member (string slist)
-  "Return t if STRING is a member of the SLIST."
   (catch 'found
     (while slist
       (if (and (stringp (car slist))
@@ -1270,6 +1292,25 @@ But if optional argument AUTO is non-nil, DEFAULT is returned."
 	  (throw 'found t))
       (setq slist (cdr slist)))))
 
+(cond ((fboundp 'member-ignore-case)
+       (defalias 'elmo-string-member-ignore-case 'member-ignore-case))
+      ((fboundp 'compare-strings)
+       (defun elmo-string-member-ignore-case (elt list)
+	 "Like `member', but ignores differences in case and text representation.
+ELT must be a string.  Upper-case and lower-case letters are treated as equal.
+Unibyte strings are converted to multibyte for comparison."
+	 (while (and list (not (eq t (compare-strings elt 0 nil (car list) 0 nil t))))
+	   (setq list (cdr list)))
+	 list))
+      (t
+       (defun elmo-string-member-ignore-case (elt list)
+	 "Like `member', but ignores differences in case and text representation.
+ELT must be a string.  Upper-case and lower-case letters are treated as equal."
+	 (let ((str (downcase elt)))
+	   (while (and list (not (string= str (downcase (car list)))))
+	     (setq list (cdr list)))
+	   list))))
+
 (defun elmo-string-match-member (str list &optional case-ignore)
   (let ((case-fold-search case-ignore))
     (catch 'member
@@ -1561,6 +1602,49 @@ NUMBER-SET is altered."
 				  (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.
@@ -1593,6 +1677,7 @@ If the cache is partial file-cache, TYPE is 'partial."
 	    (nth (% (/ sum 16) 2) chars)
 	    (nth (% sum 16) chars))))
 
+;;;
 (defun elmo-file-cache-get-path (msgid &optional section)
   "Get cache path for MSGID.
 If optional argument SECTION is specified, partial cache path is returned."
@@ -1617,14 +1702,16 @@ SECTION is the section string."
 
 (defun elmo-file-cache-delete (path)
   "Delete a cache on PATH."
-  (when (file-exists-p path)
-    (if (file-directory-p path)
-	(progn
-	  (dolist (file (directory-files path t "^[^\\.]"))
-	    (delete-file file))
-	  (delete-directory path))
-      (delete-file path))
-    t))
+  (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
+	    (dolist (file (directory-files path t "^[^\\.]"))
+	      (delete-file file))
+	    (delete-directory path))
+	(delete-file path))
+      t)))
 
 (defun elmo-file-cache-exists-p (msgid)
   "Returns 'section or 'entire if a cache which corresponds to MSGID exists."
@@ -1946,6 +2033,18 @@ If ALIST is nil, `elmo-obsolete-variable-alist' is used."
 		     elmo-msgdb-directory)
    elmo-dop-queue))
 
+(if (and (fboundp 'regexp-opt)
+	 (not (featurep 'xemacs)))
+    (defalias 'elmo-regexp-opt 'regexp-opt)
+  (defun elmo-regexp-opt (strings &optional paren)
+    "Return a regexp to match a string in STRINGS.
+Each string should be unique in STRINGS and should not contain any regexps,
+quoted or not.  If optional PAREN is non-nil, ensure that the returned regexp
+is enclosed by at least one regexp grouping construct."
+    (let ((open-paren (if paren "\\(" "")) (close-paren (if paren "\\)" "")))
+      (concat open-paren (mapconcat 'regexp-quote strings "\\|")
+	      close-paren))))
+
 (require 'product)
 (product-provide (provide 'elmo-util) (require 'elmo-version))