X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Felmo-util.el;h=6e9e5da4f94b1b8a4ebcf3489f704c94936da087;hb=16b8dcb951d32d536cd4b065dd4a2a53e118d261;hp=59fb3f8668bb042d7b9144d8059d01e50ebca739;hpb=1cd38ff71e9246d17a04722dd20625a9ecb8a9ef;p=elisp%2Fwanderlust.git diff --git a/elmo/elmo-util.el b/elmo/elmo-util.el index 59fb3f8..6e9e5da 100644 --- a/elmo/elmo-util.el +++ b/elmo/elmo-util.el @@ -38,6 +38,7 @@ (require 'eword-decode) (require 'utf7) (require 'poem) +(require 'emu) (defmacro elmo-set-buffer-multibyte (flag) "Set the multibyte flag of the current buffer to FLAG." @@ -149,7 +150,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" @@ -178,6 +179,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 "$") @@ -233,7 +243,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 @@ -323,14 +333,17 @@ Return value is a cons cell of (STRUCTURE . REST)" (replace-match "\n")) (buffer-string)))) -(defun elmo-uniq-list (lst) +(defun elmo-uniq-list (lst &optional delete-function) "Distractively uniqfy elements of LST." + (setq delete-function (or delete-function #'delete)) (let ((tmp lst)) - (while tmp (setq tmp - (setcdr tmp - (and (cdr tmp) - (delete (car tmp) - (cdr tmp))))))) + (while tmp + (setq tmp + (setcdr tmp + (and (cdr tmp) + (funcall delete-function + (car tmp) + (cdr tmp))))))) lst) (defun elmo-list-insert (list element after) @@ -746,14 +759,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))) @@ -947,13 +954,10 @@ the directory becomes empty after deletion." file (nth 2 condition) number number-list))))) (defmacro elmo-get-hash-val (string hashtable) - `(and (stringp ,string) - (let ((sym (intern-soft ,string ,hashtable))) - (if (boundp sym) - (symbol-value sym))))) + `(symbol-value (intern-soft ,string ,hashtable))) (defmacro elmo-set-hash-val (string value hashtable) - (list 'set (list 'intern string hashtable) value)) + `(set (intern ,string ,hashtable) ,value)) (defmacro elmo-clear-hash-val (string hashtable) (static-if (fboundp 'unintern) @@ -1218,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 &optional 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)) @@ -1264,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)) @@ -1582,49 +1602,6 @@ 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. @@ -1657,6 +1634,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." @@ -1681,16 +1659,14 @@ SECTION is the section string." (defun elmo-file-cache-delete (path) "Delete a cache on PATH." - (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))) + (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." @@ -1996,6 +1972,64 @@ If ALIST is nil, `elmo-obsolete-variable-alist' is used." (elmo-resque-obsolete-variable (cdr pair) (car pair)))) +(defsubst elmo-msgdb-get-last-message-id (string) + (if string + (save-match-data + (let (beg) + (elmo-set-work-buf + (insert string) + (goto-char (point-max)) + (when (search-backward "<" nil t) + (setq beg (point)) + (if (search-forward ">" nil t) + (elmo-replace-in-string + (buffer-substring beg (point)) "\n[ \t]*" "")))))))) + +(defun elmo-msgdb-get-message-id-from-buffer () + (let ((msgid (elmo-field-body "message-id"))) + (if msgid + (if (string-match "<\\(.+\\)>$" msgid) + msgid + (concat "<" msgid ">")) ; Invaild message-id. + ;; no message-id, so put dummy msgid. + (concat "<" (timezone-make-date-sortable + (elmo-field-body "date")) + (nth 1 (eword-extract-address-components + (or (elmo-field-body "from") "nobody"))) ">")))) + +(defsubst elmo-msgdb-insert-file-header (file) + "Insert the header of the article." + (let ((beg 0) + insert-file-contents-pre-hook ; To avoid autoconv-xmas... + insert-file-contents-post-hook + format-alist) + (when (file-exists-p file) + ;; Read until header separator is found. + (while (and (eq elmo-msgdb-file-header-chop-length + (nth 1 + (insert-file-contents-as-binary + file nil beg + (incf beg elmo-msgdb-file-header-chop-length)))) + (prog1 (not (search-forward "\n\n" nil t)) + (goto-char (point-max)))))))) + +;; +;; overview handling +;; +(defun elmo-multiple-field-body (name &optional boundary) + (save-excursion + (save-restriction + (std11-narrow-to-header boundary) + (goto-char (point-min)) + (let ((case-fold-search t) + (field-body nil)) + (while (re-search-forward (concat "^" name ":[ \t]*") nil t) + (setq field-body + (nconc field-body + (list (buffer-substring-no-properties + (match-end 0) (std11-field-end)))))) + field-body)))) + ;;; Queue. (defvar elmo-dop-queue-filename "queue" "*Disconnected operation queue is saved in this file.") @@ -2012,6 +2046,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))