modb-entity-handler.
(wl-summary-save-view-cache): Don't cause an error when dir is nil.
* modb-entity.el: New file (again).
* modb.el (toplevel): Require modb-entity.
(elmo-msgdb-message-entity-handler): New method.
* modb-standard.el (modb-standard-entity-id): Use
elmo-message-entity-handler.
(modb-standard-load-entity): Ditto.
(elmo-msgdb-append-entity): Ditto.
(elmo-msgdb-create-message-entity-from-buffer): Ditto.
* modb-legacy.el (elmo-msgdb-get-decoded-cache,
elmo-msgdb-decoded-cache-hashtb,
(modb-legacy-make-message-entity,
elmo-msgdb-make-message-entity,
elmo-msgdb-create-message-entity-from-buffer,
elmo-msgdb-message-entity-number,
elmo-msgdb-message-entity-set-number,
elmo-msgdb-message-entity-field,
elmo-msgdb-message-entity-set-field,
elmo-msgdb-copy-message-entity,
elmo-msgdb-match-condition-internal,
elmo-msgdb-match-condition-primitive): Moved to modb-entity.el.
* elmo.el (elmo-message-copy-entity): Use elmo-message-entity-handler.
(elmo-message-entity-set-number): Ditto.
(elmo-message-entity-field): Ditto.
(elmo-message-entity-set-field): Ditto.
* elmo-shimbun.el (elmo-shimbun-msgdb-create-entity): Ditto.
* elmo-sendlog.el (elmo-folder-msgdb-create): Ditto.
* elmo-pop3.el (elmo-pop3-msgdb-create-message): Ditto.
* elmo-nntp.el (elmo-nntp-create-msgdb-from-overview-string): Ditto.
(elmo-nntp-msgdb-create-message): Ditto.
* elmo-nmz.el (elmo-nmz-msgdb-create-entity): Ditto.
(elmo-folder-msgdb-create): Add unread flag.
* elmo-maildir.el (elmo-folder-msgdb-create): Ditto.
* elmo-localdir.el (elmo-localdir-msgdb-create-entity): Ditto.
* elmo-imap4.el (elmo-imap4-fetch-callback-1): Ditto.
* elmo-cache.el (elmo-folder-msgdb-create): Ditto.
* elmo-archive.el (elmo-archive-msgdb-create-entity-subr): Call
elmo-msgdb-messge-entity-handler.
* elmo-version.el (elmo-version): Up to 2.11.17.
* WL-ELS (ELMO-MODULES): Added modb-entity (again).
+2003-09-22 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * WL-ELS (ELMO-MODULES): Added modb-entity (again).
+
2003-09-21 Yuuichi Teranishi <teranisi@gohome.org>
* WL-ELS (ELMO-MODULES): Removed modb-entity.
elmo-archive elmo-pipe elmo-cache
elmo-internal elmo-flag elmo-sendlog
elmo-dop elmo-nmz elmo-split
- modb modb-legacy modb-standard
+ modb modb-entity modb-legacy modb-standard
))
\f
2003-09-22 Yuuichi Teranishi <teranisi@gohome.org>
+ * modb-entity.el: New file (again).
+
+ * modb.el (toplevel): Require modb-entity.
+ (elmo-msgdb-message-entity-handler): New method.
+
+ * modb-standard.el (modb-standard-entity-id): Use
+ elmo-message-entity-handler.
+ (modb-standard-load-entity): Ditto.
+ (elmo-msgdb-append-entity): Ditto.
+ (elmo-msgdb-create-message-entity-from-buffer): Ditto.
+
+ * modb-legacy.el (elmo-msgdb-get-decoded-cache,
+ elmo-msgdb-decoded-cache-hashtb,
+ (modb-legacy-make-message-entity,
+ elmo-msgdb-make-message-entity,
+ elmo-msgdb-create-message-entity-from-buffer,
+ elmo-msgdb-message-entity-number,
+ elmo-msgdb-message-entity-set-number,
+ elmo-msgdb-message-entity-field,
+ elmo-msgdb-message-entity-set-field,
+ elmo-msgdb-copy-message-entity,
+ elmo-msgdb-match-condition-internal,
+ elmo-msgdb-match-condition-primitive): Moved to modb-entity.el.
+
+ * elmo.el (elmo-message-copy-entity): Use elmo-message-entity-handler.
+ (elmo-message-entity-set-number): Ditto.
+ (elmo-message-entity-field): Ditto.
+ (elmo-message-entity-set-field): Ditto.
+
+ * elmo-shimbun.el (elmo-shimbun-msgdb-create-entity): Ditto.
+
+ * elmo-sendlog.el (elmo-folder-msgdb-create): Ditto.
+
+ * elmo-pop3.el (elmo-pop3-msgdb-create-message): Ditto.
+
+ * elmo-nntp.el (elmo-nntp-create-msgdb-from-overview-string): Ditto.
+ (elmo-nntp-msgdb-create-message): Ditto.
+
+ * elmo-nmz.el (elmo-nmz-msgdb-create-entity): Ditto.
+ (elmo-folder-msgdb-create): Add unread flag.
+
+ * elmo-maildir.el (elmo-folder-msgdb-create): Ditto.
+
+ * elmo-localdir.el (elmo-localdir-msgdb-create-entity): Ditto.
+
+ * elmo-imap4.el (elmo-imap4-fetch-callback-1): Ditto.
+
+ * elmo-cache.el (elmo-folder-msgdb-create): Ditto.
+
+ * elmo-archive.el (elmo-archive-msgdb-create-entity-subr): Call
+ elmo-msgdb-messge-entity-handler.
* elmo-version.el (elmo-version): Up to 2.11.17.
2003-09-22 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
(setq header-end (point))
(setq header-end (point-max)))
(narrow-to-region (point-min) header-end)
- (elmo-msgdb-create-message-entity-from-buffer msgdb number)))
+ (elmo-msgdb-create-message-entity-from-buffer
+ (elmo-msgdb-message-entity-handler msgdb) number)))
;; verrrry slow!!
(defsubst elmo-archive-msgdb-create-entity (msgdb
(while numbers
(setq entity
(elmo-msgdb-create-message-entity-from-file
- new-msgdb
+ (elmo-msgdb-message-entity-handler new-msgdb)
(car numbers) (elmo-message-file-name folder (car numbers))))
(when entity
(setq message-id (elmo-message-entity-field entity 'message-id)
(while (search-forward "\r\n" nil t)
(replace-match "\n"))
(elmo-msgdb-create-message-entity-from-buffer
- (elmo-folder-msgdb-internal (cdr app-data))
+ (elmo-msgdb-message-entity-handler
+ (elmo-folder-msgdb-internal (cdr app-data)))
(elmo-imap4-response-value element 'uid)
:size (elmo-imap4-response-value element 'rfc822size)))
(elmo-imap4-response-value element 'flags)
(defun elmo-localdir-msgdb-create-entity (msgdb dir number)
(elmo-msgdb-create-message-entity-from-file
- msgdb number (expand-file-name (int-to-string number) dir)))
+ (elmo-msgdb-message-entity-handler msgdb)
+ number (expand-file-name (int-to-string number) dir)))
(luna-define-method elmo-folder-msgdb-create ((folder elmo-localdir-folder)
numbers
(setq location (elmo-map-message-location folder number))
(setq entity
(elmo-msgdb-create-message-entity-from-file
- new-msgdb
+ (elmo-msgdb-message-entity-handler new-msgdb)
number
(elmo-maildir-message-file-name folder location)))
(when entity
(let ((location (expand-file-name (elmo-map-message-location folder number)))
entity uid)
(setq entity (elmo-msgdb-create-message-entity-from-file
- msgdb number location))
+ (elmo-msgdb-message-entity-handler msgdb) number location))
(unless (or (> (length (elmo-message-entity-field entity 'to)) 0)
(> (length (elmo-message-entity-field entity 'cc)) 0)
(not (string= (elmo-message-entity-field entity 'subject)
(elmo-nmz-msgdb-create-entity
new-msgdb folder (car numlist)))
(when entity
- (elmo-msgdb-append-entity new-msgdb entity '(new)))
+ (elmo-msgdb-append-entity new-msgdb entity '(new unread)))
(when (> num elmo-display-progress-threshold)
(setq i (1+ i))
(setq percent (/ (* i 100) num))
(setq extra (cons (cons ext field) extra))))
(setq extras (cdr extras)))
(setq entity (elmo-msgdb-make-message-entity
- new-msgdb
+ (elmo-msgdb-message-entity-handler new-msgdb)
:message-id (aref ov-entity 4)
:number num
:references (elmo-msgdb-get-last-message-id
(narrow-to-region beg (point))
(setq entity
(elmo-msgdb-create-message-entity-from-buffer
- new-msgdb num))
+ (elmo-msgdb-message-entity-handler new-msgdb) num))
(when entity
(setq message-id
(elmo-message-entity-field entity 'message-id))
(narrow-to-region beg (point))
(setq entity
(elmo-msgdb-create-message-entity-from-buffer
- new-msgdb (car numlist)))
+ (elmo-msgdb-message-entity-handler new-msgdb)
+ (car numlist)))
(setq numlist (cdr numlist))
(when entity
(with-current-buffer (process-buffer process)
(while numbers
(setq entity
(elmo-msgdb-create-message-entity-from-file
- new-msgdb (car numbers)
+ (elmo-msgdb-message-entity-handler new-msgdb) (car numbers)
(elmo-message-file-name folder (car numbers))))
(if (null entity)
(elmo-folder-set-killed-list-internal
(elmo-shimbun-folder-shimbun-internal folder)
header)
(setq ov (elmo-msgdb-create-message-entity-from-buffer
- (elmo-folder-msgdb-internal folder) number))
+ (elmo-msgdb-message-entity-handler
+ (elmo-folder-msgdb-internal folder)) number))
(elmo-message-entity-set-field
ov
'xref (shimbun-header-xref header)))
(elmo-msgdb-unset-flag (elmo-folder-msgdb folder) number 'cached)))
(defun elmo-message-copy-entity (entity)
- (elmo-msgdb-copy-message-entity (elmo-message-entity-db entity)
+ (elmo-msgdb-copy-message-entity (elmo-message-entity-handler entity)
entity))
(luna-define-generic elmo-message-entity (folder key)
,@form))
(defmacro elmo-message-entity-number (entity)
- `(elmo-msgdb-message-entity-number (elmo-message-entity-db ,entity)
+ `(elmo-msgdb-message-entity-number (elmo-message-entity-handler ,entity)
,entity))
(defmacro elmo-message-entity-set-number (entity number)
- `(elmo-msgdb-message-entity-set-number (elmo-message-entity-db ,entity)
+ `(elmo-msgdb-message-entity-set-number (elmo-message-entity-handler ,entity)
,entity
,number))
FIELD is the symbol of the field name.
if optional DECODE is non-nil, returned value is decoded."
(elmo-msgdb-message-entity-field
- (elmo-message-entity-db entity)
+ (elmo-message-entity-handler entity)
entity field decode))
(defun elmo-message-entity-set-field (entity field value)
FIELD is the symbol of the field name.
VALUE is the field value (raw)."
(elmo-msgdb-message-entity-set-field
- (elmo-message-entity-db entity)
+ (elmo-message-entity-handler entity)
entity field value))
(luna-define-generic elmo-folder-count-flags (folder)
--- /dev/null
+;;; modb-entity.el --- Message Entity Interface.
+
+;; Copyright (C) 2003 Yuuichi Teranishi <teranisi@gohome.org>
+
+;; Author: Yuuichi Teranishi <teranisi@gohome.org>
+;; Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+;; Keywords: mail, net news
+
+;; This file is part of ELMO (Elisp Library for Message Orchestration).
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+;;
+
+;;; Commentary:
+;;
+;; Message entity handling.
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(require 'luna)
+(require 'elmo-vars)
+(require 'elmo-util)
+
+(eval-and-compile (luna-define-class modb-entity-handler))
+
+(defcustom modb-entity-default-handler 'modb-legacy-entity-handler
+ "Default entity handler."
+ :type 'symbol
+ :group 'elmo)
+
+(defvar modb-entity-default-cache-internal nil)
+
+(defun elmo-message-entity-handler (&optional entity)
+ "Get modb entity handler instance which corresponds to the ENTITY."
+ (if (and entity
+ (not (stringp (car entity))))
+ (car entity)
+ (or modb-entity-default-cache-internal
+ (setq modb-entity-default-cache-internal
+ (luna-make-entity modb-entity-default-handler)))))
+
+(luna-define-generic elmo-msgdb-make-message-entity (handler &rest args)
+ "Make a message entity using HANDLER.")
+
+(luna-define-generic elmo-msgdb-message-entity-number (handler entity)
+ "Number of the ENTITY.")
+
+(luna-define-generic elmo-msgdb-message-entity-set-number (handler
+ entity number)
+ "Set number of the ENTITY.")
+
+(luna-define-generic elmo-msgdb-message-entity-field (handler
+ entity field
+ &optional decode)
+ "Retrieve field value of the message entity.
+HANDLER is the message entity handler.
+ENTITY is the message entity structure.
+FIELD is a symbol of the field.
+If optional DECODE is no-nil, the field value is decoded.")
+
+(luna-define-generic elmo-msgdb-message-entity-set-field (handler
+ entity field value)
+ "Set the field value of the message entity.
+HANDLER is the message entity handler.
+ENTITY is the message entity structure.
+FIELD is a symbol of the field.
+VALUE is the field value to set.")
+
+(luna-define-generic elmo-msgdb-copy-message-entity (handler entity)
+ "Copy message entity.
+HANDLER is the message entity handler.
+ENTITY is the message entity structure.")
+
+(luna-define-generic elmo-msgdb-create-message-entity-from-file (handler
+ number
+ file)
+ "Create message entity from file.
+HANDLER is the message entity handler.
+NUMBER is the number of the newly created message entity.
+FILE is the message file.")
+
+(luna-define-generic elmo-msgdb-create-message-entity-from-buffer (handler
+ number
+ &rest args)
+ "Create message entity from current buffer.
+HANDLER is the message entity handler.
+NUMBER is the number of the newly created message entity.
+Rest of the ARGS is a plist of message entity field for initial value.
+Header region is supposed to be narrowed.")
+
+;; Transitional interface.
+(luna-define-generic elmo-msgdb-match-condition-internal (handler
+ condition
+ entity
+ flags
+ numbers)
+ "Return non-nil when the entity matches the condition.")
+
+;; Generic implementation.
+(luna-define-method elmo-msgdb-create-message-entity-from-file
+ ((handler modb-entity-handler) number file)
+ (let (insert-file-contents-pre-hook ; To avoid autoconv-xmas...
+ insert-file-contents-post-hook header-end
+ (attrib (file-attributes file))
+ ret-val size mtime)
+ (with-temp-buffer
+ (if (not (file-exists-p file))
+ ()
+ (setq size (nth 7 attrib))
+ (setq mtime (timezone-make-date-arpa-standard
+ (current-time-string (nth 5 attrib)) (current-time-zone)))
+ ;; insert header from file.
+ (catch 'done
+ (condition-case nil
+ (elmo-msgdb-insert-file-header file)
+ (error (throw 'done nil)))
+ (goto-char (point-min))
+ (setq header-end
+ (if (re-search-forward "\\(^--.*$\\)\\|\\(\n\n\\)" nil t)
+ (point)
+ (point-max)))
+ (narrow-to-region (point-min) header-end)
+ (elmo-msgdb-create-message-entity-from-buffer
+ handler number :size size :date mtime))))))
+
+(luna-define-method elmo-msgdb-make-message-entity ((handler
+ modb-entity-handler)
+ args)
+ (cons handler args))
+
+(luna-define-method elmo-msgdb-message-entity-field ((handler
+ modb-entity-handler)
+ entity field
+ &optional decode)
+ (plist-get (cdr entity) (intern (concat ":" (symbol-name field)))))
+
+(luna-define-method elmo-msgdb-message-entity-number ((handler
+ modb-entity-handler)
+ entity)
+ (plist-get (cdr entity) :number))
+
+;; Legacy implementation.
+(eval-and-compile (luna-define-class modb-legacy-entity-handler
+ (modb-entity-handler)))
+
+;;
+;; mime decode cache
+;;
+(defvar elmo-msgdb-decoded-cache-hashtb nil)
+(make-variable-buffer-local 'elmo-msgdb-decoded-cache-hashtb)
+
+(defsubst elmo-msgdb-get-decoded-cache (string)
+ (if elmo-use-decoded-cache
+ (let ((hashtb (or elmo-msgdb-decoded-cache-hashtb
+ (setq elmo-msgdb-decoded-cache-hashtb
+ (elmo-make-hash 2048))))
+ decoded)
+ (or (elmo-get-hash-val string hashtb)
+ (progn
+ (elmo-set-hash-val
+ string
+ (setq decoded
+ (decode-mime-charset-string string elmo-mime-charset))
+ hashtb)
+ decoded)))
+ (decode-mime-charset-string string elmo-mime-charset)))
+
+(defsubst modb-legacy-make-message-entity (args)
+ "Make an message entity."
+ (cons (plist-get args :message-id)
+ (vector (plist-get args :number)
+ (plist-get args :references)
+ (plist-get args :from)
+ (plist-get args :subject)
+ (plist-get args :date)
+ (plist-get args :to)
+ (plist-get args :cc)
+ (plist-get args :size)
+ (plist-get args :extra))))
+
+(luna-define-method elmo-msgdb-make-message-entity
+ ((handler modb-legacy-entity-handler) args)
+ (modb-legacy-make-message-entity args))
+
+(luna-define-method elmo-msgdb-create-message-entity-from-buffer
+ ((handler modb-legacy-entity-handler) number args)
+ (let ((extras elmo-msgdb-extra-fields)
+ (default-mime-charset default-mime-charset)
+ entity message-id references from subject to cc date
+ extra field-body charset size)
+ (save-excursion
+ (setq entity (modb-legacy-make-message-entity args))
+ (elmo-set-buffer-multibyte default-enable-multibyte-characters)
+ (setq message-id (elmo-msgdb-get-message-id-from-buffer))
+ (and (setq charset (cdr (assoc "charset" (mime-read-Content-Type))))
+ (setq charset (intern-soft charset))
+ (setq default-mime-charset charset))
+ (setq references
+ (or (elmo-msgdb-get-last-message-id
+ (elmo-field-body "in-reply-to"))
+ (elmo-msgdb-get-last-message-id
+ (elmo-field-body "references")))
+ from (elmo-replace-in-string
+ (elmo-mime-string (or (elmo-field-body "from")
+ elmo-no-from))
+ "\t" " ")
+ subject (elmo-replace-in-string
+ (elmo-mime-string (or (elmo-field-body "subject")
+ elmo-no-subject))
+ "\t" " ")
+ date (elmo-field-body "date")
+ to (mapconcat 'identity (elmo-multiple-field-body "to") ",")
+ cc (mapconcat 'identity (elmo-multiple-field-body "cc") ","))
+ (unless (elmo-msgdb-message-entity-field handler entity 'size)
+ (if (setq size (elmo-field-body "content-length"))
+ (setq size (string-to-int size))
+ (setq size 0)))
+ (while extras
+ (if (setq field-body (elmo-field-body (car extras)))
+ (elmo-msgdb-message-entity-set-field
+ handler entity (intern (downcase (car extras))) field-body))
+ (setq extras (cdr extras)))
+ (dolist (field '(message-id number references from subject
+ date to cc size))
+ (when (symbol-value field)
+ (elmo-msgdb-message-entity-set-field
+ handler entity field (symbol-value field))))
+ entity)))
+
+(luna-define-method elmo-msgdb-message-entity-number
+ ((handler modb-legacy-entity-handler) entity)
+ (and entity (aref (cdr entity) 0)))
+
+(luna-define-method elmo-msgdb-message-entity-set-number
+ ((handler modb-legacy-entity-handler) entity number)
+ (and entity (aset (cdr entity) 0 number))
+ entity)
+
+(luna-define-method elmo-msgdb-message-entity-field
+ ((handler modb-legacy-entity-handler) entity field &optional decode)
+ (and entity
+ (let ((field-value
+ (case field
+ (to (aref (cdr entity) 5))
+ (cc (aref (cdr entity) 6))
+ (date (aref (cdr entity) 4))
+ (subject (aref (cdr entity) 3))
+ (from (aref (cdr entity) 2))
+ (message-id (car entity))
+ (references (aref (cdr entity) 1))
+ (size (aref (cdr entity) 7))
+ (t (cdr (assoc (symbol-name field) (aref (cdr entity) 8)))))))
+ (if (and decode (memq field '(from subject)))
+ (elmo-msgdb-get-decoded-cache field-value)
+ field-value))))
+
+(luna-define-method elmo-msgdb-message-entity-set-field
+ ((handler modb-legacy-entity-handler) entity field value)
+ (and entity
+ (case field
+ (number (aset (cdr entity) 0 value))
+ (to (aset (cdr entity) 5 value))
+ (cc (aset (cdr entity) 6 value))
+ (date (aset (cdr entity) 4 value))
+ (subject (aset (cdr entity) 3 value))
+ (from (aset (cdr entity) 2 value))
+ (message-id (setcar entity value))
+ (references (aset (cdr entity) 1 value))
+ (size (aset (cdr entity) 7 value))
+ (t
+ (let ((extras (and entity (aref (cdr entity) 8)))
+ extra)
+ (if (setq extra (assoc (symbol-name field) extras))
+ (setcdr extra value)
+ (aset (cdr entity) 8 (cons (cons (symbol-name field)
+ value) extras))))))))
+
+(luna-define-method elmo-msgdb-copy-message-entity
+ ((handler modb-legacy-entity-handler) entity)
+ (cons (car entity)
+ (copy-sequence (cdr entity))))
+
+(luna-define-method elmo-msgdb-match-condition-internal
+ ((handler modb-legacy-entity-handler) condition entity flags numbers)
+ (cond
+ ((vectorp condition)
+ (elmo-msgdb-match-condition-primitive condition entity flags numbers))
+ ((eq (car condition) 'and)
+ (let ((lhs (elmo-msgdb-match-condition-internal handler
+ (nth 1 condition)
+ entity flags numbers)))
+ (cond
+ ((elmo-filter-condition-p lhs)
+ (let ((rhs (elmo-msgdb-match-condition-internal
+ handler (nth 2 condition) entity flags numbers)))
+ (cond ((elmo-filter-condition-p rhs)
+ (list 'and lhs rhs))
+ (rhs
+ lhs))))
+ (lhs
+ (elmo-msgdb-match-condition-internal handler (nth 2 condition)
+ entity flags numbers)))))
+ ((eq (car condition) 'or)
+ (let ((lhs (elmo-msgdb-match-condition-internal handler (nth 1 condition)
+ entity flags numbers)))
+ (cond
+ ((elmo-filter-condition-p lhs)
+ (let ((rhs (elmo-msgdb-match-condition-internal handler
+ (nth 2 condition)
+ entity flags numbers)))
+ (cond ((elmo-filter-condition-p rhs)
+ (list 'or lhs rhs))
+ (rhs
+ t)
+ (t
+ lhs))))
+ (lhs
+ t)
+ (t
+ (elmo-msgdb-match-condition-internal handler
+ (nth 2 condition)
+ entity flags numbers)))))))
+
+;;
+(defun elmo-msgdb-match-condition-primitive (condition entity flags numbers)
+ (catch 'unresolved
+ (let ((key (elmo-filter-key condition))
+ (case-fold-search t)
+ result)
+ (cond
+ ((string= key "last")
+ (setq result (<= (length (memq
+ (elmo-msgdb-message-entity-number
+ (elmo-message-entity-handler entity)
+ entity)
+ numbers))
+ (string-to-int (elmo-filter-value condition)))))
+ ((string= key "first")
+ (setq result (< (-
+ (length numbers)
+ (length (memq
+ (elmo-msgdb-message-entity-number
+ (elmo-message-entity-handler entity)
+ entity)
+ numbers)))
+ (string-to-int (elmo-filter-value condition)))))
+ ((string= key "flag")
+ (setq result
+ (cond
+ ((string= (elmo-filter-value condition) "any")
+ (or (memq 'important flags)
+ (memq 'answered flags)
+ (memq 'unread flags)))
+ ((string= (elmo-filter-value condition) "digest")
+ (or (memq 'important flags)
+ (memq 'unread flags)))
+ ((string= (elmo-filter-value condition) "unread")
+ (memq 'unread flags))
+ ((string= (elmo-filter-value condition) "important")
+ (memq 'important flags))
+ ((string= (elmo-filter-value condition) "answered")
+ (memq 'answered flags)))))
+ ((string= key "from")
+ (setq result (string-match
+ (elmo-filter-value condition)
+ (elmo-msgdb-message-entity-field
+ (elmo-message-entity-handler entity)
+ entity 'from t))))
+ ((string= key "subject")
+ (setq result (string-match
+ (elmo-filter-value condition)
+ (elmo-msgdb-message-entity-field
+ (elmo-message-entity-handler entity)
+ entity 'subject t))))
+ ((string= key "to")
+ (setq result (string-match
+ (elmo-filter-value condition)
+ (elmo-msgdb-message-entity-field
+ (elmo-message-entity-handler entity)
+ entity 'to))))
+ ((string= key "cc")
+ (setq result (string-match
+ (elmo-filter-value condition)
+ (elmo-msgdb-message-entity-field
+ (elmo-message-entity-handler entity)
+ entity 'cc))))
+ ((or (string= key "since")
+ (string= key "before"))
+ (let ((field-date (elmo-date-make-sortable-string
+ (timezone-fix-time
+ (elmo-msgdb-message-entity-field
+ (elmo-message-entity-handler entity)
+ entity 'date)
+ (current-time-zone) nil)))
+ (specified-date
+ (elmo-date-make-sortable-string
+ (elmo-date-get-datevec
+ (elmo-filter-value condition)))))
+ (setq result (if (string= key "since")
+ (or (string= specified-date field-date)
+ (string< specified-date field-date))
+ (string< field-date specified-date)))))
+ ((member key elmo-msgdb-extra-fields)
+ (let ((extval (elmo-msgdb-message-entity-field
+ (elmo-message-entity-handler entity)
+ entity (intern key))))
+ (when (stringp extval)
+ (setq result (string-match
+ (elmo-filter-value condition)
+ extval)))))
+ (t
+ (throw 'unresolved condition)))
+ (if (eq (elmo-filter-type condition) 'unmatch)
+ (not result)
+ result))))
+
+(require 'product)
+(product-provide (provide 'modb-entity) (require 'elmo-version))
+
+;;; modb-entity.el ends here
;;;
;; Internal use only (obsolete interface)
;;
-;;
-;; mime decode cache
-;;
-(defvar elmo-msgdb-decoded-cache-hashtb nil)
-(make-variable-buffer-local 'elmo-msgdb-decoded-cache-hashtb)
-
-(defsubst elmo-msgdb-get-decoded-cache (string)
- (if elmo-use-decoded-cache
- (let ((hashtb (or elmo-msgdb-decoded-cache-hashtb
- (setq elmo-msgdb-decoded-cache-hashtb
- (elmo-make-hash 2048))))
- decoded)
- (or (elmo-get-hash-val string hashtb)
- (progn
- (elmo-set-hash-val
- string
- (setq decoded
- (decode-mime-charset-string string elmo-mime-charset))
- hashtb)
- decoded)))
- (decode-mime-charset-string string elmo-mime-charset)))
-
(defsubst elmo-msgdb-overview-entity-get-id (entity)
(and entity (car entity)))
((numberp key) (format "#%d" key)))
(elmo-msgdb-get-entity-hashtb msgdb)))
-;;; Message entity handling.
-(defsubst modb-legacy-make-message-entity (args)
- "Make an message entity."
- (cons (plist-get args :message-id)
- (vector (plist-get args :number)
- (plist-get args :references)
- (plist-get args :from)
- (plist-get args :subject)
- (plist-get args :date)
- (plist-get args :to)
- (plist-get args :cc)
- (plist-get args :size)
- (plist-get args :extra))))
-
-(luna-define-method elmo-msgdb-make-message-entity ((msgdb modb-legacy)
- args)
- (modb-legacy-make-message-entity args))
-
-(luna-define-method elmo-msgdb-create-message-entity-from-buffer
- ((msgdb modb-legacy) number args)
- (let ((extras elmo-msgdb-extra-fields)
- (default-mime-charset default-mime-charset)
- entity message-id references from subject to cc date
- extra field-body charset size)
- (save-excursion
- (setq entity (modb-legacy-make-message-entity args))
- (elmo-set-buffer-multibyte default-enable-multibyte-characters)
- (setq message-id (elmo-msgdb-get-message-id-from-buffer))
- (and (setq charset (cdr (assoc "charset" (mime-read-Content-Type))))
- (setq charset (intern-soft charset))
- (setq default-mime-charset charset))
- (setq references
- (or (elmo-msgdb-get-last-message-id
- (elmo-field-body "in-reply-to"))
- (elmo-msgdb-get-last-message-id
- (elmo-field-body "references")))
- from (elmo-replace-in-string
- (elmo-mime-string (or (elmo-field-body "from")
- elmo-no-from))
- "\t" " ")
- subject (elmo-replace-in-string
- (elmo-mime-string (or (elmo-field-body "subject")
- elmo-no-subject))
- "\t" " ")
- date (elmo-field-body "date")
- to (mapconcat 'identity (elmo-multiple-field-body "to") ",")
- cc (mapconcat 'identity (elmo-multiple-field-body "cc") ","))
- (unless (elmo-msgdb-message-entity-field msgdb entity 'size)
- (if (setq size (elmo-field-body "content-length"))
- (setq size (string-to-int size))
- (setq size 0)))
- (while extras
- (if (setq field-body (elmo-field-body (car extras)))
- (elmo-msgdb-message-entity-set-field
- msgdb entity (intern (downcase (car extras))) field-body))
- (setq extras (cdr extras)))
- (dolist (field '(message-id number references from subject
- date to cc size))
- (when (symbol-value field)
- (elmo-msgdb-message-entity-set-field
- msgdb entity field (symbol-value field))))
- entity)))
-
-;;; Message entity interface
-;;
-(luna-define-method elmo-msgdb-message-entity-number ((msgdb modb-legacy)
- entity)
- (and entity (aref (cdr entity) 0)))
-
-(luna-define-method elmo-msgdb-message-entity-set-number ((msgdb modb-legacy)
- entity
- number)
- (and entity (aset (cdr entity) 0 number))
- entity)
-
-(luna-define-method elmo-msgdb-message-entity-field ((msgdb modb-legacy)
- entity field
- &optional decode)
- (and entity
- (let ((field-value
- (case field
- (to (aref (cdr entity) 5))
- (cc (aref (cdr entity) 6))
- (date (aref (cdr entity) 4))
- (subject (aref (cdr entity) 3))
- (from (aref (cdr entity) 2))
- (message-id (car entity))
- (references (aref (cdr entity) 1))
- (size (aref (cdr entity) 7))
- (t (cdr (assoc (symbol-name field) (aref (cdr entity) 8)))))))
- (if (and decode (memq field '(from subject)))
- (elmo-msgdb-get-decoded-cache field-value)
- field-value))))
-
-(luna-define-method elmo-msgdb-message-entity-set-field ((msgdb modb-legacy)
- entity field value)
- (and entity
- (case field
- (number (aset (cdr entity) 0 value))
- (to (aset (cdr entity) 5 value))
- (cc (aset (cdr entity) 6 value))
- (date (aset (cdr entity) 4 value))
- (subject (aset (cdr entity) 3 value))
- (from (aset (cdr entity) 2 value))
- (message-id (setcar entity value))
- (references (aset (cdr entity) 1 value))
- (size (aset (cdr entity) 7 value))
- (t
- (let ((extras (and entity (aref (cdr entity) 8)))
- extra)
- (if (setq extra (assoc (symbol-name field) extras))
- (setcdr extra value)
- (aset (cdr entity) 8 (cons (cons (symbol-name field)
- value) extras))))))))
-
-(luna-define-method elmo-msgdb-copy-message-entity ((msgdb modb-legacy)
- entity)
- (cons (car entity)
- (copy-sequence (cdr entity))))
-
-(luna-define-method elmo-msgdb-match-condition-internal ((msgdb modb-legacy)
- condition
- entity flags numbers)
- (cond
- ((vectorp condition)
- (elmo-msgdb-match-condition-primitive condition entity flags numbers))
- ((eq (car condition) 'and)
- (let ((lhs (elmo-msgdb-match-condition-internal msgdb
- (nth 1 condition)
- entity flags numbers)))
- (cond
- ((elmo-filter-condition-p lhs)
- (let ((rhs (elmo-msgdb-match-condition-internal
- msgdb (nth 2 condition) entity flags numbers)))
- (cond ((elmo-filter-condition-p rhs)
- (list 'and lhs rhs))
- (rhs
- lhs))))
- (lhs
- (elmo-msgdb-match-condition-internal msgdb (nth 2 condition)
- entity flags numbers)))))
- ((eq (car condition) 'or)
- (let ((lhs (elmo-msgdb-match-condition-internal msgdb (nth 1 condition)
- entity flags numbers)))
- (cond
- ((elmo-filter-condition-p lhs)
- (let ((rhs (elmo-msgdb-match-condition-internal msgdb
- (nth 2 condition)
- entity flags numbers)))
- (cond ((elmo-filter-condition-p rhs)
- (list 'or lhs rhs))
- (rhs
- t)
- (t
- lhs))))
- (lhs
- t)
- (t
- (elmo-msgdb-match-condition-internal msgdb
- (nth 2 condition)
- entity flags numbers)))))))
-
-;;
-(defun elmo-msgdb-match-condition-primitive (condition entity flags numbers)
- (catch 'unresolved
- (let ((key (elmo-filter-key condition))
- (case-fold-search t)
- result)
- (cond
- ((string= key "last")
- (setq result (<= (length (memq
- (elmo-msgdb-overview-entity-get-number
- entity)
- numbers))
- (string-to-int (elmo-filter-value condition)))))
- ((string= key "first")
- (setq result (< (-
- (length numbers)
- (length (memq
- (elmo-msgdb-overview-entity-get-number
- entity)
- numbers)))
- (string-to-int (elmo-filter-value condition)))))
- ((string= key "flag")
- (setq result
- (cond
- ((string= (elmo-filter-value condition) "any")
- (or (memq 'important flags)
- (memq 'answered flags)
- (memq 'unread flags)))
- ((string= (elmo-filter-value condition) "digest")
- (or (memq 'important flags)
- (memq 'unread flags)))
- ((string= (elmo-filter-value condition) "unread")
- (memq 'unread flags))
- ((string= (elmo-filter-value condition) "important")
- (memq 'important flags))
- ((string= (elmo-filter-value condition) "answered")
- (memq 'answered flags)))))
- ((string= key "from")
- (setq result (string-match
- (elmo-filter-value condition)
- (elmo-msgdb-overview-entity-get-from entity))))
- ((string= key "subject")
- (setq result (string-match
- (elmo-filter-value condition)
- (elmo-msgdb-overview-entity-get-subject entity))))
- ((string= key "to")
- (setq result (string-match
- (elmo-filter-value condition)
- (elmo-msgdb-overview-entity-get-to entity))))
- ((string= key "cc")
- (setq result (string-match
- (elmo-filter-value condition)
- (elmo-msgdb-overview-entity-get-cc entity))))
- ((or (string= key "since")
- (string= key "before"))
- (let ((field-date (elmo-date-make-sortable-string
- (timezone-fix-time
- (elmo-msgdb-overview-entity-get-date entity)
- (current-time-zone) nil)))
- (specified-date
- (elmo-date-make-sortable-string
- (elmo-date-get-datevec
- (elmo-filter-value condition)))))
- (setq result (if (string= key "since")
- (or (string= specified-date field-date)
- (string< specified-date field-date))
- (string< field-date specified-date)))))
- ((member key elmo-msgdb-extra-fields)
- (let ((extval (elmo-msgdb-overview-entity-get-extra-field entity key)))
- (when (stringp extval)
- (setq result (string-match
- (elmo-filter-value condition)
- extval)))))
- (t
- (throw 'unresolved condition)))
- (if (eq (elmo-filter-type condition) 'unmatch)
- (not result)
- result))))
-
(require 'product)
(product-provide (provide 'modb-legacy) (require 'elmo-version))
(if (eq 'autoload (car-safe entity))
(cddr entity)
(elmo-msgdb-message-entity-field
- (elmo-message-entity-db entity)
+ (elmo-message-entity-handler entity)
entity 'message-id)))
(defsubst modb-standard-entity-map (modb)
path)))
(elmo-set-hash-val (modb-standard-key
(elmo-msgdb-message-entity-number
- (elmo-message-entity-db entity)
+ (elmo-message-entity-handler entity)
entity))
entity
table)
(elmo-set-hash-val (elmo-msgdb-message-entity-field
- (elmo-message-entity-db entity)
+ (elmo-message-entity-handler entity)
entity 'message-id)
entity
table))
(luna-define-method elmo-msgdb-append-entity ((msgdb modb-standard)
entity &optional flags)
(let ((number (elmo-msgdb-message-entity-number
- (elmo-message-entity-db entity) entity))
+ (elmo-message-entity-handler entity) entity))
(msg-id (elmo-msgdb-message-entity-field
- (elmo-message-entity-db entity) entity 'message-id))
+ (elmo-message-entity-handler entity) entity 'message-id))
duplicate)
;; number-list
(modb-standard-set-number-list-internal
(save-excursion
(setq entity (modb-standard-make-message-entity args)
;; For compatibility.
- msgdb (elmo-message-entity-db entity))
+ msgdb (elmo-message-entity-handler entity))
(elmo-set-buffer-multibyte default-enable-multibyte-characters)
(setq message-id (elmo-msgdb-get-message-id-from-buffer))
(and (setq charset (cdr (assoc "charset" (mime-read-Content-Type))))
(eval-when-compile (require 'cl))
(require 'luna)
+(require 'modb-entity)
(eval-and-compile
(luna-define-class modb-generic () (location ; location for save.
A number is for message number in the MSGDB.
A string is for message-id of the message.")
-;; Message entity handling.
-(defvar modb-cache-internal nil)
-(defun elmo-message-entity-db (entity)
- "Get modb instance which corresponds to the ENTITY."
- (if (or (null (car entity))
- (stringp (car entity)))
- ;; Transitional implementation for modb-legacy.
- (or modb-cache-internal
- (progn
- (require 'modb-legacy)
- (setq modb-cache-internal (luna-make-entity 'modb-legacy))))
- ;; XXX Next generation entity structure...not decided yet.
- (car entity)))
-
-(luna-define-generic elmo-msgdb-make-message-entity (msgdb
- &rest args)
- "Make a message entity for MSGDB.")
-
-(luna-define-generic elmo-msgdb-message-entity-number (msgdb entity)
- "Number of the ENTITY.")
-
-(luna-define-generic elmo-msgdb-message-entity-set-number (msgdb entity number)
- "Set number of the ENTITY.")
-
-(luna-define-generic elmo-msgdb-message-entity-field (msgdb
- entity field
- &optional decode)
- "Retrieve field value of the message entity.
-MSGDB is the msgdb structure.
-ENTITY is the message entity structure.
-FIELD is a symbol of the field.
-If optional DECODE is no-nil, the field value is decoded.")
-
-(luna-define-generic elmo-msgdb-message-entity-set-field (msgdb
- entity field value)
- "Set the field value of the message entity.
-MSGDB is the msgdb structure.
-ENTITY is the message entity structure.
-FIELD is a symbol of the field.
-VALUE is the field value to set.")
-
-(luna-define-generic elmo-msgdb-copy-message-entity (msgdb entity)
- "Copy message entity.
-MSGDB is the msgdb structure.
-ENTITY is the message entity structure.")
-
-(luna-define-generic elmo-msgdb-create-message-entity-from-file (msgdb number
- file)
- "Create message entity from file.
-MSGDB is the msgdb structure.
-NUMBER is the number of the newly created message entity.
-FILE is the message file.")
-
-(luna-define-generic elmo-msgdb-create-message-entity-from-buffer (msgdb
- number
- &rest args)
- "Create message entity from current buffer.
-NUMBER is the number of the newly created message entity.
-Rest of the ARGS is a plist of message entity field for initial value.
-Header region is supposed to be narrowed.")
-
-;; Transitional interface.
-(luna-define-generic elmo-msgdb-match-condition-internal (msgdb
- condition
- entity
- flags
- numbers)
- "Return non-nil when the entity matches the condition.")
+(luna-define-generic elmo-msgdb-message-entity-handler (msgdb)
+ "Get modb entity handler instance which corresponds to the MSGDB.")
;;; generic implement
;;
(luna-define-method elmo-msgdb-length ((msgdb modb-generic))
0)
-;; Generic method.
-(luna-define-method elmo-msgdb-create-message-entity-from-file
- ((msgdb modb-generic) number file)
- (let (insert-file-contents-pre-hook ; To avoid autoconv-xmas...
- insert-file-contents-post-hook header-end
- (attrib (file-attributes file))
- ret-val size mtime)
- (with-temp-buffer
- (if (not (file-exists-p file))
- ()
- (setq size (nth 7 attrib))
- (setq mtime (timezone-make-date-arpa-standard
- (current-time-string (nth 5 attrib)) (current-time-zone)))
- ;; insert header from file.
- (catch 'done
- (condition-case nil
- (elmo-msgdb-insert-file-header file)
- (error (throw 'done nil)))
- (goto-char (point-min))
- (setq header-end
- (if (re-search-forward "\\(^--.*$\\)\\|\\(\n\n\\)" nil t)
- (point)
- (point-max)))
- (narrow-to-region (point-min) header-end)
- (elmo-msgdb-create-message-entity-from-buffer
- msgdb number :size size :date mtime))))))
-
-;; Dummy message-entity methods.
-(luna-define-method elmo-msgdb-make-message-entity ((msgdb modb-generic)
- args)
- (cons msgdb args))
-
-(luna-define-method elmo-msgdb-message-entity-field ((msgdb modb-generic)
- entity field
- &optional decode)
- (plist-get (cdr entity) (intern (concat ":" (symbol-name field)))))
-
-(luna-define-method elmo-msgdb-message-entity-number ((msgdb modb-generic)
- entity)
- (plist-get (cdr entity) :number))
+
+(luna-define-method elmo-msgdb-message-entity-handler ((msgdb modb-generic))
+ (or modb-entity-default-cache-internal
+ (setq modb-entity-default-cache-internal
+ (luna-make-entity modb-entity-default-handler))))
;; for on demand loading
(provide 'modb-generic)
2003-09-22 Yuuichi Teranishi <teranisi@gohome.org>
+ * wl-summary.el (wl-summary-detect-mark-position): Use
+ modb-entity-handler.
+ (wl-summary-save-view-cache): Don't cause an error when dir is nil.
+
* Version number is increased to 2.11.17.
2003-09-21 Yuuichi Teranishi <teranisi@gohome.org>
(insert
(wl-summary-create-line
(elmo-msgdb-make-message-entity
- (luna-make-entity 'modb-generic)
+ (luna-make-entity 'modb-entity-handler)
:number 10000
:from "foo"
:subject "bar"
(tmp-buffer (get-buffer-create " *wl-summary-save-view-cache*"))
(temp-column wl-summary-buffer-temp-mark-column)
(charset wl-summary-buffer-mime-charset))
- (if (file-directory-p dir)
- (); ok.
- (if (file-exists-p dir)
- (error "File %s already exists" dir)
- (elmo-make-directory dir)))
- (if (eq save-view 'thread)
- (wl-thread-save-entity dir))
- (when wl-summary-check-line-format
- (wl-summary-line-format-save))
- (unwind-protect
- (progn
- (when (file-writable-p cache)
- (copy-to-buffer tmp-buffer (point-min) (point-max))
- (with-current-buffer tmp-buffer
- (widen)
- (make-local-variable 'wl-summary-highlight)
- (setq wl-summary-highlight nil
- wl-summary-buffer-target-mark-list mark-list
- wl-summary-buffer-temp-mark-list temp-list
- wl-summary-buffer-temp-mark-column temp-column)
- (wl-summary-delete-all-temp-marks 'no-msg 'force)
- (encode-coding-region
- (point-min) (point-max)
- (or (and wl-on-mule
- ;; one in mcs-ltn1(apel<10.4) cannot take 2 arg.
- (mime-charset-to-coding-system charset 'LF))
- ;; Mule 2 doesn't have `*ctext*unix'.
- (mime-charset-to-coding-system charset)))
- (write-region-as-binary (point-min)(point-max)
- cache nil 'no-msg)))
- (when (file-writable-p view) ; 'thread or 'sequence
- (save-excursion
- (set-buffer tmp-buffer)
- (erase-buffer)
- (prin1 save-view tmp-buffer)
- (princ "\n" tmp-buffer)
- (write-region (point-min) (point-max) view nil 'no-msg))))
- ;; kill tmp buffer.
- (kill-buffer tmp-buffer)))))
+ (when dir
+ (if (file-directory-p dir)
+ (); ok.
+ (if (file-exists-p dir)
+ (error "File %s already exists" dir)
+ (elmo-make-directory dir)))
+ (if (eq save-view 'thread)
+ (wl-thread-save-entity dir))
+ (when wl-summary-check-line-format
+ (wl-summary-line-format-save))
+ (unwind-protect
+ (progn
+ (when (file-writable-p cache)
+ (copy-to-buffer tmp-buffer (point-min) (point-max))
+ (with-current-buffer tmp-buffer
+ (widen)
+ (make-local-variable 'wl-summary-highlight)
+ (setq wl-summary-highlight nil
+ wl-summary-buffer-target-mark-list mark-list
+ wl-summary-buffer-temp-mark-list temp-list
+ wl-summary-buffer-temp-mark-column temp-column)
+ (wl-summary-delete-all-temp-marks 'no-msg 'force)
+ (encode-coding-region
+ (point-min) (point-max)
+ (or (and wl-on-mule
+ ;; one in mcs-ltn1(apel<10.4) cannot take 2 arg.
+ (mime-charset-to-coding-system charset 'LF))
+ ;; Mule 2 doesn't have `*ctext*unix'.
+ (mime-charset-to-coding-system charset)))
+ (write-region-as-binary (point-min)(point-max)
+ cache nil 'no-msg)))
+ (when (file-writable-p view) ; 'thread or 'sequence
+ (save-excursion
+ (set-buffer tmp-buffer)
+ (erase-buffer)
+ (prin1 save-view tmp-buffer)
+ (princ "\n" tmp-buffer)
+ (write-region (point-min) (point-max) view nil 'no-msg))))
+ ;; kill tmp buffer.
+ (kill-buffer tmp-buffer))))))
(defsubst wl-summary-get-sync-range (folder)
(intern (or (and
projects / elisp / wanderlust.git / commitdiff