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