From fadb26a7b6c89d8363007f5dc28ead16639e85a5 Mon Sep 17 00:00:00 2001 From: hmurata Date: Sun, 22 Jan 2006 08:22:48 +0000 Subject: [PATCH] * wl-summary.el (wl-summary-get-list-info): Rewrite with `elmo-find-list-match-value' * 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'. --- elmo/ChangeLog | 20 +++++++++++++ elmo/elmo-util.el | 32 +++++++++++++++++++++ elmo/elmo-vars.el | 33 ++++++++++++++++++++++ elmo/modb-entity.el | 78 +++++++-------------------------------------------- wl/ChangeLog | 5 ++++ wl/wl-summary.el | 57 +++++++------------------------------ 6 files changed, 110 insertions(+), 115 deletions(-) diff --git a/elmo/ChangeLog b/elmo/ChangeLog index eb71f40..a3d068b 100644 --- a/elmo/ChangeLog +++ b/elmo/ChangeLog @@ -1,3 +1,23 @@ +2006-01-22 Hiroya Murata + + * 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 * elmo-net.el (elmo-network-session-retry-count): New user option. diff --git a/elmo/elmo-util.el b/elmo/elmo-util.el index 67783fd..70bfef7 100644 --- a/elmo/elmo-util.el +++ b/elmo/elmo-util.el @@ -1811,6 +1811,18 @@ NUMBER-SET is altered." (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) @@ -1820,6 +1832,26 @@ NUMBER-SET is altered." (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. diff --git a/elmo/elmo-vars.el b/elmo/elmo-vars.el index 2c40a47..ef20639 100644 --- a/elmo/elmo-vars.el +++ b/elmo/elmo-vars.el @@ -442,6 +442,39 @@ Arguments for this function are NAME, BUFFER, HOST and SERVICE.") :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 "]+\\)-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)) diff --git a/elmo/modb-entity.el b/elmo/modb-entity.el index 0250a7d..d96a0da 100644 --- a/elmo/modb-entity.el +++ b/elmo/modb-entity.el @@ -777,75 +777,17 @@ If each field is t, function is set as default converter." ;; 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) diff --git a/wl/ChangeLog b/wl/ChangeLog index 2fdebbf..45949f2 100644 --- a/wl/ChangeLog +++ b/wl/ChangeLog @@ -1,3 +1,8 @@ +2006-01-22 Hiroya Murata + + * wl-summary.el (wl-summary-get-list-info): Rewrite with + `elmo-find-list-match-value' + 2006-01-15 Yoichi NAKAYAMA * wl-summary.el (wl-summary-get-list-info): Optimize. diff --git a/wl/wl-summary.el b/wl/wl-summary.el index 59a1f7d..8b8e215 100644 --- a/wl/wl-summary.el +++ b/wl/wl-summary.el @@ -973,53 +973,16 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." (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 "