-;;; elmo-util.el -- Utilities for Elmo.
+;;; elmo-util.el --- Utilities for ELMO.
;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
;;
;;; Commentary:
-;;
+;;
;;; Code:
-;;
+;;
(eval-when-compile (require 'cl))
(require 'elmo-vars)
(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."
- (cond ((boundp 'MULE)
- (list 'setq 'mc-flag flag))
- ((featurep 'xemacs)
- flag)
- ((and (boundp 'emacs-major-version) (>= emacs-major-version 20))
- (list 'set-buffer-multibyte flag))
- (t
- flag)))
+(eval-and-compile
+ (autoload 'md5 "md5"))
(defvar elmo-work-buf-name " *elmo work*")
(defvar elmo-temp-buf-name " *elmo temp*")
(filename newname &optional ok-if-already-exists)
(copy-file filename newname ok-if-already-exists t)))
-;; Nemacs's `read' is different.
-(static-if (fboundp 'nemacs-version)
- (defun elmo-read (obj)
- (prog1 (read obj)
- (if (bufferp obj)
- (or (bobp) (forward-char -1)))))
- (defalias 'elmo-read 'read))
-
(defmacro elmo-set-work-buf (&rest body)
"Execute BODY on work buffer. Work buffer remains."
(` (save-excursion
(set-buffer (get-buffer-create elmo-work-buf-name))
- (elmo-set-buffer-multibyte default-enable-multibyte-characters)
+ (set-buffer-multibyte default-enable-multibyte-characters)
(erase-buffer)
(,@ body))))
+(put 'elmo-set-work-buf 'lisp-indent-function 0)
+(def-edebug-spec elmo-set-work-buf t)
+
(defmacro elmo-bind-directory (dir &rest body)
"Set current directory DIR and execute BODY."
(` (let ((default-directory (file-name-as-directory (, dir))))
(,@ body))))
+(put 'elmo-bind-directory 'lisp-indent-function 1)
+(def-edebug-spec elmo-bind-directory
+ (form &rest form))
+
(defun elmo-object-load (filename &optional mime-charset no-err)
"Load OBJECT from the file specified by FILENAME.
File content is decoded with MIME-CHARSET."
(as-binary-input-file
(insert-file-contents filename))
(when mime-charset
- (elmo-set-buffer-multibyte default-enable-multibyte-characters)
+ (set-buffer-multibyte default-enable-multibyte-characters)
(decode-mime-charset-region (point-min) (point-max) mime-charset))
(condition-case nil
(read (current-buffer))
(if (file-writable-p filename)
(progn
(when mime-charset
-;;; (elmo-set-buffer-multibyte default-enable-multibyte-characters)
+;;; (set-buffer-multibyte default-enable-multibyte-characters)
(encode-mime-charset-region (point-min) (point-max) mime-charset))
(as-binary-output-file
(write-region (point-min) (point-max) filename nil 'no-msg)))
- (message (format "%s is not writable." filename)))))
+ (message "%s is not writable." filename))))
(defun elmo-object-save (filename object &optional mime-charset)
"Save OBJECT to the file specified by FILENAME.
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)))
(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"
(concat field "(2) Search by") default)
")"))
((string-match "Since\\|Before" field)
- (concat (downcase field) ":"
- (completing-read (format "Value for '%s': " field)
- (mapcar (function
- (lambda (x)
- (list (format "%s" (car x)))))
- elmo-date-descriptions))))
+ (let ((default (format-time-string "%Y-%m-%d")))
+ (setq value (completing-read
+ (format "Value for '%s' [%s]: " field default)
+ (mapcar (function
+ (lambda (x)
+ (list (format "%s" (car x)))))
+ 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 "$")
(elmo-condition-parse-error)))
;; or-expr ::= and-expr /
-;; and-expr "|" or-expr
+;; and-expr "|" or-expr
(defun elmo-condition-parse-or-expr ()
(let ((left (elmo-condition-parse-and-expr)))
(if (looking-at "| *")
(goto-char (match-end 0))))
;; search-key ::= [A-Za-z-]+
;; ;; "since" / "before" / "last" / "first" /
-;; ;; "body" / field-name
+;; ;; "body" / "flag" / field-name
((looking-at "\\(!\\)? *\\([A-Za-z-]+\\) *: *")
(goto-char (match-end 0))
(let ((search-key (vector
;; time ::= "yesterday" / "lastweek" / "lastmonth" / "lastyear" /
;; number SPACE* "daysago" /
;; number "-" month "-" number ; ex. 10-May-2000
+;; number "-" number "-" number ; ex. 2000-05-10
;; number ::= [0-9]+
;; month ::= "Jan" / "Feb" / "Mar" / "Apr" / "May" / "Jun" /
;; "Jul" / "Aug" / "Sep" / "Oct" / "Nov" / "Dec"
(defun elmo-condition-parse-search-value ()
(cond
((looking-at "\"")
- (elmo-read (current-buffer)))
- ((or (looking-at "yesterday") (looking-at "lastweek")
+ (read (current-buffer)))
+ ((or (looking-at elmo-condition-atom-regexp)
+ (looking-at "yesterday") (looking-at "lastweek")
(looking-at "lastmonth") (looking-at "lastyear")
(looking-at "[0-9]+ *daysago")
(looking-at "[0-9]+-[A-Za-z]+-[0-9]+")
- (looking-at "[0-9]+")
- (looking-at elmo-condition-atom-regexp))
+ (looking-at "[0-9]+-[0-9]+-[0-9]+")
+ (looking-at "[0-9]+"))
(prog1 (elmo-match-buffer 0)
(goto-char (match-end 0))))
(t (error "Syntax error '%s'" (buffer-string)))))
(elmo-set-work-buf
(let ((coding-system-for-read 'no-conversion)
(coding-system-for-write 'no-conversion))
- (if unibyte (elmo-set-buffer-multibyte nil))
+ (if unibyte (set-buffer-multibyte nil))
(insert string)
(goto-char (point-min))
(while (search-forward (char-to-string char) nil t)
(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-uniq-sorted-list (list &optional equal-function)
+ "Distractively uniqfy elements of sorted LIST."
+ (setq equal-function (or equal-function #'equal))
+ (let ((list list))
+ (while list
+ (while (funcall equal-function (car list) (cadr list))
+ (setcdr list (cddr list)))
+ (setq list (cdr list))))
+ list)
+
(defun elmo-list-insert (list element after)
- "Insert an ELEMENT to the LIST, just after AFTER."
- (let ((li list)
- (curn 0)
- p pn)
- (while li
- (if (eq (car li) after)
- (setq p li pn curn li nil)
- (incf curn))
- (setq li (cdr li)))
- (if pn
- (setcdr (nthcdr pn list) (cons element (cdr p)))
+ (let* ((match (memq after list))
+ (rest (and match (cdr (memq after list)))))
+ (if match
+ (progn
+ (setcdr match (list element))
+ (nconc list rest))
(nconc list (list element)))))
-(defun elmo-string-partial-p (string)
- (and (stringp string) (string-match "message/partial" string)))
-
(defun elmo-get-file-string (filename &optional remove-final-newline)
(elmo-set-work-buf
(let (insert-file-contents-pre-hook ; To avoid autoconv-xmas...
(defun elmo-passwd-alist-load ()
(save-excursion
(let ((filename (expand-file-name elmo-passwd-alist-file-name
- elmo-msgdb-dir))
- (tmp-buffer (get-buffer-create " *elmo-passwd-alist-tmp*"))
- insert-file-contents-pre-hook ; To avoid autoconv-xmas...
- insert-file-contents-post-hook
- ret-val)
+ elmo-msgdb-directory))
+ (tmp-buffer (get-buffer-create " *elmo-passwd-alist-tmp*"))
+ insert-file-contents-pre-hook ; To avoid autoconv-xmas...
+ insert-file-contents-post-hook
+ ret-val)
(if (not (file-readable-p filename))
- ()
- (set-buffer tmp-buffer)
- (insert-file-contents filename)
- (setq ret-val
- (condition-case nil
- (read (current-buffer))
- (error nil nil))))
+ ()
+ (set-buffer tmp-buffer)
+ (insert-file-contents filename)
+ (setq ret-val
+ (condition-case nil
+ (read (current-buffer))
+ (error nil nil))))
(kill-buffer tmp-buffer)
ret-val)))
(defun elmo-passwd-alist-clear ()
"Clear password cache."
(interactive)
+ (dolist (pair elmo-passwd-alist)
+ (when (stringp (cdr-safe pair))
+ (fillarray (cdr pair) 0)))
(setq elmo-passwd-alist nil))
-
+
(defun elmo-passwd-alist-save ()
"Save password into file."
(interactive)
(save-excursion
(let ((filename (expand-file-name elmo-passwd-alist-file-name
- elmo-msgdb-dir))
- (tmp-buffer (get-buffer-create " *elmo-passwd-alist-tmp*")))
+ elmo-msgdb-directory))
+ (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)
;;; (not (equal 384 (file-modes filename))))
;;; (error "%s is not safe.chmod 600 %s!" filename filename))
(if (file-writable-p filename)
- (progn
- (write-region (point-min) (point-max)
- filename nil 'no-msg)
- (set-file-modes filename 384))
- (message (format "%s is not writable." filename)))
+ (progn
+ (write-region (point-min) (point-max)
+ filename nil 'no-msg)
+ (set-file-modes filename 384))
+ (message "%s is not writable." filename))
(kill-buffer tmp-buffer))))
(defun elmo-get-passwd (key)
(defun elmo-remove-passwd (key)
"Remove password from password pool (for failure)."
(let (pass-cons)
- (if (setq pass-cons (assoc key elmo-passwd-alist))
- (progn
- (unwind-protect
- (fillarray (cdr pass-cons) 0))
- (setq elmo-passwd-alist
- (delete pass-cons elmo-passwd-alist))))))
+ (while (setq pass-cons (assoc key elmo-passwd-alist))
+ (unwind-protect
+ (fillarray (cdr pass-cons) 0)
+ (setq elmo-passwd-alist
+ (delete pass-cons elmo-passwd-alist))))))
(defmacro elmo-read-char-exclusive ()
(cond ((featurep 'xemacs)
- '(let ((table (quote ((backspace . ?\C-h) (delete . ?\C-?)
- (left . ?\C-h))))
- event key)
- (while (not
- (and
- (key-press-event-p (setq event (next-command-event)))
- (setq key (or (event-to-character event)
- (cdr (assq (event-key event) table)))))))
- key))
- ((fboundp 'read-char-exclusive)
- '(read-char-exclusive))
- (t
- '(read-char))))
+ '(let ((table (quote ((backspace . ?\C-h) (delete . ?\C-?)
+ (left . ?\C-h))))
+ event key)
+ (while (not
+ (and
+ (key-press-event-p (setq event (next-command-event)))
+ (setq key (or (event-to-character event)
+ (cdr (assq (event-key event) table)))))))
+ key))
+ ((fboundp 'read-char-exclusive)
+ '(read-char-exclusive))
+ (t
+ '(read-char))))
(defun elmo-read-passwd (prompt &optional stars)
"Read a single line of text from user without echoing, and return it."
(setq tlist (cdr tlist)))
(setq str
(concat str ")")))
- (setq str
+ (setq str
(if (symbolp tlist)
(symbol-name tlist)
tlist)))
str))
-
+
(defun elmo-plug-on-by-servers (alist &optional servers)
(let ((server-list (or servers elmo-plug-on-servers)))
(setq result (+ result (or (elmo-disk-usage (car files)) 0)))
(setq files (cdr files)))
result)
- (float (nth 7 file-attr))))))
+ (float (nth 7 file-attr)))
+ 0)))
(defun elmo-get-last-accessed-time (path &optional dir)
"Return the last accessed time of PATH."
(setq last-modified (+ (* (nth 0 last-modified)
(float 65536)) (nth 1 last-modified)))))
-(defun elmo-make-directory (path)
+(defun elmo-make-directory (path &optional mode)
"Create directory recursively."
(let ((parent (directory-file-name (file-name-directory path))))
(if (null (file-directory-p parent))
(elmo-make-directory parent))
(make-directory path)
- (if (string= path (expand-file-name elmo-msgdb-dir))
- (set-file-modes path (+ (* 64 7) (* 8 0) 0))))) ; chmod 0700
+ (set-file-modes path (or mode
+ (+ (* 64 7) (* 8 0) 0))))) ; chmod 0700
(defun elmo-delete-directory (path &optional no-hierarchy)
"Delete directory recursively."
(unless hierarchy
(delete-directory path)))))
+(defun elmo-delete-match-files (path regexp &optional remove-if-empty)
+ "Delete directory files specified by PATH.
+If optional REMOVE-IF-EMPTY is non-nil, delete directory itself if
+the directory becomes empty after deletion."
+ (when (stringp path) ; nil is not permitted.
+ (dolist (file (directory-files path t regexp))
+ (delete-file file))
+ (if remove-if-empty
+ (ignore-errors
+ (delete-directory path) ; should be removed if empty.
+ ))))
+
(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)))
(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
(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)
(setq l1 (cdr l1)))
(cons diff1 (list l2)))))
+(defmacro elmo-filter-condition-p (filter)
+ `(or (vectorp ,filter) (consp ,filter)))
+
(defmacro elmo-filter-type (filter)
(` (aref (, filter) 0)))
(length (memq number number-list)))
(string-to-int (elmo-filter-value condition)))))
((string= (elmo-filter-key condition) "since")
- (let ((date (elmo-date-get-datevec (elmo-filter-value condition))))
+ (let ((field-date (elmo-date-make-sortable-string
+ (timezone-fix-time
+ (std11-field-body "date")
+ (current-time-zone) nil)))
+ (specified-date (elmo-date-make-sortable-string
+ (elmo-date-get-datevec
+ (elmo-filter-value condition)))))
(setq result
- (string<
- (timezone-make-sortable-date (aref date 0)
- (aref date 1)
- (aref date 2)
- (timezone-make-time-string
- (aref date 3)
- (aref date 4)
- (aref date 5)))
- (timezone-make-date-sortable (std11-field-body "date"))))))
+ (or (string= field-date specified-date)
+ (string< specified-date field-date)))))
((string= (elmo-filter-key condition) "before")
- (let ((date (elmo-date-get-datevec (elmo-filter-value condition))))
- (setq result
- (string<
- (timezone-make-date-sortable (std11-field-body "date"))
- (timezone-make-sortable-date (aref date 0)
- (aref date 1)
- (aref date 2)
- (timezone-make-time-string
- (aref date 3)
- (aref date 4)
- (aref date 5)))))))
+ (setq result
+ (string<
+ (elmo-date-make-sortable-string
+ (timezone-fix-time
+ (std11-field-body "date")
+ (current-time-zone) nil))
+ (elmo-date-make-sortable-string
+ (elmo-date-get-datevec
+ (elmo-filter-value condition))))))
((string= (elmo-filter-key condition) "body")
(and (re-search-forward "^$" nil t) ; goto body
(setq result (search-forward (elmo-filter-value condition)
nil t))))
(t
- (let ((fval (std11-field-body (elmo-filter-key condition))))
+ (dolist (fval (elmo-multiple-field-body (elmo-filter-key condition)))
(if (eq (length fval) 0) (setq fval nil))
(if fval (setq fval (eword-decode-string fval)))
- (setq result (and fval (string-match
- (elmo-filter-value condition) fval))))))
+ (setq result (or result
+ (and fval (string-match
+ (elmo-filter-value condition) fval)))))))
(if (eq (elmo-filter-type condition) 'unmatch)
(setq result (not result)))
result))
'("last" "first" "from"
"subject" "to" "cc" "since"
"before"))))))
-
+
(defun elmo-buffer-field-condition-match (condition number number-list)
(cond
((vectorp condition)
(cond
((string= (elmo-filter-key condition) "last")
(setq result (<= (length (memq number number-list))
- (string-to-int (elmo-filter-value condition)))))
+ (string-to-int (elmo-filter-value condition))))
+ (if (eq (elmo-filter-type condition) 'unmatch)
+ (setq result (not result))))
((string= (elmo-filter-key condition) "first")
(setq result (< (- (length number-list)
(length (memq number number-list)))
- (string-to-int (elmo-filter-value condition)))))
+ (string-to-int (elmo-filter-value condition))))
+ (if (eq (elmo-filter-type condition) 'unmatch)
+ (setq result (not result))))
(t
(elmo-set-work-buf
(as-binary-input-file (insert-file-contents file))
- (elmo-set-buffer-multibyte default-enable-multibyte-characters)
+ (set-buffer-multibyte default-enable-multibyte-characters)
;; Should consider charset?
(decode-mime-charset-region (point-min)(point-max) elmo-mime-charset)
(setq result
(elmo-buffer-field-primitive-condition-match
condition number number-list)))))
- (if (eq (elmo-filter-type condition) 'unmatch)
- (setq result (not result)))
result))
(defun elmo-file-field-condition-match (file condition number number-list)
file (nth 2 condition) number number-list)))))
(defmacro elmo-get-hash-val (string hashtable)
- (let ((sym (list 'intern-soft string hashtable)))
- (list 'if (list 'boundp sym)
- (list 'symbol-value sym))))
+ (static-if (fboundp 'unintern)
+ `(symbol-value (intern-soft ,string ,hashtable))
+ `(let ((sym (intern-soft ,string ,hashtable)))
+ (and (boundp sym)
+ (symbol-value sym)))))
(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)
(defun elmo-make-hash (&optional hashsize)
"Make a new hash table which have HASHSIZE size."
(make-vector
- (if hashsize
+ (if hashsize
(max
;; Prime numbers as lengths tend to result in good
- ;; hashing; lengths one less than a power of two are
+ ;; hashing; lengths one less than a power of two are
;; also good.
(min
(let ((i 1))
(defsubst elmo-mime-string (string)
"Normalize MIME encoded STRING."
- (and string
- (let (str)
- (elmo-set-work-buf
- (elmo-set-buffer-multibyte default-enable-multibyte-characters)
- (setq str (eword-decode-string
- (decode-mime-charset-string string elmo-mime-charset)))
- (setq str (encode-mime-charset-string str elmo-mime-charset))
- (elmo-set-buffer-multibyte nil)
- str))))
+ (and string
+ (elmo-set-work-buf
+ (set-buffer-multibyte default-enable-multibyte-characters)
+ (setq string
+ (encode-mime-charset-string
+ (eword-decode-and-unfold-unstructured-field-body
+ string)
+ elmo-mime-charset))
+ (set-buffer-multibyte nil)
+ string)))
(defsubst elmo-collect-field (beg end downcase-field-name)
(save-excursion
(setq filename (substring filename (+ (match-end 0) 1))))
(concat result filename)))
-(defsubst elmo-copy-file (src dst)
+(defsubst elmo-copy-file (src dst &optional ok-if-already-exists)
(condition-case err
- (elmo-add-name-to-file src dst t)
- (error (copy-file src dst t))))
+ (elmo-add-name-to-file src dst ok-if-already-exists)
+ (error (copy-file src dst ok-if-already-exists t))))
(defsubst elmo-buffer-exists-p (buffer)
(if (bufferp buffer)
(let (result)
(while lst
(unless (funcall pred (car lst))
- (setq result (nconc result (list (car lst)))))
+ (setq result (cons (car lst) result)))
(setq lst (cdr lst)))
- result))
+ (nreverse 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)
(setq err-mes (concat err-mes (format
(if (stringp (car errobj))
"%s"
- (if (boundp 'nemacs-version)
- "%s"
- "%S")) (car errobj))))
+ "%S")
+ (car errobj))))
(setq errobj (cdr errobj))
(if errobj (setq err-mes (concat err-mes (if first ": " ", "))))
(setq first nil))
(defun elmo-progress-clear (label)
(let ((counter (assq label elmo-progress-counter-alist)))
(when counter
- (elmo-display-progress label "" 100)
+ (elmo-display-progress label
+ (elmo-progress-counter-format counter)
+ 100)
(setq elmo-progress-counter-alist
(delq counter elmo-progress-counter-alist)))))
(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))
(defalias 'elmo-field-body 'std11-fetch-field) ;;no narrow-to-region
(defalias 'elmo-field-body 'std11-field-body))
+(defun elmo-unfold-field-body (name)
+ (let ((value (elmo-field-body name)))
+ (and value
+ (std11-unfold-string value))))
+
+(defun elmo-decoded-field-body (field-name &optional mode)
+ (let ((field-body (elmo-field-body field-name)))
+ (and field-body
+ (elmo-set-work-buf
+ (mime-decode-field-body field-body field-name mode)))))
+
(defun elmo-address-quote-specials (word)
"Make quoted string of WORD if needed."
(let ((lal (std11-lexical-analyze word)))
(defmacro elmo-string (string)
"STRING without text property."
(` (let ((obj (copy-sequence (, string))))
- (set-text-properties 0 (length obj) nil obj)
+ (and obj (set-text-properties 0 (length obj) nil obj))
obj)))
(defun elmo-flatten (list-of-list)
(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))
(throw 'found t))
(setq slist (cdr slist)))))
+(static-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
(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."
(cond
((and in (eq c ?\\))
(setq i (1+ i)
- i (1+ i)
- content (cons (aref string i) content)))
+ content (cons (aref string i) content)
+ i (1+ i)))
((eq c ?\")
(setq in (not in)
i (1+ i)))
(cons "" string)))
;;; Number set defined by OKAZAKI Tetsurou <okazaki@be.to>
-;;
+;;
;; number ::= [0-9]+
;; beg ::= number
;; end ::= number
(setq number-set-1 (nconc number-set-1 (list number))))
number-set-1))
+(defun elmo-make-number-list (beg end)
+ (let (number-list i)
+ (setq i end)
+ (while (>= i beg)
+ (setq number-list (cons i number-list))
+ (setq i (1- i)))
+ number-list))
+
(defun elmo-number-set-to-number-list (number-set)
"Return a number list which corresponds to NUMBER-SET."
- (let (number-list elem i)
+ (let ((number-list (list 'dummy))
+ elem)
(while number-set
(setq elem (car number-set))
(cond
((consp elem)
- (setq i (car elem))
- (while (<= i (cdr elem))
- (setq number-list (cons i number-list))
- (incf i)))
+ (nconc number-list (elmo-make-number-list (car elem) (cdr elem))))
((integerp elem)
- (setq number-list (cons elem number-list))))
+ (nconc number-list (list elem))))
(setq number-set (cdr number-set)))
- (nreverse number-list)))
+ (cdr number-list)))
(defcustom elmo-list-subdirectories-ignore-regexp "^\\(\\.\\.?\\|[0-9]+\\)$"
"*Regexp to filter subfolders."
(store-match-data nil)
(while (string-match regexp string (match-end 0))
(setq list (cons (substring string (match-beginning matchn)
- (match-end matchn)) list)))
+ (match-end matchn)) list)))
(nreverse list)))
;;; File cache.
(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."
(if (setq msgid (elmo-msgid-to-cache msgid))
(expand-file-name
(if section
- (format "%s/%s/%s/%s/%s"
- elmo-msgdb-dir
- elmo-cache-dirname
+ (format "%s/%s/%s/%s"
+ elmo-cache-directory
(elmo-cache-get-path-subr msgid)
msgid
section)
- (format "%s/%s/%s/%s"
- elmo-msgdb-dir
- elmo-cache-dirname
+ (format "%s/%s/%s"
+ elmo-cache-directory
(elmo-cache-get-path-subr msgid)
msgid)))))
(defun elmo-file-cache-delete (path)
"Delete a cache on PATH."
- (let (files)
- (when (file-exists-p path)
- (if (file-directory-p path)
- (progn
- (setq files (directory-files path t "^[^\\.]"))
- (while files
- (delete-file (car files))
- (setq files (cdr files)))
- (delete-directory path))
- (delete-file 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."
;; ignore error
(error)))
+(defun elmo-file-cache-load (cache-path section)
+ "Load cache on PATH into the current buffer.
+Return t if cache is loaded successfully."
+ (condition-case nil
+ (let (cache-file)
+ (when (and cache-path
+ (if (elmo-cache-path-section-p cache-path)
+ section
+ (null section))
+ (setq cache-file (elmo-file-cache-expand-path
+ cache-path
+ section))
+ (file-exists-p cache-file))
+ (insert-file-contents-as-binary cache-file)
+ t))
+ ;; igore error
+ (error)))
+
(defun elmo-cache-path-section-p (path)
"Return non-nil when PATH is `section' cache path."
(file-directory-p path))
(method (completing-read (format "Expire by (%s): "
elmo-cache-expire-default-method)
'(("size" . "size")
- ("age" . "age")))))
- (if (string= method "")
- (setq method elmo-cache-expire-default-method))
+ ("age" . "age"))
+ nil t)))
+ (when (string= method "")
+ (setq method elmo-cache-expire-default-method))
(funcall (intern (concat "elmo-cache-expire-by-" method)))))
(defun elmo-read-float-value-from-minibuffer (prompt &optional initial)
total beginning)
(message "Checking disk usage...")
(setq total (/ (elmo-disk-usage
- (expand-file-name
- elmo-cache-dirname elmo-msgdb-dir)) Kbytes))
+ elmo-cache-directory) Kbytes))
(setq beginning total)
(message "Checking disk usage...done")
(let ((cfl (elmo-cache-get-sorted-cache-file-list))
(defun elmo-cache-get-sorted-cache-file-list ()
(let ((dirs (directory-files
- (expand-file-name elmo-cache-dirname elmo-msgdb-dir)
+ elmo-cache-directory
t "^[^\\.]"))
(i 0) num
elist
elmo-cache-expire-default-age)))
(int-to-string elmo-cache-expire-default-age)))
(dirs (directory-files
- (expand-file-name elmo-cache-dirname elmo-msgdb-dir)
+ elmo-cache-directory
t "^[^\\.]"))
(count 0)
curtime)
(format "%s/%s"
(elmo-cache-get-path-subr msgid)
msgid))
- (expand-file-name elmo-cache-dirname
- elmo-msgdb-dir)))))
+ elmo-cache-directory))))
;;;
;; 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)
-(defvar elmo-obsolete-variable-show-warnings nil)
+
+(defcustom elmo-obsolete-variable-show-warnings t
+ "Show warning window if obsolete variable is treated."
+ :type 'boolean
+ :group 'elmo)
(defun elmo-define-obsolete-variable (obsolete var)
"Define obsolete variable.
(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.
(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 "<"
+ (if (elmo-unfold-field-body "date")
+ (timezone-make-date-sortable (elmo-unfold-field-body "date"))
+ (md5 (string-as-unibyte (buffer-string))))
+ (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.")
(setq elmo-dop-queue
(elmo-object-load
(expand-file-name elmo-dop-queue-filename
- elmo-msgdb-dir))))
+ elmo-msgdb-directory))))
(defun elmo-dop-queue-save ()
(elmo-object-save
(expand-file-name elmo-dop-queue-filename
- elmo-msgdb-dir)
+ 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