-(defun elmo-number-set-to-number-list (number-set)
- "Return a number list which corresponds to NUMBER-SET."
- (let (number-list elem i)
- (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)))
- ((integerp elem)
- (setq number-list (cons elem number-list))))
- (setq number-set (cdr number-set)))
- (nreverse number-list)))
-
-(defcustom elmo-list-subdirectories-ignore-regexp "^\\(\\.\\.?\\|[0-9]+\\)$"
- "*Regexp to filter subfolders."
- :type 'regexp
- :group 'elmo)
-
-(defun elmo-list-subdirectories-1 (basedir curdir one-level)
- (let ((root (zerop (length curdir)))
- (w32-get-true-file-link-count t) ; for Meadow
- attr dirs dir)
- (catch 'done
- (dolist (file (directory-files (setq dir (expand-file-name curdir basedir))))
- (when (and (not (string-match
- elmo-list-subdirectories-ignore-regexp
- file))
- (car (setq attr (file-attributes
- (expand-file-name file dir)))))
- (when (eq one-level 'check) (throw 'done t))
- (let ((relpath
- (concat curdir (and (not root) elmo-path-sep) file))
- subdirs)
- (setq dirs (nconc dirs
- (if (if elmo-have-link-count (< 2 (nth 1 attr))
- (setq subdirs
- (elmo-list-subdirectories-1
- basedir
- relpath
- (if one-level 'check))))
- (if one-level
- (list (list relpath))
- (cons relpath
- (or subdirs
- (elmo-list-subdirectories-1
- basedir
- relpath
- nil))))
- (list relpath)))))))
- dirs)))
-
-(defun elmo-list-subdirectories (directory file one-level)
- (let ((subdirs (elmo-list-subdirectories-1 directory file one-level)))
- (if (zerop (length file))
- subdirs
- (cons file subdirs))))
-
-(defun elmo-mapcar-list-of-list (func list-of-list)
- (mapcar
- (lambda (x)
- (cond ((listp x) (elmo-mapcar-list-of-list func x))
- (t (funcall func x))))
- list-of-list))
-
-(defun elmo-parse (string regexp &optional matchn)
- (or matchn (setq matchn 1))
- (let (list)
- (store-match-data nil)
- (while (string-match regexp string (match-end 0))
- (setq list (cons (substring string (match-beginning matchn)
- (match-end matchn)) list)))
- (nreverse list)))
-
-;;; File cache.
-(defmacro elmo-make-file-cache (path status)
- "PATH is the cache file name.
-STATUS is one of 'section, 'entire or nil.
- nil means no cache exists.
-'section means partial section cache exists.
-'entire means entire cache exists.
-If the cache is partial file-cache, TYPE is 'partial."
- (` (cons (, path) (, status))))
-
-(defmacro elmo-file-cache-path (file-cache)
- "Returns the file path of the FILE-CACHE."
- (` (car (, file-cache))))
-
-(defmacro elmo-file-cache-status (file-cache)
- "Returns the status of the FILE-CACHE."
- (` (cdr (, file-cache))))
-
-(defsubst elmo-cache-to-msgid (filename)
- (concat "<" (elmo-recover-string-from-filename filename) ">"))
-
-(defsubst elmo-cache-get-path-subr (msgid)
- (let ((chars '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 ?A ?B ?C ?D ?E ?F))
- (clist (string-to-char-list msgid))
- (sum 0))
- (while clist
- (setq sum (+ sum (car clist)))
- (setq clist (cdr clist)))
- (format "%c%c"
- (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
- (elmo-cache-get-path-subr msgid)
- msgid
- section)
- (format "%s/%s/%s/%s"
- elmo-msgdb-dir
- elmo-cache-dirname
- (elmo-cache-get-path-subr msgid)
- msgid)))))
-
-(defmacro elmo-file-cache-expand-path (path section)
- "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))))
-
-(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)))))
-
-(defun elmo-file-cache-exists-p (msgid)
- "Returns 'section or 'entire if a cache which corresponds to MSGID exists."
- (elmo-file-cache-status (elmo-file-cache-get msgid)))
-
-(defun elmo-file-cache-save (cache-path section)
- "Save current buffer as cache on PATH.
-Return t if cache is saved successfully."
- (condition-case nil
- (let ((path (if section (expand-file-name section cache-path)
- cache-path))
- files dir)
- (if (and (null section)
- (file-directory-p path))
- (progn
- (setq files (directory-files path t "^[^\\.]"))
- (while files
- (delete-file (car files))
- (setq files (cdr files)))
- (delete-directory path))
- (if (and section
- (not (file-directory-p cache-path)))
- (delete-file cache-path)))
- (when path
- (setq dir (directory-file-name (file-name-directory path)))
- (if (not (file-exists-p dir))
- (elmo-make-directory dir))
- (write-region-as-binary (point-min) (point-max)
- path nil 'no-msg)
- t))
- ;; ignore error
- (error)))
-
-(defun elmo-file-cache-get (msgid &optional section)
- "Returns the current file-cache object associated with MSGID.
-MSGID is the message-id of the message.
-If optional argument SECTION is specified, get partial file-cache object
-associated with SECTION."
- (if msgid
- (let ((path (elmo-cache-get-path msgid)))
- (if (and path (file-exists-p path))
- (if (file-directory-p path)
- (if section
- (if (file-exists-p (setq path (expand-file-name
- section path)))
- (cons path 'section))
- ;; section is not specified but sectional.
- (cons path 'section))
- ;; not directory.
- (unless section
- (cons path 'entire)))
- ;; no cache.
- (cons path nil)))))
-
-;;;
-;; Expire cache.
-
-(defun elmo-cache-expire ()
- (interactive)
- (let* ((completion-ignore-case t)
- (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))
- (funcall (intern (concat "elmo-cache-expire-by-" method)))))
-
-(defun elmo-read-float-value-from-minibuffer (prompt &optional initial)
- (let ((str (read-from-minibuffer prompt initial)))
- (cond
- ((string-match "[0-9]*\\.[0-9]+" str)
- (string-to-number str))
- ((string-match "[0-9]+" str)
- (string-to-number (concat str ".0")))
- (t (error "%s is not number" str)))))
-
-(defun elmo-cache-expire-by-size (&optional kbytes)
- "Expire cache file by size.
-If KBYTES is kilo bytes (This value must be float)."
- (interactive)
- (let ((size (or kbytes
- (and (interactive-p)
- (elmo-read-float-value-from-minibuffer
- "Enter cache disk size (Kbytes): "
- (number-to-string
- (if (integerp elmo-cache-expire-default-size)
- (float elmo-cache-expire-default-size)
- elmo-cache-expire-default-size))))
- (if (integerp elmo-cache-expire-default-size)
- (float elmo-cache-expire-default-size))))
- (count 0)
- (Kbytes 1024)
- total beginning)
- (message "Checking disk usage...")
- (setq total (/ (elmo-disk-usage
- (expand-file-name
- elmo-cache-dirname elmo-msgdb-dir)) Kbytes))
- (setq beginning total)
- (message "Checking disk usage...done")
- (let ((cfl (elmo-cache-get-sorted-cache-file-list))
- (deleted 0)
- oldest
- cur-size cur-file)
- (while (and (<= size total)
- (setq oldest (elmo-cache-get-oldest-cache-file-entity cfl)))
- (setq cur-file (expand-file-name (car (cdr oldest)) (car oldest)))
- (setq cur-size (/ (elmo-disk-usage cur-file) Kbytes))
- (when (elmo-file-cache-delete cur-file)
- (setq count (+ count 1))
- (message "%d cache(s) are expired." count))
- (setq deleted (+ deleted cur-size))
- (setq total (- total cur-size)))
- (message "%d cache(s) are expired from disk (%d Kbytes/%d Kbytes)."
- count deleted beginning))))
-
-(defun elmo-cache-make-file-entity (filename path)
- (cons filename (elmo-get-last-accessed-time filename path)))
-
-(defun elmo-cache-get-oldest-cache-file-entity (cache-file-list)
- (let ((cfl cache-file-list)
- flist firsts oldest-entity wonlist)
- (while cfl
- (setq flist (cdr (car cfl)))
- (setq firsts (append firsts (list
- (cons (car (car cfl))
- (car flist)))))
- (setq cfl (cdr cfl)))
-;;; (prin1 firsts)
- (while firsts
- (if (and (not oldest-entity)
- (cdr (cdr (car firsts))))
- (setq oldest-entity (car firsts)))
- (if (and (cdr (cdr (car firsts)))
- (cdr (cdr oldest-entity))
- (> (cdr (cdr oldest-entity)) (cdr (cdr (car firsts)))))
- (setq oldest-entity (car firsts)))
- (setq firsts (cdr firsts)))
- (setq wonlist (assoc (car oldest-entity) cache-file-list))
- (and wonlist
- (setcdr wonlist (delete (car (cdr wonlist)) (cdr wonlist))))
- oldest-entity))
-
-(defun elmo-cache-get-sorted-cache-file-list ()
- (let ((dirs (directory-files
- (expand-file-name elmo-cache-dirname elmo-msgdb-dir)
- 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")
- ret-val))
-
-(defun elmo-cache-expire-by-age (&optional days)
- (let ((age (or (and days (int-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)))
- (dirs (directory-files
- (expand-file-name elmo-cache-dirname elmo-msgdb-dir)
- t "^[^\\.]"))
- (count 0)
- curtime)
- (if (string= age "")
- (setq age elmo-cache-expire-default-age)
- (setq age (string-to-int age)))
- (setq curtime (current-time))
- (setq curtime (+ (* (nth 0 curtime)
- (float 65536)) (nth 1 curtime)))
- (while dirs
- (let ((files (directory-files (car dirs) t "^[^\\.]"))
- (limit-age (* age 86400)))
- (while files
- (when (> (- curtime (elmo-get-last-accessed-time (car files)))
- limit-age)
- (when (elmo-file-cache-delete (car files))
- (setq count (+ 1 count))
- (message "%d cache file(s) are expired." count)))
- (setq files (cdr files))))
- (setq dirs (cdr dirs)))))
-
-;;;
-;; msgid to path.
-(defun elmo-msgid-to-cache (msgid)
- (when (and msgid
- (string-match "<\\(.+\\)>$" msgid))
- (elmo-replace-string-as-filename (elmo-match-string 1 msgid))))
-
-(defun elmo-cache-get-path (msgid &optional folder number)
- "Get path for cache file associated with MSGID, FOLDER, and NUMBER."
- (if (setq msgid (elmo-msgid-to-cache msgid))
- (expand-file-name
- (expand-file-name
- (if folder
- (format "%s/%s/%s@%s"
- (elmo-cache-get-path-subr msgid)
- msgid
- (or number "")
- (elmo-safe-filename folder))
- (format "%s/%s"
- (elmo-cache-get-path-subr msgid)
- msgid))
- (expand-file-name elmo-cache-dirname
- elmo-msgdb-dir)))))
-
-;;;
-;; 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))
-
-(defvar elmo-obsolete-variable-alist nil)
-(defvar elmo-obsolete-variable-show-warnings nil)
-
-(defun elmo-define-obsolete-variable (obsolete var)
- "Define obsolete variable.
-OBSOLETE is a symbol for obsolete variable.
-VAR is a symbol for new variable.
-Definition is stored in `elmo-obsolete-variable-alist'."
- (let ((pair (assq var elmo-obsolete-variable-alist)))
- (if pair
- (setcdr pair obsolete)
- (setq elmo-obsolete-variable-alist
- (cons (cons var obsolete)
- elmo-obsolete-variable-alist)))))
-
-(defun elmo-resque-obsolete-variable (obsolete var)
- "Resque obsolete variable OBSOLETE as VAR.
-If `elmo-obsolete-variable-show-warnings' is non-nil, show warning message."
- (when (boundp obsolete)
- (static-if (and (fboundp 'defvaralias)
- (subrp (symbol-function 'defvaralias)))
- (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))))))
-
-(defun elmo-resque-obsolete-variables (&optional alist)
- "Resque obsolete variables in ALIST.
-ALIST is a list of cons cell of
-\(OBSOLETE-VARIABLE-SYMBOL . NEW-VARIABLE-SYMBOL\).
-If ALIST is nil, `elmo-obsolete-variable-alist' is used."
- (dolist (pair elmo-obsolete-variable-alist)
- (elmo-resque-obsolete-variable (cdr pair)
- (car pair))))
-
-