;;; Code:
;;
-(eval-when-compile (require 'cl))
+(eval-when-compile
+ (require 'cl)
+ (require 'static))
(require 'elmo-vars)
(require 'elmo-date)
(require 'mcharset)
(fset 'elmo-base64-decode-string
(mel-find-function 'mime-decode-string "base64"))
-;; Any Emacsen may have add-name-to-file(), because loadup.el requires it. :-p
-;; Check make-symbolic-link() instead. -- 981002 by Fuji
-(if (fboundp 'make-symbolic-link) ;; xxx
+(if elmo-use-hardlink
(defalias 'elmo-add-name-to-file 'add-name-to-file)
(defun elmo-add-name-to-file
(filename newname &optional ok-if-already-exists)
(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))
- (set-buffer-multibyte default-enable-multibyte-characters)
- (erase-buffer)
- (,@ body))))
+ `(save-excursion
+ (set-buffer (get-buffer-create elmo-work-buf-name))
+ (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))))
+ `(let ((default-directory (file-name-as-directory ,dir)))
+ ,@body))
(put 'elmo-bind-directory 'lisp-indent-function 1)
(def-edebug-spec elmo-bind-directory
(put 'elmo-with-enable-multibyte 'lisp-indent-function 0)
(def-edebug-spec elmo-with-enable-multibyte t)
+(static-if (condition-case nil
+ (plist-get '(one) 'other)
+ (error t))
+ (defmacro elmo-safe-plist-get (plist prop)
+ `(ignore-errors
+ (plist-get ,plist ,prop)))
+ (defalias 'elmo-safe-plist-get 'plist-get))
+
(eval-when-compile
(unless (fboundp 'coding-system-base)
(defalias 'coding-system-base 'ignore))
(defvar elmo-passwd-alist nil)
(defun elmo-passwd-alist-load ()
- (with-temp-buffer
- (let ((filename (expand-file-name elmo-passwd-alist-file-name
- elmo-msgdb-directory))
- insert-file-contents-pre-hook ; To avoid autoconv-xmas...
- insert-file-contents-post-hook
- ret-val)
- (if (not (file-readable-p filename))
- ()
- (insert-file-contents filename)
- (condition-case nil
- (read (current-buffer))
- (error nil nil))))))
+ (let ((filename (expand-file-name elmo-passwd-alist-file-name
+ elmo-msgdb-directory)))
+ (if (not (file-readable-p filename))
+ ()
+ (with-temp-buffer
+ (let (insert-file-contents-pre-hook ; To avoid autoconv-xmas...
+ insert-file-contents-post-hook)
+ (insert-file-contents filename)
+ (goto-char (point-min))
+ (ignore-errors
+ (read (current-buffer))))))))
(defun elmo-passwd-alist-clear ()
"Clear password cache."
(elmo-base64-encode-string pass)))))
(if elmo-passwd-life-time
(run-with-timer elmo-passwd-life-time nil
- (` (lambda () (elmo-remove-passwd (, key))))))
+ `(lambda () (elmo-remove-passwd ,key))))
pass)))
(defun elmo-remove-passwd (key)
))))
(defun elmo-list-filter (l1 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))
+ "Return a list from L2 in which each element is a member of L1."
+ (let (result)
+ (dolist (element l2)
+ (if (memq element l1)
+ (setq result (cons element result))))
+ (nreverse result)))
(defsubst elmo-list-delete-if-smaller (list number)
(let ((ret-val (copy-sequence list)))
(setq list1 (cdr list1)))
(list clist1 clist2)))
-(defun elmo-list-bigger-diff (list1 list2 &optional mes)
- "Returns a list (- +). + is bigger than max of LIST1, in LIST2."
- (if (null list2)
- (cons list1 nil)
- (let* ((l1 list1)
- (l2 list2)
- (max-of-l2 (or (nth (max 0 (1- (length l2))) l2) 0))
- diff1 num i percent
- )
- (setq i 0)
- (setq num (+ (length l1)))
- (while l1
- (if (memq (car l1) l2)
- (if (eq (car l1) (car l2))
- (setq l2 (cdr l2))
- (delq (car l1) l2))
- (if (> (car l1) max-of-l2)
- (setq diff1 (nconc diff1 (list (car l1))))))
- (if mes
- (progn
- (setq i (+ i 1))
- (setq percent (/ (* i 100) num))
- (if (eq (% percent 5) 0)
- (elmo-display-progress
- 'elmo-list-bigger-diff "%s%d%%" percent mes))))
- (setq l1 (cdr l1)))
- (cons diff1 (list l2)))))
-
(defmacro elmo-get-hash-val (string hashtable)
(static-if (fboundp 'unintern)
`(symbol-value (intern-soft ,string ,hashtable))
(and string
(elmo-with-enable-multibyte
(encode-mime-charset-string
- (eword-decode-and-unfold-unstructured-field-body string)
+ (or (ignore-errors
+ (eword-decode-and-unfold-unstructured-field-body string))
+ string)
elmo-mime-charset))))
(defsubst elmo-collect-field (beg end downcase-field-name)
(list 'error-message doc
'error-conditions (cons error conds))))))
-(cond ((fboundp 'progress-feedback-with-label)
- (defalias 'elmo-display-progress 'progress-feedback-with-label))
- ((fboundp 'lprogress-display)
- (defalias 'elmo-display-progress 'lprogress-display))
- (t
- (defun elmo-display-progress (label format &optional value &rest args)
- "Print a progress message."
- (if (and (null format) (null args))
- (message nil)
- (apply (function message) (concat format " %d%%")
- (nconc args (list value)))))))
+(defvar elmo-progress-counter nil)
-(defvar elmo-progress-counter-alist nil)
+(defalias 'elmo-progress-counter-label 'car-safe)
(defmacro elmo-progress-counter-value (counter)
- (` (aref (cdr (, counter)) 0)))
-
-(defmacro elmo-progress-counter-all-value (counter)
- (` (aref (cdr (, counter)) 1)))
-
-(defmacro elmo-progress-counter-format (counter)
- (` (aref (cdr (, counter)) 2)))
+ `(aref (cdr ,counter) 0))
(defmacro elmo-progress-counter-set-value (counter value)
- (` (aset (cdr (, counter)) 0 (, value))))
-
-(defun elmo-progress-set (label all-value &optional format)
- (unless (assq label elmo-progress-counter-alist)
- (setq elmo-progress-counter-alist
- (cons (cons label (vector 0 all-value (or format "")))
- elmo-progress-counter-alist))))
-
-(defun elmo-progress-clear (label)
- (let ((counter (assq label elmo-progress-counter-alist)))
- (when counter
- (elmo-display-progress label
- (elmo-progress-counter-format counter)
- 100)
- (setq elmo-progress-counter-alist
- (delq counter elmo-progress-counter-alist)))))
-
-(defun elmo-progress-notify (label &optional value op &rest args)
- (let ((counter (assq label elmo-progress-counter-alist)))
- (when counter
- (let* ((value (or value 1))
- (cur-value (elmo-progress-counter-value counter))
- (all-value (elmo-progress-counter-all-value counter))
- (new-value (if (eq op 'set) value (+ cur-value value)))
- (cur-rate (/ (* cur-value 100) all-value))
- (new-rate (/ (* new-value 100) all-value)))
- (elmo-progress-counter-set-value counter new-value)
- (unless (= cur-rate new-rate)
- (apply 'elmo-display-progress
- label
- (elmo-progress-counter-format counter)
- new-rate
- args))
- (when (>= new-rate 100)
- (elmo-progress-clear label))))))
+ `(aset (cdr ,counter) 0 ,value))
+
+(defmacro elmo-progress-counter-total (counter)
+ `(aref (cdr ,counter) 1))
+
+(defmacro elmo-progress-counter-set-total (counter value)
+ `(aset (cdr ,counter) 1 ,value))
+
+(defmacro elmo-progress-counter-action (counter)
+ `(aref (cdr ,counter) 2))
+
+(defmacro elmo-progress-counter-set-action (counter action)
+ `(aset (cdr ,counter) 2, action))
+
+(defvar elmo-progress-callback-function nil)
+
+(defun elmo-progress-call-callback (counter &optional value)
+ (when elmo-progress-callback-function
+ (funcall elmo-progress-callback-function
+ (elmo-progress-counter-label counter)
+ (elmo-progress-counter-action counter)
+ (or value
+ (elmo-progress-counter-value counter))
+ (elmo-progress-counter-total counter))))
+
+(defun elmo-progress-start (label total action)
+ (when (and (null elmo-progress-counter)
+ (or (null total)
+ (> total 0)))
+ (let ((counter (cons label (vector 0 total action))))
+ (elmo-progress-call-callback counter 'start)
+ (setq elmo-progress-counter
+ (cond ((null total)
+ counter)
+ ((elmo-progress-call-callback counter 'query)
+ (elmo-progress-call-callback counter)
+ counter)
+ (t
+ t)))
+ counter)))
+
+(defun elmo-progress-clear (counter)
+ (when counter
+ (when (and (elmo-progress-counter-label elmo-progress-counter)
+ (elmo-progress-counter-total elmo-progress-counter))
+ (elmo-progress-call-callback elmo-progress-counter 100))
+ (setq elmo-progress-counter nil)))
+
+(defun elmo-progress-done (counter)
+ (when (elmo-progress-counter-label counter)
+ (elmo-progress-call-callback counter 'done)))
+
+(defun elmo-progress-notify (label &rest params)
+ (when (eq label (elmo-progress-counter-label elmo-progress-counter))
+ (let ((counter elmo-progress-counter))
+ (if (or (elmo-progress-counter-total counter)
+ (and (elmo-progress-counter-set-total
+ counter
+ (elmo-safe-plist-get params :total))
+ (elmo-progress-call-callback counter 'query)))
+ (progn
+ (elmo-progress-counter-set-value
+ counter
+ (or (elmo-safe-plist-get params :set)
+ (+ (elmo-progress-counter-value counter)
+ (or (elmo-safe-plist-get params :inc)
+ (car params)
+ 1))))
+ (elmo-progress-call-callback counter))
+ (setq elmo-progress-counter t)))))
+
+(defmacro elmo-with-progress-display (spec message &rest body)
+ "Evaluate BODY with progress message and return its value.
+SPEC is a list as followed (LABEL TOTAL [VAR]).
+LABEL is an identifier what is specidied by `elmo-progress-notify'.
+If TOTAL is nil, the first `elmo-progress-notify' call must be
+with a `:total' parameter.
+If optional parameter VAR is specified, bind it with a progress counter object.
+MESSAGE is a doing part of progress message."
+ (let ((label (nth 0 spec))
+ (total (nth 1 spec))
+ (var (or (nth 2 spec) (make-symbol "--elmo-progress-temp--"))))
+ `(let ((,var (elmo-progress-start (quote ,label) ,total ,message)))
+ (prog1
+ (unwind-protect
+ (progn
+ ,@body)
+ (elmo-progress-clear ,var))
+ (elmo-progress-done ,var)))))
(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)))))
+ ((symbolp form &optional symbolp) form &rest form))
(defun elmo-time-expire (before-time diff-time)
(let* ((current (current-time))
(defun elmo-decoded-field-body (field-name &optional mode)
(let ((field-body (elmo-field-body field-name)))
(and field-body
- (elmo-with-enable-multibyte
- (mime-decode-field-body field-body field-name mode)))))
+ (or (ignore-errors
+ (elmo-with-enable-multibyte
+ (mime-decode-field-body field-body field-name mode)))
+ field-body))))
(defun elmo-address-quote-specials (word)
"Make quoted string of WORD if needed."
(defmacro elmo-string (string)
"STRING without text property."
- (` (let ((obj (copy-sequence (, string))))
- (and obj (set-text-properties 0 (length obj) nil obj))
- obj)))
+ `(let ((obj (copy-sequence ,string)))
+ (and obj (set-text-properties 0 (length obj) nil obj))
+ obj))
(defun elmo-flatten (list-of-list)
"Flatten LIST-OF-LIST."
- (unless (null list-of-list)
- (append (if (and (car list-of-list)
- (listp (car list-of-list)))
- (car list-of-list)
- (list (car list-of-list)))
- (elmo-flatten (cdr list-of-list)))))
+ (and list-of-list
+ (apply #'append
+ (mapcar (lambda (element)
+ (if (listp element) element (list element)))
+ list-of-list))))
(defun elmo-y-or-n-p (prompt &optional auto default)
"Same as `y-or-n-p'.
(defun elmo-string-member (string slist)
(catch 'found
- (while slist
- (if (and (stringp (car slist))
- (string= string (car slist)))
- (throw 'found t))
- (setq slist (cdr slist)))))
+ (dolist (element slist)
+ (cond ((null element))
+ ((stringp element)
+ (when (string= string element)
+ (throw 'found t)))
+ ((symbolp element)
+ (when (string= string (symbol-value element))
+ (throw 'found t)))))))
(static-cond ((fboundp 'member-ignore-case)
(defalias 'elmo-string-member-ignore-case 'member-ignore-case))
(and result
(char-list-to-string (elmo-uniq-list result #'delq))))))
-(defun elmo-collect-separators-internal (specs)
- (let (separators)
- (while specs
- (let ((spec (car specs)))
- (cond
- ((listp spec)
- (setq separators (nconc (elmo-collect-separators-internal spec)
- separators)
- specs (cdr specs)))
- ((characterp spec)
- (setq separators (cons spec separators)
- specs nil))
- (t
- (setq specs nil)))))
- separators))
+(defun elmo-collect-separators-internal (specs &optional separators)
+ (while specs
+ (let ((spec (car specs)))
+ (cond
+ ((listp spec)
+ (setq separators (elmo-collect-separators-internal spec separators)
+ specs (cdr specs)))
+ ((characterp spec)
+ (setq separators (cons spec separators)
+ specs nil))
+ (t
+ (setq specs nil)))))
+ separators)
(defun elmo-collect-trail-separators (element specs)
(cond
(cdr result))
(funcall function object)))
+(defun elmo-map-until-success (function sequence)
+ (let (result)
+ (while (and (null result)
+ sequence)
+ (setq result (funcall function (car sequence))
+ sequence (cdr sequence)))
+ result))
+
+(defun elmo-string-match-substring (regexp string &optional matchn)
+ (when (string-match regexp string)
+ (match-string (or matchn 1) string)))
+
(defun elmo-parse (string regexp &optional matchn)
(or matchn (setq matchn 1))
(let (list)
(match-end matchn)) list)))
(nreverse list)))
+(defun elmo-find-list-match-value (specs getter)
+ (lexical-let ((getter getter))
+ (elmo-map-until-success
+ (lambda (spec)
+ (cond
+ ((symbolp spec)
+ (funcall getter spec))
+ ((consp spec)
+ (lexical-let ((value (funcall getter (car spec))))
+ (when value
+ (elmo-map-until-success
+ (lambda (rule)
+ (cond
+ ((stringp rule)
+ (elmo-string-match-substring rule value))
+ ((consp rule)
+ (elmo-string-match-substring (car rule) value (cdr rule)))))
+ (cdr spec)))))))
+ specs)))
+
;;; File cache.
(defmacro elmo-make-file-cache (path status)
"PATH is the cache file name.
'section means partial section cache exists.
'entire means entire cache exists.
If the cache is partial file-cache, TYPE is 'partial."
- (` (cons (, path) (, status))))
+ `(cons ,path ,status))
(defmacro elmo-file-cache-path (file-cache)
"Returns the file path of the FILE-CACHE."
- (` (car (, file-cache))))
+ `(car ,file-cache))
(defmacro elmo-file-cache-status (file-cache)
"Returns the status of the FILE-CACHE."
- (` (cdr (, file-cache))))
+ `(cdr ,file-cache))
(defsubst elmo-cache-to-msgid (filename)
(concat "<" (elmo-recover-string-from-filename filename) ">"))
"Return file name for the file-cache corresponds to the section.
PATH is the file-cache path.
SECTION is the section string."
- (` (expand-file-name (or (, section) "") (, path))))
+ `(expand-file-name (or ,section "") ,path))
(defun elmo-file-cache-delete (path)
"Delete a cache on PATH."
oldest-entity))
(defun elmo-cache-get-sorted-cache-file-list ()
- (let ((dirs (directory-files
- elmo-cache-directory
- t "^[^\\.]"))
- (i 0) num
- elist
- ret-val)
- (setq num (length dirs))
- (message "Collecting cache info...")
- (while dirs
- (setq elist (mapcar (lambda (x)
- (elmo-cache-make-file-entity x (car dirs)))
- (directory-files (car dirs) nil "^[^\\.]")))
- (setq ret-val (append ret-val
- (list (cons
- (car dirs)
- (sort
- elist
- (lambda (x y)
- (< (cdr x)
- (cdr y))))))))
- (when (> num elmo-display-progress-threshold)
- (setq i (+ i 1))
- (elmo-display-progress
- 'elmo-cache-get-sorted-cache-file-list "Collecting cache info..."
- (/ (* i 100) num)))
- (setq dirs (cdr dirs)))
- (message "Collecting cache info...done")
+ (let ((dirs (directory-files elmo-cache-directory t "^[^\\.]"))
+ elist ret-val)
+ (elmo-with-progress-display (elmo-collecting-cache (length dirs))
+ "Collecting cache info"
+ (dolist (dir dirs)
+ (setq elist (mapcar (lambda (x)
+ (elmo-cache-make-file-entity x dir))
+ (directory-files dir nil "^[^\\.]")))
+ (setq ret-val (append ret-val
+ (list (cons
+ dir
+ (sort
+ elist
+ (lambda (x y)
+ (< (cdr x)
+ (cdr y))))))))))
ret-val))
(defun elmo-cache-expire-by-age (&optional days)
+ "Expire cache file by age.
+Optional argument DAYS specifies the days to expire caches."
+ (interactive)
(let ((age (or (and days (int-to-string days))
(and (interactive-p)
(read-from-minibuffer
curtime)
(if (string= age "")
(setq age elmo-cache-expire-default-age)
- (setq age (string-to-int age)))
+ (setq age (string-to-number age)))
(setq curtime (current-time))
(setq curtime (+ (* (nth 0 curtime)
(float 65536)) (nth 1 curtime)))
file nil beg
(incf beg elmo-msgdb-file-header-chop-length))))
(prog1 (not (search-forward "\n\n" nil t))
- (goto-char (point-max))))))))
+ (goto-char (point-max)))))
+ (elmo-delete-cr-buffer))))
;;
;; overview handling