;;; Commentary:
;;
+;; Message entity handling.
;;; Code:
-;;
(eval-when-compile (require 'cl))
+(require 'luna)
(require 'elmo-vars)
(require 'elmo-util)
-(require 'mime)
+
+(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-message-match-condition (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)
decoded)))
(decode-mime-charset-string string elmo-mime-charset)))
-
-;;; Message entity interface
-;;
-(defun elmo-msgdb-make-message-entity (&rest args)
+(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 :size)
(plist-get args :extra))))
-(defsubst elmo-msgdb-message-entity-field (entity field &optional decode)
+(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-unfold-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
(elmo-msgdb-get-decoded-cache field-value)
field-value))))
-(defsubst elmo-msgdb-message-entity-set-field (entity 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))
(t
(let ((extras (and entity (aref (cdr entity) 8)))
extra)
- (if (setq extra (assoc field extras))
+ (if (setq extra (assoc (symbol-name field) extras))
(setcdr extra value)
(aset (cdr entity) 8 (cons (cons (symbol-name field)
value) extras))))))))
-(defun elmo-msgdb-copy-overview-entity (entity)
+(luna-define-method elmo-msgdb-copy-message-entity
+ ((handler modb-legacy-entity-handler) entity)
(cons (car entity)
(copy-sequence (cdr entity))))
-;;; obsolete interface
-;;
-(defsubst elmo-msgdb-overview-entity-get-id (entity)
- (and entity (car entity)))
-
-(defsubst elmo-msgdb-overview-entity-get-number (entity)
- (and entity (aref (cdr entity) 0)))
-
-(defsubst elmo-msgdb-overview-entity-set-number (entity number)
- (and entity (aset (cdr entity) 0 number))
- entity)
-
-(defsubst elmo-msgdb-overview-entity-get-references (entity)
- (and entity (aref (cdr entity) 1)))
-
-(defsubst elmo-msgdb-overview-entity-set-references (entity references)
- (and entity (aset (cdr entity) 1 references))
- entity)
-
-(defsubst elmo-msgdb-overview-entity-get-from-no-decode (entity)
- (and entity (aref (cdr entity) 2)))
-
-(defsubst elmo-msgdb-overview-entity-get-from (entity)
- (and entity
- (aref (cdr entity) 2)
- (elmo-msgdb-get-decoded-cache (aref (cdr entity) 2))))
-
-(defsubst elmo-msgdb-overview-entity-set-from (entity from)
- (and entity (aset (cdr entity) 2 from))
- entity)
-
-(defsubst elmo-msgdb-overview-entity-get-subject (entity)
- (and entity
- (aref (cdr entity) 3)
- (elmo-msgdb-get-decoded-cache (aref (cdr entity) 3))))
-
-(defsubst elmo-msgdb-overview-entity-get-subject-no-decode (entity)
- (and entity (aref (cdr entity) 3)))
-
-(defsubst elmo-msgdb-overview-entity-set-subject (entity subject)
- (and entity (aset (cdr entity) 3 subject))
- entity)
-
-(defsubst elmo-msgdb-overview-entity-get-date (entity)
- (and entity (aref (cdr entity) 4)))
-
-(defsubst elmo-msgdb-overview-entity-set-date (entity date)
- (and entity (aset (cdr entity) 4 date))
- entity)
-
-(defsubst elmo-msgdb-overview-entity-get-to (entity)
- (and entity (aref (cdr entity) 5)))
-
-(defsubst elmo-msgdb-overview-entity-get-cc (entity)
- (and entity (aref (cdr entity) 6)))
-
-(defsubst elmo-msgdb-overview-entity-get-size (entity)
- (and entity (aref (cdr entity) 7)))
-
-(defsubst elmo-msgdb-overview-entity-set-size (entity size)
- (and entity (aset (cdr entity) 7 size))
- entity)
-
-(defsubst elmo-msgdb-overview-entity-get-extra (entity)
- (and entity (aref (cdr entity) 8)))
-
-(defsubst elmo-msgdb-overview-entity-set-extra (entity extra)
- (and entity (aset (cdr entity) 8 extra))
- entity)
-
-(defsubst elmo-msgdb-overview-entity-get-extra-field (entity field-name)
- (let ((field-name (downcase field-name))
- (extra (and entity (aref (cdr entity) 8))))
- (and extra
- (cdr (assoc field-name extra)))))
-
-(defsubst elmo-msgdb-overview-entity-set-extra-field (entity field-name value)
- (let ((field-name (downcase field-name))
- (extras (and entity (aref (cdr entity) 8)))
- extra)
- (if (setq extra (assoc field-name extras))
- (setcdr extra value)
- (elmo-msgdb-overview-entity-set-extra
- entity
- (cons (cons field-name value) extras)))))
-
+(luna-define-method elmo-msgdb-message-match-condition
+ ((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-message-match-condition handler
+ (nth 1 condition)
+ entity flags numbers)))
+ (cond
+ ((elmo-filter-condition-p lhs)
+ (let ((rhs (elmo-msgdb-message-match-condition
+ handler (nth 2 condition) entity flags numbers)))
+ (cond ((elmo-filter-condition-p rhs)
+ (list 'and lhs rhs))
+ (rhs
+ lhs))))
+ (lhs
+ (elmo-msgdb-message-match-condition handler (nth 2 condition)
+ entity flags numbers)))))
+ ((eq (car condition) 'or)
+ (let ((lhs (elmo-msgdb-message-match-condition handler (nth 1 condition)
+ entity flags numbers)))
+ (cond
+ ((elmo-filter-condition-p lhs)
+ (let ((rhs (elmo-msgdb-message-match-condition 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-message-match-condition handler
+ (nth 2 condition)
+ entity flags numbers)))))))
-;;;
;;
(defun elmo-msgdb-match-condition-primitive (condition entity flags numbers)
(catch 'unresolved
(cond
((string= key "last")
(setq result (<= (length (memq
- (elmo-msgdb-overview-entity-get-number
+ (elmo-msgdb-message-entity-number
+ (elmo-message-entity-handler entity)
entity)
numbers))
(string-to-int (elmo-filter-value condition)))))
(setq result (< (-
(length numbers)
(length (memq
- (elmo-msgdb-overview-entity-get-number
+ (elmo-msgdb-message-entity-number
+ (elmo-message-entity-handler entity)
entity)
numbers)))
(string-to-int (elmo-filter-value condition)))))
((string= key "from")
(setq result (string-match
(elmo-filter-value condition)
- (elmo-msgdb-overview-entity-get-from entity))))
+ (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-overview-entity-get-subject entity))))
+ (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-overview-entity-get-to entity))))
+ (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-overview-entity-get-cc entity))))
+ (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-overview-entity-get-date entity)
+ (elmo-msgdb-message-entity-field
+ (elmo-message-entity-handler entity)
+ entity 'date)
(current-time-zone) nil)))
(specified-date
(elmo-date-make-sortable-string
(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)))
+ (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)
(not result)
result))))
-(defun elmo-msgdb-match-condition-internal (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 (nth 1 condition)
- entity flags numbers)))
- (cond
- ((elmo-filter-condition-p lhs)
- (let ((rhs (elmo-msgdb-match-condition-internal
- (nth 2 condition) entity flags numbers)))
- (cond ((elmo-filter-condition-p rhs)
- (list 'and lhs rhs))
- (rhs
- lhs))))
- (lhs
- (elmo-msgdb-match-condition-internal (nth 2 condition)
- entity flags numbers)))))
- ((eq (car condition) 'or)
- (let ((lhs (elmo-msgdb-match-condition-internal (nth 1 condition)
- entity flags numbers)))
- (cond
- ((elmo-filter-condition-p lhs)
- (let ((rhs (elmo-msgdb-match-condition-internal (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 (nth 2 condition)
- entity flags numbers)))))))
-
-
(require 'product)
(product-provide (provide 'modb-entity) (require 'elmo-version))
projects / elisp / wanderlust.git / blobdiff