elmo/elmo-cache.el

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