:group 'elmo)
(defcustom modb-entity-field-extractor-alist
- '((ml-info . modb-entity-extract-mailing-list-info))
+ '((ml-info modb-entity-extract-mailing-list-info
+ modb-entity-ml-info-real-fields))
"*An alist of field name and function to extract field body from buffer."
- :type '(repeat (cons (symbol :tag "Field Name")
- (function :tag "Function")))
+ :type '(repeat (list (symbol :tag "Field Name")
+ (function :tag "Extractor")
+ (choice :tag "Real Field"
+ (repeat :tag "Field Name List" string)
+ (function :tag "Function"))))
:group 'elmo)
(defvar modb-entity-default-cache-internal nil)
(lambda (element)
(if (stringp element)
(elmo-with-enable-multibyte
- (encode-mime-charset-string element elmo-mime-charset)))
- element)
+ (encode-mime-charset-string element elmo-mime-charset))
+ element))
value))
(defun modb-entity-create-field-indices (slots)
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 (string-to-number size))
(setq size 0)))
(while extras
(if (setq field-body (elmo-field-body (car extras)))
(if (string= key "since")
(not (elmo-time< field-date specified-date))
(elmo-time< field-date specified-date))))
+ ((or (string= key "larger")
+ (string= key "smaller"))
+ (let ((bytes (elmo-msgdb-message-entity-field handler entity 'size))
+ (threshold (string-to-number (elmo-filter-value condition))))
+ (if (string= key "larger")
+ (> bytes threshold)
+ (< bytes threshold))))
((setq field-value (elmo-msgdb-message-entity-field handler
entity
(intern key)
(luna-define-method elmo-msgdb-create-message-entity-from-buffer
((handler modb-standard-entity-handler) number args)
- (let ((default-mime-charset default-mime-charset)
- entity content-type charset)
+ (let (entity)
(save-excursion
(set-buffer-multibyte default-enable-multibyte-characters)
- (and (setq content-type (elmo-decoded-field-body
- "content-type" 'summary))
- (setq charset (mime-content-type-parameter
- (mime-parse-Content-Type content-type) "charset"))
- (setq charset (intern-soft charset))
- (mime-charset-p charset)
- (setq default-mime-charset charset))
(setq entity
(modb-standard-make-message-entity
handler
(mime-decode-field-body field-body "cc" 'summary))
(elmo-multiple-field-body "cc") ",")
:content-type
- content-type
+ (elmo-decoded-field-body "content-type" 'summary)
:size
(let ((size (elmo-field-body "content-length")))
(if size
- (string-to-int size)
+ (string-to-number size)
(or (plist-get args :size) 0)))))))
(let (field-name field-body extractor)
(dolist (extra (cons "newsgroups" elmo-msgdb-extra-fields))
(setq field-name (intern (downcase extra))
- extractor (cdr (assq field-name
- modb-entity-field-extractor-alist))
+ extractor (nth 1 (assq field-name
+ modb-entity-field-extractor-alist))
field-body (if extractor
(funcall extractor field-name)
(elmo-decoded-field-body extra 'summary)))
;; mailing list info handling
-(defun modb-entity-extract-ml-info-from-x-sequence ()
- (let ((sequence (elmo-decoded-field-body "x-sequence" 'summary))
- name count)
- (when sequence
- (elmo-set-list '(name count) (split-string sequence " "))
- (cons name count))))
-
-(defun modb-entity-extract-ml-info-from-subject ()
- (let ((subject (elmo-decoded-field-body "subject" 'summary)))
- (when (and subject
- (string-match "^\\s(\\(\\S)+\\)[ :]\\([0-9]+\\)\\s)[ \t]*"
- subject))
- (cons (match-string 1 subject) (match-string 2 subject)))))
-
-(defun modb-entity-extract-ml-info-from-return-path ()
- (let ((return-path (elmo-decoded-field-body "return-path" 'summary)))
- (when (and return-path
- (string-match "^<\\([^@>]+\\)-return-\\([0-9]+\\)-"
- return-path))
- (cons (match-string 1 return-path)
- (match-string 2 return-path)))))
-
-(defun modb-entity-extract-ml-info-from-delivered-to ()
- (let ((delivered-to (elmo-decoded-field-body "delivered-to" 'summary)))
- (when (and delivered-to
- (string-match "^mailing list \\([^@]+\\)@" delivered-to))
- (cons (match-string 1 delivered-to) nil))))
-
-(defun modb-entity-extract-ml-info-from-mailing-list ()
- (let ((mailing-list (elmo-decoded-field-body "mailing-list" 'summary)))
- ;; *-help@, *-owner@, etc.
- (when (and mailing-list
- (string-match "\\(^\\|; \\)contact \\([^@]+\\)-[^-@]+@"
- mailing-list))
- (cons (match-string 2 mailing-list) nil))))
-
-(defvar modb-entity-extract-mailing-list-info-functions
- '(modb-entity-extract-ml-info-from-x-sequence
- modb-entity-extract-ml-info-from-subject
- modb-entity-extract-ml-info-from-return-path
- modb-entity-extract-ml-info-from-delivered-to
- modb-entity-extract-ml-info-from-mailing-list))
-
(defun modb-entity-extract-mailing-list-info (field)
- (let ((ml-name (elmo-decoded-field-body "x-ml-name" 'summary))
- (ml-count (or (elmo-decoded-field-body "x-mail-count" 'summary)
- (elmo-decoded-field-body "x-ml-count" 'summary)))
- (functions modb-entity-extract-mailing-list-info-functions)
- result)
- (while (and functions
- (or (null ml-name) (null ml-count)))
- (when (setq result (funcall (car functions)))
- (unless ml-name
- (setq ml-name (car result)))
- (unless ml-count
- (setq ml-count (cdr result))))
- (setq functions (cdr functions)))
- (when (or ml-name ml-count)
- (cons (and ml-name (car (split-string ml-name " ")))
- (and ml-count (string-to-int ml-count))))))
+ (let* ((getter (lambda (field)
+ (elmo-decoded-field-body (symbol-name field) 'summary)))
+ (name (elmo-find-list-match-value
+ elmo-mailing-list-name-spec-list
+ getter))
+ (count (elmo-find-list-match-value
+ elmo-mailing-list-count-spec-list
+ getter)))
+ (when (or name count)
+ (cons name (and count (string-to-number count))))))
+
+(defun modb-entity-ml-info-real-fields (field)
+ (elmo-uniq-list
+ (mapcar (lambda (entry)
+ (symbol-name (if (consp entry) (car entry) entry)))
+ (append elmo-mailing-list-name-spec-list
+ elmo-mailing-list-count-spec-list))))
(defun modb-entity-make-mailing-list-info-string (field value)
(when (car value)
(if (memq field '(number :number))
(car (cdr entity))
(with-current-buffer (cdr (cdr entity))
- (let ((extractor (cdr (assq field
- modb-entity-field-extractor-alist))))
+ (let ((extractor
+ (nth 1 (assq field modb-entity-field-extractor-alist))))
(if extractor
(funcall extractor field)
(mapconcat
projects / elisp / wanderlust.git / blobdiff