+2006-01-22 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+
+ * elmo-vars.el (elmo-mailing-list-name-spec-list): New user option.
+ (elmo-mailing-list-count-spec-list): Ditto.
+
+ * elmo-util.el (elmo-map-until-success): New function.
+ (elmo-string-match-substring): Ditto.
+ (elmo-find-list-match-value): Ditto.
+
+ * modb-entity.el (modb-entity-extract-ml-info-from-x-sequence):
+ Removed.
+ (modb-entity-extract-ml-info-from-subject): Ditto.
+ (modb-entity-extract-ml-info-from-return-path): Ditto.
+ (modb-entity-extract-ml-info-from-delivered-to): Ditto.
+ (modb-entity-extract-ml-info-from-mailing-list): Ditto.
+ (modb-entity-extract-ml-info-from-mailman): Ditto.
+ (modb-entity-extract-mailing-list-info-functions): Ditto.
+ (modb-entity-extract-mailing-list-info): Rewrite with
+ `elmo-find-list-match-value'.
+
2006-01-03 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
* elmo-net.el (elmo-network-session-retry-count): New user option.
(cdr result))
(funcall function object)))
+(defun elmo-map-until-success (function sequence)
+ (let (result)
+ (while (and (null result)
+ sequence)
+ (setq result (funcall function (car sequence))
+ sequence (cdr sequence)))
+ result))
+
+(defun elmo-string-match-substring (regexp string &optional matchn)
+ (when (string-match regexp string)
+ (match-string (or matchn 1) string)))
+
(defun elmo-parse (string regexp &optional matchn)
(or matchn (setq matchn 1))
(let (list)
(match-end matchn)) list)))
(nreverse list)))
+(defun elmo-find-list-match-value (specs getter)
+ (lexical-let ((getter getter))
+ (elmo-map-until-success
+ (lambda (spec)
+ (cond
+ ((symbolp spec)
+ (funcall getter spec))
+ ((consp spec)
+ (lexical-let ((value (funcall getter (car spec))))
+ (when value
+ (elmo-map-until-success
+ (lambda (rule)
+ (cond
+ ((stringp rule)
+ (elmo-string-match-substring rule value))
+ ((consp rule)
+ (elmo-string-match-substring (car rule) value (cdr rule)))))
+ (cdr spec)))))))
+ specs)))
+
;;; File cache.
(defmacro elmo-make-file-cache (path status)
"PATH is the cache file name.
:type 'symbol
:group 'elmo)
+(defcustom elmo-mailing-list-name-spec-list
+ '(x-ml-name
+ (x-sequence "^\\([^ ]+\\)")
+ (subject "^\\s(\\(\\S)+\\)[ :][0-9]+\\s)[ \t]*")
+ (list-post "<mailto:\\(.+\\)@")
+ (list-id ("\\(<\\|^\\)\\([^.]+\\)\\." . 2))
+ (mailing-list ("\\(^\\|; \\)contact \\([^@]+\\)-[^-@]+@" . 2))
+ (return-path "^<\\([^@>]+\\)-return-[0-9]+-")
+ (delivered-to "^mailing list \\([^@]+\\)@"))
+ "*List of spec to extract mailing list name from field value."
+ :type '(repeat
+ (choice (symbol :tag "Field Name")
+ (list (symbol :tag "Field Name")
+ (choice regexp
+ (cons regexp
+ (integer :tag "Match Index"))))))
+ :group 'elmo)
+
+(defcustom elmo-mailing-list-count-spec-list
+ '(x-mail-count
+ x-ml-count
+ (x-sequence "^[^ ]+ \\([^ ]+\\)")
+ (subject "^\\s(\\S)+[ :]\\([0-9]+\\)\\s)[ \t]*")
+ (return-path "^<[^@>]+-return-\\([0-9]+\\)-"))
+ "*List of spec to extract mailing list count from field value."
+ :type '(repeat
+ (choice (symbol :tag "Field Name")
+ (list (symbol :tag "Field Name")
+ (choice regexp
+ (cons regexp
+ (integer :tag "Match Index"))))))
+ :group 'elmo)
+
(require 'product)
(product-provide (provide 'elmo-vars) (require 'elmo-version))
;; 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))))
-
-(defun modb-entity-extract-ml-info-from-mailman ()
- (when (elmo-field-body "x-mailman-version")
- (let ((list-id (elmo-decoded-field-body "list-id" 'summary)))
- (when (and list-id
- (or (string-match "<\\([^.]+\\)\\." list-id)
- (string-match "^\\([^.]+\\)\\." list-id)))
- (cons (match-string 1 list-id) 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-mailman
- 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-make-mailing-list-info-string (field value)
(when (car value)
+2006-01-22 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+
+ * wl-summary.el (wl-summary-get-list-info): Rewrite with
+ `elmo-find-list-match-value'
+
2006-01-15 Yoichi NAKAYAMA <yoichi@geiin.org>
* wl-summary.el (wl-summary-get-list-info): Optimize.
(defun wl-summary-get-list-info (entity)
"Returns (\"ML-name\" . ML-count) of ENTITY."
(or (elmo-message-entity-field entity 'ml-info)
- (let (sequence ml-name ml-count subject
- return-path delivered-to mailing-list
- list-post list-id)
- (setq sequence (elmo-message-entity-field entity 'x-sequence)
- ml-name (or (elmo-message-entity-field entity 'x-ml-name)
- (and sequence
- (car (split-string sequence " "))))
- ml-count (or (elmo-message-entity-field entity 'x-mail-count)
- (elmo-message-entity-field entity 'x-ml-count)
- (and sequence
- (cadr (split-string sequence " ")))))
- (and (setq subject (elmo-message-entity-field entity 'subject))
- (setq subject (elmo-delete-char ?\n subject))
- (string-match "^\\s(\\(\\S)+\\)[ :]\\([0-9]+\\)\\s)[ \t]*"
- subject)
- (progn
- (or ml-name (setq ml-name (match-string 1 subject)))
- (or ml-count (setq ml-count (match-string 2 subject)))))
- (and (setq return-path
- (elmo-message-entity-field entity 'return-path))
- (string-match "^<\\([^@>]+\\)-return-\\([0-9]+\\)-" return-path)
- (progn
- (or ml-name (setq ml-name (match-string 1 return-path)))
- (or ml-count (setq ml-count (match-string 2 return-path)))))
- (or ml-name
- (and (setq list-post (elmo-message-entity-field entity 'list-post))
- (string-match "<mailto:\\(.+\\)@" list-post)
- (setq ml-name (match-string 1 list-post))))
- (or ml-name
- (and (setq list-id (elmo-message-entity-field entity 'list-id))
- (or (string-match "<\\([^.]+\\)\\." list-id)
- (string-match "^\\([^.]+\\)\\." list-id))
- (setq ml-name (match-string 1 list-id))))
- (or ml-name
- (and (setq delivered-to
- (elmo-message-entity-field entity 'delivered-to))
- (string-match "^mailing list \\([^@]+\\)@" delivered-to)
- (setq ml-name (match-string 1 delivered-to))))
- (or ml-name
- (and (setq mailing-list
- (elmo-message-entity-field entity 'mailing-list))
- ;; *-help@, *-owner@, etc.
- (string-match "\\(^\\|; \\)contact \\([^@]+\\)-[^-@]+@"
- mailing-list)
- (setq ml-name (match-string 2 mailing-list))))
- (cons (and ml-name (car (split-string ml-name " ")))
- (and ml-count (string-to-int ml-count))))))
+ (lexical-let ((entity entity))
+ (let* ((getter (lambda (field)
+ (elmo-message-entity-field entity field)))
+ (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)))
+ (cons name (and count (string-to-int count)))))))
(defun wl-summary-overview-entity-compare-by-list-info (x y)
"Compare entity X and Y by mailing-list info."
projects / elisp / wanderlust.git / commitdiff