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))
40 (luna-define-class modb-entity-handler () (mime-charset))
41 (luna-define-internal-accessors 'modb-entity-handler))
43 (defcustom modb-entity-default-handler 'modb-legacy-entity-handler
44 "Default entity handler."
48 (defcustom modb-entity-field-extractor-alist
49 '((ml-info . modb-entity-extract-mailing-list-info))
50 "*An alist of field name and function to extract field body from buffer."
51 :type '(repeat (cons (symbol :tag "Field Name")
52 (function :tag "Function")))
55 (defvar modb-entity-default-cache-internal nil)
57 (defun elmo-message-entity-handler (&optional entity)
58 "Get modb entity handler instance which corresponds to the ENTITY."
61 (not (eq (car entity) t))
62 (not (stringp (car entity))))
64 (or modb-entity-default-cache-internal
65 (setq modb-entity-default-cache-internal
66 (luna-make-entity modb-entity-default-handler)))))
68 (luna-define-generic modb-entity-handler-list-parameters (handler)
69 "Return a parameter list of HANDLER.")
71 (luna-define-generic elmo-msgdb-make-message-entity (handler &rest args)
72 "Make a message entity using HANDLER.")
74 (luna-define-generic elmo-msgdb-message-entity-number (handler entity)
75 "Number of the ENTITY.")
77 (luna-define-generic elmo-msgdb-message-entity-set-number (handler
79 "Set number of the ENTITY.")
81 (luna-define-generic elmo-msgdb-message-entity-field (handler entity field
83 "Retrieve field value of the message entity.
84 HANDLER is the message entity handler.
85 ENTITY is the message entity structure.
86 FIELD is a symbol of the field.
87 If optional argument TYPE is specified, return converted value.")
89 (luna-define-generic elmo-msgdb-message-entity-set-field (handler
91 "Set the field value of the message entity.
92 HANDLER is the message entity handler.
93 ENTITY is the message entity structure.
94 FIELD is a symbol of the field.
95 VALUE is the field value to set.")
97 (luna-define-generic elmo-msgdb-message-entity-update-fields (handler
99 "Update message entity by VALUES.
100 HANDLER is the message entity handler.
101 ENTITY is the message entity structure.
102 VALUES is an alist of field-name and field-value.")
104 (luna-define-generic elmo-msgdb-copy-message-entity (handler entity
107 "Copy message entity.
108 HANDLER is the message entity handler.
109 ENTITY is the message entity structure.
110 If optional argument MAKE-HANDLER is specified, use it to make new entity.")
112 (luna-define-generic elmo-msgdb-create-message-entity-from-file (handler
115 "Create message entity from file.
116 HANDLER is the message entity handler.
117 NUMBER is the number of the newly created message entity.
118 FILE is the message file.")
120 (luna-define-generic elmo-msgdb-create-message-entity-from-buffer (handler
123 "Create message entity from current buffer.
124 HANDLER is the message entity handler.
125 NUMBER is the number of the newly created message entity.
126 Rest of the ARGS is a plist of message entity field for initial value.
127 Header region is supposed to be narrowed.")
129 ;; Transitional interface.
130 (luna-define-generic elmo-msgdb-message-match-condition (handler
133 "Return non-nil when the entity matches the condition.")
135 ;; Generic implementation.
136 (luna-define-method initialize-instance :after ((handler modb-entity-handler)
138 (unless (modb-entity-handler-mime-charset-internal handler)
139 (modb-entity-handler-set-mime-charset-internal handler elmo-mime-charset))
142 (luna-define-method modb-entity-handler-list-parameters
143 ((handler modb-entity-handler))
144 (list 'mime-charset))
146 (luna-define-method elmo-msgdb-create-message-entity-from-file
147 ((handler modb-entity-handler) number file)
148 (let (insert-file-contents-pre-hook ; To avoid autoconv-xmas...
149 insert-file-contents-post-hook header-end
150 (attrib (file-attributes file))
153 (if (not (file-exists-p file))
155 (setq size (nth 7 attrib))
156 (setq mtime (timezone-make-date-arpa-standard
157 (current-time-string (nth 5 attrib)) (current-time-zone)))
158 ;; insert header from file.
161 (elmo-msgdb-insert-file-header file)
162 (error (throw 'done nil)))
163 (goto-char (point-min))
165 (if (re-search-forward "\\(^--.*$\\)\\|\\(\n\n\\)" nil t)
168 (narrow-to-region (point-min) header-end)
169 (elmo-msgdb-create-message-entity-from-buffer
170 handler number :size size :date mtime))))))
172 (luna-define-method elmo-msgdb-make-message-entity ((handler
177 (luna-define-method elmo-msgdb-message-entity-field ((handler
181 (plist-get (cdr entity) (intern (concat ":" (symbol-name field)))))
183 (luna-define-method elmo-msgdb-message-entity-number ((handler
186 (plist-get (cdr entity) :number))
188 (luna-define-method elmo-msgdb-message-entity-update-fields
189 ((handler modb-entity-handler) entity values)
191 (dolist (pair values)
194 (elmo-msgdb-message-entity-field handler entity (car pair)))
195 (elmo-msgdb-message-entity-set-field handler entity
196 (car pair) (cdr pair))
201 (defsubst modb-entity-handler-mime-charset (handler)
202 (or (modb-entity-handler-mime-charset-internal handler)
205 (defun modb-entity-handler-equal-p (handler other)
206 "Return non-nil, if OTHER hanlder is equal this HANDLER."
207 (and (eq (luna-class-name handler)
208 (luna-class-name other))
210 (dolist (slot (modb-entity-handler-list-parameters handler))
211 (when (not (equal (luna-slot-value handler slot)
212 (luna-slot-value other slot)))
213 (throw 'mismatch nil)))
216 (defun modb-entity-handler-dump-parameters (handler)
217 "Return parameters for reconstruct HANDLER as plist."
219 (mapcar (lambda (slot)
220 (let ((value (luna-slot-value handler slot)))
222 (list (intern (concat ":" (symbol-name slot)))
224 (modb-entity-handler-list-parameters handler))))
226 ;; field in/out converter
227 (defun modb-set-field-converter (converter type &rest specs)
228 "Set convert function of TYPE into CONVERTER.
229 SPECS must be like `FIELD1 FUNCTION1 FIELD2 FUNCTION2 ...'.
230 If each field is t, function is set as default converter."
232 (let ((alist (symbol-value converter))
235 (let ((field (pop specs))
236 (function (pop specs))
238 (if (setq cell (assq type alist))
239 (setcdr cell (put-alist field function (cdr cell)))
240 (setq cell (cons type (list (cons field function)))
241 alist (cons cell alist)))
242 ;; support colon keyword (syntax sugar).
243 (unless (or (eq field t)
244 (string-match "^:" (symbol-name field)))
245 (setcdr cell (put-alist (intern (concat ":" (symbol-name field)))
248 (set converter alist))))
249 (put 'modb-set-field-converter 'lisp-indent-function 2)
251 (defsubst modb-convert-field-value (converter field value &optional type)
253 (let* ((alist (cdr (assq (or type t) converter)))
254 (function (cdr (or (assq field alist)
257 (funcall function field value)
261 (defvar elmo-msgdb-decoded-cache-hashtb nil)
262 (make-variable-buffer-local 'elmo-msgdb-decoded-cache-hashtb)
264 (defsubst elmo-msgdb-get-decoded-cache (string)
265 (if elmo-use-decoded-cache
266 (let ((hashtb (or elmo-msgdb-decoded-cache-hashtb
267 (setq elmo-msgdb-decoded-cache-hashtb
268 (elmo-make-hash 2048))))
270 (or (elmo-get-hash-val string hashtb)
273 (elmo-with-enable-multibyte
274 (decode-mime-charset-string string elmo-mime-charset)))
275 (elmo-set-hash-val string decoded hashtb))))
276 (elmo-with-enable-multibyte
277 (decode-mime-charset-string string elmo-mime-charset))))
279 (defun modb-entity-string-decoder (field value)
280 (elmo-msgdb-get-decoded-cache value))
282 (defun modb-entity-string-encoder (field value)
283 (elmo-with-enable-multibyte
284 (encode-mime-charset-string value elmo-mime-charset)))
286 (defun modb-entity-parse-date-string (field value)
288 (elmo-time-parse-date-string value)
291 (defun modb-entity-make-date-string (field value)
294 (elmo-time-make-date-string value)))
296 (defun modb-entity-mime-decoder (field value)
297 (mime-decode-field-body value (symbol-name field) 'summary))
299 (defun modb-entity-mime-encoder (field value)
300 (mime-encode-field-body value (symbol-name field)))
302 (defun modb-entity-address-list-decoder (field value)
304 (mapcar (lambda (address)
305 (mime-decode-field-body address (symbol-name field)))
306 (elmo-parse-addresses value))
309 (defun modb-entity-address-list-encoder (field value)
312 (mime-encode-field-body (mapconcat 'identity value ", ")
313 (symbol-name field))))
315 (defun modb-entity-parse-address-string (field value)
316 (modb-entity-encode-string-recursive
319 (elmo-parse-addresses value)
322 (defun modb-entity-make-address-string (field value)
323 (let ((value (modb-entity-decode-string-recursive field value)))
326 (mapconcat 'identity value ", "))))
328 (defun modb-entity-decode-string-recursive (field value)
331 (if (stringp element)
332 (elmo-msgdb-get-decoded-cache element)
336 (defun modb-entity-encode-string-recursive (field value)
339 (if (stringp element)
340 (elmo-with-enable-multibyte
341 (encode-mime-charset-string element elmo-mime-charset))
345 (defun modb-entity-create-field-indices (slots)
349 (setq indices (cons (cons (car slots) index) indices)
354 (mapcar (lambda (cell)
355 (cons (intern (concat ":" (symbol-name (car cell))))
360 ;; Legacy implementation.
362 (luna-define-class modb-legacy-entity-handler (modb-entity-handler)))
364 (defconst modb-legacy-entity-field-slots
375 (defconst modb-legacy-entity-field-indices
376 (modb-entity-create-field-indices modb-legacy-entity-field-slots))
378 (defvar modb-legacy-entity-normalizer nil)
379 (modb-set-field-converter 'modb-legacy-entity-normalizer nil
383 'from #'modb-entity-string-encoder
384 'subject #'modb-entity-string-encoder
385 'date #'modb-entity-make-date-string
386 'to #'modb-entity-address-list-encoder
387 'cc #'modb-entity-address-list-encoder
389 t #'modb-entity-mime-encoder)
391 (defvar modb-legacy-entity-specializer nil)
393 (modb-set-field-converter 'modb-legacy-entity-specializer nil
397 'from #'modb-entity-string-decoder
398 'subject #'modb-entity-string-decoder
399 'date #'modb-entity-parse-date-string
400 'to #'modb-entity-address-list-decoder
401 'cc #'modb-entity-address-list-decoder
403 t #'modb-entity-mime-decoder)
405 (modb-set-field-converter 'modb-legacy-entity-specializer 'string
407 'number nil ; not supported
409 'from #'modb-entity-string-decoder
410 'subject #'modb-entity-string-decoder
412 'size nil ; not supported
413 t #'modb-entity-mime-decoder)
416 (defmacro modb-legacy-entity-field-index (field)
417 `(cdr (assq ,field modb-legacy-entity-field-indices)))
419 (defsubst modb-legacy-entity-set-field (entity field value &optional as-is)
423 (setq value (modb-convert-field-value
424 modb-legacy-entity-normalizer
426 (cond ((memq field '(message-id :message-id))
427 (setcar entity value))
428 ((setq index (modb-legacy-entity-field-index field))
429 (aset (cdr entity) index value))
431 (setq index (modb-legacy-entity-field-index :extra))
432 (let ((extras (and entity (aref (cdr entity) index)))
434 (if (setq extra (assoc (symbol-name field) extras))
436 (aset (cdr entity) index (cons (cons (symbol-name field)
437 value) extras)))))))))
439 (defsubst modb-legacy-make-message-entity (args)
440 "Make an message entity."
441 (let ((entity (cons nil (make-vector 9 nil)))
444 (setq field (pop args)
447 (modb-legacy-entity-set-field entity field value)))
450 (luna-define-method elmo-msgdb-make-message-entity
451 ((handler modb-legacy-entity-handler) args)
452 (modb-legacy-make-message-entity args))
454 (luna-define-method elmo-msgdb-create-message-entity-from-buffer
455 ((handler modb-legacy-entity-handler) number args)
456 (let ((extras elmo-msgdb-extra-fields)
457 (default-mime-charset default-mime-charset)
458 entity message-id references from subject to cc date
459 extra field-body charset size)
461 (setq entity (modb-legacy-make-message-entity args))
462 (set-buffer-multibyte default-enable-multibyte-characters)
463 (setq message-id (elmo-msgdb-get-message-id-from-buffer))
464 (and (setq charset (cdr (assoc "charset" (mime-read-Content-Type))))
465 (setq charset (intern-soft charset))
466 (setq default-mime-charset charset))
468 (elmo-msgdb-get-references-from-buffer)
469 from (elmo-replace-in-string
470 (elmo-mime-string (or (elmo-field-body "from")
473 subject (elmo-replace-in-string
474 (elmo-mime-string (or (elmo-field-body "subject")
477 date (elmo-decoded-field-body "date")
478 to (mapconcat 'identity (elmo-multiple-field-body "to") ",")
479 cc (mapconcat 'identity (elmo-multiple-field-body "cc") ","))
480 (unless (elmo-msgdb-message-entity-field handler entity 'size)
481 (if (setq size (elmo-field-body "content-length"))
482 (setq size (string-to-int size))
485 (if (setq field-body (elmo-field-body (car extras)))
486 (modb-legacy-entity-set-field
487 entity (intern (downcase (car extras))) field-body 'as-is))
488 (setq extras (cdr extras)))
489 (dolist (field '(message-id number references from subject
491 (when (symbol-value field)
492 (modb-legacy-entity-set-field
493 entity field (symbol-value field) 'as-is)))
496 (luna-define-method elmo-msgdb-message-entity-number
497 ((handler modb-legacy-entity-handler) entity)
498 (and entity (aref (cdr entity) 0)))
500 (luna-define-method elmo-msgdb-message-entity-set-number
501 ((handler modb-legacy-entity-handler) entity number)
502 (and entity (aset (cdr entity) 0 number)))
504 (luna-define-method elmo-msgdb-message-entity-field
505 ((handler modb-legacy-entity-handler) entity field &optional type)
508 (modb-convert-field-value
509 modb-legacy-entity-specializer
511 (cond ((memq field '(message-id :message-id))
513 ((setq index (modb-legacy-entity-field-index field))
514 (aref (cdr entity) index))
516 (setq index (modb-legacy-entity-field-index :extra))
517 (cdr (assoc (symbol-name field)
518 (aref (cdr entity) index)))))
521 (luna-define-method elmo-msgdb-message-entity-set-field
522 ((handler modb-legacy-entity-handler) entity field value)
523 (modb-legacy-entity-set-field entity field value))
525 (luna-define-method elmo-msgdb-copy-message-entity
526 ((handler modb-legacy-entity-handler) entity &optional make-handler)
528 (let ((copy (elmo-msgdb-make-message-entity make-handler)))
529 (dolist (field (append '(message-id number references from subject
531 (mapcar (lambda (extra) (intern (car extra)))
532 (aref (cdr entity) 8))))
533 (elmo-msgdb-message-entity-set-field
534 make-handler copy field
535 (elmo-msgdb-message-entity-field handler entity field)))
538 (copy-sequence (cdr entity)))))
540 (luna-define-method elmo-msgdb-message-match-condition
541 ((handler modb-entity-handler) condition entity)
542 (let ((key (elmo-filter-key condition))
546 ((or (string= key "since")
547 (string= key "before"))
548 (let ((field-date (elmo-msgdb-message-entity-field
549 handler entity 'date))
551 (elmo-datevec-to-time
552 (elmo-date-get-datevec
553 (elmo-filter-value condition)))))
554 (if (string= key "since")
555 (not (elmo-time< field-date specified-date))
556 (elmo-time< field-date specified-date))))
557 ((or (string= key "larger")
558 (string= key "smaller"))
559 (let ((bytes (elmo-msgdb-message-entity-field handler entity 'size))
560 (threshold (string-to-int (elmo-filter-value condition))))
561 (if (string= key "larger")
563 (< bytes threshold))))
564 ((setq field-value (elmo-msgdb-message-entity-field handler
568 (and (stringp field-value)
569 (string-match (elmo-filter-value condition) field-value)))
574 ;; Standard implementation.
576 (luna-define-class modb-standard-entity-handler (modb-entity-handler)))
578 (defconst modb-standard-entity-field-slots
591 (defconst modb-standard-entity-field-indices
592 (modb-entity-create-field-indices modb-standard-entity-field-slots))
594 (defvar modb-standard-entity-normalizer nil)
595 (modb-set-field-converter 'modb-standard-entity-normalizer nil
598 'date #'modb-entity-parse-date-string
599 'to #'modb-entity-parse-address-string
600 'cc #'modb-entity-parse-address-string
604 t #'modb-entity-encode-string-recursive)
606 (defvar modb-standard-entity-specializer nil)
607 (modb-set-field-converter 'modb-standard-entity-specializer nil
614 t #'modb-entity-decode-string-recursive)
615 (modb-set-field-converter 'modb-standard-entity-specializer 'string
618 'date #'modb-entity-make-date-string
619 'to #'modb-entity-make-address-string
620 'cc #'modb-entity-make-address-string
624 'ml-info #'modb-entity-make-mailing-list-info-string
625 t #'modb-entity-decode-string-recursive)
627 (defmacro modb-standard-entity-field-index (field)
628 `(cdr (assq ,field modb-standard-entity-field-indices)))
630 (defsubst modb-standard-entity-set-field (entity field value &optional as-is)
634 (let ((elmo-mime-charset
635 (modb-entity-handler-mime-charset (car entity))))
636 (setq value (modb-convert-field-value modb-standard-entity-normalizer
638 (cond ((memq field '(message-id :message-id))
639 (setcar (cdr entity) value))
640 ((setq index (modb-standard-entity-field-index field))
641 (aset (cdr (cdr entity)) index value))
643 (setq index (modb-standard-entity-field-index :extra))
644 (let ((extras (aref (cdr (cdr entity)) index))
646 (if (setq cell (assq field extras))
648 (aset (cdr (cdr entity))
650 (cons (cons field value) extras)))))))))
652 (defsubst modb-standard-make-message-entity (handler args)
653 (let ((entity (cons handler
656 (length modb-standard-entity-field-slots)
660 (setq field (pop args)
663 (modb-standard-entity-set-field entity field value)))
666 (luna-define-method elmo-msgdb-make-message-entity
667 ((handler modb-standard-entity-handler) args)
668 (modb-standard-make-message-entity handler args))
670 (luna-define-method elmo-msgdb-message-entity-number
671 ((handler modb-standard-entity-handler) entity)
672 (and entity (aref (cdr (cdr entity)) 0)))
674 (luna-define-method elmo-msgdb-message-entity-set-number
675 ((handler modb-standard-entity-handler) entity number)
676 (and entity (aset (cdr (cdr entity)) 0 number)))
678 (luna-define-method elmo-msgdb-message-entity-field
679 ((handler modb-standard-entity-handler) entity field &optional type)
681 (let ((elmo-mime-charset
682 (modb-entity-handler-mime-charset handler))
684 (modb-convert-field-value
685 modb-standard-entity-specializer
687 (cond ((memq field '(message-id :message-id))
689 ((setq index (modb-standard-entity-field-index field))
690 (aref (cdr (cdr entity)) index))
692 (setq index (modb-standard-entity-field-index :extra))
693 (cdr (assq field (aref (cdr (cdr entity)) index)))))
696 (luna-define-method elmo-msgdb-message-entity-set-field
697 ((handler modb-standard-entity-handler) entity field value)
698 (modb-standard-entity-set-field entity field value))
700 (luna-define-method elmo-msgdb-copy-message-entity
701 ((handler modb-standard-entity-handler) entity &optional make-handler)
703 (let ((copy (elmo-msgdb-make-message-entity make-handler)))
704 (dolist (field (nconc
706 (copy-sequence modb-standard-entity-field-slots))
710 (modb-standard-entity-field-index :extra)))
712 (elmo-msgdb-message-entity-set-field
713 make-handler copy field
714 (elmo-msgdb-message-entity-field handler entity field)))
717 (cons (car (cdr entity))
718 (copy-sequence (cdr (cdr entity)))))))
720 (luna-define-method elmo-msgdb-create-message-entity-from-buffer
721 ((handler modb-standard-entity-handler) number args)
722 (let ((default-mime-charset default-mime-charset)
723 entity content-type charset)
725 (set-buffer-multibyte default-enable-multibyte-characters)
726 (and (setq content-type (elmo-decoded-field-body
727 "content-type" 'summary))
728 (setq charset (mime-content-type-parameter
729 (mime-parse-Content-Type content-type) "charset"))
730 (setq charset (intern-soft charset))
731 (mime-charset-p charset)
732 (setq default-mime-charset charset))
734 (modb-standard-make-message-entity
742 (elmo-msgdb-get-message-id-from-buffer)
744 (elmo-msgdb-get-references-from-buffer)
746 (elmo-replace-in-string
747 (or (elmo-decoded-field-body "from" 'summary)
751 (elmo-replace-in-string
752 (or (elmo-decoded-field-body "subject" 'summary)
756 (elmo-decoded-field-body "date" 'summary)
760 (mime-decode-field-body field-body "to" 'summary))
761 (elmo-multiple-field-body "to") ",")
765 (mime-decode-field-body field-body "cc" 'summary))
766 (elmo-multiple-field-body "cc") ",")
770 (let ((size (elmo-field-body "content-length")))
773 (or (plist-get args :size) 0)))))))
774 (let (field-name field-body extractor)
775 (dolist (extra (cons "newsgroups" elmo-msgdb-extra-fields))
776 (setq field-name (intern (downcase extra))
777 extractor (cdr (assq field-name
778 modb-entity-field-extractor-alist))
779 field-body (if extractor
780 (funcall extractor field-name)
781 (elmo-decoded-field-body extra 'summary)))
783 (modb-standard-entity-set-field entity field-name field-body))))
787 ;; mailing list info handling
788 (defun modb-entity-extract-ml-info-from-x-sequence ()
789 (let ((sequence (elmo-decoded-field-body "x-sequence" 'summary))
792 (elmo-set-list '(name count) (split-string sequence " "))
795 (defun modb-entity-extract-ml-info-from-subject ()
796 (let ((subject (elmo-decoded-field-body "subject" 'summary)))
798 (string-match "^\\s(\\(\\S)+\\)[ :]\\([0-9]+\\)\\s)[ \t]*"
800 (cons (match-string 1 subject) (match-string 2 subject)))))
802 (defun modb-entity-extract-ml-info-from-return-path ()
803 (let ((return-path (elmo-decoded-field-body "return-path" 'summary)))
804 (when (and return-path
805 (string-match "^<\\([^@>]+\\)-return-\\([0-9]+\\)-"
807 (cons (match-string 1 return-path)
808 (match-string 2 return-path)))))
810 (defun modb-entity-extract-ml-info-from-delivered-to ()
811 (let ((delivered-to (elmo-decoded-field-body "delivered-to" 'summary)))
812 (when (and delivered-to
813 (string-match "^mailing list \\([^@]+\\)@" delivered-to))
814 (cons (match-string 1 delivered-to) nil))))
816 (defun modb-entity-extract-ml-info-from-mailing-list ()
817 (let ((mailing-list (elmo-decoded-field-body "mailing-list" 'summary)))
818 ;; *-help@, *-owner@, etc.
819 (when (and mailing-list
820 (string-match "\\(^\\|; \\)contact \\([^@]+\\)-[^-@]+@"
822 (cons (match-string 2 mailing-list) nil))))
824 (defvar modb-entity-extract-mailing-list-info-functions
825 '(modb-entity-extract-ml-info-from-x-sequence
826 modb-entity-extract-ml-info-from-subject
827 modb-entity-extract-ml-info-from-return-path
828 modb-entity-extract-ml-info-from-delivered-to
829 modb-entity-extract-ml-info-from-mailing-list))
831 (defun modb-entity-extract-mailing-list-info (field)
832 (let ((ml-name (elmo-decoded-field-body "x-ml-name" 'summary))
833 (ml-count (or (elmo-decoded-field-body "x-mail-count" 'summary)
834 (elmo-decoded-field-body "x-ml-count" 'summary)))
835 (functions modb-entity-extract-mailing-list-info-functions)
837 (while (and functions
838 (or (null ml-name) (null ml-count)))
839 (when (setq result (funcall (car functions)))
841 (setq ml-name (car result)))
843 (setq ml-count (cdr result))))
844 (setq functions (cdr functions)))
845 (when (or ml-name ml-count)
846 (cons (and ml-name (car (split-string ml-name " ")))
847 (and ml-count (string-to-int ml-count))))))
849 (defun modb-entity-make-mailing-list-info-string (field value)
851 (format (if (cdr value) "(%s %05.0f)" "(%s)")
852 (elmo-msgdb-get-decoded-cache (car value))
855 ;; message buffer handler
857 (luna-define-class modb-buffer-entity-handler (modb-entity-handler)))
859 (defvar modb-buffer-entity-specializer nil)
860 (modb-set-field-converter 'modb-buffer-entity-specializer nil
861 'date #'elmo-time-parse-date-string)
863 (luna-define-method elmo-msgdb-make-message-entity
864 ((handler modb-buffer-entity-handler) args)
865 (cons handler (cons (or (plist-get args :number)
866 (plist-get args 'number))
867 (or (plist-get args :buffer)
868 (plist-get args 'buffer)
871 (luna-define-method elmo-msgdb-message-entity-number
872 ((handler modb-buffer-entity-handler) entity)
875 (luna-define-method elmo-msgdb-message-entity-set-number
876 ((handler modb-buffer-entity-handler) entity number)
877 (and entity (setcar (cdr entity) number)))
879 (luna-define-method elmo-msgdb-message-entity-field
880 ((handler modb-buffer-entity-handler) entity field &optional type)
882 (let ((elmo-mime-charset
883 (modb-entity-handler-mime-charset handler)))
884 (modb-convert-field-value
885 modb-buffer-entity-specializer
887 (if (memq field '(number :number))
889 (with-current-buffer (cdr (cdr entity))
890 (let ((extractor (cdr (assq field
891 modb-entity-field-extractor-alist))))
893 (funcall extractor field)
896 (mime-decode-field-body field-body (symbol-name field)
898 (elmo-multiple-field-body (symbol-name field))
902 (luna-define-method elmo-msgdb-message-match-condition :around
903 ((handler modb-buffer-entity-handler) condition entity)
904 (let ((key (elmo-filter-key condition))
905 (case-fold-search t))
907 ((string= (elmo-filter-key condition) "body")
908 (with-current-buffer (cdr (cdr entity))
909 (goto-char (point-min))
910 (and (re-search-forward "^$" nil t) ; goto body
911 (search-forward (elmo-filter-value condition) nil t))))
913 (luna-call-next-method)))))
916 (product-provide (provide 'modb-entity) (require 'elmo-version))
918 ;;; modb-entity.el ends here