1 ;;; modb-entity.el --- Message Entity Interface.
3 ;; Copyright (C) 2003 Yuuichi Teranishi <teranisi@gohome.org>
5 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
6 ;; Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
7 ;; Keywords: mail, net news
9 ;; This file is part of ELMO (Elisp Library for Message Orchestration).
11 ;; This program is free software; you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
16 ;; This program is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24 ;; Boston, MA 02111-1307, USA.
29 ;; Message entity handling.
33 (eval-when-compile (require 'cl))
39 (eval-and-compile (luna-define-class modb-entity-handler))
41 (defcustom modb-entity-default-handler 'modb-legacy-entity-handler
42 "Default entity handler."
46 (defvar modb-entity-default-cache-internal nil)
48 (defun elmo-message-entity-handler (&optional entity)
49 "Get modb entity handler instance which corresponds to the ENTITY."
52 (not (stringp (car entity))))
54 (or modb-entity-default-cache-internal
55 (setq modb-entity-default-cache-internal
56 (luna-make-entity modb-entity-default-handler)))))
58 (luna-define-generic elmo-msgdb-make-message-entity (handler &rest args)
59 "Make a message entity using HANDLER.")
61 (luna-define-generic elmo-msgdb-message-entity-number (handler entity)
62 "Number of the ENTITY.")
64 (luna-define-generic elmo-msgdb-message-entity-set-number (handler
66 "Set number of the ENTITY.")
68 (luna-define-generic elmo-msgdb-message-entity-field (handler
71 "Retrieve field value of the message entity.
72 HANDLER is the message entity handler.
73 ENTITY is the message entity structure.
74 FIELD is a symbol of the field.
75 If optional DECODE is no-nil, the field value is decoded.")
77 (luna-define-generic elmo-msgdb-message-entity-set-field (handler
79 "Set the field value of the message entity.
80 HANDLER is the message entity handler.
81 ENTITY is the message entity structure.
82 FIELD is a symbol of the field.
83 VALUE is the field value to set.")
85 (luna-define-generic elmo-msgdb-copy-message-entity (handler entity)
87 HANDLER is the message entity handler.
88 ENTITY is the message entity structure.")
90 (luna-define-generic elmo-msgdb-create-message-entity-from-file (handler
93 "Create message entity from file.
94 HANDLER is the message entity handler.
95 NUMBER is the number of the newly created message entity.
96 FILE is the message file.")
98 (luna-define-generic elmo-msgdb-create-message-entity-from-buffer (handler
101 "Create message entity from current buffer.
102 HANDLER is the message entity handler.
103 NUMBER is the number of the newly created message entity.
104 Rest of the ARGS is a plist of message entity field for initial value.
105 Header region is supposed to be narrowed.")
107 ;; Transitional interface.
108 (luna-define-generic elmo-msgdb-message-match-condition (handler
113 "Return non-nil when the entity matches the condition.")
115 ;; Generic implementation.
116 (luna-define-method elmo-msgdb-create-message-entity-from-file
117 ((handler modb-entity-handler) number file)
118 (let (insert-file-contents-pre-hook ; To avoid autoconv-xmas...
119 insert-file-contents-post-hook header-end
120 (attrib (file-attributes file))
123 (if (not (file-exists-p file))
125 (setq size (nth 7 attrib))
126 (setq mtime (timezone-make-date-arpa-standard
127 (current-time-string (nth 5 attrib)) (current-time-zone)))
128 ;; insert header from file.
131 (elmo-msgdb-insert-file-header file)
132 (error (throw 'done nil)))
133 (goto-char (point-min))
135 (if (re-search-forward "\\(^--.*$\\)\\|\\(\n\n\\)" nil t)
138 (narrow-to-region (point-min) header-end)
139 (elmo-msgdb-create-message-entity-from-buffer
140 handler number :size size :date mtime))))))
142 (luna-define-method elmo-msgdb-make-message-entity ((handler
147 (luna-define-method elmo-msgdb-message-entity-field ((handler
151 (plist-get (cdr entity) (intern (concat ":" (symbol-name field)))))
153 (luna-define-method elmo-msgdb-message-entity-number ((handler
156 (plist-get (cdr entity) :number))
158 ;; Legacy implementation.
159 (eval-and-compile (luna-define-class modb-legacy-entity-handler
160 (modb-entity-handler)))
165 (defvar elmo-msgdb-decoded-cache-hashtb nil)
166 (make-variable-buffer-local 'elmo-msgdb-decoded-cache-hashtb)
168 (defsubst elmo-msgdb-get-decoded-cache (string)
169 (if elmo-use-decoded-cache
170 (let ((hashtb (or elmo-msgdb-decoded-cache-hashtb
171 (setq elmo-msgdb-decoded-cache-hashtb
172 (elmo-make-hash 2048))))
174 (or (elmo-get-hash-val string hashtb)
179 (decode-mime-charset-string string elmo-mime-charset))
182 (decode-mime-charset-string string elmo-mime-charset)))
184 (defsubst modb-legacy-make-message-entity (args)
185 "Make an message entity."
186 (cons (plist-get args :message-id)
187 (vector (plist-get args :number)
188 (plist-get args :references)
189 (plist-get args :from)
190 (plist-get args :subject)
191 (plist-get args :date)
194 (plist-get args :size)
195 (plist-get args :extra))))
197 (luna-define-method elmo-msgdb-make-message-entity
198 ((handler modb-legacy-entity-handler) args)
199 (modb-legacy-make-message-entity args))
201 (luna-define-method elmo-msgdb-create-message-entity-from-buffer
202 ((handler modb-legacy-entity-handler) number args)
203 (let ((extras elmo-msgdb-extra-fields)
204 (default-mime-charset default-mime-charset)
205 entity message-id references from subject to cc date
206 extra field-body charset size)
208 (setq entity (modb-legacy-make-message-entity args))
209 (set-buffer-multibyte default-enable-multibyte-characters)
210 (setq message-id (elmo-msgdb-get-message-id-from-buffer))
211 (and (setq charset (cdr (assoc "charset" (mime-read-Content-Type))))
212 (setq charset (intern-soft charset))
213 (setq default-mime-charset charset))
215 (or (elmo-msgdb-get-last-message-id
216 (elmo-field-body "in-reply-to"))
217 (elmo-msgdb-get-last-message-id
218 (elmo-field-body "references")))
219 from (elmo-replace-in-string
220 (elmo-mime-string (or (elmo-field-body "from")
223 subject (elmo-replace-in-string
224 (elmo-mime-string (or (elmo-field-body "subject")
227 date (elmo-unfold-field-body "date")
228 to (mapconcat 'identity (elmo-multiple-field-body "to") ",")
229 cc (mapconcat 'identity (elmo-multiple-field-body "cc") ","))
230 (unless (elmo-msgdb-message-entity-field handler entity 'size)
231 (if (setq size (elmo-field-body "content-length"))
232 (setq size (string-to-int size))
235 (if (setq field-body (elmo-field-body (car extras)))
236 (elmo-msgdb-message-entity-set-field
237 handler entity (intern (downcase (car extras))) field-body))
238 (setq extras (cdr extras)))
239 (dolist (field '(message-id number references from subject
241 (when (symbol-value field)
242 (elmo-msgdb-message-entity-set-field
243 handler entity field (symbol-value field))))
246 (luna-define-method elmo-msgdb-message-entity-number
247 ((handler modb-legacy-entity-handler) entity)
248 (and entity (aref (cdr entity) 0)))
250 (luna-define-method elmo-msgdb-message-entity-set-number
251 ((handler modb-legacy-entity-handler) entity number)
252 (and entity (aset (cdr entity) 0 number))
255 (luna-define-method elmo-msgdb-message-entity-field
256 ((handler modb-legacy-entity-handler) entity field &optional decode)
260 (to (aref (cdr entity) 5))
261 (cc (aref (cdr entity) 6))
262 (date (aref (cdr entity) 4))
263 (subject (aref (cdr entity) 3))
264 (from (aref (cdr entity) 2))
265 (message-id (car entity))
266 (references (aref (cdr entity) 1))
267 (size (aref (cdr entity) 7))
268 (t (cdr (assoc (symbol-name field) (aref (cdr entity) 8)))))))
269 (if (and decode (memq field '(from subject)))
270 (elmo-msgdb-get-decoded-cache field-value)
273 (luna-define-method elmo-msgdb-message-entity-set-field
274 ((handler modb-legacy-entity-handler) entity field value)
277 (number (aset (cdr entity) 0 value))
278 (to (aset (cdr entity) 5 value))
279 (cc (aset (cdr entity) 6 value))
280 (date (aset (cdr entity) 4 value))
281 (subject (aset (cdr entity) 3 value))
282 (from (aset (cdr entity) 2 value))
283 (message-id (setcar entity value))
284 (references (aset (cdr entity) 1 value))
285 (size (aset (cdr entity) 7 value))
287 (let ((extras (and entity (aref (cdr entity) 8)))
289 (if (setq extra (assoc (symbol-name field) extras))
291 (aset (cdr entity) 8 (cons (cons (symbol-name field)
292 value) extras))))))))
294 (luna-define-method elmo-msgdb-copy-message-entity
295 ((handler modb-legacy-entity-handler) entity)
297 (copy-sequence (cdr entity))))
299 (luna-define-method elmo-msgdb-message-match-condition
300 ((handler modb-legacy-entity-handler) condition entity flags numbers)
303 (elmo-msgdb-match-condition-primitive handler condition
304 entity flags numbers))
305 ((eq (car condition) 'and)
306 (let ((lhs (elmo-msgdb-message-match-condition handler
308 entity flags numbers)))
310 ((elmo-filter-condition-p lhs)
311 (let ((rhs (elmo-msgdb-message-match-condition
312 handler (nth 2 condition) entity flags numbers)))
313 (cond ((elmo-filter-condition-p rhs)
318 (elmo-msgdb-message-match-condition handler (nth 2 condition)
319 entity flags numbers)))))
320 ((eq (car condition) 'or)
321 (let ((lhs (elmo-msgdb-message-match-condition handler (nth 1 condition)
322 entity flags numbers)))
324 ((elmo-filter-condition-p lhs)
325 (let ((rhs (elmo-msgdb-message-match-condition handler
327 entity flags numbers)))
328 (cond ((elmo-filter-condition-p rhs)
337 (elmo-msgdb-message-match-condition handler
339 entity flags numbers)))))))
342 (defun elmo-msgdb-match-condition-primitive (handler
348 (let ((key (elmo-filter-key condition))
352 ((string= key "last")
353 (setq result (<= (length (memq
354 (elmo-msgdb-message-entity-number
357 (string-to-int (elmo-filter-value condition)))))
358 ((string= key "first")
362 (elmo-msgdb-message-entity-number
365 (string-to-int (elmo-filter-value condition)))))
366 ((string= key "flag")
369 ((string= (elmo-filter-value condition) "any")
370 (or (memq 'important flags)
371 (memq 'answered flags)
372 (memq 'unread flags)))
373 ((string= (elmo-filter-value condition) "digest")
374 (or (memq 'important flags)
375 (memq 'unread flags)))
376 ((string= (elmo-filter-value condition) "unread")
377 (memq 'unread flags))
378 ((string= (elmo-filter-value condition) "important")
379 (memq 'important flags))
380 ((string= (elmo-filter-value condition) "answered")
381 (memq 'answered flags)))))
382 ((string= key "from")
383 (setq result (string-match
384 (elmo-filter-value condition)
385 (elmo-msgdb-message-entity-field
386 handler entity 'from t))))
387 ((string= key "subject")
388 (setq result (string-match
389 (elmo-filter-value condition)
390 (elmo-msgdb-message-entity-field
391 handler entity 'subject t))))
393 (setq result (string-match
394 (elmo-filter-value condition)
395 (elmo-msgdb-message-entity-field
396 handler entity 'to))))
398 (setq result (string-match
399 (elmo-filter-value condition)
400 (elmo-msgdb-message-entity-field
401 handler entity 'cc))))
402 ((or (string= key "since")
403 (string= key "before"))
404 (let ((field-date (elmo-date-make-sortable-string
406 (elmo-msgdb-message-entity-field
407 handler entity 'date)
408 (current-time-zone) nil)))
410 (elmo-date-make-sortable-string
411 (elmo-date-get-datevec
412 (elmo-filter-value condition)))))
413 (setq result (if (string= key "since")
414 (or (string= specified-date field-date)
415 (string< specified-date field-date))
416 (string< field-date specified-date)))))
417 ((member key elmo-msgdb-extra-fields)
418 (let ((extval (elmo-msgdb-message-entity-field handler
421 (when (stringp extval)
422 (setq result (string-match
423 (elmo-filter-value condition)
426 (throw 'unresolved condition)))
427 (if (eq (elmo-filter-type condition) 'unmatch)
432 (product-provide (provide 'modb-entity) (require 'elmo-version))
434 ;;; modb-entity.el ends here