(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."
(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"
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 "$")
(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
(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)
))))
(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)))
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)
(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))
(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))
(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.
(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."
(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."
(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.")
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))
projects / elisp / wanderlust.git / blobdiff