elmo/elmo-cache.el

   1 ;;; elmo-cache.el -- Cache modules for Elmo.
   2
   3 ;; Copyright 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
   4 ;; Copyright 2000 Kenichi OKADA <okada@opaopa.org>
   5
   6 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
   7 ;;         Kenichi OKADA <okada@opaopa.org>
   8 ;; Keywords: mail, net news
   9
  10 ;; This file is part of ELMO (Elisp Library for Message Orchestration).
  11
  12 ;; This program is free software; you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16 ;;
  17 ;; This program is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21 ;;
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  25 ;; Boston, MA 02111-1307, USA.
  26 ;;
  27
  28 ;;; Commentary:
  29 ;;
  30
  31 ;;; Code:
  32 ;;
  33 (require 'elmo-vars)
  34 (require 'elmo-util)
  35
  36 (defun elmo-cache-delete (msgid folder number)
  37   "Delete cache file associated with message-id 'MSGID', FOLDER, NUMBER."
  38   (let ((path (elmo-cache-exists-p msgid folder number)))
  39     (if path (delete-file path))))
  40
  41 (defsubst elmo-cache-to-msgid (filename)
  42   (concat "<" (elmo-recover-msgid-from-filename filename) ">"))
  43
  44 (defun elmo-cache-force-delete (path &optional locked)
  45   "Delete cache file."
  46   ;; for safety...
  47   (unless (string-match elmo-cache-dirname path)
  48     (error "%s is not cache file!" path))
  49   (let (message-id)
  50     (if (or (elmo-msgdb-global-mark-get
  51              (setq message-id
  52                    (elmo-cache-to-msgid (file-name-nondirectory path))))
  53             (member message-id locked))
  54         nil ;; Don't delete caches with mark (or locked message).
  55       (if (and path
  56                (file-directory-p path))
  57           (progn
  58             (mapcar 'delete-file (directory-files path t "^[^\\.]"))
  59             (delete-directory path))
  60         (delete-file path))
  61       t)))
  62
  63 (defun elmo-cache-delete-partial (msgid folder number)
  64   "Delete cache file only if it is partial message."
  65   (if msgid
  66       (let ((path1 (elmo-cache-get-path msgid))
  67             path2)
  68         (if (and path1
  69                  (file-exists-p path1))
  70             (if (and folder
  71                      (file-directory-p path1))
  72                 (when (file-exists-p (setq path2
  73                                            (expand-file-name
  74                                             (format "%s@%s"
  75                                                     number
  76                                                     (elmo-safe-filename
  77                                                      folder))
  78                                             path1)))
  79                   (delete-file path2)
  80                   (unless (directory-files path1 t "^[^\\.]")
  81                     (delete-directory path1))))))))
  82
  83 (defun elmo-cache-read (msgid &optional folder number outbuf)
  84   "Read cache contents to outbuf"
  85   (save-excursion
  86     (let ((path (elmo-cache-exists-p msgid folder number)))
  87       (when path
  88         (if outbuf (set-buffer outbuf))
  89         (erase-buffer)
  90         (as-binary-input-file (insert-file-contents path))
  91         t))))
  92
  93 (defun elmo-cache-expire ()
  94   (interactive)
  95   (let* ((completion-ignore-case t)
  96          (method (completing-read (format "Expire by (%s): "
  97                                           elmo-cache-expire-default-method)
  98                                   '(("size" . "size")
  99                                     ("age" . "age")))))
 100     (if (string= method "")
 101         (setq method elmo-cache-expire-default-method))
 102     (funcall (intern (concat "elmo-cache-expire-by-" method)))))
 103
 104 (defun elmo-read-float-value-from-minibuffer (prompt &optional initial)
 105   (let ((str (read-from-minibuffer prompt initial)))
 106     (cond
 107      ((string-match "[0-9]*\\.[0-9]+" str)
 108       (string-to-number str))
 109      ((string-match "[0-9]+" str)
 110       (string-to-number (concat str ".0")))
 111      (t (error "%s is not number" str)))))
 112
 113 (defun elmo-cache-expire-by-size (&optional kbytes)
 114   "Expire cache file by size.
 115 If KBYTES is kilo bytes (This value must be float)."
 116   (interactive)
 117   (let ((size (or kbytes
 118                   (and (interactive-p)
 119                        (elmo-read-float-value-from-minibuffer
 120                         "Enter cache disk size (Kbytes): "
 121                         (number-to-string
 122                          (if (integerp elmo-cache-expire-default-size)
 123                              (float elmo-cache-expire-default-size)
 124                            elmo-cache-expire-default-size))))
 125                   (if (integerp elmo-cache-expire-default-size)
 126                       (float elmo-cache-expire-default-size))))
 127         (locked (elmo-dop-lock-list-load))
 128         (count 0)
 129         (Kbytes 1024)
 130         total beginning)
 131     (message "Checking disk usage...")
 132     (setq total (/ (elmo-disk-usage
 133                     (expand-file-name
 134                      elmo-cache-dirname elmo-msgdb-dir)) Kbytes))
 135     (setq beginning total)
 136     (message "Checking disk usage...done.")
 137     (let ((cfl (elmo-cache-get-sorted-cache-file-list))
 138           (deleted 0)
 139           oldest
 140           cur-size cur-file)
 141       (while (and (<= size total)
 142                   (setq oldest (elmo-cache-get-oldest-cache-file-entity cfl)))
 143         (setq cur-file (expand-file-name (car (cdr oldest)) (car oldest)))
 144         (if (file-directory-p cur-file)
 145             (setq cur-size (elmo-disk-usage cur-file))
 146           (setq cur-size
 147                 (/ (float (nth 7 (file-attributes cur-file)))
 148                    Kbytes)))
 149         (when (elmo-cache-force-delete cur-file locked)
 150           (setq count (+ count 1))
 151           (message "%d cache(s) are expired." count))
 152         (setq deleted (+ deleted cur-size))
 153         (setq total (- total cur-size)))
 154       (message "%d cache(s) are expired from disk (%d Kbytes/%d Kbytes)."
 155                count deleted beginning))))
 156
 157 (defun elmo-cache-make-file-entity (filename path)
 158   (cons filename (elmo-get-last-accessed-time filename path)))
 159
 160 (defun elmo-cache-get-oldest-cache-file-entity (cache-file-list)
 161   (let ((cfl cache-file-list)
 162         flist firsts oldest-entity wonlist)
 163     (while cfl
 164       (setq flist (cdr (car cfl)))
 165       (setq firsts (append firsts (list
 166                                    (cons (car (car cfl))
 167                                          (car flist)))))
 168       (setq cfl (cdr cfl)))
 169 ;    (prin1 firsts)
 170     (while firsts
 171       (if (and (not oldest-entity)
 172                (cdr (cdr (car firsts))))
 173           (setq oldest-entity (car firsts)))
 174       (if (and (cdr (cdr (car firsts)))
 175                (cdr (cdr oldest-entity))
 176                (> (cdr (cdr oldest-entity)) (cdr (cdr (car firsts)))))
 177           (setq oldest-entity (car firsts)))
 178       (setq firsts (cdr firsts)))
 179     (setq wonlist (assoc (car oldest-entity) cache-file-list))
 180     (and wonlist
 181          (setcdr wonlist (delete (car (cdr wonlist)) (cdr wonlist))))
 182     oldest-entity))
 183
 184 (defun elmo-cache-get-sorted-cache-file-list ()
 185   (let ((dirs (directory-files
 186                (expand-file-name elmo-cache-dirname elmo-msgdb-dir)
 187                t "^[^\\.]"))
 188         (i 0) num
 189         elist
 190         ret-val)
 191     (setq num (length dirs))
 192     (message "Collecting cache info...")
 193     (while dirs
 194       (setq elist (mapcar (lambda (x)
 195                             (elmo-cache-make-file-entity x (car dirs)))
 196                           (directory-files (car dirs) nil "^[^\\.]")))
 197       (setq ret-val (append ret-val
 198                             (list (cons
 199                                    (car dirs)
 200                                    (sort
 201                                     elist
 202                                     (lambda (x y)
 203                                       (< (cdr x)
 204                                          (cdr y))))))))
 205       (when (> num elmo-display-progress-threshold)
 206         (setq i (+ i 1))
 207         (elmo-display-progress
 208          'elmo-cache-get-sorted-cache-file-list "Collecting cache info..."
 209          (/ (* i 100) num)))
 210       (setq dirs (cdr dirs)))
 211     (message "Collecting cache info...done.")
 212     ret-val))
 213
 214 (defun elmo-cache-expire-by-age (&optional days)
 215   (let ((age (or (and days (int-to-string days))
 216                  (and (interactive-p)
 217                       (read-from-minibuffer
 218                        (format "Enter days (%s): "
 219                                elmo-cache-expire-default-age)))
 220                  (int-to-string elmo-cache-expire-default-age)))
 221         (dirs (directory-files
 222                (expand-file-name elmo-cache-dirname elmo-msgdb-dir)
 223                t "^[^\\.]"))
 224         (locked (elmo-dop-lock-list-load))
 225         (count 0)
 226         curtime)
 227     (if (string= age "")
 228         (setq age elmo-cache-expire-default-age)
 229       (setq age (string-to-int age)))
 230     (setq curtime (current-time))
 231     (setq curtime (+ (* (nth 0 curtime)
 232                         (float 65536)) (nth 1 curtime)))
 233     (while dirs
 234       (let ((files (directory-files (car dirs) t "^[^\\.]"))
 235             (limit-age (* age 86400)))
 236         (while files
 237           (when (> (- curtime (elmo-get-last-accessed-time (car files)))
 238                    limit-age)
 239             (when (elmo-cache-force-delete (car files) locked)
 240               (setq count (+ 1 count))
 241               (message "%d cache file(s) are expired." count)))
 242           (setq files (cdr files))))
 243       (setq dirs (cdr dirs)))))
 244
 245 (defun elmo-cache-save (msgid partial folder number &optional inbuf)
 246   "If partial is non-nil, save current buffer (or INBUF) as partial cache."
 247   (condition-case nil
 248   (save-excursion
 249     (let* ((path (if partial
 250                      (elmo-cache-get-path msgid folder number)
 251                    (elmo-cache-get-path msgid)))
 252            dir tmp-buf)
 253       (when path
 254         (setq dir (directory-file-name (file-name-directory path)))
 255         (if (not (file-exists-p dir))
 256             (elmo-make-directory dir))
 257         (if inbuf (set-buffer inbuf))
 258         (goto-char (point-min))
 259         (as-binary-output-file (write-region (point-min) (point-max)
 260                                              path nil 'no-msg)))))
 261   (error)))
 262
 263 (defun elmo-cache-exists-p (msgid &optional folder number)
 264   "Returns the path if the cache exists."
 265   (save-match-data
 266     (if msgid
 267         (let ((path (elmo-cache-get-path msgid)))
 268           (if (and path
 269                    (file-exists-p path))
 270               (if (and folder
 271                        (file-directory-p path))
 272                   (if (file-exists-p (setq path (expand-file-name
 273                                                  (format "%s@%s"
 274                                                          (or number "")
 275                                                          (elmo-safe-filename
 276                                                           folder))
 277                                                  path)))
 278                       path
 279                     )
 280                 ;; not directory.
 281                 path))))))
 282
 283 (defun elmo-cache-search-all (folder condition from-msgs)
 284   (let* ((number-alist (elmo-msgdb-number-load
 285                         (elmo-msgdb-expand-path folder)))
 286          (nalist number-alist)
 287          (num (length number-alist))
 288          cache-file
 289          ret-val
 290          case-fold-search msg
 291          percent i)
 292     (setq i 0)
 293     (while nalist
 294       (if (and (setq cache-file (elmo-cache-exists-p (cdr (car nalist))
 295                                                      folder
 296                                                      (car (car nalist))))
 297                (elmo-file-field-condition-match cache-file condition))
 298           (setq ret-val (append ret-val (list (caar nalist)))))
 299       (when (> num elmo-display-progress-threshold)
 300         (setq i (1+ i))
 301         (setq percent (/ (* i 100) num))
 302         (elmo-display-progress
 303          'elmo-cache-search-all "Searching..."
 304          percent))
 305       (setq nalist (cdr nalist)))
 306     ret-val))
 307
 308 (defun elmo-cache-collect-sub-directories (init dir &optional recursively)
 309   "Collect subdirectories under 'dir'"
 310   (let ((dirs
 311          (delete (expand-file-name elmo-cache-dirname
 312                                    elmo-msgdb-dir)
 313                  (directory-files dir t "^[^\\.]")))
 314         ret-val)
 315     (setq dirs (elmo-delete-if (lambda (x) (not (file-directory-p x))) dirs))
 316     (setq ret-val (append init dirs))
 317     (while (and recursively dirs)
 318       (setq ret-val
 319             (elmo-cache-collect-sub-directories
 320              ret-val
 321              (car dirs) recursively))
 322       (setq dirs (cdr dirs)))
 323     ret-val))
 324
 325 (defun elmo-msgid-to-cache (msgid)
 326   (when (and msgid
 327              (string-match "<\\(.+\\)>$" msgid))
 328     (elmo-replace-msgid-as-filename (elmo-match-string 1 msgid))))
 329
 330 (defun elmo-cache-get-path (msgid &optional folder number)
 331   "Get path for cache file associated with MSGID, FOLDER, and NUMBER."
 332   (if (setq msgid (elmo-msgid-to-cache msgid))
 333       (expand-file-name
 334        (expand-file-name
 335         (if folder
 336             (format "%s/%s/%s@%s"
 337                     (elmo-cache-get-path-subr msgid)
 338                     msgid
 339                     (or number "")
 340                     (elmo-safe-filename folder))
 341           (format "%s/%s"
 342                   (elmo-cache-get-path-subr msgid)
 343                   msgid))
 344         (expand-file-name elmo-cache-dirname
 345                           elmo-msgdb-dir)))))
 346
 347 (defsubst elmo-cache-get-path-subr (msgid)
 348   (let ((chars '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 ?A ?B ?C ?D ?E ?F))
 349         (clist (string-to-char-list msgid))
 350         (sum 0))
 351     (while clist
 352       (setq sum (+ sum (car clist)))
 353       (setq clist (cdr clist)))
 354     (format "%c%c"
 355             (nth (% (/ sum 16) 2) chars)
 356             (nth (% sum 16) chars))))
 357
 358
 359 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 360 ;;; buffer cache module
 361
 362 (defconst elmo-buffer-cache-name " *elmo cache*")
 363
 364 (defvar elmo-buffer-cache nil
 365   "Message cache. (old ... new) order alist with association
 366  ((\"folder\" message \"message-id\") . cache-buffer)")
 367
 368 (defmacro elmo-buffer-cache-buffer-get (entry)
 369   (` (cdr (, entry))))
 370
 371 (defmacro elmo-buffer-cache-folder-get (entry)
 372   (` (car (car (, entry)))))
 373
 374 (defmacro elmo-buffer-cache-message-get (entry)
 375   (` (cdr (car (, entry)))))
 376
 377 (defmacro elmo-buffer-cache-entry-make (fld-msg-id buf)
 378   (` (cons (, fld-msg-id) (, buf))))
 379
 380 (defmacro elmo-buffer-cache-hit (fld-msg-id)
 381   "Return value assosiated with key."
 382   (` (elmo-buffer-cache-buffer-get
 383       (assoc (, fld-msg-id) elmo-buffer-cache))))
 384
 385 (defun elmo-buffer-cache-sort (entry)
 386   (let* ((pointer (cons nil elmo-buffer-cache))
 387          (top pointer))
 388     (while (cdr pointer)
 389       (if (equal (car (cdr pointer)) entry)
 390           (setcdr pointer (cdr (cdr pointer)))
 391         (setq pointer (cdr pointer))))
 392     (setcdr pointer (list entry))
 393     (setq elmo-buffer-cache (cdr top))))
 394
 395 (defun elmo-buffer-cache-add (fld-msg-id)
 396   "Adding (fld-msg-id . buf) to the top of \"elmo-buffer-cache\".
 397 Returning its cache buffer."
 398   (let ((len (length elmo-buffer-cache))
 399         (buf nil))
 400     (if (< len elmo-buffer-cache-size)
 401         (setq buf (get-buffer-create (format "%s%d" elmo-buffer-cache-name len)))
 402       (setq buf (elmo-buffer-cache-buffer-get (nth (1- len) elmo-buffer-cache)))
 403       (setcdr (nthcdr (- len 2) elmo-buffer-cache) nil))
 404     (save-excursion
 405       (set-buffer buf)
 406       (elmo-set-buffer-multibyte nil))
 407     (setq elmo-buffer-cache
 408           (cons (elmo-buffer-cache-entry-make fld-msg-id buf)
 409                 elmo-buffer-cache))
 410     buf))
 411
 412 (defun elmo-buffer-cache-delete ()
 413   "Delete the most recent cache entry."
 414   (let ((buf (elmo-buffer-cache-buffer-get (car elmo-buffer-cache))))
 415     (setq elmo-buffer-cache
 416           (nconc (cdr elmo-buffer-cache)
 417                  (list (elmo-buffer-cache-entry-make nil buf))))))
 418
 419 (defun elmo-buffer-cache-clean-up ()
 420   "A function to flush all decoded messages in cache list."
 421   (interactive)
 422   (let ((n 0) buf)
 423     (while (< n elmo-buffer-cache-size)
 424       (setq buf (concat elmo-buffer-cache-name (int-to-string n)))
 425       (elmo-kill-buffer buf)
 426       (setq n (1+ n))))
 427   (setq elmo-buffer-cache nil))
 428
 429 ;;;
 430 ;;; cache backend by Kenichi OKADA <okada@opaopa.org>
 431 ;;;
 432
 433 (defsubst elmo-cache-get-folder-directory (spec)
 434   (if (file-name-absolute-p (nth 1 spec))
 435       (nth 1 spec) ; already full path.
 436     (expand-file-name (nth 1 spec)
 437                       (expand-file-name elmo-cache-dirname elmo-msgdb-dir))))
 438
 439 (defun elmo-cache-msgdb-expand-path (spec)
 440   (let ((fld-name (nth 1 spec)))
 441     (expand-file-name fld-name
 442                       (expand-file-name "internal/cache"
 443                                         elmo-msgdb-dir))))
 444
 445 (defun elmo-cache-number-to-filename (spec number)
 446   (let ((number-alist
 447          (elmo-cache-list-folder-subr spec nil t)))
 448     (elmo-msgid-to-cache
 449      (cdr (assq number number-alist)))))
 450
 451 (if (boundp 'nemacs-version)
 452     (defsubst elmo-cache-insert-header (file)
 453       "Insert the header of the article (Does not work on nemacs)."
 454       (as-binary-input-file
 455        (insert-file-contents file)))
 456   (defsubst elmo-cache-insert-header (file)
 457     "Insert the header of the article."
 458     (let ((beg 0)
 459           insert-file-contents-pre-hook   ; To avoid autoconv-xmas...
 460           insert-file-contents-post-hook
 461           format-alist)
 462       (when (file-exists-p file)
 463         ;; Read until header separator is found.
 464         (while (and (eq elmo-localdir-header-chop-length
 465                         (nth 1
 466                              (as-binary-input-file
 467                               (insert-file-contents
 468                                file nil beg
 469                                (incf beg elmo-localdir-header-chop-length)))))
 470                     (prog1 (not (search-forward "\n\n" nil t))
 471                       (goto-char (point-max)))))))))
 472
 473 (defsubst elmo-cache-msgdb-create-overview-entity-from-file (number file)
 474   (save-excursion
 475     (let ((tmp-buffer (get-buffer-create " *ELMO Cache Temp*"))
 476           insert-file-contents-pre-hook   ; To avoid autoconv-xmas...
 477           insert-file-contents-post-hook header-end
 478           (attrib (file-attributes file))
 479           ret-val size mtime)
 480       (set-buffer tmp-buffer)
 481       (erase-buffer)
 482       (if (not (file-exists-p file))
 483           ()
 484         (setq size (nth 7 attrib))
 485         (setq mtime (timezone-make-date-arpa-standard
 486                      (current-time-string (nth 5 attrib)) (current-time-zone)))
 487         ;; insert header from file.
 488         (catch 'done
 489           (condition-case nil
 490               (elmo-cache-insert-header file)
 491             (error (throw 'done nil)))
 492           (goto-char (point-min))
 493           (setq header-end
 494                 (if (re-search-forward "\\(^--.*$\\)\\|\\(\n\n\\)" nil t)
 495                     (point)
 496                   (point-max)))
 497           (narrow-to-region (point-min) header-end)
 498           (setq ret-val (elmo-msgdb-create-overview-from-buffer number size mtime))
 499           (kill-buffer tmp-buffer))
 500         ret-val))))
 501
 502 (defun elmo-cache-msgdb-create-as-numlist (spec numlist new-mark
 503                                                    already-mark seen-mark
 504                                                    important-mark seen-list)
 505   (when numlist
 506     (let ((dir (elmo-cache-get-folder-directory spec))
 507           (nalist (elmo-cache-list-folder-subr spec nil t))
 508           overview number-alist mark-alist entity message-id
 509           i percent len num seen gmark)
 510       (setq len (length numlist))
 511       (setq i 0)
 512       (message "Creating msgdb...")
 513       (while numlist
 514         (setq entity
 515               (elmo-cache-msgdb-create-overview-entity-from-file
 516                (car numlist)
 517                (expand-file-name
 518                 (elmo-msgid-to-cache
 519                  (setq message-id (cdr (assq (car numlist) nalist)))) dir)))
 520         (if (null entity)
 521             ()
 522           (setq num (elmo-msgdb-overview-entity-get-number entity))
 523           (setq overview
 524                 (elmo-msgdb-append-element
 525                  overview entity))
 526           (setq number-alist
 527                 (elmo-msgdb-number-add number-alist num message-id))
 528           (setq seen (member message-id seen-list))
 529           (if (setq gmark (or (elmo-msgdb-global-mark-get message-id)
 530                               (if seen
 531                                   nil
 532                                 new-mark)))
 533               (setq mark-alist
 534                     (elmo-msgdb-mark-append
 535                      mark-alist
 536                      num
 537                      gmark))))
 538         (when (> len elmo-display-progress-threshold)
 539           (setq i (1+ i))
 540           (setq percent (/ (* i 100) len))
 541           (elmo-display-progress
 542            'elmo-cache-msgdb-create-as-numlist "Creating msgdb..."
 543            percent))
 544         (setq numlist (cdr numlist)))
 545       (message "Creating msgdb...done.")
 546       (list overview number-alist mark-alist))))
 547
 548 (defalias 'elmo-cache-msgdb-create 'elmo-cache-msgdb-create-as-numlist)
 549
 550 (defun elmo-cache-list-folders (spec &optional hierarchy)
 551   (let ((folder (concat "'cache" (nth 1 spec))))
 552     (elmo-cache-list-folders-subr folder hierarchy)))
 553
 554 (defun elmo-cache-list-folders-subr (folder &optional hierarchy)
 555   (let ((case-fold-search t)
 556         folders curdir dirent relpath abspath attr
 557         subprefix subfolder)
 558     (condition-case ()
 559         (progn
 560           (setq curdir
 561                 (expand-file-name
 562                  (nth 1 (elmo-folder-get-spec folder))
 563                  (expand-file-name elmo-cache-dirname elmo-msgdb-dir)))
 564           (if (string-match "^[+=$!]$" folder) ;; localdir, archive, localnews
 565               (setq subprefix folder)
 566             (setq subprefix (concat folder elmo-path-sep)))
 567             ;; include parent
 568             ;(setq folders (list folder)))
 569           (setq dirent (directory-files curdir nil "^[01][0-9A-F]$"))
 570           (catch 'done
 571            (while dirent
 572             (setq relpath (car dirent))
 573             (setq dirent (cdr dirent))
 574             (setq abspath (expand-file-name relpath curdir))
 575             (and
 576              (eq (nth 0 (setq attr (file-attributes abspath))) t)
 577              (setq subfolder (concat subprefix relpath))
 578              (setq folders (nconc folders (list subfolder))))))
 579           folders)
 580       (file-error folders))))
 581
 582 (defsubst elmo-cache-list-folder-subr (spec &optional nonsort nonalist)
 583   (let* ((dir (elmo-cache-get-folder-directory spec))
 584          (flist (mapcar 'file-name-nondirectory
 585                         (elmo-delete-if 'file-directory-p
 586                                         (directory-files
 587                                          dir t "^[^@]+@[^@]+$" t))))
 588          (folder (concat "'cache/" (nth 1 spec)))
 589          (number-alist (or (elmo-msgdb-number-load
 590                             (elmo-msgdb-expand-path folder))
 591                            (list nil)))
 592          nlist)
 593     (setq nlist
 594           (mapcar '(lambda (filename)
 595                      (elmo-cache-filename-to-number filename number-alist))
 596                   flist))
 597     (if nonalist
 598         number-alist
 599       (if nonsort
 600           (cons (or (elmo-max-of-list nlist) 0) (length nlist))
 601         (sort nlist '<)))))
 602
 603 (defsubst elmo-cache-filename-to-number (filename number-alist)
 604   (let* ((msgid (elmo-cache-to-msgid filename))
 605          number)
 606     (or (car (rassoc msgid number-alist))
 607         (prog1
 608             (setq number (+ (or (caar (last number-alist))
 609                                 0) 1))
 610           (if (car number-alist)
 611               (nconc number-alist
 612                      (list (cons number msgid)))
 613             (setcar number-alist (cons number msgid)))))))
 614
 615 (defun elmo-cache-append-msg (spec string message-id &optional msg no-see)
 616   (let ((dir (elmo-cache-get-folder-directory spec))
 617         (tmp-buffer (get-buffer-create " *ELMO Temp buffer*"))
 618         filename)
 619     (save-excursion
 620       (set-buffer tmp-buffer)
 621       (erase-buffer)
 622       (setq filename (expand-file-name (elmo-msgid-to-cache message-id) dir))
 623       (unwind-protect
 624           (if (file-writable-p filename)
 625               (progn
 626                 (insert string)
 627                 (as-binary-output-file
 628                  (write-region (point-min) (point-max) filename nil 'no-msg))
 629                 t)
 630             nil)
 631         (kill-buffer tmp-buffer)))))
 632
 633 (defun elmo-cache-delete-msg (spec number locked)
 634   (let* ((dir (elmo-cache-get-folder-directory spec))
 635          (file (expand-file-name
 636                 (elmo-cache-number-to-filename spec number) dir)))
 637     ;; return nil if failed.
 638     (elmo-cache-force-delete file locked)))
 639
 640 (defun elmo-cache-read-msg (spec number outbuf &optional set-mark)
 641   (save-excursion
 642     (let* ((dir (elmo-cache-get-folder-directory spec))
 643            (file (expand-file-name
 644                   (elmo-cache-number-to-filename spec number) dir)))
 645       (set-buffer outbuf)
 646       (erase-buffer)
 647       (when (file-exists-p file)
 648         (as-binary-input-file (insert-file-contents file))
 649         (elmo-delete-cr-get-content-type)))))
 650
 651 (defun elmo-cache-delete-msgs (spec msgs)
 652   (let ((locked (elmo-dop-lock-list-load)))
 653     (not (memq nil
 654                (mapcar '(lambda (msg) (elmo-cache-delete-msg spec msg locked))
 655                        msgs)))))
 656
 657 (defun elmo-cache-list-folder (spec); called by elmo-cache-search()
 658   (let ((killed (and elmo-use-killed-list
 659                      (elmo-msgdb-killed-list-load
 660                       (elmo-msgdb-expand-path nil spec))))
 661         numbers)
 662     (setq numbers (elmo-cache-list-folder-subr spec))
 663     (if killed
 664         (delq nil
 665               (mapcar (lambda (number)
 666                         (unless (memq number killed) number))
 667                       numbers))
 668       numbers)))
 669
 670 (defun elmo-cache-max-of-folder (spec)
 671   (elmo-cache-list-folder-subr spec t))
 672
 673 (defun elmo-cache-check-validity (spec validity-file)
 674   t)
 675
 676 (defun elmo-cache-sync-validity (spec validity-file)
 677   t)
 678
 679 (defun elmo-cache-folder-exists-p (spec)
 680   (file-directory-p (elmo-cache-get-folder-directory spec)))
 681
 682 (defun elmo-cache-folder-creatable-p (spec)
 683   nil)
 684
 685 (defun elmo-cache-create-folder (spec)
 686   nil)
 687
 688 (defun elmo-cache-search (spec condition &optional from-msgs)
 689   (let* ((number-alist (elmo-cache-list-folder-subr spec nil t))
 690          (msgs (or from-msgs (mapcar 'car number-alist)))
 691          (num (length msgs))
 692          (i 0) case-fold-search ret-val)
 693     (while msgs
 694       (if (elmo-file-field-condition-match
 695            (expand-file-name
 696             (elmo-msgid-to-cache
 697              (cdr (assq (car msgs) number-alist)))
 698             (elmo-cache-get-folder-directory spec))
 699                                             condition)
 700           (setq ret-val (cons (car msgs) ret-val)))
 701       (when (> num elmo-display-progress-threshold)
 702         (setq i (1+ i))
 703         (elmo-display-progress
 704          'elmo-cache-search "Searching..."
 705          (/ (* i 100) num)))
 706       (setq msgs (cdr msgs)))
 707     (nreverse ret-val)))
 708
 709 ;;; (localdir, maildir, localnews) -> cache
 710 (defun elmo-cache-copy-msgs (dst-spec msgs src-spec
 711                                       &optional loc-alist same-number)
 712   (let ((dst-dir
 713          (elmo-cache-get-folder-directory dst-spec))
 714         (next-num (1+ (car (elmo-cache-list-folder-subr dst-spec t))))
 715         (number-alist
 716          (elmo-msgdb-number-load
 717           (elmo-msgdb-expand-path nil src-spec))))
 718     (if same-number (error "Not implemented"))
 719     (while msgs
 720       (elmo-copy-file
 721        ;; src file
 722        (elmo-call-func src-spec "get-msg-filename" (car msgs) loc-alist)
 723        ;; dst file
 724        (expand-file-name
 725         (elmo-msgid-to-cache
 726          (cdr (assq (if same-number (car msgs) next-num) number-alist)))
 727          dst-dir))
 728       (if (and (setq msgs (cdr msgs))
 729                (not same-number))
 730           (setq next-num (1+ next-num))))
 731     t))
 732
 733 (defun elmo-cache-use-cache-p (spec number)
 734   nil)
 735
 736 (defun elmo-cache-local-file-p (spec number)
 737   t)
 738
 739 (defun elmo-cache-get-msg-filename (spec number &optional loc-alist)
 740   (expand-file-name
 741    (elmo-cache-number-to-filename spec number)
 742    (elmo-cache-get-folder-directory spec)))
 743
 744 (defalias 'elmo-cache-sync-number-alist
 745   'elmo-generic-sync-number-alist)
 746 (defalias 'elmo-cache-list-folder-unread
 747   'elmo-generic-list-folder-unread)
 748 (defalias 'elmo-cache-list-folder-important
 749   'elmo-generic-list-folder-important)
 750 (defalias 'elmo-cache-commit 'elmo-generic-commit)
 751
 752 (provide 'elmo-cache)
 753
 754 ;;; elmo-cache.el ends here