cgit.sxemacs.org Git - packages/blob - xemacs-packages/mew/mew/mew-cache.el

   1 ;;; mew-cache.el --- Cache management for Mew
   2
   3 ;; Author:  Kazu Yamamoto <Kazu@Mew.org>
   4 ;; Created: Mar 23, 1997
   5 ;; Revised: Aug 31, 1999
   6
   7 ;;; Code:
   8
   9 (defconst mew-cache-version "mew-cache.el version 0.08")
  10
  11 (require 'mew)
  12
  13 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  14 ;;
  15 ;;  Prepare new message --- caching
  16 ;;
  17
  18 (defmacro mew-cache-decode-syntax (buf)
  19   (` (save-excursion
  20        (set-buffer (, buf))
  21        mew-decode-syntax)))
  22
  23 (defmacro mew-cache-decode-error (buf)
  24   (` (save-excursion
  25        (set-buffer (, buf))
  26        mew-decode-error)))
  27
  28 (defmacro mew-cache-multi-form (buf)
  29   (` (save-excursion
  30        (set-buffer (, buf))
  31        mew-syntax-multi-form)))
  32
  33 (defmacro mew-cache-icon-spec (buf)
  34   (` (save-excursion
  35        (set-buffer (, buf))
  36        mew-syntax-icon-spec)))
  37
  38 (defmacro mew-cache-privacy-result (buf)
  39   (` (save-excursion
  40        (set-buffer (, buf))
  41        mew-syntax-privacy-result)))
  42
  43 (defvar mew-cache nil
  44   "A list of decoded messages cache.
  45 The (new ... old) order of ((\"+folder\" . \"message\") . cache-buffer)")
  46
  47 (defmacro mew-cache-buffer-get (entry)
  48   (` (cdr (, entry))))
  49
  50 (defmacro mew-cache-entry-make (fld-msg buf)
  51   (` (cons (, fld-msg) (, buf))))
  52
  53 (defmacro mew-cache-hit (fld-msg)
  54   "Return value associated with key."
  55   (` (mew-cache-buffer-get (assoc (, fld-msg) mew-cache))))
  56
  57 (defun mew-cache-sort (entry)
  58   (setq mew-cache (cons entry (delete entry mew-cache))))
  59
  60 (defun mew-cache-add (fld-msg)
  61   "Adding (fld-msg . buf) to the top of 'mew-cache'.
  62 Returning its cache buffer."
  63   (let ((len (length mew-cache))
  64         buf)
  65     (if (< len mew-cache-size)
  66         (setq buf (get-buffer-create (format "%s%d" mew-buffer-cache len)))
  67       (setq buf (mew-cache-buffer-get (nth (1- len) mew-cache)))
  68       (setcdr (nthcdr (- len 2) mew-cache) nil))
  69     (setq mew-cache (cons (mew-cache-entry-make fld-msg buf) mew-cache))
  70     buf))
  71
  72 (defun mew-cache-delete ()
  73   "Delete the most recent cache entry."
  74   (let ((buf (mew-cache-buffer-get (car mew-cache))))
  75     ;; must preserve the buffer itself because the buffer creation
  76     ;; depends on the length of mew-cache.
  77     (setq mew-cache (nconc (cdr mew-cache)
  78                            (list (mew-cache-entry-make nil buf))))))
  79
  80
  81 (defmacro mew-cache-attribute-get (file)
  82   (` (list (mew-file-get-time (, file)) (mew-file-get-size (, file)))))
  83
  84 (defun mew-cache-message (fld msg &optional force)
  85   (let* ((fld-msg (cons fld msg))
  86          (hit (mew-cache-hit fld-msg))
  87          (file (mew-expand-folder fld msg))
  88          (decode nil))
  89     (if hit
  90         (save-excursion
  91           (mew-cache-sort (mew-cache-entry-make fld-msg hit))
  92           (set-buffer hit)
  93           (if (or (and (mew-folder-localp fld)
  94                        (not (equal mew-cache-attribute ;; buffer-local
  95                                    (mew-cache-attribute-get file))))
  96                   (and force mew-decode-not-decrypted)
  97                   (and force mew-decode-error))
  98               ;; cache is invalid
  99               (setq decode t)))
 100       (setq hit (mew-cache-add fld-msg))
 101       (setq decode t))
 102     (if decode
 103         (condition-case nil
 104             (save-excursion
 105               (set-buffer hit)
 106               ;; in cache buffer
 107               (setq mew-cache-folder fld)
 108               (setq mew-cache-message-number msg)
 109               (if (mew-folder-localp fld)
 110                   (setq mew-cache-attribute (mew-cache-attribute-get file))
 111                 (setq mew-cache-attribute nil))
 112               (if force
 113                   (let ((mew-header-max-length nil)
 114                         (mew-header-max-depth nil))
 115                     (mew-decode fld msg))
 116                 (mew-decode fld msg)))
 117           (quit
 118            (mew-cache-delete)
 119            (message "MIME decoding for %s/%s is quitted." fld msg)
 120            nil))) ;; will not be used
 121     hit)) ;; retrun value
 122
 123 (defun mew-cache-clean-up ()
 124   "A function to flush all decoded messages in cache list."
 125   (interactive)
 126   (mew-decode-syntax-delete)
 127   (let ((n 0))
 128     (while (< n mew-cache-size)
 129       (mew-kill-buffer (format "%s%d" mew-buffer-cache n))
 130       (setq n (1+ n))))
 131   (mew-current-set 'cache nil)
 132   (mew-current-set 'message nil)
 133   (mew-current-set 'part nil)
 134   (setq mew-cache nil))
 135
 136 (fset 'mew-cache-flush (symbol-function 'mew-cache-clean-up))
 137
 138 (provide 'mew-cache)
 139
 140 ;;; Copyright Notice:
 141
 142 ;; Copyright (C) 1997, 1998, 1999 Mew developing team.
 143 ;; All rights reserved.
 144
 145 ;; Redistribution and use in source and binary forms, with or without
 146 ;; modification, are permitted provided that the following conditions
 147 ;; are met:
 148 ;;
 149 ;; 1. Redistributions of source code must retain the above copyright
 150 ;;    notice, this list of conditions and the following disclaimer.
 151 ;; 2. Redistributions in binary form must reproduce the above copyright
 152 ;;    notice, this list of conditions and the following disclaimer in the
 153 ;;    documentation and/or other materials provided with the distribution.
 154 ;; 3. Neither the name of the team nor the names of its contributors
 155 ;;    may be used to endorse or promote products derived from this software
 156 ;;    without specific prior written permission.
 157 ;;
 158 ;; THIS SOFTWARE IS PROVIDED BY THE TEAM AND CONTRIBUTORS ``AS IS'' AND
 159 ;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 160 ;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
 161 ;; PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE TEAM OR CONTRIBUTORS BE
 162 ;; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
 163 ;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
 164 ;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
 165 ;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
 166 ;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
 167 ;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
 168 ;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 169
 170 ;;; mew-cache.el ends here