;;; 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
- (defalias 'elmo-add-name-to-file 'add-name-to-file)
- (defun elmo-add-name-to-file
- (filename newname &optional ok-if-already-exists)
- (copy-file filename newname ok-if-already-exists t)))
+(eval-and-compile
+ (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)
+ (copy-file filename newname ok-if-already-exists t))))
(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))))
+ `(with-current-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))
(goto-char (point-min))
(setq case-fold-search nil)
(re-search-forward "^;;;coding system: "
- ;;(+ (point-min) 3000) t))
+;;; (+ (point-min) 3000) t))
nil t))
(looking-at "[^\t\n\r ]+")
(find-coding-system
(setq list (cdr list))))
list)
+(defun elmo-union (l1 l2)
+ "Make a union of two lists"
+ (elmo-uniq-sorted-list (sort (append l1 l2) #'<)))
+
(defun elmo-list-insert (list element after)
(let* ((match (memq after list))
(rest (and match (cdr (memq after list)))))
print-length print-level)
(prin1 elmo-passwd-alist (current-buffer))
(princ "\n" (current-buffer))
-;;; (if (and (file-exists-p filename)
+;;; (if (and (file-exists-p filename)
;;; (not (equal 384 (file-modes filename))))
;;; (error "%s is not safe.chmod 600 %s!" filename filename))
(if (file-writable-p filename)
(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)
(directory-files path t "^[^\\.]")
(error nil)))
(result 0.0))
- ;; (result (nth 7 file-attr))) ... directory size
+;;; (result (nth 7 file-attr))) ; ... directory size
(while files
(setq result (+ result (or (elmo-disk-usage (car files)) 0)))
(setq files (cdr files)))
(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))
(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))
(and (eq (car diff) 0)
(< diff-time (nth 1 diff)))))
-(if (fboundp 'std11-fetch-field)
- (defalias 'elmo-field-body 'std11-fetch-field) ;;no narrow-to-region
- (defalias 'elmo-field-body 'std11-field-body))
+(eval-and-compile
+ (if (fboundp 'std11-fetch-field)
+ (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)))
(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."
prev
(nconc
(list
- ;; (beg . (1- number))
+;;; (beg . (1- number))
(let ((new (cons (car elem) (1- number))))
(if (eq (car new) (cdr new))
(car new)
new))
- ;; ((1+ number) . end)
+;;; ((1+ number) . end)
(let ((new (cons (1+ number) (cdr elem))))
(if (eq (car new) (cdr new))
(car new)
'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."
(cons (car (car cfl))
(car flist)))))
(setq cfl (cdr cfl)))
-;;; (prin1 firsts)
+;;; (prin1 firsts)
(while firsts
(if (and (not oldest-entity)
(cdr (cdr (car firsts))))
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)
- (let ((age (or (and days (int-to-string days))
+ "Expire cache file by age.
+Optional argument DAYS specifies the days to expire caches."
+ (interactive)
+ (let ((age (or (and days (number-to-string days))
(and (interactive-p)
(read-from-minibuffer
(format "Enter days (%s): "
elmo-cache-expire-default-age)))
- (int-to-string elmo-cache-expire-default-age)))
+ (number-to-string elmo-cache-expire-default-age)))
(dirs (directory-files
elmo-cache-directory
t "^[^\\.]"))
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
projects / elisp / wanderlust.git / blobdiff