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       (setq i (+ i 1))
 206       (elmo-display-progress
 207        'elmo-cache-get-sorted-cache-file-list "Collecting cache info..."
 208        (/ (* i 100) num))
 209       (setq dirs (cdr dirs)))
 210     ret-val))
 211
 212 (defun elmo-cache-expire-by-age (&optional days)
 213   (let ((age (or (and days (int-to-string days))
 214                  (and (interactive-p)
 215                       (read-from-minibuffer
 216                        (format "Enter days (%s): "
 217                                elmo-cache-expire-default-age)))
 218                  (int-to-string elmo-cache-expire-default-age)))
 219         (dirs (directory-files
 220                (expand-file-name elmo-cache-dirname elmo-msgdb-dir)
 221                t "^[^\\.]"))
 222         (locked (elmo-dop-lock-list-load))
 223         (count 0)
 224         curtime)
 225     (if (string= age "")
 226         (setq age elmo-cache-expire-default-age)
 227       (setq age (string-to-int age)))
 228     (setq curtime (current-time))
 229     (setq curtime (+ (* (nth 0 curtime)
 230                         (float 65536)) (nth 1 curtime)))
 231     (while dirs
 232       (let ((files (directory-files (car dirs) t "^[^\\.]"))
 233             (limit-age (* age 86400)))
 234         (while files
 235           (when (> (- curtime (elmo-get-last-accessed-time (car files)))
 236                    limit-age)
 237             (when (elmo-cache-force-delete (car files) locked)
 238               (setq count (+ 1 count))
 239               (message "%d cache file(s) are expired." count)))
 240           (setq files (cdr files))))
 241       (setq dirs (cdr dirs)))))
 242
 243 (defun elmo-cache-save (msgid partial folder number &optional inbuf)
 244   "If partial is non-nil, save current buffer (or INBUF) as partial cache."
 245   (condition-case nil
 246   (save-excursion
 247     (let* ((path (if partial
 248                      (elmo-cache-get-path msgid folder number)
 249                    (elmo-cache-get-path msgid)))
 250            dir tmp-buf)
 251       (when path
 252         (setq dir (directory-file-name (file-name-directory path)))
 253         (if (not (file-exists-p dir))
 254             (elmo-make-directory dir))
 255         (if inbuf (set-buffer inbuf))
 256         (goto-char (point-min))
 257         (as-binary-output-file (write-region (point-min) (point-max)
 258                                              path nil 'no-msg)))))
 259   (error)))
 260
 261 (defun elmo-cache-exists-p (msgid &optional folder number)
 262   "Returns the path if the cache exists."
 263   (save-match-data
 264     (if msgid
 265         (let ((path (elmo-cache-get-path msgid)))
 266           (if (and path
 267                    (file-exists-p path))
 268               (if (and folder
 269                        (file-directory-p path))
 270                   (if (file-exists-p (setq path (expand-file-name
 271                                                  (format "%s@%s"
 272                                                          (or number "")
 273                                                          (elmo-safe-filename
 274                                                           folder))
 275                                                  path)))
 276                       path
 277                     )
 278                 ;; not directory.
 279                 path))))))
 280
 281 (defun elmo-cache-search-all (folder condition from-msgs)
 282   (let* ((number-alist (elmo-msgdb-number-load
 283                         (elmo-msgdb-expand-path folder)))
 284          (nalist number-alist)
 285          (num (length number-alist))
 286          cache-file
 287          ret-val
 288          case-fold-search msg
 289          percent i)
 290     (setq i 0)
 291     (while nalist
 292       (if (and (setq cache-file (elmo-cache-exists-p (cdr (car nalist))
 293                                                      folder
 294                                                      (car (car nalist))))
 295                (elmo-file-field-condition-match cache-file condition))
 296           (setq ret-val (append ret-val (list (caar nalist)))))
 297       (setq i (1+ i))
 298       (setq percent (/ (* i 100) num))
 299       (elmo-display-progress
 300        'elmo-cache-search-all "Searching..."
 301        percent)
 302       (setq nalist (cdr nalist)))
 303     ret-val))
 304
 305 (defun elmo-cache-collect-sub-directories (init dir &optional recursively)
 306   "Collect subdirectories under 'dir'"
 307   (let ((dirs
 308          (delete (expand-file-name elmo-cache-dirname
 309                                    elmo-msgdb-dir)
 310                  (directory-files dir t "^[^\\.]")))
 311         ret-val)
 312     (setq dirs (elmo-delete-if (lambda (x) (not (file-directory-p x))) dirs))
 313     (setq ret-val (append init dirs))
 314     (while (and recursively dirs)
 315       (setq ret-val
 316             (elmo-cache-collect-sub-directories
 317              ret-val
 318              (car dirs) recursively))
 319       (setq dirs (cdr dirs)))
 320     ret-val))
 321
 322 (defun elmo-msgid-to-cache (msgid)
 323   (when (and msgid
 324              (string-match "<\\(.+\\)>$" msgid))
 325     (elmo-replace-msgid-as-filename (elmo-match-string 1 msgid))))
 326
 327 (defun elmo-cache-get-path (msgid &optional folder number)
 328   "Get path for cache file associated with MSGID, FOLDER, and NUMBER."
 329   (if (setq msgid (elmo-msgid-to-cache msgid))
 330       (expand-file-name
 331        (expand-file-name
 332         (if folder
 333             (format "%s/%s/%s@%s"
 334                     (elmo-cache-get-path-subr msgid)
 335                     msgid
 336                     (or number "")
 337                     (elmo-safe-filename folder))
 338           (format "%s/%s"
 339                   (elmo-cache-get-path-subr msgid)
 340                   msgid))
 341         (expand-file-name elmo-cache-dirname
 342                           elmo-msgdb-dir)))))
 343
 344 (defsubst elmo-cache-get-path-subr (msgid)
 345   (let ((chars '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 ?A ?B ?C ?D ?E ?F))
 346         (clist (string-to-char-list msgid))
 347         (sum 0))
 348     (while clist
 349       (setq sum (+ sum (car clist)))
 350       (setq clist (cdr clist)))
 351     (format "%c%c"
 352             (nth (% (/ sum 16) 2) chars)
 353             (nth (% sum 16) chars))))
 354
 355
 356 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 357 ;;; buffer cache module
 358
 359 (defconst elmo-buffer-cache-name " *elmo cache*")
 360
 361 (defvar elmo-buffer-cache nil
 362   "Message cache. (old ... new) order alist with association
 363  ((\"folder\" message \"message-id\") . cache-buffer)")
 364
 365 (defmacro elmo-buffer-cache-buffer-get (entry)
 366   (` (cdr (, entry))))
 367
 368 (defmacro elmo-buffer-cache-folder-get (entry)
 369   (` (car (car (, entry)))))
 370
 371 (defmacro elmo-buffer-cache-message-get (entry)
 372   (` (cdr (car (, entry)))))
 373
 374 (defmacro elmo-buffer-cache-entry-make (fld-msg-id buf)
 375   (` (cons (, fld-msg-id) (, buf))))
 376
 377 (defmacro elmo-buffer-cache-hit (fld-msg-id)
 378   "Return value assosiated with key."
 379   (` (elmo-buffer-cache-buffer-get
 380       (assoc (, fld-msg-id) elmo-buffer-cache))))
 381
 382 (defun elmo-buffer-cache-sort (entry)
 383   (let* ((pointer (cons nil elmo-buffer-cache))
 384          (top pointer))
 385     (while (cdr pointer)
 386       (if (equal (car (cdr pointer)) entry)
 387           (setcdr pointer (cdr (cdr pointer)))
 388         (setq pointer (cdr pointer))))
 389     (setcdr pointer (list entry))
 390     (setq elmo-buffer-cache (cdr top))))
 391
 392 (defun elmo-buffer-cache-add (fld-msg-id)
 393   "Adding (fld-msg-id . buf) to the top of \"elmo-buffer-cache\".
 394 Returning its cache buffer."
 395   (let ((len (length elmo-buffer-cache))
 396         (buf nil))
 397     (if (< len elmo-buffer-cache-size)
 398         (setq buf (get-buffer-create (format "%s%d" elmo-buffer-cache-name len)))
 399       (setq buf (elmo-buffer-cache-buffer-get (nth (1- len) elmo-buffer-cache)))
 400       (setcdr (nthcdr (- len 2) elmo-buffer-cache) nil))
 401     (save-excursion
 402       (set-buffer buf)
 403       (elmo-set-buffer-multibyte nil))
 404     (setq elmo-buffer-cache
 405           (cons (elmo-buffer-cache-entry-make fld-msg-id buf)
 406                 elmo-buffer-cache))
 407     buf))
 408
 409 (defun elmo-buffer-cache-delete ()
 410   "Delete the most recent cache entry."
 411   (let ((buf (elmo-buffer-cache-buffer-get (car elmo-buffer-cache))))
 412     (setq elmo-buffer-cache
 413           (nconc (cdr elmo-buffer-cache)
 414                  (list (elmo-buffer-cache-entry-make nil buf))))))
 415
 416 (defun elmo-buffer-cache-clean-up ()
 417   "A function to flush all decoded messages in cache list."
 418   (interactive)
 419   (let ((n 0) buf)
 420     (while (< n elmo-buffer-cache-size)
 421       (setq buf (concat elmo-buffer-cache-name (int-to-string n)))
 422       (elmo-kill-buffer buf)
 423       (setq n (1+ n))))
 424   (setq elmo-buffer-cache nil))
 425
 426 ;;;
 427 ;;; cache backend by Kenichi OKADA <okada@opaopa.org>
 428 ;;;
 429
 430 (defsubst elmo-cache-get-folder-directory (spec)
 431   (if (file-name-absolute-p (nth 1 spec))
 432       (nth 1 spec) ; already full path.
 433     (expand-file-name (nth 1 spec)
 434                       (expand-file-name elmo-cache-dirname elmo-msgdb-dir))))
 435
 436 (defun elmo-cache-msgdb-expand-path (spec)
 437   (let ((fld-name (nth 1 spec)))
 438     (expand-file-name fld-name
 439                       (expand-file-name "internal/cache"
 440                                         elmo-msgdb-dir))))
 441
 442 (defun elmo-cache-number-to-filename (spec number)
 443   (let ((number-alist
 444          (elmo-cache-list-folder-subr spec nil t)))
 445     (elmo-msgid-to-cache
 446      (cdr (assq number number-alist)))))
 447
 448 (if (boundp 'nemacs-version)
 449     (defsubst elmo-cache-insert-header (file)
 450       "Insert the header of the article (Does not work on nemacs)."
 451       (as-binary-input-file
 452        (insert-file-contents file)))
 453   (defsubst elmo-cache-insert-header (file)
 454     "Insert the header of the article."
 455     (let ((beg 0)
 456           insert-file-contents-pre-hook   ; To avoid autoconv-xmas...
 457           insert-file-contents-post-hook
 458           format-alist)
 459       (when (file-exists-p file)
 460         ;; Read until header separator is found.
 461         (while (and (eq elmo-localdir-header-chop-length
 462                         (nth 1
 463                              (as-binary-input-file
 464                               (insert-file-contents
 465                                file nil beg
 466                                (incf beg elmo-localdir-header-chop-length)))))
 467                     (prog1 (not (search-forward "\n\n" nil t))
 468                       (goto-char (point-max)))))))))
 469
 470 (defsubst elmo-cache-msgdb-create-overview-entity-from-file (number file)
 471   (save-excursion
 472     (let ((tmp-buffer (get-buffer-create " *ELMO Cache Temp*"))
 473           insert-file-contents-pre-hook   ; To avoid autoconv-xmas...
 474           insert-file-contents-post-hook header-end
 475           (attrib (file-attributes file))
 476           ret-val size mtime)
 477       (set-buffer tmp-buffer)
 478       (erase-buffer)
 479       (if (not (file-exists-p file))
 480           ()
 481         (setq size (nth 7 attrib))
 482         (setq mtime (timezone-make-date-arpa-standard
 483                      (current-time-string (nth 5 attrib)) (current-time-zone)))
 484         ;; insert header from file.
 485         (catch 'done
 486           (condition-case nil
 487               (elmo-cache-insert-header file)
 488             (error (throw 'done nil)))
 489           (goto-char (point-min))
 490           (setq header-end
 491                 (if (re-search-forward "\\(^--.*$\\)\\|\\(\n\n\\)" nil t)
 492                     (point)
 493                   (point-max)))
 494           (narrow-to-region (point-min) header-end)
 495           (setq ret-val (elmo-msgdb-create-overview-from-buffer number size mtime))
 496           (kill-buffer tmp-buffer))
 497         ret-val))))
 498
 499 (defun elmo-cache-msgdb-create-as-numlist (spec numlist new-mark
 500                                                    already-mark seen-mark
 501                                                    important-mark seen-list)
 502   (when numlist
 503     (let ((dir (elmo-cache-get-folder-directory spec))
 504           (nalist (elmo-cache-list-folder-subr spec nil t))
 505           overview number-alist mark-alist entity message-id
 506           i percent len num seen gmark)
 507       (setq len (length numlist))
 508       (setq i 0)
 509       (message "Creating msgdb...")
 510       (while numlist
 511         (setq entity
 512               (elmo-cache-msgdb-create-overview-entity-from-file
 513                (car numlist)
 514                (expand-file-name
 515                 (elmo-msgid-to-cache
 516                  (setq message-id (cdr (assq (car numlist) nalist)))) dir)))
 517         (if (null entity)
 518             ()
 519           (setq num (elmo-msgdb-overview-entity-get-number entity))
 520           (setq overview
 521                 (elmo-msgdb-append-element
 522                  overview entity))
 523           (setq number-alist
 524                 (elmo-msgdb-number-add number-alist num message-id))
 525           (setq seen (member message-id seen-list))
 526           (if (setq gmark (or (elmo-msgdb-global-mark-get message-id)
 527                               (if seen
 528                                   nil
 529                                 new-mark)))
 530               (setq mark-alist
 531                     (elmo-msgdb-mark-append
 532                      mark-alist
 533                      num
 534                      gmark))))
 535         (setq i (1+ i))
 536         (setq percent (/ (* i 100) len))
 537         (elmo-display-progress
 538          'elmo-cache-msgdb-create-as-numlist "Creating msgdb..."
 539          percent)
 540         (setq numlist (cdr numlist)))
 541       (message "Creating msgdb...done.")
 542       (list overview number-alist mark-alist))))
 543
 544 (defalias 'elmo-cache-msgdb-create 'elmo-cache-msgdb-create-as-numlist)
 545
 546 (defun elmo-cache-list-folders (spec &optional hierarchy)
 547   (let ((folder (concat "'cache" (nth 1 spec))))
 548     (elmo-cache-list-folders-subr folder hierarchy)))
 549
 550 (defun elmo-cache-list-folders-subr (folder &optional hierarchy)
 551   (let ((case-fold-search t)
 552         folders curdir dirent relpath abspath attr
 553         subprefix subfolder)
 554     (condition-case ()
 555         (progn
 556           (setq curdir
 557                 (expand-file-name
 558                  (nth 1 (elmo-folder-get-spec folder))
 559                  (expand-file-name elmo-cache-dirname elmo-msgdb-dir)))
 560           (if (string-match "^[+=$!]$" folder) ;; localdir, archive, localnews
 561               (setq subprefix folder)
 562             (setq subprefix (concat folder elmo-path-sep)))
 563             ;; include parent
 564             ;(setq folders (list folder)))
 565           (setq dirent (directory-files curdir nil "^[01][0-9A-F]$"))
 566           (catch 'done
 567            (while dirent
 568             (setq relpath (car dirent))
 569             (setq dirent (cdr dirent))
 570             (setq abspath (expand-file-name relpath curdir))
 571             (and
 572              (eq (nth 0 (setq attr (file-attributes abspath))) t)
 573              (setq subfolder (concat subprefix relpath))
 574              (setq folders (nconc folders (list subfolder))))))
 575           folders)
 576       (file-error folders))))
 577
 578 (defsubst elmo-cache-list-folder-subr (spec &optional nonsort nonalist)
 579   (let* ((dir (elmo-cache-get-folder-directory spec))
 580          (flist (mapcar 'file-name-nondirectory
 581                         (elmo-delete-if 'file-directory-p
 582                                         (directory-files
 583                                          dir t "^[^@]+@[^@]+$" t))))
 584          (folder (concat "'cache/" (nth 1 spec)))
 585          (number-alist (or (elmo-msgdb-number-load
 586                             (elmo-msgdb-expand-path folder))
 587                            (list nil)))
 588          nlist)
 589     (setq nlist
 590           (mapcar '(lambda (filename)
 591                      (elmo-cache-filename-to-number filename number-alist))
 592                   flist))
 593     (if nonalist
 594         number-alist
 595       (if nonsort
 596           (cons (or (elmo-max-of-list nlist) 0) (length nlist))
 597         (sort nlist '<)))))
 598
 599 (defsubst elmo-cache-filename-to-number (filename number-alist)
 600   (let* ((msgid (elmo-cache-to-msgid filename))
 601          number)
 602     (or (car (rassoc msgid number-alist))
 603         (prog1
 604             (setq number (+ (or (caar (last number-alist))
 605                                 0) 1))
 606           (if (car number-alist)
 607               (nconc number-alist
 608                      (list (cons number msgid)))
 609             (setcar number-alist (cons number msgid)))))))
 610
 611 (defun elmo-cache-append-msg (spec string message-id &optional msg no-see)
 612   (let ((dir (elmo-cache-get-folder-directory spec))
 613         (tmp-buffer (get-buffer-create " *ELMO Temp buffer*"))
 614         filename)
 615     (save-excursion
 616       (set-buffer tmp-buffer)
 617       (erase-buffer)
 618       (setq filename (expand-file-name (elmo-msgid-to-cache message-id) dir))
 619       (unwind-protect
 620           (if (file-writable-p filename)
 621               (progn
 622                 (insert string)
 623                 (as-binary-output-file
 624                  (write-region (point-min) (point-max) filename nil 'no-msg))
 625                 t)
 626             nil)
 627         (kill-buffer tmp-buffer)))))
 628
 629 (defun elmo-cache-delete-msg (spec number locked)
 630   (let* ((dir (elmo-cache-get-folder-directory spec))
 631          (file (expand-file-name
 632                 (elmo-cache-number-to-filename spec number) dir)))
 633     ;; return nil if failed.
 634     (elmo-cache-force-delete file locked)))
 635
 636 (defun elmo-cache-read-msg (spec number outbuf &optional set-mark)
 637   (save-excursion
 638     (let* ((dir (elmo-cache-get-folder-directory spec))
 639            (file (expand-file-name
 640                   (elmo-cache-number-to-filename spec number) dir)))
 641       (set-buffer outbuf)
 642       (erase-buffer)
 643       (when (file-exists-p file)
 644         (as-binary-input-file (insert-file-contents file))
 645         (elmo-delete-cr-get-content-type)))))
 646
 647 (defun elmo-cache-delete-msgs (spec msgs)
 648   (let ((locked (elmo-dop-lock-list-load)))
 649     (not (memq nil
 650                (mapcar '(lambda (msg) (elmo-cache-delete-msg spec msg locked))
 651                        msgs)))))
 652
 653 (defun elmo-cache-list-folder (spec); called by elmo-cache-search()
 654   (elmo-cache-list-folder-subr spec))
 655
 656 (defun elmo-cache-max-of-folder (spec)
 657   (elmo-cache-list-folder-subr spec t))
 658
 659 (defun elmo-cache-check-validity (spec validity-file)
 660   t)
 661
 662 (defun elmo-cache-sync-validity (spec validity-file)
 663   t)
 664
 665 (defun elmo-cache-folder-exists-p (spec)
 666   (file-directory-p (elmo-cache-get-folder-directory spec)))
 667
 668 (defun elmo-cache-folder-creatable-p (spec)
 669   nil)
 670
 671 (defun elmo-cache-create-folder (spec)
 672   nil)
 673
 674 (defun elmo-cache-search (spec condition &optional from-msgs)
 675   (let* ((number-alist (elmo-cache-list-folder-subr spec nil t))
 676          (msgs (or from-msgs (mapcar 'car number-alist)))
 677          (num (length msgs))
 678          (i 0) case-fold-search ret-val)
 679     (while msgs
 680       (if (elmo-file-field-condition-match
 681            (expand-file-name
 682             (elmo-msgid-to-cache
 683              (cdr (assq (car msgs) number-alist)))
 684             (elmo-cache-get-folder-directory spec))
 685                                             condition)
 686           (setq ret-val (cons (car msgs) ret-val)))
 687       (setq i (1+ i))
 688       (elmo-display-progress
 689        'elmo-cache-search "Searching..."
 690        (/ (* i 100) num))
 691       (setq msgs (cdr msgs)))
 692     (nreverse ret-val)))
 693
 694 ;;; (localdir, maildir, localnews) -> cache
 695 (defun elmo-cache-copy-msgs (dst-spec msgs src-spec
 696                                       &optional loc-alist same-number)
 697   (let ((dst-dir
 698          (elmo-cache-get-folder-directory dst-spec))
 699         (next-num (1+ (car (elmo-cache-list-folder-subr dst-spec t))))
 700         (number-alist
 701          (elmo-msgdb-number-load
 702           (elmo-msgdb-expand-path nil src-spec))))
 703     (if same-number (error "Not implemented"))
 704     (while msgs
 705       (elmo-copy-file
 706        ;; src file
 707        (elmo-call-func src-spec "get-msg-filename" (car msgs) loc-alist)
 708        ;; dst file
 709        (expand-file-name
 710         (elmo-msgid-to-cache
 711          (cdr (assq (if same-number (car msgs) next-num) number-alist)))
 712          dst-dir))
 713       (if (and (setq msgs (cdr msgs))
 714                (not same-number))
 715           (setq next-num (1+ next-num))))
 716     t))
 717
 718 (defun elmo-cache-use-cache-p (spec number)
 719   nil)
 720
 721 (defun elmo-cache-local-file-p (spec number)
 722   t)
 723
 724 (defun elmo-cache-get-msg-filename (spec number &optional loc-alist)
 725   (expand-file-name
 726    (elmo-cache-number-to-filename spec number)
 727    (elmo-cache-get-folder-directory spec)))
 728
 729 (defalias 'elmo-cache-sync-number-alist
 730   'elmo-generic-sync-number-alist)
 731 (defalias 'elmo-cache-list-folder-unread
 732   'elmo-generic-list-folder-unread)
 733 (defalias 'elmo-cache-list-folder-important
 734   'elmo-generic-list-folder-important)
 735 (defalias 'elmo-cache-commit 'elmo-generic-commit)
 736
 737 (provide 'elmo-cache)
 738
 739 ;;; elmo-cache.el ends here