X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Felmo-util.el;h=57cd392d295684286bed75bdb353705adef99b2d;hb=fb40159a1fc3d4fb1400f8fe3befb1056bc75b8c;hp=7a3b0153d215d28583254ae6cdeaef7f5df7fa7d;hpb=5eab7554a5557dd814c53f50f8bed0401018878c;p=elisp%2Fwanderlust.git diff --git a/elmo/elmo-util.el b/elmo/elmo-util.el index 7a3b015..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))))) @@ -1100,13 +1101,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) @@ -1262,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)) @@ -1270,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 @@ -1359,6 +1380,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." @@ -1528,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. @@ -1560,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." @@ -1584,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." @@ -1843,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"))) - (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) @@ -1881,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. @@ -1910,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))