- '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
- (delete (expand-file-name elmo-cache-dirname
- elmo-msgdb-dir)
- (directory-files dir t "^[^\\.]")))
- ret-val)
- (setq dirs (elmo-delete-if (lambda (x) (not (file-directory-p x))) dirs))
- (setq ret-val (append init dirs))
- (while (and recursively dirs)
- (setq ret-val
- (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
- (string-match "<\\(.+\\)>$" msgid))
- (elmo-replace-msgid-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)))))
-
-(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))))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; 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).")
-
-(defmacro elmo-buffer-cache-buffer-get (entry)
- (` (cdr (, entry))))
-
-(defmacro elmo-buffer-cache-folder-get (entry)
- (` (car (car (, entry)))))
-
-(defmacro elmo-buffer-cache-message-get (entry)
- (` (cdr (car (, entry)))))
-
-(defmacro elmo-buffer-cache-entry-make (fld-msg-id buf)
- (` (cons (, fld-msg-id) (, buf))))
-
-(defmacro elmo-buffer-cache-hit (fld-msg-id)
- "Return value assosiated with key."
- (` (elmo-buffer-cache-buffer-get
- (assoc (, fld-msg-id) elmo-buffer-cache))))
-
-(defun elmo-buffer-cache-sort (entry)
- (let* ((pointer (cons nil elmo-buffer-cache))
- (top pointer))
- (while (cdr pointer)
- (if (equal (car (cdr pointer)) entry)
- (setcdr pointer (cdr (cdr pointer)))
- (setq pointer (cdr pointer))))
- (setcdr pointer (list 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'.
-Returning its cache buffer."
- (let ((len (length elmo-buffer-cache))
- (buf nil))
- (if (< len elmo-buffer-cache-size)
- (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))
- buf))
-
-(defun elmo-buffer-cache-delete ()
- "Delete the most recent cache entry."
- (let ((buf (elmo-buffer-cache-buffer-get (car elmo-buffer-cache))))
- (setq elmo-buffer-cache
- (nconc (cdr elmo-buffer-cache)
- (list (elmo-buffer-cache-entry-make nil buf))))))
-
-(defun elmo-buffer-cache-clean-up ()
- "A function to flush all decoded messages in cache list."
- (interactive)
- (let ((n 0) buf)
- (while (< n elmo-buffer-cache-size)
- (setq buf (concat elmo-buffer-cache-name (int-to-string n)))
- (elmo-kill-buffer buf)
- (setq n (1+ n))))
- (setq elmo-buffer-cache nil))
-
-;;
-;; cache backend by Kenichi OKADA <okada@opaopa.org>
-;;
-
-(defsubst elmo-cache-get-folder-directory (spec)
- (if (file-name-absolute-p (nth 1 spec))
- (nth 1 spec) ; already full path.
- (expand-file-name (nth 1 spec)
- (expand-file-name elmo-cache-dirname elmo-msgdb-dir))))
-
-(defun elmo-cache-msgdb-expand-path (spec)
- (let ((fld-name (nth 1 spec)))
- (expand-file-name fld-name
- (expand-file-name "internal/cache"
- elmo-msgdb-dir))))
-
-(defun elmo-cache-number-to-filename (spec number)
- (let ((number-alist
- (elmo-cache-list-folder-subr spec nil t)))
- (elmo-msgid-to-cache
- (cdr (assq number number-alist)))))
-
-(if (boundp 'nemacs-version)
- (defsubst elmo-cache-insert-header (file)
- "Insert the header of the article (Does not work on nemacs)."
- (as-binary-input-file
- (insert-file-contents file)))
- (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-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
- (insert-file-contents
- file nil beg
- (incf beg elmo-localdir-header-chop-length)))))
- (prog1 (not (search-forward "\n\n" nil t))
- (goto-char (point-max)))))))))
-
-(defsubst elmo-cache-msgdb-create-overview-entity-from-file (number file)
- (save-excursion
- (let ((tmp-buffer (get-buffer-create " *ELMO Cache Temp*"))
- insert-file-contents-pre-hook ; To avoid autoconv-xmas...
- insert-file-contents-post-hook header-end
- (attrib (file-attributes file))
- ret-val size mtime)
- (set-buffer tmp-buffer)
- (erase-buffer)
- (if (not (file-exists-p file))
- ()
- (setq size (nth 7 attrib))
- (setq mtime (timezone-make-date-arpa-standard
- (current-time-string (nth 5 attrib)) (current-time-zone)))
- ;; insert header from file.
- (catch 'done
- (condition-case nil
- (elmo-cache-insert-header file)
- (error (throw 'done nil)))
- (goto-char (point-min))
- (setq header-end
- (if (re-search-forward "\\(^--.*$\\)\\|\\(\n\n\\)" nil t)
- (point)
- (point-max)))
- (narrow-to-region (point-min) header-end)
- (setq ret-val (elmo-msgdb-create-overview-from-buffer number size mtime))
- (kill-buffer tmp-buffer))
- ret-val))))
-
-(defun elmo-cache-msgdb-create-as-numlist (spec numlist new-mark
- already-mark seen-mark
- important-mark seen-list)
- (when numlist
- (let ((dir (elmo-cache-get-folder-directory spec))
- (nalist (elmo-cache-list-folder-subr spec nil t))
- overview number-alist mark-alist entity message-id
- i percent len num seen gmark)
- (setq len (length numlist))
- (setq i 0)
- (message "Creating msgdb...")
- (while numlist
- (setq entity
- (elmo-cache-msgdb-create-overview-entity-from-file
- (car numlist)
- (expand-file-name
- (elmo-msgid-to-cache
- (setq message-id (cdr (assq (car numlist) nalist)))) dir)))
- (if (null entity)
- ()
- (setq num (elmo-msgdb-overview-entity-get-number entity))
- (setq overview
- (elmo-msgdb-append-element
- overview entity))
- (setq number-alist
- (elmo-msgdb-number-add number-alist num message-id))
- (setq seen (member message-id seen-list))
- (if (setq gmark (or (elmo-msgdb-global-mark-get message-id)
- (if seen
- nil
- new-mark)))
- (setq mark-alist
- (elmo-msgdb-mark-append
- mark-alist
- num
- gmark))))
- (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")
- (list overview number-alist mark-alist))))
-
-(defalias 'elmo-cache-msgdb-create 'elmo-cache-msgdb-create-as-numlist)
-
-(defun elmo-cache-list-folders (spec &optional hierarchy)
- (let ((folder (concat "'cache" (nth 1 spec))))
- (elmo-cache-list-folders-subr folder hierarchy)))
-
-(defun elmo-cache-list-folders-subr (folder &optional hierarchy)
- (let ((case-fold-search t)
- folders curdir dirent relpath abspath attr
- subprefix subfolder)
- (condition-case ()
- (progn
- (setq curdir
- (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
- (setq subprefix folder)
- (setq subprefix (concat folder elmo-path-sep)))
- ;; include parent
- ;(setq folders (list folder)))
- (setq dirent (directory-files curdir nil "^[01][0-9A-F]$"))
- (catch 'done
- (while dirent
- (setq relpath (car dirent))
- (setq dirent (cdr dirent))
- (setq abspath (expand-file-name relpath curdir))
- (and
- (eq (nth 0 (setq attr (file-attributes abspath))) t)
- (setq subfolder (concat subprefix relpath))
- (setq folders (nconc folders (list subfolder))))))
- folders)
- (file-error folders))))
-
-(defsubst elmo-cache-list-folder-subr (spec &optional nonsort nonalist)
- (let* ((dir (elmo-cache-get-folder-directory spec))
- (flist (mapcar 'file-name-nondirectory
- (elmo-delete-if 'file-directory-p
- (directory-files
- dir t "^[^@]+@[^@]+$" t))))
- (folder (concat "'cache/" (nth 1 spec)))
- (number-alist (or (elmo-msgdb-number-load
- (elmo-msgdb-expand-path folder))
- (list nil)))
- nlist)
- (setq nlist
- (mapcar '(lambda (filename)
- (elmo-cache-filename-to-number filename number-alist))
- flist))
- (if nonalist
- number-alist
- (if nonsort
- (cons (or (elmo-max-of-list nlist) 0) (length nlist))
- (sort nlist '<)))))
-
-(defsubst elmo-cache-filename-to-number (filename number-alist)
- (let* ((msgid (elmo-cache-to-msgid filename))
- number)
- (or (car (rassoc msgid number-alist))
- (prog1
- (setq number (+ (or (caar (last number-alist))
- 0) 1))
- (if (car number-alist)
- (nconc number-alist
- (list (cons number msgid)))
- (setcar number-alist (cons number msgid)))))))
-
-(defun elmo-cache-append-msg (spec string message-id &optional msg no-see)
- (let ((dir (elmo-cache-get-folder-directory spec))
- (tmp-buffer (get-buffer-create " *ELMO Temp buffer*"))
- filename)
- (save-excursion
- (set-buffer tmp-buffer)
- (erase-buffer)
- (setq filename (expand-file-name (elmo-msgid-to-cache message-id) dir))
- (unwind-protect
- (if (file-writable-p filename)
- (progn
- (insert string)
- (as-binary-output-file
- (write-region (point-min) (point-max) filename nil 'no-msg))
- t)
- nil)
- (kill-buffer tmp-buffer)))))
-
-(defun elmo-cache-delete-msg (spec number locked)
- (let* ((dir (elmo-cache-get-folder-directory spec))
- (file (expand-file-name
- (elmo-cache-number-to-filename spec number) dir)))
- ;; return nil if failed.
- (elmo-cache-force-delete file locked)))
-
-(defun elmo-cache-read-msg (spec number outbuf &optional set-mark)
- (save-excursion
- (let* ((dir (elmo-cache-get-folder-directory spec))
- (file (expand-file-name
- (elmo-cache-number-to-filename spec number) dir)))
- (set-buffer outbuf)
- (erase-buffer)
- (when (file-exists-p file)
- (as-binary-input-file (insert-file-contents file))
- (elmo-delete-cr-get-content-type)))))
-
-(defun elmo-cache-delete-msgs (spec msgs)
- (let ((locked (elmo-dop-lock-list-load)))
- (not (memq nil
- (mapcar '(lambda (msg) (elmo-cache-delete-msg spec msg locked))
- msgs)))))
-
-(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))
-
-(defun elmo-cache-check-validity (spec validity-file)