-;;; 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 'elmo-date)
+(require 'mcharset)
+(require 'pces)
(require 'std11)
(require 'eword-decode)
(require 'utf7)
+(require 'poem)
(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)))
+ (list 'setq 'mc-flag flag))
+ ((featurep 'xemacs)
+ flag)
+ ((and (boundp 'emacs-major-version) (>= emacs-major-version 20))
+ (list 'set-buffer-multibyte flag))
+ (t
+ flag)))
(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))
+(defalias 'elmo-read 'read)
(defmacro elmo-set-work-buf (&rest body)
"Execute BODY on work buffer. Work buffer remains."
;;;(princ "\n" (current-buffer))
(elmo-save-buffer filename mime-charset)))
-(defun elmo-get-network-stream-type (stream-type stream-type-alist)
- (catch 'found
- (while stream-type-alist
- (if (eq (nth 1 (car stream-type-alist)) stream-type)
- (throw 'found (car stream-type-alist)))
- (setq stream-type-alist (cdr stream-type-alist)))))
-
;;; Search Condition
(defconst elmo-condition-atom-regexp "[^/ \")|&]*")
"Since" "Before" "ToCc"
"!From" "!Subject" "!To" "!Cc" "!Body"
"!Since" "!Before" "!ToCc")
- elmo-msgdb-extra-fields)) nil t))
+ elmo-msgdb-extra-fields))))
value)
(setq field (if (string= field "")
(setq field default)
(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 "| *")
(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)))
"Clear password cache."
(interactive)
(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*")))
(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 (format "%s is not writable." filename)))
(kill-buffer tmp-buffer))))
(defun elmo-get-passwd (key)
(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)))
(if (null (file-directory-p parent))
(elmo-make-directory parent))
(make-directory path)
- (if (string= path (expand-file-name elmo-msgdb-dir))
+ (if (string= path (expand-file-name elmo-msgdb-directory))
(set-file-modes path (+ (* 64 7) (* 8 0) 0))))) ; chmod 0700
(defun elmo-delete-directory (path &optional no-hierarchy)
(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)
(setq result (not result)))
result))
-(defun elmo-condition-find-key-internal (condition key)
+(defun elmo-condition-in-msgdb-p-internal (condition fields)
(cond
((vectorp condition)
- (if (string= (elmo-filter-key condition) key)
+ (if (not (member (elmo-filter-key condition) fields))
(throw 'found t)))
((or (eq (car condition) 'and)
(eq (car condition) 'or))
- (elmo-condition-find-key-internal (nth 1 condition) key)
- (elmo-condition-find-key-internal (nth 2 condition) key))))
-
-(defun elmo-condition-find-key (condition key)
- (catch 'found
- (elmo-condition-find-key-internal condition key)))
+ (elmo-condition-in-msgdb-p-internal (nth 1 condition) fields)
+ (elmo-condition-in-msgdb-p-internal (nth 2 condition) fields))))
+
+(defun elmo-condition-in-msgdb-p (condition)
+ (not (catch 'found
+ (elmo-condition-in-msgdb-p-internal condition
+ (append
+ elmo-msgdb-extra-fields
+ '("last" "first" "from"
+ "subject" "to" "cc" "since"
+ "before"))))))
(defun elmo-buffer-field-condition-match (condition number number-list)
(cond
(elmo-buffer-field-condition-match
(nth 2 condition) number number-list)))))
-(defsubst elmo-file-field-condition-match (file condition number number-list)
- (elmo-set-work-buf
- (as-binary-input-file (insert-file-contents file))
- (elmo-set-buffer-multibyte default-enable-multibyte-characters)
- ;; Should consider charset?
- (decode-mime-charset-region (point-min)(point-max) elmo-mime-charset)
- (elmo-buffer-field-condition-match condition number number-list)))
+(defsubst elmo-file-field-primitive-condition-match (file
+ condition
+ number
+ number-list)
+ (let (result)
+ (goto-char (point-min))
+ (cond
+ ((string= (elmo-filter-key condition) "last")
+ (setq result (<= (length (memq number number-list))
+ (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))))
+ (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)
+ ;; 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)))))
+ result))
+
+(defun elmo-file-field-condition-match (file condition number number-list)
+ (cond
+ ((vectorp condition)
+ (elmo-file-field-primitive-condition-match
+ file condition number number-list))
+ ((eq (car condition) 'and)
+ (and (elmo-file-field-condition-match
+ file (nth 1 condition) number number-list)
+ (elmo-file-field-condition-match
+ file (nth 2 condition) number number-list)))
+ ((eq (car condition) 'or)
+ (or (elmo-file-field-condition-match
+ file (nth 1 condition) number number-list)
+ (elmo-file-field-condition-match
+ file (nth 2 condition) number number-list)))))
(defmacro elmo-get-hash-val (string hashtable)
(let ((sym (list 'intern-soft string hashtable)))
(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))
(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)
(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))
(apply (function message) (concat format " %d%%")
(nconc args (list value)))))))
+(defvar elmo-progress-counter-alist nil)
+
+(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)))
+
+(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))))))
+
(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-address-quote-specials (word)
+ "Make quoted string of WORD if needed."
+ (let ((lal (std11-lexical-analyze word)))
+ (if (or (assq 'specials lal)
+ (assq 'domain-literal lal))
+ (prin1-to-string word)
+ word)))
+
(defmacro elmo-string (string)
"STRING without text property."
(` (let ((obj (copy-sequence (, string))))
(throw 'loop a))
(setq alist (cdr alist))))))
+(defun elmo-string-assoc-all (key alist)
+ (let (matches)
+ (while alist
+ (if (string= key (car (car alist)))
+ (setq matches
+ (cons (car alist)
+ matches)))
+ (setq alist (cdr alist)))
+ matches))
+
(defun elmo-string-rassoc (key alist)
(let (a)
(catch 'loop
(setq alist (cdr alist)))
matches))
+;;; Folder parser utils.
+(defun elmo-parse-token (string &optional seps)
+ "Parse atom from STRING using SEPS as a string of separator char list."
+ (let ((len (length string))
+ (seps (and seps (string-to-char-list seps)))
+ (i 0)
+ (sep nil)
+ content c in)
+ (if (eq len 0)
+ (cons "" "")
+ (while (and (< i len) (or in (null sep)))
+ (setq c (aref string i))
+ (cond
+ ((and in (eq c ?\\))
+ (setq i (1+ i)
+ content (cons (aref string i) content)
+ i (1+ i)))
+ ((eq c ?\")
+ (setq in (not in)
+ i (1+ i)))
+ (in (setq content (cons c content)
+ i (1+ i)))
+ ((memq c seps)
+ (setq sep c))
+ (t (setq content (cons c content)
+ i (1+ i)))))
+ (if in (error "Parse error in quoted"))
+ (cons (if (null content) "" (char-list-to-string (nreverse content)))
+ (substring string i)))))
+
+(defun elmo-parse-prefixed-element (prefix string &optional seps)
+ (if (and (not (eq (length string) 0))
+ (eq (aref string 0) prefix))
+ (elmo-parse-token (substring string 1) seps)
+ (cons "" string)))
+
;;; Number set defined by OKAZAKI Tetsurou <okazaki@be.to>
-;;
+;;
;; number ::= [0-9]+
;; beg ::= number
;; end ::= number
:type 'regexp
:group 'elmo)
-(defun elmo-list-subdirectories (directory file one-level)
- (let ((root (zerop (length file)))
+(defun elmo-list-subdirectories-1 (basedir curdir one-level)
+ (let ((root (zerop (length curdir)))
(w32-get-true-file-link-count t) ; for Meadow
- files attr dirs dir)
- (setq files (directory-files (setq dir (expand-file-name file directory))))
- (while files
- (if (and (not (string-match elmo-list-subdirectories-ignore-regexp
- (car files)))
- (car (setq attr (file-attributes (expand-file-name
- (car files) dir)))))
- (if (and (not one-level)
- (and elmo-have-link-count (< 2 (nth 1 attr))))
- (setq dirs
- (nconc dirs
- (elmo-list-subdirectories
- directory
- (concat file
- (and (not root) elmo-path-sep)
- (car files))
- one-level)))
+ 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
- (list
- (concat file
- (and (not root) elmo-path-sep)
- (car files)))))))
- (setq files (cdr files)))
- (nconc (and (not root) (list file)) 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))
(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.
+(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"
+ elmo-cache-directory
+ (elmo-cache-get-path-subr msgid)
+ msgid
+ section)
+ (format "%s/%s/%s"
+ elmo-cache-directory
+ (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-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))
+
+(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 (elmo-cache-path-section-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
+ elmo-cache-directory) 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
+ 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")
+ 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
+ elmo-cache-directory
+ 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)
+ (save-match-data
+ (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))
+ elmo-cache-directory))))
+
+;;;
+;; Warnings.
+
(defconst elmo-warning-buffer-name "*elmo warning*")
(defun elmo-warning (&rest args)
(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.
"Resque obsolete variable OBSOLETE as VAR.
If `elmo-obsolete-variable-show-warnings' is non-nil, show warning message."
(when (boundp obsolete)
- (set var (symbol-value 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)
(elmo-resque-obsolete-variable (cdr pair)
(car pair))))
+;;; Queue.
+(defvar elmo-dop-queue-filename "queue"
+ "*Disconnected operation queue is saved in this file.")
+
+(defun elmo-dop-queue-load ()
+ (setq elmo-dop-queue
+ (elmo-object-load
+ (expand-file-name elmo-dop-queue-filename
+ elmo-msgdb-directory))))
+
+(defun elmo-dop-queue-save ()
+ (elmo-object-save
+ (expand-file-name elmo-dop-queue-filename
+ elmo-msgdb-directory)
+ elmo-dop-queue))
(require 'product)
(product-provide (provide 'elmo-util) (require 'elmo-version))
projects / elisp / wanderlust.git / blobdiff