;;; elmo-cache.el -- Cache modules for Elmo.
-;; Copyright 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
-;; Copyright 2000 Kenichi OKADA <okada@opaopa.org>
+;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
+;; Copyright (C) 2000 Kenichi OKADA <okada@opaopa.org>
;; Author: Yuuichi Teranishi <teranisi@gohome.org>
-;; Kenichi OKADA <okada@opaopa.org>
+;; Kenichi OKADA <okada@opaopa.org>
;; Keywords: mail, net news
-;; Time-stamp: <00/03/01 09:57:55 teranisi>
;; This file is part of ELMO (Elisp Library for Message Orchestration).
(unless (string-match elmo-cache-dirname path)
(error "%s is not cache file!" path))
(let (message-id)
- (if (or (elmo-msgdb-global-mark-get
+ (if (or (elmo-msgdb-global-mark-get
(setq message-id
(elmo-cache-to-msgid (file-name-nondirectory path))))
(member message-id locked))
- nil ;; Don't delete caches with mark (or locked message).
- (if (and path
+ nil;; Don't delete caches with mark (or locked message).
+ (if (and path
(file-directory-p path))
(progn
(mapcar 'delete-file (directory-files path t "^[^\\.]"))
(if msgid
(let ((path1 (elmo-cache-get-path msgid))
path2)
- (if (and path1
+ (if (and path1
(file-exists-p path1))
(if (and folder
(file-directory-p path1))
- (when (file-exists-p (setq path2
+ (when (file-exists-p (setq path2
(expand-file-name
- (format "%s@%s"
+ (format "%s@%s"
number
(elmo-safe-filename
folder))
(delete-directory path1))))))))
(defun elmo-cache-read (msgid &optional folder number outbuf)
- "Read cache contents to outbuf"
+ "Read cache contents to OUTBUF."
(save-excursion
(let ((path (elmo-cache-exists-p msgid folder number)))
(when path
(defun elmo-read-float-value-from-minibuffer (prompt &optional initial)
(let ((str (read-from-minibuffer prompt initial)))
- (cond
+ (cond
((string-match "[0-9]*\\.[0-9]+" str)
(string-to-number str))
((string-match "[0-9]+" str)
(t (error "%s is not number" str)))))
(defun elmo-cache-expire-by-size (&optional kbytes)
- "Expire cache file by size.
+ "Expire cache file by size.
If KBYTES is kilo bytes (This value must be float)."
(interactive)
(let ((size (or kbytes
(expand-file-name
elmo-cache-dirname elmo-msgdb-dir)) Kbytes))
(setq beginning total)
- (message "Checking disk usage...done.")
+ (message "Checking disk usage...done")
(let ((cfl (elmo-cache-get-sorted-cache-file-list))
(deleted 0)
- oldest
+ 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)))
- (if (file-directory-p cur-file)
- (setq cur-size (elmo-disk-usage cur-file))
- (setq cur-size
- (/ (float (nth 7 (file-attributes cur-file)))
- Kbytes)))
+ (setq cur-size (/ (elmo-disk-usage cur-file) Kbytes))
(when (elmo-cache-force-delete cur-file locked)
(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)."
+ (message "%d cache(s) are expired from disk (%d Kbytes/%d Kbytes)."
count deleted beginning))))
(defun elmo-cache-make-file-entity (filename path)
flist firsts oldest-entity wonlist)
(while cfl
(setq flist (cdr (car cfl)))
- (setq firsts (append firsts (list
- (cons (car (car cfl))
+ (setq firsts (append firsts (list
+ (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
- (expand-file-name elmo-cache-dirname elmo-msgdb-dir)
+ (let ((dirs (directory-files
+ (expand-file-name elmo-cache-dirname elmo-msgdb-dir)
t "^[^\\.]"))
(i 0) num
elist
(setq num (length dirs))
(message "Collecting cache info...")
(while dirs
- (setq elist (mapcar (lambda (x)
+ (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
+ (sort
elist
(lambda (x y)
(< (cdr x)
(cdr y))))))))
- (setq i (+ i 1))
- (elmo-display-progress
- 'elmo-cache-get-sorted-cache-file-list "Collecting cache info..."
- (/ (* i 100) num))
+ (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
+ (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)
+ (dirs (directory-files
+ (expand-file-name elmo-cache-dirname elmo-msgdb-dir)
t "^[^\\.]"))
(locked (elmo-dop-lock-list-load))
(count 0)
(setq age elmo-cache-expire-default-age)
(setq age (string-to-int age)))
(setq curtime (current-time))
- (setq curtime (+ (* (nth 0 curtime)
+ (setq curtime (+ (* (nth 0 curtime)
(float 65536)) (nth 1 curtime)))
(while dirs
(let ((files (directory-files (car dirs) t "^[^\\.]"))
(setq dirs (cdr dirs)))))
(defun elmo-cache-save (msgid partial folder number &optional inbuf)
- "If partial is non-nil, save current buffer (or INBUF) as partial cache."
+ "If PARTIAL is non-nil, save current buffer (or INBUF) as partial cache."
(condition-case nil
- (save-excursion
- (let* ((path (if partial
- (elmo-cache-get-path msgid folder number)
- (elmo-cache-get-path msgid)))
- dir tmp-buf)
- (when path
- (setq dir (directory-file-name (file-name-directory path)))
- (if (not (file-exists-p dir))
- (elmo-make-directory dir))
- (if inbuf (set-buffer inbuf))
- (goto-char (point-min))
- (as-binary-output-file (write-region (point-min) (point-max)
- path nil 'no-msg)))))
- (error)))
+ (save-excursion
+ (let* ((path (if partial
+ (elmo-cache-get-path msgid folder number)
+ (elmo-cache-get-path msgid)))
+ dir tmp-buf)
+ (when path
+ (setq dir (directory-file-name (file-name-directory path)))
+ (if (not (file-exists-p dir))
+ (elmo-make-directory dir))
+ (if inbuf (set-buffer inbuf))
+ (goto-char (point-min))
+ (as-binary-output-file (write-region (point-min) (point-max)
+ path nil 'no-msg)))))
+ (error)))
(defun elmo-cache-exists-p (msgid &optional folder number)
"Returns the path if the cache exists."
(if (and folder
(file-directory-p path))
(if (file-exists-p (setq path (expand-file-name
- (format "%s@%s"
- (or number "")
+ (format "%s@%s"
+ (or number "")
(elmo-safe-filename
folder))
path)))
(defun elmo-cache-search-all (folder condition from-msgs)
(let* ((number-alist (elmo-msgdb-number-load
(elmo-msgdb-expand-path folder)))
- (nalist number-alist)
+ (number-list (or from-msgs (mapcar 'car number-alist)))
(num (length number-alist))
cache-file
ret-val
case-fold-search msg
percent i)
- (setq i 0)
- (while nalist
- (if (and (setq cache-file (elmo-cache-exists-p (cdr (car nalist))
- folder
- (car (car nalist))))
- (elmo-file-field-condition-match cache-file condition))
- (setq ret-val (append ret-val (list (caar nalist)))))
- (setq i (1+ i))
- (setq percent (/ (* i 100) num))
- (elmo-display-progress
- 'elmo-cache-search-all "Searching..."
- percent)
- (setq nalist (cdr nalist)))
+ (setq i 0)
+ (while number-alist
+ (if (and (memq (car (car number-alist)) number-list)
+ (setq cache-file (elmo-cache-exists-p (cdr (car
+ number-alist))
+ folder
+ (car (car
+ number-alist))))
+ (elmo-file-field-condition-match cache-file condition
+ (car (car number-alist))
+ number-list))
+ (setq ret-val (append ret-val (list (caar number-alist)))))
+ (when (> num elmo-display-progress-threshold)
+ (setq i (1+ i))
+ (setq percent (/ (* i 100) num))
+ (elmo-display-progress
+ 'elmo-cache-search-all "Searching..."
+ percent))
+ (setq number-alist (cdr number-alist)))
ret-val))
(defun elmo-cache-collect-sub-directories (init dir &optional recursively)
- "Collect subdirectories under 'dir'"
- (let ((dirs
+ "Collect subdirectories under DIR."
+ (let ((dirs
(delete (expand-file-name elmo-cache-dirname
elmo-msgdb-dir)
(directory-files dir t "^[^\\.]")))
(setq ret-val (append init dirs))
(while (and recursively dirs)
(setq ret-val
- (elmo-cache-collect-sub-directories
+ (elmo-cache-collect-sub-directories
ret-val
(car dirs) recursively))
(setq dirs (cdr dirs)))
ret-val))
(defun elmo-msgid-to-cache (msgid)
- (when (and msgid
+ (when (and msgid
(string-match "<\\(.+\\)>$" msgid))
(elmo-replace-msgid-as-filename (elmo-match-string 1 msgid))))
(expand-file-name
(expand-file-name
(if folder
- (format "%s/%s/%s@%s"
+ (format "%s/%s/%s@%s"
(elmo-cache-get-path-subr msgid)
msgid
(or number "")
(elmo-safe-filename folder))
- (format "%s/%s"
+ (format "%s/%s"
(elmo-cache-get-path-subr msgid)
msgid))
(expand-file-name elmo-cache-dirname
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; buffer cache module
+;; buffer cache module
(defconst elmo-buffer-cache-name " *elmo cache*")
(defvar elmo-buffer-cache nil
- "Message cache. (old ... new) order alist with association
- ((\"folder\" message \"message-id\") . cache-buffer)")
+ "Message cache. (old ... new) order alist.
+With association ((\"folder\" message \"message-id\") . cache-buffer).")
(defmacro elmo-buffer-cache-buffer-get (entry)
(` (cdr (, entry))))
(setq elmo-buffer-cache (cdr top))))
(defun elmo-buffer-cache-add (fld-msg-id)
- "Adding (fld-msg-id . buf) to the top of \"elmo-buffer-cache\".
+ "Adding (FLD-MSG-ID . buf) to the top of `elmo-buffer-cache'.
Returning its cache buffer."
(let ((len (length elmo-buffer-cache))
(buf nil))
(setq buf (get-buffer-create (format "%s%d" elmo-buffer-cache-name len)))
(setq buf (elmo-buffer-cache-buffer-get (nth (1- len) elmo-buffer-cache)))
(setcdr (nthcdr (- len 2) elmo-buffer-cache) nil))
+ (save-excursion
+ (set-buffer buf)
+ (elmo-set-buffer-multibyte nil))
(setq elmo-buffer-cache
(cons (elmo-buffer-cache-entry-make fld-msg-id buf)
elmo-buffer-cache))
(setq n (1+ n))))
(setq elmo-buffer-cache nil))
-;;;
-;;; cache backend by Kenichi OKADA <okada@opaopa.org>
-;;;
+;;
+;; cache backend by Kenichi OKADA <okada@opaopa.org>
+;;
(defsubst elmo-cache-get-folder-directory (spec)
(if (file-name-absolute-p (nth 1 spec))
(defsubst elmo-cache-insert-header (file)
"Insert the header of the article."
(let ((beg 0)
- insert-file-contents-pre-hook ; To avoid autoconv-xmas...
+ 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-localdir-header-chop-length
- (nth 1
- (as-binary-input-file
+ (nth 1
+ (as-binary-input-file
(insert-file-contents
file nil beg
(incf beg elmo-localdir-header-chop-length)))))
nil
new-mark)))
(setq mark-alist
- (elmo-msgdb-mark-append
- mark-alist
+ (elmo-msgdb-mark-append
+ mark-alist
num
gmark))))
- (setq i (1+ i))
- (setq percent (/ (* i 100) len))
- (elmo-display-progress
- 'elmo-cache-msgdb-create-as-numlist "Creating msgdb..."
- percent)
+ (when (> len elmo-display-progress-threshold)
+ (setq i (1+ i))
+ (setq percent (/ (* i 100) len))
+ (elmo-display-progress
+ 'elmo-cache-msgdb-create-as-numlist "Creating msgdb..."
+ percent))
(setq numlist (cdr numlist)))
- (message "Creating msgdb...done.")
+ (message "Creating msgdb...done")
(list overview number-alist mark-alist))))
(defalias 'elmo-cache-msgdb-create 'elmo-cache-msgdb-create-as-numlist)
(expand-file-name
(nth 1 (elmo-folder-get-spec folder))
(expand-file-name elmo-cache-dirname elmo-msgdb-dir)))
- (if (string-match "^[+=$!]$" folder) ;; localdir, archive, localnews
+ (if (string-match "^[+=$!]$" folder) ; localdir, archive, localnews
(setq subprefix folder)
(setq subprefix (concat folder elmo-path-sep)))
;; include parent
(let* ((dir (elmo-cache-get-folder-directory spec))
(flist (mapcar 'file-name-nondirectory
(elmo-delete-if 'file-directory-p
- (directory-files
+ (directory-files
dir t "^[^@]+@[^@]+$" t))))
(folder (concat "'cache/" (nth 1 spec)))
- (number-alist (or (elmo-msgdb-number-load
+ (number-alist (or (elmo-msgdb-number-load
(elmo-msgdb-expand-path folder))
(list nil)))
nlist)
;; return nil if failed.
(elmo-cache-force-delete file locked)))
-(defun elmo-cache-read-msg (spec number outbuf &optional set-mark)
+(defun elmo-cache-read-msg (spec number outbuf &optional msgdb unread)
(save-excursion
(let* ((dir (elmo-cache-get-folder-directory spec))
- (file (expand-file-name
+ (file (expand-file-name
(elmo-cache-number-to-filename spec number) dir)))
(set-buffer outbuf)
(erase-buffer)
(mapcar '(lambda (msg) (elmo-cache-delete-msg spec msg locked))
msgs)))))
-(defun elmo-cache-list-folder (spec); called by elmo-cache-search()
- (elmo-cache-list-folder-subr spec))
+(defun elmo-cache-list-folder (spec) ; called by elmo-cache-search()
+ (let ((killed (and elmo-use-killed-list
+ (elmo-msgdb-killed-list-load
+ (elmo-msgdb-expand-path spec))))
+ numbers)
+ (setq numbers (elmo-cache-list-folder-subr spec))
+ (elmo-living-messages numbers killed)))
(defun elmo-cache-max-of-folder (spec)
(elmo-cache-list-folder-subr spec t))
(i 0) case-fold-search ret-val)
(while msgs
(if (elmo-file-field-condition-match
- (expand-file-name
+ (expand-file-name
(elmo-msgid-to-cache
(cdr (assq (car msgs) number-alist)))
(elmo-cache-get-folder-directory spec))
- condition)
+ condition
+ (car msgs)
+ msgs)
(setq ret-val (cons (car msgs) ret-val)))
- (setq i (1+ i))
- (elmo-display-progress
- 'elmo-cache-search "Searching..."
- (/ (* i 100) num))
+ (when (> num elmo-display-progress-threshold)
+ (setq i (1+ i))
+ (elmo-display-progress
+ 'elmo-cache-search "Searching..."
+ (/ (* i 100) num)))
(setq msgs (cdr msgs)))
(nreverse ret-val)))
(next-num (1+ (car (elmo-cache-list-folder-subr dst-spec t))))
(number-alist
(elmo-msgdb-number-load
- (elmo-msgdb-expand-path nil src-spec))))
+ (elmo-msgdb-expand-path src-spec))))
(if same-number (error "Not implemented"))
(while msgs
(elmo-copy-file
(expand-file-name
(elmo-msgid-to-cache
(cdr (assq (if same-number (car msgs) next-num) number-alist)))
- dst-dir))
+ dst-dir))
(if (and (setq msgs (cdr msgs))
(not same-number))
(setq next-num (1+ next-num))))
(elmo-cache-number-to-filename spec number)
(elmo-cache-get-folder-directory spec)))
-(defalias 'elmo-cache-sync-number-alist
+(defalias 'elmo-cache-sync-number-alist
'elmo-generic-sync-number-alist)
-(defalias 'elmo-cache-list-folder-unread
+(defalias 'elmo-cache-list-folder-unread
'elmo-generic-list-folder-unread)
(defalias 'elmo-cache-list-folder-important
'elmo-generic-list-folder-important)
(defalias 'elmo-cache-commit 'elmo-generic-commit)
+(defalias 'elmo-cache-folder-diff 'elmo-generic-folder-diff)
-(provide 'elmo-cache)
+(require 'product)
+(product-provide (provide 'elmo-cache) (require 'elmo-version))
;;; elmo-cache.el ends here
projects / elisp / wanderlust.git / blobdiff