X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Felmo-util.el;h=57cd392d295684286bed75bdb353705adef99b2d;hb=fb40159a1fc3d4fb1400f8fe3befb1056bc75b8c;hp=f8f3bf1e83a41a6db6dcaa38a3be216e1e405064;hpb=260a7a718cdcb1c9b5e7f6dff06646c33a7fdeef;p=elisp%2Fwanderlust.git diff --git a/elmo/elmo-util.el b/elmo/elmo-util.el index f8f3bf1..57cd392 100644 --- a/elmo/elmo-util.el +++ b/elmo/elmo-util.el @@ -75,8 +75,6 @@ (filename newname &optional ok-if-already-exists) (copy-file filename newname ok-if-already-exists t))) -(defalias 'elmo-read 'read) - (defmacro elmo-set-work-buf (&rest body) "Execute BODY on work buffer. Work buffer remains." (` (save-excursion @@ -132,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))) @@ -234,7 +233,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 @@ -269,7 +268,7 @@ 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") @@ -417,7 +416,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) @@ -765,7 +765,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 @@ -775,7 +775,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) @@ -948,6 +948,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))))) @@ -1264,7 +1265,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)) @@ -1272,6 +1272,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 @@ -1563,6 +1582,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. @@ -1595,6 +1657,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." @@ -1619,14 +1682,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." @@ -1878,15 +1943,18 @@ If KBYTES is kilo bytes (This value must be float)." ;;; ;; 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"))) - (ignore-errors (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) @@ -1916,9 +1984,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. @@ -1945,6 +2013,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))