From d73166be44be9fced24d471f553d38c8d59b8afb Mon Sep 17 00:00:00 2001 From: hmurata Date: Sun, 20 Mar 2005 09:19:40 +0000 Subject: [PATCH] * wl-util.el (wl-parse-addresses): Define alias of `elmo-parse-addresses' (move to `elmo-util.el'). * wl-summary.el (wl-summary-default-from): Follow the API change. (wl-summary-overview-entity-compare-by-date): Ditto. (wl-summary-overview-entity-compare-by-from): Ditto. (wl-summary-get-list-info): Get value of `ml-info' field from entity at first. (wl-summary-rescan-message): Treat prefix argument. (wl-summary-prefetch-msg): Follow the API change. (wl-summary-search-by-subject): Ditto. (wl-summary-insert-thread): Ditto. (wl-summary-line-subject): Ditto. (wl-summary-line-from): Ditto. (wl-summary-create-line): Ditto. (wl-summary-print-message-with-ps-print): Ditto. * wl-score.el (wl-score-ov-entity-get): Ditto. (wl-score-followup): Ditto. (wl-score-add-followups): Use `elmo-message-entity-field' instead of `car'. (wl-score-get-latest-msgs): Follow the API change. (wl-score-get-header): Ditto. * wl-refile.el (wl-refile-learn): Ditto. (wl-refile-subject-learn): Ditto. (wl-refile-get-field-value): Ditto. (wl-refile-guess-by-history): Ditto. (wl-refile-guess-by-subject): Ditto. * wl-mime.el (wl-mime-combine-message/partial-pieces): Ditto. * wl-expire.el (wl-expire-date-p): Removed. (wl-expire-archive-date): Follow the API change. (wl-expire-localdir-date): Ditto. (wl-summary-expire): Ditto. * modb.el (elmo-msgdb-message-field): Add argument `type'. (elmo-msgdb-match-condition): Get handler from entity instead of msgdb. * modb-standard.el (modb-standard-economize-entity-size): Abolish. (modb-standard-load-entity): Treat new file format. (modb-standard-save-entity-1): Save as new file format. (modb-standard-save-entity): Split messages into section here. (elmo-msgdb-message-field): Follow the API change. (modb-standard-default-entity-handler): New internal variable. (elmo-msgdb-message-entity-handler): Define. * modb-entity.el (elmo-msgdb-prefer-in-reply-to-for-parent): Moved to `elmo-vars.el'. (modb-entity-field-extractor-alist): New user option. (elmo-msgdb-message-entity-field): Removed argument `decode' and added argument `type'. (elmo-msgdb-copy-message-entity): Add optional argument `make-handler'. (modb-set-field-converter): New function. (modb-convert-field-value): Ditto. (modb-entity-string-decoder): Ditto. (modb-entity-string-encoder): Ditto. (modb-entity-parse-date-string): Ditto. (modb-entity-make-date-string): Ditto. (modb-entity-mime-decoder): Ditto. (modb-entity-mime-encoder): Ditto. (modb-entity-address-list-decoder): Ditto. (modb-entity-address-list-encoder): Ditto. (modb-entity-parse-address-string): Ditto. (modb-entity-make-address-string): Ditto. (modb-entity-create-field-indices): Ditto. (modb-legacy-entity-field-slots): New constant. (modb-legacy-entity-field-indices): Ditto. (modb-legacy-entity-normalizer): New variable. (modb-legacy-entity-specializer): Ditto. (modb-legacy-entity-field-index): New macro. (modb-legacy-entity-set-field): New function. (modb-legacy-make-message-entity): Rewrite. (elmo-msgdb-create-message-entity-from-buffer): Use `elmo-msgdb-get-references-from-buffer'. Use `elmo-decoded-field-body' instead of `elmo-unfold-field-body'. Use `modb-legacy-entity-set-field' instead of `elmo-msgdb-message-entity-set-field'. (elmo-msgdb-message-entity-field): Rewrite. (elmo-msgdb-message-entity-set-field): Ditto. (elmo-msgdb-copy-message-entity): Make new entity by `make-handler' if it specified. (elmo-msgdb-message-match-condition): Define a method of `modb-entity-handler' and follow the API change. (modb-standard-entity-handler): New class. (modb-entity-extract-ml-info-from-x-sequence): New function. (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-mailing-list-info): Ditto. (modb-entity-extract-mailing-list-info-functions): New variable. * elmo.el (elmo-message-field): Add optional argument `type'. * elmo-vars.el (elmo-msgdb-prefer-in-reply-to-for-parent): Moved from `modb-entity.el'. * elmo-util.el (elmo-object-load): Decode by coding-system from `set-auto-coding-function'. (elmo-object-save): Use `detect-mime-charset-region' and add coding cookie if encode. (elmo-msgdb-get-references-from-buffer): New function. (elmo-parse-addresses): Ditto (renamed from `wl-parse-addresses'). * elmo-spam.el (elmo-spam-message-spam-p): Follow the API change. * elmo-shimbun.el (elmo-shimbun-parse-time-string): Removed. (elmo-shimbun-entity-to-header): Use `shimbun-create-header' instead of `shimbun-make-header' and follow the API change. (elmo-shimbun-update-overview): Follow the API change. (elmo-map-folder-list-message-locations): Ditto. * elmo-pipe.el (elmo-message-field): Ditto. * elmo-nntp.el (elmo-nntp-create-msgdb-from-overview-string): Ditto. * elmo-nmz.el (elmo-nmz-msgdb-create-entity): Ditto. * elmo-multi.el (elmo-message-field): Ditto. * elmo-msgdb.el (elmo-message-entity-field): Ditto. (elmo-msgdb-sort-by-date): Ditto. (elmo-msgdb-flag-table): Use `elmo-msgdb-message-field' instead of `elmo-message-entity-field'. (elmo-msgdb-overview-entity-get-from-no-decode): Follow the API change. (elmo-msgdb-overview-entity-get-from): Ditto. (elmo-msgdb-overview-entity-get-subject): Ditto. (elmo-msgdb-overview-entity-get-subject-no-decode): Ditto. (elmo-msgdb-overview-entity-get-date): Ditto. (elmo-msgdb-overview-entity-get-to): Ditto. (elmo-msgdb-overview-entity-get-cc): Ditto. * elmo-mime.el (elmo-message-mime-entity): Ditto. (elmo-mime-collect-message/partial-pieces): Ditto. * elmo-filter.el (elmo-message-field): Ditto. * elmo-date.el (elmo-datevec-to-time): New function. (elmo-time-parse-date-string): Ditto. (elmo-time-make-date-string): Ditto. (elmo-time<): Ditto. --- elmo/ChangeLog | 111 +++++++++ elmo/elmo-date.el | 24 ++ elmo/elmo-filter.el | 4 +- elmo/elmo-mime.el | 4 +- elmo/elmo-msgdb.el | 38 ++-- elmo/elmo-multi.el | 4 +- elmo/elmo-nmz.el | 4 +- elmo/elmo-nntp.el | 37 ++- elmo/elmo-pipe.el | 5 +- elmo/elmo-shimbun.el | 44 ++-- elmo/elmo-spam.el | 2 +- elmo/elmo-util.el | 76 ++++++- elmo/elmo-vars.el | 7 + elmo/elmo.el | 10 +- elmo/modb-entity.el | 594 +++++++++++++++++++++++++++++++++++++++++-------- elmo/modb-standard.el | 100 ++++++--- elmo/modb.el | 12 +- wl/ChangeLog | 37 +++ wl/wl-expire.el | 31 +-- wl/wl-mime.el | 2 +- wl/wl-refile.el | 30 ++- wl/wl-score.el | 22 +- wl/wl-summary.el | 152 ++++++------- wl/wl-util.el | 44 +--- 24 files changed, 1000 insertions(+), 394 deletions(-) diff --git a/elmo/ChangeLog b/elmo/ChangeLog index 78487ae..439aa3e 100644 --- a/elmo/ChangeLog +++ b/elmo/ChangeLog @@ -1,5 +1,116 @@ 2005-03-20 Hiroya Murata + * modb.el (elmo-msgdb-message-field): Add argument `type'. + (elmo-msgdb-match-condition): Get handler from entity instead of + msgdb. + + * modb-standard.el (modb-standard-economize-entity-size): Abolish. + (modb-standard-load-entity): Treat new file format. + (modb-standard-save-entity-1): Save as new file format. + (modb-standard-save-entity): Split messages into section here. + (elmo-msgdb-message-field): Follow the API change. + (modb-standard-default-entity-handler): New internal variable. + (elmo-msgdb-message-entity-handler): Define. + + * modb-entity.el (elmo-msgdb-prefer-in-reply-to-for-parent): Moved + to `elmo-vars.el'. + (modb-entity-field-extractor-alist): New user option. + (elmo-msgdb-message-entity-field): Removed argument `decode' and + added argument `type'. + (elmo-msgdb-copy-message-entity): Add optional argument + `make-handler'. + (modb-set-field-converter): New function. + (modb-convert-field-value): Ditto. + (modb-entity-string-decoder): Ditto. + (modb-entity-string-encoder): Ditto. + (modb-entity-parse-date-string): Ditto. + (modb-entity-make-date-string): Ditto. + (modb-entity-mime-decoder): Ditto. + (modb-entity-mime-encoder): Ditto. + (modb-entity-address-list-decoder): Ditto. + (modb-entity-address-list-encoder): Ditto. + (modb-entity-parse-address-string): Ditto. + (modb-entity-make-address-string): Ditto. + (modb-entity-create-field-indices): Ditto. + (modb-legacy-entity-field-slots): New constant. + (modb-legacy-entity-field-indices): Ditto. + (modb-legacy-entity-normalizer): New variable. + (modb-legacy-entity-specializer): Ditto. + (modb-legacy-entity-field-index): New macro. + (modb-legacy-entity-set-field): New function. + (modb-legacy-make-message-entity): Rewrite. + (elmo-msgdb-create-message-entity-from-buffer): Use + `elmo-msgdb-get-references-from-buffer'. Use + `elmo-decoded-field-body' instead of `elmo-unfold-field-body'. + Use `modb-legacy-entity-set-field' instead of + `elmo-msgdb-message-entity-set-field'. + (elmo-msgdb-message-entity-field): Rewrite. + (elmo-msgdb-message-entity-set-field): Ditto. + (elmo-msgdb-copy-message-entity): Make new entity by + `make-handler' if it specified. + (elmo-msgdb-message-match-condition): Define a method of + `modb-entity-handler' and follow the API change. + (modb-standard-entity-handler): New class. + (modb-entity-extract-ml-info-from-x-sequence): New function. + (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-mailing-list-info): Ditto. + (modb-entity-extract-mailing-list-info-functions): New variable. + + * elmo.el (elmo-message-field): Add optional argument `type'. + + * elmo-vars.el (elmo-msgdb-prefer-in-reply-to-for-parent): Moved + from `modb-entity.el'. + + * elmo-util.el (elmo-object-load): Decode by coding-system from + `set-auto-coding-function'. + (elmo-object-save): Use `detect-mime-charset-region' and add + coding cookie if encode. + (elmo-msgdb-get-references-from-buffer): New function. + (elmo-parse-addresses): Ditto (renamed from `wl-parse-addresses'). + + * elmo-spam.el (elmo-spam-message-spam-p): Follow the API change. + + * elmo-shimbun.el (elmo-shimbun-parse-time-string): Removed. + (elmo-shimbun-entity-to-header): Use `shimbun-create-header' + instead of `shimbun-make-header' and follow the API change. + (elmo-shimbun-update-overview): Follow the API change. + (elmo-map-folder-list-message-locations): Ditto. + + * elmo-pipe.el (elmo-message-field): Ditto. + + * elmo-nntp.el (elmo-nntp-create-msgdb-from-overview-string): + Ditto. + + * elmo-nmz.el (elmo-nmz-msgdb-create-entity): Ditto. + + * elmo-multi.el (elmo-message-field): Ditto. + + * elmo-msgdb.el (elmo-message-entity-field): Ditto. + (elmo-msgdb-sort-by-date): Ditto. + (elmo-msgdb-flag-table): Use `elmo-msgdb-message-field' instead of + `elmo-message-entity-field'. + (elmo-msgdb-overview-entity-get-from-no-decode): Follow the API + change. + (elmo-msgdb-overview-entity-get-from): Ditto. + (elmo-msgdb-overview-entity-get-subject): Ditto. + (elmo-msgdb-overview-entity-get-subject-no-decode): Ditto. + (elmo-msgdb-overview-entity-get-date): Ditto. + (elmo-msgdb-overview-entity-get-to): Ditto. + (elmo-msgdb-overview-entity-get-cc): Ditto. + + * elmo-mime.el (elmo-message-mime-entity): Ditto. + (elmo-mime-collect-message/partial-pieces): Ditto. + + * elmo-filter.el (elmo-message-field): Ditto. + + * elmo-date.el (elmo-datevec-to-time): New function. + (elmo-time-parse-date-string): Ditto. + (elmo-time-make-date-string): Ditto. + (elmo-time<): Ditto. + * elmo-version.el (elmo-version): Up to 2.15.1. 2005-03-14 Yoichi NAKAYAMA diff --git a/elmo/elmo-date.el b/elmo/elmo-date.el index ea2f0e5..822dfef 100644 --- a/elmo/elmo-date.el +++ b/elmo/elmo-date.el @@ -211,6 +211,30 @@ Otherwise treat \\ in NEWTEXT string as special: (aref (, datevec) 4) (aref (, datevec) 5))))) +(defsubst elmo-datevec-to-time (datevec) + (encode-time (aref datevec 5) (aref datevec 4) (aref datevec 3) + (aref datevec 2) (aref datevec 1) (aref datevec 0) + (aref datevec 6))) + +(defun elmo-time-parse-date-string (date) + (ignore-errors + (elmo-datevec-to-time (timezone-fix-time date nil nil)))) + +(defun elmo-time-make-date-string (time) + (let ((system-time-locale "C")) + (format-time-string "%a, %d %b %Y %T %z" time))) + +(defun elmo-time< (lhs rhs) + (while (and (car lhs) (car rhs)) + (cond ((< (car lhs) (car rhs)) + (setq lhs nil)) + ((= (car lhs) (car rhs)) + (setq lhs (cdr lhs) + rhs (cdr rhs))) + (t + (setq rhs nil)))) + (not (null rhs))) + (require 'product) (product-provide (provide 'elmo-date) (require 'elmo-version)) diff --git a/elmo/elmo-filter.el b/elmo/elmo-filter.el index b73c5a3..040d45d 100644 --- a/elmo/elmo-filter.el +++ b/elmo/elmo-filter.el @@ -431,9 +431,9 @@ (elmo-message-folder (elmo-filter-folder-target-internal folder) number)) (luna-define-method elmo-message-field ((folder elmo-filter-folder) - number field) + number field &optional type) (elmo-message-field - (elmo-filter-folder-target-internal folder) number field)) + (elmo-filter-folder-target-internal folder) number field type)) (luna-define-method elmo-message-set-field ((folder elmo-filter-folder) number field value) diff --git a/elmo/elmo-mime.el b/elmo/elmo-mime.el index c3ddca3..d000a08 100644 --- a/elmo/elmo-mime.el +++ b/elmo/elmo-mime.el @@ -306,7 +306,7 @@ If third optional argument ENTIRE is non-nil, fetch entire message at once." (mime-entity-content-type message) "id")))) (elmo-message-reassembled-mime-entity folder id rawbuf - (elmo-message-entity-field entity 'subject 'decode) + (elmo-message-entity-field entity 'subject) ignore-cache unread)) message @@ -405,7 +405,7 @@ If third optional argument ENTIRE is non-nil, fetch entire message at once." (elmo-folder-do-each-message-entity (entity folder) (when (string-match subject-regexp - (elmo-message-entity-field entity 'subject 'decode)) + (elmo-message-entity-field entity 'subject)) (erase-buffer) (let* ((message (elmo-message-mime-entity-internal folder diff --git a/elmo/elmo-msgdb.el b/elmo/elmo-msgdb.el index 238a08e..a62c96d 100644 --- a/elmo/elmo-msgdb.el +++ b/elmo/elmo-msgdb.el @@ -87,19 +87,19 @@ entity number)) -(defsubst elmo-message-entity-field (entity field &optional decode) +(defsubst elmo-message-entity-field (entity field &optional type) "Get message entity field value. ENTITY is the message entity structure obtained by `elmo-message-entity'. FIELD is the symbol of the field name. -if optional DECODE is non-nil, returned value is decoded." +If optional argument TYPE is specified, return converted value." (elmo-msgdb-message-entity-field (elmo-message-entity-handler entity) - entity field decode)) + entity field type)) (defsubst elmo-message-entity-set-field (entity field value) "Set message entity field value. ENTITY is the message entity structure. FIELD is the symbol of the field name. -VALUE is the field value (raw)." +VALUE is the field value." (elmo-msgdb-message-entity-set-field (elmo-message-entity-handler entity) entity field value)) @@ -140,11 +140,9 @@ VALUE is the field value (raw)." msgdb (lambda (x y app-data) (condition-case nil - (string< - (timezone-make-date-sortable - (elmo-message-entity-field x 'date)) - (timezone-make-date-sortable - (elmo-message-entity-field y 'date))) + (elmo-time< + (elmo-message-entity-field x 'date) + (elmo-message-entity-field y 'date)) (error))))) (defsubst elmo-msgdb-get-parent-entity (entity msgdb) @@ -236,9 +234,7 @@ VALUE is the field value (raw)." (elmo-make-hash (elmo-msgdb-length msgdb)))) msg-id) (dolist (number (elmo-msgdb-list-messages msgdb)) - (when (setq msg-id (elmo-message-entity-field - (elmo-msgdb-message-entity msgdb number) - 'message-id)) + (when (setq msg-id (elmo-msgdb-message-field msgdb number 'message-id)) (elmo-flag-table-set flag-table msg-id (elmo-msgdb-flags msgdb number)))) @@ -416,34 +412,38 @@ header separator." (elmo-message-entity-set-field entity 'references references)) (defsubst elmo-msgdb-overview-entity-get-from-no-decode (entity) - (elmo-message-entity-field entity 'from)) + (elmo-with-enable-multibyte + (encode-mime-charset-string + (elmo-message-entity-field entity 'from) elmo-mime-charset))) (defsubst elmo-msgdb-overview-entity-get-from (entity) - (elmo-message-entity-field entity 'from t)) + (elmo-message-entity-field entity 'from)) (defsubst elmo-msgdb-overview-entity-set-from (entity from) (elmo-message-entity-set-field entity 'from from)) (defsubst elmo-msgdb-overview-entity-get-subject (entity) - (elmo-message-entity-field entity 'subject t)) + (elmo-message-entity-field entity 'subject)) (defsubst elmo-msgdb-overview-entity-get-subject-no-decode (entity) - (elmo-message-entity-field entity 'subject)) + (elmo-with-enable-multibyte + (encode-mime-charset-string + (elmo-message-entity-field entity 'subject) elmo-mime-charset))) (defsubst elmo-msgdb-overview-entity-set-subject (entity subject) (elmo-message-entity-set-field entity 'subject subject)) (defsubst elmo-msgdb-overview-entity-get-date (entity) - (elmo-message-entity-field entity 'date)) + (elmo-message-entity-field entity 'date 'string)) (defsubst elmo-msgdb-overview-entity-set-date (entity date) (elmo-message-entity-set-field entity 'date date)) (defsubst elmo-msgdb-overview-entity-get-to (entity) - (elmo-message-entity-field entity 'to)) + (elmo-message-entity-field entity 'to 'string)) (defsubst elmo-msgdb-overview-entity-get-cc (entity) - (elmo-message-entity-field entity 'cc)) + (elmo-message-entity-field entity 'cc 'string)) (defsubst elmo-msgdb-overview-entity-get-size (entity) (elmo-message-entity-field entity 'size)) diff --git a/elmo/elmo-multi.el b/elmo/elmo-multi.el index b8926c9..6c47a55 100644 --- a/elmo/elmo-multi.el +++ b/elmo/elmo-multi.el @@ -250,9 +250,9 @@ (elmo-message-entity-field entity 'references))) (luna-define-method elmo-message-field ((folder elmo-multi-folder) - number field) + number field &optional type) (let ((pair (elmo-multi-real-folder-number folder number))) - (elmo-message-field (car pair) (cdr pair) field))) + (elmo-message-field (car pair) (cdr pair) field type))) (luna-define-method elmo-message-flag-available-p ((folder elmo-multi-folder) number diff --git a/elmo/elmo-nmz.el b/elmo/elmo-nmz.el index 765829d..56adf88 100644 --- a/elmo/elmo-nmz.el +++ b/elmo/elmo-nmz.el @@ -107,8 +107,8 @@ If the value is a list, all elements are used as index paths for namazu." entity uid) (setq entity (elmo-msgdb-create-message-entity-from-file (elmo-msgdb-message-entity-handler msgdb) number location)) - (unless (or (> (length (elmo-message-entity-field entity 'to)) 0) - (> (length (elmo-message-entity-field entity 'cc)) 0) + (unless (or (elmo-message-entity-field entity 'to) + (elmo-message-entity-field entity 'cc) (not (string= (elmo-message-entity-field entity 'subject) elmo-no-subject))) (elmo-message-entity-set-field entity 'subject location) diff --git a/elmo/elmo-nntp.el b/elmo/elmo-nntp.el index 894e571..f23a9dd 100644 --- a/elmo/elmo-nntp.el +++ b/elmo/elmo-nntp.el @@ -734,7 +734,7 @@ Don't cache if nil.") (let ((new-msgdb (elmo-make-msgdb)) ov-list message-id entity ov-entity num - extras extra ext field field-index flags) + field field-index flags) (setq ov-list (elmo-nntp-parse-overview-string str)) (while ov-list (setq ov-entity (car ov-list)) @@ -747,33 +747,28 @@ Don't cache if nil.") (setq num (string-to-int (aref ov-entity 0))) (when (or (null numlist) (memq num numlist)) - (setq extras elmo-msgdb-extra-fields - extra nil) - (while extras - (setq ext (downcase (car extras))) - (when (setq field-index (cdr (assoc ext elmo-nntp-overview-index))) - (when (> (length ov-entity) field-index) - (setq field (aref ov-entity field-index)) - (when (eq field-index 8) ;; xref - (setq field (elmo-msgdb-remove-field-string field))) - (setq extra (cons (cons ext field) extra)))) - (setq extras (cdr extras))) (setq entity (elmo-msgdb-make-message-entity (elmo-msgdb-message-entity-handler new-msgdb) :message-id (aref ov-entity 4) :number num :references (elmo-msgdb-get-last-message-id (aref ov-entity 5)) - :from (elmo-mime-string (elmo-delete-char - ?\" - (or - (aref ov-entity 2) - elmo-no-from) 'uni)) - :subject (elmo-mime-string (or (aref ov-entity 1) - elmo-no-subject)) + :from (elmo-delete-char ?\" + (or (aref ov-entity 2) + elmo-no-from)) + :subject (or (aref ov-entity 1) + elmo-no-subject) :date (aref ov-entity 3) - :size (string-to-int (aref ov-entity 6)) - :extra extra)) + :size (string-to-int (aref ov-entity 6)))) + (dolist (extra elmo-msgdb-extra-fields) + (setq extra (downcase extra)) + (when (and (setq field-index + (cdr (assoc extra elmo-nntp-overview-index))) + (> (length ov-entity) field-index)) + (setq field (aref ov-entity field-index)) + (when (eq field-index 8) ;; xref + (setq field (elmo-msgdb-remove-field-string field))) + (elmo-message-entity-set-field entity (intern extra) field))) (setq message-id (elmo-message-entity-field entity 'message-id) flags (elmo-flag-table-get flag-table message-id)) (elmo-global-flags-set flags folder num message-id) diff --git a/elmo/elmo-pipe.el b/elmo/elmo-pipe.el index 07a12e4..f052d84 100644 --- a/elmo/elmo-pipe.el +++ b/elmo/elmo-pipe.el @@ -370,10 +370,11 @@ (elmo-message-flags (elmo-pipe-folder-dst-internal folder) number)) (luna-define-method elmo-message-field ((folder elmo-pipe-folder) - number field) + number field &optional type) (elmo-message-field (elmo-pipe-folder-dst-internal folder) number - field)) + field + type)) (luna-define-method elmo-message-set-cached ((folder elmo-pipe-folder) number cached) diff --git a/elmo/elmo-shimbun.el b/elmo/elmo-shimbun.el index 12660af..c0fd6c5 100644 --- a/elmo/elmo-shimbun.el +++ b/elmo/elmo-shimbun.el @@ -129,8 +129,7 @@ If it is the symbol `all', update overview for all shimbun folders." (elmo-shimbun-folder-set-header-hash-internal folder (setq hash (elmo-make-hash)))) - (elmo-set-hash-val (elmo-message-entity-field entity - 'message-id) + (elmo-set-hash-val (elmo-message-entity-field entity 'message-id) header hash) header))))) @@ -140,14 +139,6 @@ If it is the symbol `all', update overview for all shimbun folders." (+ (* (- (car now) (car time)) 65536) (- (nth 1 now) (nth 1 time))))) -(defun elmo-shimbun-parse-time-string (string) - "Parse the time-string STRING and return its time as Emacs style." - (ignore-errors - (let ((x (timezone-fix-time string nil nil))) - (encode-time (aref x 5) (aref x 4) (aref x 3) - (aref x 2) (aref x 1) (aref x 0) - (aref x 6))))) - (defsubst elmo-shimbun-headers-check-p (folder) (or (null (elmo-shimbun-folder-last-check-internal folder)) (and (elmo-shimbun-folder-last-check-internal folder) @@ -157,22 +148,20 @@ If it is the symbol `all', update overview for all shimbun folders." (defun elmo-shimbun-entity-to-header (entity) (let (message-id shimbun-id) - (if (setq message-id (elmo-message-entity-field - entity 'x-original-id)) + (if (setq message-id (elmo-message-entity-field entity 'x-original-id)) (setq shimbun-id (elmo-message-entity-field entity 'message-id)) (setq message-id (elmo-message-entity-field entity 'message-id) shimbun-id nil)) (elmo-with-enable-multibyte - (shimbun-make-header + (shimbun-create-header (elmo-message-entity-number entity) - (shimbun-mime-encode-string - (elmo-message-entity-field entity 'subject 'decode)) - (shimbun-mime-encode-string - (elmo-message-entity-field entity 'from 'decode)) - (elmo-message-entity-field entity 'date) + (elmo-message-entity-field entity 'subject) + (elmo-message-entity-field entity 'from) + (elmo-time-make-date-string + (elmo-message-entity-field entity 'date)) message-id (elmo-message-entity-field entity 'references) - 0 + (elmo-message-entity-field entity 'size) 0 (elmo-message-entity-field entity 'xref) (and shimbun-id @@ -392,17 +381,11 @@ If it is the symbol `all', update overview for all shimbun folders." (elmo-shimbun-folder-entity-hash folder)) (list (cons 'x-original-id message-id))) (list - (cons 'from - (elmo-mime-string (shimbun-header-from header))) - (cons 'subject - (elmo-mime-string (shimbun-header-subject header))) - (cons 'date - (shimbun-header-date header)) + (cons 'from (shimbun-header-from header 'no-encode)) + (cons 'subject (shimbun-header-subject header 'no-encode)) + (cons 'date (shimbun-header-date header)) (cons 'references - (or (elmo-msgdb-get-last-message-id - (elmo-field-body "in-reply-to")) - (elmo-msgdb-get-last-message-id - (elmo-field-body "references"))))))) + (elmo-msgdb-get-references-from-buffer))))) (elmo-emit-signal 'update-overview folder (elmo-message-entity-number entity))))) @@ -455,8 +438,7 @@ If it is the symbol `all', update overview for all shimbun folders." (when (and (elmo-message-entity-field ov 'xref) (if expire-days (< (elmo-shimbun-lapse-seconds - (elmo-shimbun-parse-time-string - (elmo-message-entity-field ov 'date))) + (elmo-message-entity-field ov 'date)) (* expire-days 86400 ; seconds per day )) t)) diff --git a/elmo/elmo-spam.el b/elmo/elmo-spam.el index 350f99e..1870d26 100644 --- a/elmo/elmo-spam.el +++ b/elmo/elmo-spam.el @@ -229,7 +229,7 @@ If optional argument RESTORE is non-nil, unregister from spam list.") (lambda (field-name) (or (elmo-message-entity-field entity (intern (downcase field-name)) - 'decode) + 'string) (progn (unless buffer (setq buffer (get-buffer-create diff --git a/elmo/elmo-util.el b/elmo/elmo-util.el index dbbe808..e2c232c 100644 --- a/elmo/elmo-util.el +++ b/elmo/elmo-util.el @@ -104,17 +104,21 @@ File content is decoded with MIME-CHARSET." (if (not (file-readable-p filename)) nil (with-temp-buffer - (as-binary-input-file - (insert-file-contents filename)) - (when mime-charset - (set-buffer-multibyte default-enable-multibyte-characters) - (decode-mime-charset-region (point-min) (point-max) mime-charset)) + (insert-file-contents-as-binary filename) + (let ((coding-system (or (funcall set-auto-coding-function + filename + (- (point-max) (point-min))) + (mime-charset-to-coding-system + mime-charset)))) + (when coding-system + (decode-coding-region (point-min) (point-max) coding-system))) + (goto-char (point-min)) (condition-case nil (read (current-buffer)) (error (unless no-err (message "Warning: Loading object from %s failed." filename) - (elmo-object-save filename nil)) + (elmo-object-save filename nil mime-charset)) nil))))) (defsubst elmo-save-buffer (filename &optional mime-charset) @@ -142,8 +146,15 @@ File content is encoded with MIME-CHARSET." (with-temp-buffer (let (print-length print-level) (prin1 object (current-buffer))) -;;; (princ "\n" (current-buffer)) - (elmo-save-buffer filename mime-charset))) + (when mime-charset + (let ((coding (mime-charset-to-coding-system + (or (detect-mime-charset-region (point-min) (point-max)) + mime-charset)))) + (goto-char (point-min)) + (insert ";;; -*- mode: emacs-lisp; coding: " + (symbol-name coding) " -*-\n") + (encode-coding-region (point-min) (point-max) coding))) + (elmo-save-buffer filename))) ;;; Search Condition @@ -1996,6 +2007,13 @@ If ALIST is nil, `elmo-obsolete-variable-alist' is used." (nth 1 (eword-extract-address-components (or (elmo-field-body "from") "nobody"))) ">")))) +(defun elmo-msgdb-get-references-from-buffer () + (if elmo-msgdb-prefer-in-reply-to-for-parent + (or (elmo-msgdb-get-last-message-id (elmo-field-body "in-reply-to")) + (elmo-msgdb-get-last-message-id (elmo-field-body "references"))) + (or (elmo-msgdb-get-last-message-id (elmo-field-body "references")) + (elmo-msgdb-get-last-message-id (elmo-field-body "in-reply-to"))))) + (defsubst elmo-msgdb-insert-file-header (file) "Insert the header of the article." (let ((beg 0) @@ -2029,6 +2047,48 @@ If ALIST is nil, `elmo-obsolete-variable-alist' is used." (match-end 0) (std11-field-end)))))) field-body)))) +(defun elmo-parse-addresses (string) + (if (null string) + () + (elmo-set-work-buf + (let (list start s char) + (insert string) + (goto-char (point-min)) + (skip-chars-forward "\t\f\n\r ") + (setq start (point)) + (while (not (eobp)) + (skip-chars-forward "^\"\\,(") + (setq char (following-char)) + (cond ((= char ?\\) + (forward-char 1) + (if (not (eobp)) + (forward-char 1))) + ((= char ?,) + (setq s (buffer-substring start (point))) + (if (or (null (string-match "^[\t\f\n\r ]+$" s)) + (not (string= s ""))) + (setq list (cons s list))) + (skip-chars-forward ",\t\f\n\r ") + (setq start (point))) + ((= char ?\") + (re-search-forward "[^\\]\"" nil 0)) + ((= char ?\() + (let ((parens 1)) + (forward-char 1) + (while (and (not (eobp)) (not (zerop parens))) + (re-search-forward "[()]" nil 0) + (cond ((or (eobp) + (= (char-after (- (point) 2)) ?\\))) + ((= (preceding-char) ?\() + (setq parens (1+ parens))) + (t + (setq parens (1- parens))))))))) + (setq s (buffer-substring start (point))) + (if (and (null (string-match "^[\t\f\n\r ]+$" s)) + (not (string= s ""))) + (setq list (cons s list))) + (nreverse list))))) + ;;; Queue. (defvar elmo-dop-queue-filename "queue" "*Disconnected operation queue is saved in this file.") diff --git a/elmo/elmo-vars.el b/elmo/elmo-vars.el index 62945c3..2c40a47 100644 --- a/elmo/elmo-vars.el +++ b/elmo/elmo-vars.el @@ -278,6 +278,13 @@ For disconnected operations.") (defvar elmo-strict-diff-folder-list nil "List of regexps of folder name which should be checked its diff strictly.") +(defcustom elmo-msgdb-prefer-in-reply-to-for-parent nil + "*Non-nil to prefer In-Reply-To header for finding parent message on thread, +rather than References header." + :type 'boolean + :group 'elmo + :group 'elmo-setting) + (defcustom elmo-msgdb-extra-fields nil "Extra fields for msgdb." :type '(repeat string) diff --git a/elmo/elmo.el b/elmo/elmo.el index a55fb99..15d7438 100644 --- a/elmo/elmo.el +++ b/elmo/elmo.el @@ -1271,14 +1271,16 @@ If optional IS-LOCAL is non-nil, update only local (not server) status." ;; XXX Transitional implementation. (elmo-folder-unset-flag folder (list number) flag is-local)) -(luna-define-generic elmo-message-field (folder number field) +(luna-define-generic elmo-message-field (folder number field &optional type) "Get message field value in the msgdb. FOLDER is the ELMO folder structure. NUMBER is a number of the message. -FIELD is a symbol of the field.") +FIELD is a symbol of the field. +If optional argument TYPE is specified, return converted value.") -(luna-define-method elmo-message-field ((folder elmo-folder) number field) - (elmo-msgdb-message-field (elmo-folder-msgdb folder) number field)) +(luna-define-method elmo-message-field ((folder elmo-folder) + number field &optional type) + (elmo-msgdb-message-field (elmo-folder-msgdb folder) number field type)) (luna-define-generic elmo-message-set-field (folder number field value) "Set message field value in the msgdb. diff --git a/elmo/modb-entity.el b/elmo/modb-entity.el index c39c733..71572e2 100644 --- a/elmo/modb-entity.el +++ b/elmo/modb-entity.el @@ -43,10 +43,11 @@ :type 'symbol :group 'elmo) -(defcustom elmo-msgdb-prefer-in-reply-to-for-parent nil - "*Non-nil to prefer In-Reply-To header for finding parent message on thread, -rather than References header." - :type 'boolean +(defcustom modb-entity-field-extractor-alist + '((ml-info . modb-entity-extract-mailing-list-info)) + "*An alist of field name and function to extract field body from buffer." + :type '(repeat (cons (symbol :tag "Field Name") + (function :tag "Function"))) :group 'elmo) (defvar modb-entity-default-cache-internal nil) @@ -72,14 +73,13 @@ rather than References header." entity number) "Set number of the ENTITY.") -(luna-define-generic elmo-msgdb-message-entity-field (handler - entity field - &optional decode) +(luna-define-generic elmo-msgdb-message-entity-field (handler entity field + &optional type) "Retrieve field value of the message entity. HANDLER is the message entity handler. ENTITY is the message entity structure. FIELD is a symbol of the field. -If optional DECODE is no-nil, the field value is decoded.") +If optional argument TYPE is specified, return converted value.") (luna-define-generic elmo-msgdb-message-entity-set-field (handler entity field value) @@ -96,10 +96,13 @@ HANDLER is the message entity handler. ENTITY is the message entity structure. VALUES is an alist of field-name and field-value.") -(luna-define-generic elmo-msgdb-copy-message-entity (handler entity) +(luna-define-generic elmo-msgdb-copy-message-entity (handler entity + &optional + make-handler) "Copy message entity. HANDLER is the message entity handler. -ENTITY is the message entity structure.") +ENTITY is the message entity structure. +If optional argument MAKE-HANDLER is specified, use it to make new entity.") (luna-define-generic elmo-msgdb-create-message-entity-from-file (handler number @@ -161,7 +164,7 @@ Header region is supposed to be narrowed.") (luna-define-method elmo-msgdb-message-entity-field ((handler modb-entity-handler) entity field - &optional decode) + &optional type) (plist-get (cdr entity) (intern (concat ":" (symbol-name field))))) (luna-define-method elmo-msgdb-message-entity-number ((handler @@ -181,13 +184,42 @@ Header region is supposed to be narrowed.") (setq updated t))) updated)) -;; Legacy implementation. -(eval-and-compile (luna-define-class modb-legacy-entity-handler - (modb-entity-handler))) -;; +;; field in/out converter +(defun modb-set-field-converter (converter type &rest specs) + "Set convert function of TYPE into CONVERTER. +SPECS must be like `FIELD1 FUNCTION1 FIELD2 FUNCTION2 ...'. +If each field is t, function is set as default converter." + (when specs + (let ((alist (symbol-value converter)) + (type (or type t))) + (while specs + (let ((field (pop specs)) + (function (pop specs)) + cell) + (if (setq cell (assq type alist)) + (setcdr cell (put-alist field function (cdr cell))) + (setq cell (cons type (list (cons field function))) + alist (cons cell alist))) + ;; support colon keyword (syntax sugar). + (unless (or (eq field t) + (string-match "^:" (symbol-name field))) + (setcdr cell (put-alist (intern (concat ":" (symbol-name field))) + function + (cdr cell)))))) + (set converter alist)))) +(put 'modb-set-field-converter 'lisp-indent-function 2) + +(defsubst modb-convert-field-value (converter field value &optional type) + (and value + (let* ((alist (cdr (assq (or type t) converter))) + (function (cdr (or (assq field alist) + (assq t alist))))) + (if function + (funcall function field value) + value)))) + ;; mime decode cache -;; (defvar elmo-msgdb-decoded-cache-hashtb nil) (make-variable-buffer-local 'elmo-msgdb-decoded-cache-hashtb) @@ -206,18 +238,157 @@ Header region is supposed to be narrowed.") (elmo-with-enable-multibyte (decode-mime-charset-string string elmo-mime-charset)))) +(defun modb-entity-string-decoder (field value) + (elmo-msgdb-get-decoded-cache value)) + +(defun modb-entity-string-encoder (field value) + (elmo-with-enable-multibyte + (encode-mime-charset-string value elmo-mime-charset))) + +(defun modb-entity-parse-date-string (field value) + (if (stringp value) + (elmo-time-parse-date-string value) + value)) + +(defun modb-entity-make-date-string (field value) + (if (stringp value) + value + (elmo-time-make-date-string value))) + +(defun modb-entity-mime-decoder (field value) + (mime-decode-field-body value (symbol-name field) 'summary)) + +(defun modb-entity-mime-encoder (field value) + (mime-encode-field-body value (symbol-name field))) + +(defun modb-entity-address-list-decoder (field value) + (if (stringp value) + (mapcar (lambda (address) + (mime-decode-field-body address (symbol-name field))) + (elmo-parse-addresses value)) + value)) + +(defun modb-entity-address-list-encoder (field value) + (if (stringp value) + value + (mime-encode-field-body (mapconcat 'identity value ", ") + (symbol-name field)))) + +(defun modb-entity-parse-address-string (field value) + (if (stringp value) + (elmo-parse-addresses value) + value)) + +(defun modb-entity-make-address-string (field value) + (if (stringp value) + value + (mapconcat 'identity value ", "))) + + +(defun modb-entity-create-field-indices (slots) + (let ((index 0) + indices) + (while slots + (setq indices (cons (cons (car slots) index) indices) + index (1+ index) + slots (cdr slots))) + (append + indices + (mapcar (lambda (cell) + (cons (intern (concat ":" (symbol-name (car cell)))) + (cdr cell))) + indices)))) + + +;; Legacy implementation. +(eval-and-compile + (luna-define-class modb-legacy-entity-handler (modb-entity-handler))) + +(defconst modb-legacy-entity-field-slots + '(number + references + from + subject + date + to + cc + size + extra)) + +(defconst modb-legacy-entity-field-indices + (modb-entity-create-field-indices modb-legacy-entity-field-slots)) + +(defvar modb-legacy-entity-normalizer nil) +(modb-set-field-converter 'modb-legacy-entity-normalizer nil + 'message-id nil + 'number nil + 'references nil + 'from #'modb-entity-string-encoder + 'subject #'modb-entity-string-encoder + 'date #'modb-entity-make-date-string + 'to #'modb-entity-address-list-encoder + 'cc #'modb-entity-address-list-encoder + 'size nil + t #'modb-entity-mime-encoder) + +(defvar modb-legacy-entity-specializer nil) +;; default type +(modb-set-field-converter 'modb-legacy-entity-specializer nil + 'message-id nil + 'number nil + 'references nil + 'from #'modb-entity-string-decoder + 'subject #'modb-entity-string-decoder + 'date #'modb-entity-parse-date-string + 'to #'modb-entity-address-list-decoder + 'cc #'modb-entity-address-list-decoder + 'size nil + t #'modb-entity-mime-decoder) +;; string type +(modb-set-field-converter 'modb-legacy-entity-specializer 'string + 'message-id nil + 'number nil ; not supported + 'references nil + 'from #'modb-entity-string-decoder + 'subject #'modb-entity-string-decoder + 'date nil + 'size nil ; not supported + t #'modb-entity-mime-decoder) + + +(defmacro modb-legacy-entity-field-index (field) + `(cdr (assq ,field modb-legacy-entity-field-indices))) + +(defsubst modb-legacy-entity-set-field (entity field value &optional as-is) + (when entity + (let (index) + (unless as-is + (setq value (modb-convert-field-value + modb-legacy-entity-normalizer + field value))) + (cond ((memq field '(message-id :message-id)) + (setcar entity value)) + ((setq index (modb-legacy-entity-field-index field)) + (aset (cdr entity) index value)) + (t + (setq index (modb-legacy-entity-field-index :extra)) + (let ((extras (and entity (aref (cdr entity) index))) + extra) + (if (setq extra (assoc (symbol-name field) extras)) + (setcdr extra value) + (aset (cdr entity) index (cons (cons (symbol-name field) + value) extras))))))))) + (defsubst modb-legacy-make-message-entity (args) "Make an message entity." - (cons (plist-get args :message-id) - (vector (plist-get args :number) - (plist-get args :references) - (plist-get args :from) - (plist-get args :subject) - (plist-get args :date) - (plist-get args :to) - (plist-get args :cc) - (plist-get args :size) - (plist-get args :extra)))) + (let ((entity (cons nil (make-vector 9 nil))) + field value) + (while args + (setq field (pop args) + value (pop args)) + (when value + (modb-legacy-entity-set-field entity field value))) + entity)) (luna-define-method elmo-msgdb-make-message-entity ((handler modb-legacy-entity-handler) args) @@ -237,15 +408,7 @@ Header region is supposed to be narrowed.") (setq charset (intern-soft charset)) (setq default-mime-charset charset)) (setq references - (if elmo-msgdb-prefer-in-reply-to-for-parent - (or (elmo-msgdb-get-last-message-id - (elmo-field-body "in-reply-to")) - (elmo-msgdb-get-last-message-id - (elmo-field-body "references"))) - (or (elmo-msgdb-get-last-message-id - (elmo-field-body "references")) - (elmo-msgdb-get-last-message-id - (elmo-field-body "in-reply-to")))) + (elmo-msgdb-get-references-from-buffer) from (elmo-replace-in-string (elmo-mime-string (or (elmo-field-body "from") elmo-no-from)) @@ -254,7 +417,7 @@ Header region is supposed to be narrowed.") (elmo-mime-string (or (elmo-field-body "subject") elmo-no-subject)) "\t" " ") - date (elmo-unfold-field-body "date") + date (elmo-decoded-field-body "date") to (mapconcat 'identity (elmo-multiple-field-body "to") ",") cc (mapconcat 'identity (elmo-multiple-field-body "cc") ",")) (unless (elmo-msgdb-message-entity-field handler entity 'size) @@ -263,14 +426,14 @@ Header region is supposed to be narrowed.") (setq size 0))) (while extras (if (setq field-body (elmo-field-body (car extras))) - (elmo-msgdb-message-entity-set-field - handler entity (intern (downcase (car extras))) field-body)) + (modb-legacy-entity-set-field + entity (intern (downcase (car extras))) field-body 'as-is)) (setq extras (cdr extras))) (dolist (field '(message-id number references from subject date to cc size)) (when (symbol-value field) - (elmo-msgdb-message-entity-set-field - handler entity field (symbol-value field)))) + (modb-legacy-entity-set-field + entity field (symbol-value field) 'as-is))) entity))) (luna-define-method elmo-msgdb-message-entity-number @@ -283,51 +446,43 @@ Header region is supposed to be narrowed.") entity) (luna-define-method elmo-msgdb-message-entity-field - ((handler modb-legacy-entity-handler) entity field &optional decode) + ((handler modb-legacy-entity-handler) entity field &optional type) (and entity - (let ((field-value - (case field - (to (aref (cdr entity) 5)) - (cc (aref (cdr entity) 6)) - (date (aref (cdr entity) 4)) - (subject (aref (cdr entity) 3)) - (from (aref (cdr entity) 2)) - (message-id (car entity)) - (references (aref (cdr entity) 1)) - (size (aref (cdr entity) 7)) - (t (cdr (assoc (symbol-name field) (aref (cdr entity) 8))))))) - (if (and decode (memq field '(from subject))) - (elmo-msgdb-get-decoded-cache field-value) - field-value)))) + (let (index) + (modb-convert-field-value + modb-legacy-entity-specializer + field + (cond ((memq field '(message-id :message-id)) + (car entity)) + ((setq index (modb-legacy-entity-field-index field)) + (aref (cdr entity) index)) + (t + (setq index (modb-legacy-entity-field-index :extra)) + (cdr (assoc (symbol-name field) + (aref (cdr entity) index))))) + type)))) (luna-define-method elmo-msgdb-message-entity-set-field ((handler modb-legacy-entity-handler) entity field value) - (and entity - (case field - (number (aset (cdr entity) 0 value)) - (to (aset (cdr entity) 5 value)) - (cc (aset (cdr entity) 6 value)) - (date (aset (cdr entity) 4 value)) - (subject (aset (cdr entity) 3 value)) - (from (aset (cdr entity) 2 value)) - (message-id (setcar entity value)) - (references (aset (cdr entity) 1 value)) - (size (aset (cdr entity) 7 value)) - (t - (let ((extras (and entity (aref (cdr entity) 8))) - extra) - (if (setq extra (assoc (symbol-name field) extras)) - (setcdr extra value) - (aset (cdr entity) 8 (cons (cons (symbol-name field) - value) extras)))))))) + (modb-legacy-entity-set-field entity field value)) (luna-define-method elmo-msgdb-copy-message-entity - ((handler modb-legacy-entity-handler) entity) - (cons (car entity) - (copy-sequence (cdr entity)))) + ((handler modb-legacy-entity-handler) entity &optional make-handler) + (if make-handler + (let ((copy (elmo-msgdb-make-message-entity make-handler))) + (dolist (field (append '(message-id number references from subject + date to cc size) + (mapcar (lambda (extra) (intern (car extra))) + (aref (cdr entity) 8)))) + (elmo-msgdb-message-entity-set-field + make-handler copy field + (elmo-msgdb-message-entity-field handler entity field))) + copy) + (cons (car entity) + (copy-sequence (cdr entity))))) (luna-define-method elmo-msgdb-message-match-condition - ((handler modb-legacy-entity-handler) condition entity flags numbers) + ((handler modb-entity-handler) condition entity flags numbers) (cond ((vectorp condition) (elmo-msgdb-match-condition-primitive handler condition @@ -413,41 +568,38 @@ Header region is supposed to be narrowed.") (setq result (string-match (elmo-filter-value condition) (elmo-msgdb-message-entity-field - handler entity 'from t)))) + handler entity 'from)))) ((string= key "subject") (setq result (string-match (elmo-filter-value condition) (elmo-msgdb-message-entity-field - handler entity 'subject t)))) + handler entity 'subject)))) ((string= key "to") (setq result (string-match (elmo-filter-value condition) (elmo-msgdb-message-entity-field - handler entity 'to)))) + handler entity 'to 'string)))) ((string= key "cc") (setq result (string-match (elmo-filter-value condition) (elmo-msgdb-message-entity-field - handler entity 'cc)))) + handler entity 'cc 'string)))) ((or (string= key "since") (string= key "before")) - (let ((field-date (elmo-date-make-sortable-string - (timezone-fix-time - (elmo-msgdb-message-entity-field - handler entity 'date) - (current-time-zone) nil))) + (let ((field-date (elmo-msgdb-message-entity-field + handler entity 'date)) (specified-date - (elmo-date-make-sortable-string + (elmo-datevec-to-time (elmo-date-get-datevec (elmo-filter-value condition))))) (setq result (if (string= key "since") - (or (string= specified-date field-date) - (string< specified-date field-date)) - (string< field-date specified-date))))) + (not (elmo-time< field-date specified-date)) + (elmo-time< field-date specified-date))))) ((member key elmo-msgdb-extra-fields) (let ((extval (elmo-msgdb-message-entity-field handler entity - (intern key)))) + (intern key) + 'string))) (when (stringp extval) (setq result (string-match (elmo-filter-value condition) @@ -458,6 +610,266 @@ Header region is supposed to be narrowed.") (not result) result)))) + +;; Standard implementation. +(eval-and-compile + (luna-define-class modb-standard-entity-handler (modb-entity-handler))) + +(defconst modb-standard-entity-field-slots + '(number + from + subject + date + to + cc + content-type + references + size + score + extra)) + +(defconst modb-standard-entity-field-indices + (modb-entity-create-field-indices modb-standard-entity-field-slots)) + +(defvar modb-standard-entity-normalizer nil) +(modb-set-field-converter 'modb-standard-entity-normalizer nil + 'date #'modb-entity-parse-date-string + 'to #'modb-entity-parse-address-string + 'cc #'modb-entity-parse-address-string + t nil) + +(defvar modb-standard-entity-specializer nil) +(modb-set-field-converter 'modb-standard-entity-specializer nil t nil) +(modb-set-field-converter 'modb-standard-entity-specializer 'string + 'date #'modb-entity-make-date-string + 'to #'modb-entity-make-address-string + 'cc #'modb-entity-make-address-string + 'ml-info #'modb-entity-make-mailing-list-info-string + t nil) + +(defmacro modb-standard-entity-field-index (field) + `(cdr (assq ,field modb-standard-entity-field-indices))) + +(defsubst modb-standard-entity-set-field (entity field value &optional as-is) + (when entity + (let (index) + (unless as-is + (setq value (modb-convert-field-value modb-standard-entity-normalizer + field value))) + (cond ((memq field '(message-id :message-id)) + (setcar (cdr entity) value)) + ((setq index (modb-standard-entity-field-index field)) + (aset (cdr (cdr entity)) index value)) + (t + (setq index (modb-standard-entity-field-index :extra)) + (let ((extras (aref (cdr (cdr entity)) index)) + cell) + (if (setq cell (assq field extras)) + (setcdr cell value) + (aset (cdr (cdr entity)) + index + (cons (cons field value) extras))))))))) + +(defsubst modb-standard-make-message-entity (handler args) + (let ((entity (cons handler + (cons nil + (make-vector + (length modb-standard-entity-field-slots) + nil)))) + field value) + (while args + (setq field (pop args) + value (pop args)) + (when value + (modb-standard-entity-set-field entity field value))) + entity)) + +(luna-define-method elmo-msgdb-make-message-entity + ((handler modb-standard-entity-handler) args) + (modb-standard-make-message-entity handler args)) + +(luna-define-method elmo-msgdb-message-entity-number + ((handler modb-standard-entity-handler) entity) + (and entity (aref (cdr (cdr entity)) 0))) + +(luna-define-method elmo-msgdb-message-entity-set-number + ((handler modb-standard-entity-handler) entity number) + (and entity (aset (cdr (cdr entity)) 0 number))) + +(luna-define-method elmo-msgdb-message-entity-field + ((handler modb-standard-entity-handler) entity field &optional type) + (and entity + (let (index) + (modb-convert-field-value + modb-standard-entity-specializer + field + (cond ((memq field '(message-id :message-id)) + (car (cdr entity))) + ((setq index (modb-standard-entity-field-index field)) + (aref (cdr (cdr entity)) index)) + (t + (setq index (modb-standard-entity-field-index :extra)) + (cdr (assq field (aref (cdr (cdr entity)) index))))) + type)))) + +(luna-define-method elmo-msgdb-message-entity-set-field + ((handler modb-standard-entity-handler) entity field value) + (modb-standard-entity-set-field entity field value)) + +(luna-define-method elmo-msgdb-copy-message-entity + ((handler modb-standard-entity-handler) entity &optional make-handler) + (if make-handler + (let ((copy (elmo-msgdb-make-message-entity make-handler))) + (dolist (field (nconc + (delq 'extra + (copy-sequence modb-standard-entity-field-slots)) + (mapcar 'car + (aref + (cdr entity) + (modb-standard-entity-field-index :extra))) + '(message-id))) + (elmo-msgdb-message-entity-set-field + make-handler copy field + (elmo-msgdb-message-entity-field handler entity field))) + copy) + (cons handler + (cons (car (cdr entity)) + (copy-sequence (cdr (cdr entity))))))) + +(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) + (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 + (append + args + (list + :number + number + :message-id + (elmo-msgdb-get-message-id-from-buffer) + :references + (elmo-msgdb-get-references-from-buffer) + :from + (elmo-replace-in-string + (or (elmo-decoded-field-body "from" 'summary) + elmo-no-from) + "\t" " ") + :subject + (elmo-replace-in-string + (or (elmo-decoded-field-body "subject" 'summary) + elmo-no-subject) + "\t" " ") + :date + (elmo-decoded-field-body "date" 'summary) + :to + (mapconcat + (lambda (field-body) + (mime-decode-field-body field-body "to" 'summary)) + (elmo-multiple-field-body "to") ",") + :cc + (mapconcat + (lambda (field-body) + (mime-decode-field-body field-body "cc" 'summary)) + (elmo-multiple-field-body "cc") ",") + :content-type + content-type + :size + (let ((size (elmo-field-body "content-length"))) + (if size + (string-to-int 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)) + field-body (if extractor + (funcall extractor field-name) + (elmo-decoded-field-body extra 'summary))) + (when field-body + (modb-standard-entity-set-field entity field-name field-body)))) + entity))) + + +;; 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)))))) + +(defun modb-entity-make-mailing-list-info-string (field value) + (when (car value) + (format (if (cdr value) "(%s %05.0f)" "(%s)") + (car value) (cdr value)))) + (require 'product) (product-provide (provide 'modb-entity) (require 'elmo-version)) diff --git a/elmo/modb-standard.el b/elmo/modb-standard.el index 46e4b61..77646ba 100644 --- a/elmo/modb-standard.el +++ b/elmo/modb-standard.el @@ -40,12 +40,6 @@ number) :group 'elmo) -(defcustom modb-standard-economize-entity-size t - "*Economize message entity size. -When non-nil, redundunt message-id string are not saved." - :type 'boolean - :group 'elmo) - (defvar modb-standard-entity-filename "entity" "Message entity database.") @@ -196,44 +190,73 @@ When non-nil, redundunt message-id string are not saved." (defun modb-standard-load-entity (modb path &optional section) (let ((table (or (modb-standard-entity-map-internal modb) (elmo-make-hash (elmo-msgdb-length modb)))) + (objects (elmo-object-load + (expand-file-name + (modb-standard-entity-filename section) + path))) number msgid) - (dolist (entity (elmo-object-load - (expand-file-name - (modb-standard-entity-filename section) - path))) - (setq number (elmo-msgdb-message-entity-number - (elmo-message-entity-handler entity) - entity) - msgid (modb-standard-loaded-message-id modb number)) - (when msgid - (setcar entity msgid) - (elmo-set-hash-val msgid entity table) - (elmo-set-hash-val (modb-standard-key number) entity table))) + (cond ((eq (car objects) 'modb-standard-entity-handler) + ;; (standard PARAMETERS ENTITY*) + ;; PARAMETERS is nil (reserved for future extention). + (let ((handler (apply #'luna-make-entity + (car objects) + (car (cdr objects)))) + entity) + (dolist (element (cdr (cdr objects))) + (setq entity (cons handler (cons nil element)) + number (elmo-msgdb-message-entity-number handler entity) + msgid (modb-standard-loaded-message-id modb number)) + (when msgid + (elmo-msgdb-message-entity-set-field + handler entity 'message-id msgid) + (elmo-set-hash-val (modb-standard-key number) entity table) + (elmo-set-hash-val msgid entity table))))) + (t + ;; legacy format + (dolist (entity objects) + (setq number (elmo-msgdb-message-entity-number + (elmo-message-entity-handler entity) + entity) + msgid (modb-standard-loaded-message-id modb number)) + (when msgid + (setcar entity msgid) + (elmo-set-hash-val (modb-standard-key number) entity table) + (elmo-set-hash-val msgid entity table))))) (modb-standard-set-entity-map-internal modb table))) (defsubst modb-standard-save-entity-1 (modb path &optional section) (let ((table (modb-standard-entity-map-internal modb)) (filename (expand-file-name - (modb-standard-entity-filename section) path)) + (modb-standard-entity-filename (car section)) path)) + (handler (elmo-msgdb-message-entity-handler modb)) entity entities) - (dolist (number (modb-standard-number-list-internal modb)) - (when (and (or (null section) - (= section (/ number modb-standard-divide-number))) - (setq entity (elmo-msgdb-message-entity modb number))) - (when modb-standard-economize-entity-size - (when (stringp (car entity)) - (setq entity (cons t (cdr entity))))) - (setq entities (cons entity entities)))) + (dolist (number (or (cdr section) + (modb-standard-number-list-internal modb))) + (when (setq entity (elmo-msgdb-message-entity modb number)) + (unless (eq (luna-class-name (elmo-message-entity-handler entity)) + (luna-class-name handler)) + (setq entity (elmo-msgdb-copy-message-entity + (elmo-message-entity-handler entity) + entity handler))) + (setq entities (cons (cdr (cdr entity)) entities)))) (if entities - (elmo-object-save filename entities) + (elmo-object-save filename + (cons (luna-class-name handler) (cons nil entities)) + elmo-mime-charset) (ignore-errors (delete-file filename))))) (defun modb-standard-save-entity (modb path) - (let ((sections (modb-generic-message-modified-internal modb))) - (cond ((listp sections) - (dolist (section sections) - (modb-standard-save-entity-1 modb path section))) - (sections + (let ((modified (modb-generic-message-modified-internal modb))) + (cond ((listp modified) + (let ((sections (mapcar 'list modified)) + section) + (dolist (number (modb-standard-number-list-internal modb)) + (when (setq section (assq (/ number modb-standard-divide-number) + sections)) + (nconc section (list number)))) + (dolist (section sections) + (modb-standard-save-entity-1 modb path section)))) + (modified (modb-standard-save-entity-1 modb path))))) ;;; Implement @@ -553,7 +576,7 @@ When non-nil, redundunt message-id string are not saved." (elmo-message-entity-number ret)))) (luna-define-method elmo-msgdb-message-field ((msgdb modb-standard) - number field) + number field &optional type) (let ((ret (elmo-get-hash-val (modb-standard-key number) (modb-standard-entity-map-internal msgdb)))) @@ -562,7 +585,7 @@ When non-nil, redundunt message-id string are not saved." (cdr (cdr ret)) (elmo-message-entity-field (elmo-msgdb-message-entity msgdb (modb-standard-key number)) - field)))) + field type)))) (luna-define-method elmo-msgdb-message-entity ((msgdb modb-standard) key) (when key @@ -572,6 +595,13 @@ When non-nil, redundunt message-id string are not saved." ((numberp key) (modb-standard-key key))) 'autoload))) +(defvar modb-standard-default-entity-handler nil) + +(luna-define-method elmo-msgdb-message-entity-handler ((msgdb modb-standard)) + (or modb-standard-default-entity-handler + (setq modb-standard-default-entity-handler + (luna-make-entity 'modb-standard-entity-handler)))) + (require 'product) (product-provide (provide 'modb-standard) (require 'elmo-version)) diff --git a/elmo/modb.el b/elmo/modb.el index 891ffed..6741ee6 100644 --- a/elmo/modb.el +++ b/elmo/modb.el @@ -162,15 +162,17 @@ KEY is a number or a string. A number is for message number in the MSGDB. A string is for message-id of the message.") -(luna-define-generic elmo-msgdb-message-field (msgdb number field) +(luna-define-generic elmo-msgdb-message-field (msgdb number field + &optional type) "Get message field value in the MSGDB. NUMBER is a number of the message. -FIELD is a symbol of the field.") +FIELD is a symbol of the field. +If optional argument TYPE is specified, return converted value.") (luna-define-method elmo-msgdb-message-field ((msgdb modb-generic) - number field) + number field &optional type) (elmo-message-entity-field (elmo-msgdb-message-entity msgdb number) - field)) + field type)) (luna-define-generic elmo-msgdb-message-entity-handler (msgdb) "Get modb entity handler instance which corresponds to the MSGDB.") @@ -217,7 +219,7 @@ FIELD is a symbol of the field.") (let ((entity (elmo-msgdb-message-entity msgdb number))) (if entity (elmo-msgdb-message-match-condition - (elmo-msgdb-message-entity-handler msgdb) + (elmo-message-entity-handler entity) condition entity (elmo-msgdb-flags msgdb number) diff --git a/wl/ChangeLog b/wl/ChangeLog index 0eb0bd7..417c7c4 100644 --- a/wl/ChangeLog +++ b/wl/ChangeLog @@ -1,5 +1,42 @@ 2005-03-20 Hiroya Murata + * wl-util.el (wl-parse-addresses): Define alias of + `elmo-parse-addresses' (move to `elmo-util.el'). + + * wl-summary.el (wl-summary-default-from): Follow the API change. + (wl-summary-overview-entity-compare-by-date): Ditto. + (wl-summary-overview-entity-compare-by-from): Ditto. + (wl-summary-get-list-info): Get value of `ml-info' field from + entity at first. + (wl-summary-rescan-message): Treat prefix argument. + (wl-summary-prefetch-msg): Follow the API change. + (wl-summary-search-by-subject): Ditto. + (wl-summary-insert-thread): Ditto. + (wl-summary-line-subject): Ditto. + (wl-summary-line-from): Ditto. + (wl-summary-create-line): Ditto. + (wl-summary-print-message-with-ps-print): Ditto. + + * wl-score.el (wl-score-ov-entity-get): Ditto. + (wl-score-followup): Ditto. + (wl-score-add-followups): Use `elmo-message-entity-field' instead + of `car'. + (wl-score-get-latest-msgs): Follow the API change. + (wl-score-get-header): Ditto. + + * wl-refile.el (wl-refile-learn): Ditto. + (wl-refile-subject-learn): Ditto. + (wl-refile-get-field-value): Ditto. + (wl-refile-guess-by-history): Ditto. + (wl-refile-guess-by-subject): Ditto. + + * wl-mime.el (wl-mime-combine-message/partial-pieces): Ditto. + + * wl-expire.el (wl-expire-date-p): Removed. + (wl-expire-archive-date): Follow the API change. + (wl-expire-localdir-date): Ditto. + (wl-summary-expire): Ditto. + * Version number is increased to 2.15.1. 2005-03-20 Yoichi NAKAYAMA diff --git a/wl/wl-expire.el b/wl/wl-expire.el index b705c38..61b4931 100644 --- a/wl/wl-expire.el +++ b/wl/wl-expire.el @@ -78,16 +78,6 @@ (timezone-make-time-string (aref (, date) 3) (aref (, date) 4) (aref (, date) 5))))) -(defsubst wl-expire-date-p (key-datevec date) - (let ((datevec (condition-case nil - (timezone-fix-time date nil nil) - (error nil)))) - (and - datevec (> (aref datevec 1) 0) - (string< - (wl-expire-make-sortable-date datevec) - (wl-expire-make-sortable-date key-datevec))))) - ;; New functions to avoid accessing to the msgdb directly. (defsubst wl-expire-message-p (folder number) "Return non-nil when a message in the FOLDER with NUMBER can be expired." @@ -465,7 +455,8 @@ Refile to archive folder followed message date." (wl-append deleted-list (car (wl-expire-delete folder dels)))) (setq delete-list (car tmp)) (while (setq msg (wl-pop delete-list)) - (setq date (elmo-message-field folder msg 'date)) + (setq date (elmo-time-make-date-string + (elmo-message-field folder msg 'date))) (setq time (condition-case nil (timezone-fix-time date nil nil) @@ -549,7 +540,8 @@ ex. +ml/wl/1999_11/, +ml/wl/1999_12/." msg arcmsg-alist arcmsg-list deleted-list ret-val) (while (setq msg (wl-pop delete-list)) - (setq date (elmo-message-field folder msg 'date)) + (setq date (elmo-time-make-date-string + (elmo-message-field folder msg 'date))) (setq time (condition-case nil (timezone-fix-time date nil nil) @@ -644,14 +636,15 @@ ex. +ml/wl/1999_11/, +ml/wl/1999_12/." (setq count (1- count)))) (setq msgs (cdr msgs)))))) ((eq val-type 'date) - (let* ((key-date (elmo-date-get-offset-datevec - (timezone-fix-time (current-time-string) - (current-time-zone) nil) - value t))) + (let* ((key-date (elmo-datevec-to-time + (elmo-date-get-offset-datevec + (timezone-fix-time (current-time-string) + (current-time-zone) nil) + value t)))) (elmo-folder-do-each-message-entity (entity folder) - (when (wl-expire-date-p - key-date - (elmo-message-entity-field entity 'date)) + (when (elmo-time< + (elmo-message-entity-field entity 'date) + key-date) (wl-append delete-list (list (elmo-message-entity-number entity))))))) (t diff --git a/wl/wl-mime.el b/wl/wl-mime.el index f30f6a3..f49c093 100644 --- a/wl/wl-mime.el +++ b/wl/wl-mime.el @@ -698,7 +698,7 @@ With ARG, ask destination folder." (elmo-folder-do-each-message-entity (entity folder) (when (string-match (regexp-quote subject-id) - (elmo-message-entity-field entity 'subject 'decode)) + (elmo-message-entity-field entity 'subject)) (let* ((message ;; request message at the cursor in Subject buffer. (wl-message-request-partial diff --git a/wl/wl-refile.el b/wl/wl-refile.el index b128365..4b134c6 100644 --- a/wl/wl-refile.el +++ b/wl/wl-refile.el @@ -86,13 +86,11 @@ (let (tocc-list from key hit ml) (setq dst (elmo-string dst)) (setq tocc-list - (mapcar (function - (lambda (entity) - (downcase (wl-address-header-extract-address entity)))) - (wl-parse-addresses - (concat - (elmo-message-entity-field entity 'to) "," - (elmo-message-entity-field entity 'cc))))) + (mapcar (lambda (entity) + (downcase (wl-address-header-extract-address entity))) + (append + (elmo-message-entity-field entity 'to) + (elmo-message-entity-field entity 'cc)))) (while tocc-list (if (wl-string-member (car tocc-list) @@ -134,7 +132,7 @@ (defun wl-refile-subject-learn (entity dst) (let ((subject (funcall wl-summary-subject-filter-function - (elmo-message-entity-field entity 'subject 'decode))) + (elmo-message-entity-field entity 'subject))) hit) (setq dst (elmo-string dst)) (if (and subject (not (string= subject ""))) @@ -202,7 +200,7 @@ If RULE does not match ENTITY, returns nil." (defun wl-refile-get-field-value (entity field) "Get FIELD value from ENTITY." - (elmo-message-entity-field entity (intern (downcase field)) 'decode)) + (elmo-message-entity-field entity (intern (downcase field)) 'string)) (defun wl-refile-guess-by-rule (entity) (let ((rules wl-refile-rule-alist) @@ -215,13 +213,11 @@ If RULE does not match ENTITY, returns nil." (defun wl-refile-guess-by-history (entity) (let ((tocc-list - (mapcar (function - (lambda (entity) - (downcase (wl-address-header-extract-address entity)))) - (wl-parse-addresses - (concat - (elmo-message-entity-field entity 'to) "," - (elmo-message-entity-field entity 'cc))))) + (mapcar (lambda (entity) + (downcase (wl-address-header-extract-address entity))) + (append + (elmo-message-entity-field entity 'to) + (elmo-message-entity-field entity 'cc)))) ret-val) (setq tocc-list (wl-address-delete-user-mail-addresses tocc-list)) (while tocc-list @@ -255,7 +251,7 @@ If RULE does not match ENTITY, returns nil." (defun wl-refile-guess-by-subject (entity) (cdr (assoc (funcall wl-summary-subject-filter-function - (elmo-message-entity-field entity 'subject 'decode)) + (elmo-message-entity-field entity 'subject)) wl-refile-subject-alist))) (require 'product) diff --git a/wl/wl-score.el b/wl/wl-score.el index f17e36b..90cb5bc 100644 --- a/wl/wl-score.el +++ b/wl/wl-score.el @@ -176,8 +176,8 @@ Remove Re, Was, Fwd etc." (not (or (string< s1 s2) (string= s1 s2)))) -(defsubst wl-score-ov-entity-get (entity index &optional extra decode) - (elmo-message-entity-field entity (if extra (intern extra) index) decode)) +(defsubst wl-score-ov-entity-get (entity index &optional extra) + (elmo-message-entity-field entity (if extra (intern extra) index))) (defun wl-score-string< (a1 a2) (string-lessp (wl-score-ov-entity-get (car a1) wl-score-index) @@ -755,8 +755,9 @@ Set `wl-score-cache' nil." (< expire (setq day (wl-day-number - (elmo-message-entity-field - (car art) 'date)))))) + (elmo-time-make-date-string + (elmo-message-entity-field + (car art) 'date))))))) (when (setq new (wl-score-add-followups (car art) score all-scores alist thread day)) @@ -780,7 +781,7 @@ Set `wl-score-cache' nil." (list (cons "references" news))))) (defun wl-score-add-followups (header score scores alist &optional thread day) - (let* ((id (car header)) + (let* ((id (elmo-message-entity-field header 'message-id)) (scores (car scores)) entry dont) (when id @@ -903,10 +904,11 @@ Set `wl-score-cache' nil." (catch 'break (while rnumbers (if (< (wl-day-number - (elmo-message-entity-field - (elmo-message-entity wl-summary-buffer-elmo-folder - (car rnumbers)) - 'date)) + (elmo-time-make-date-string + (elmo-message-entity-field + (elmo-message-entity wl-summary-buffer-elmo-folder + (car rnumbers)) + 'date))) expire) (throw 'break t)) (wl-push (car rnumbers) msgs) @@ -920,7 +922,7 @@ Set `wl-score-cache' nil." (wl-score-ov-entity-get (elmo-message-entity wl-summary-buffer-elmo-folder (wl-summary-message-number)) - index extra decode)))) + index extra)))) (defun wl-score-kill-help-buffer () (when (get-buffer "*Score Help*") diff --git a/wl/wl-summary.el b/wl/wl-summary.el index 63bf3c8..1dbe408 100644 --- a/wl/wl-summary.el +++ b/wl/wl-summary.el @@ -219,24 +219,20 @@ See also variable `wl-use-petname'." (wl-summary-buffer-folder-name)) (wl-address-user-mail-address-p from) (cond - ((and (setq tos (elmo-message-entity-field - wl-message-entity 'to t)) - (not (string= "" tos))) + ((setq tos (elmo-message-entity-field wl-message-entity 'to)) (setq retval (concat "To:" (mapconcat - (function - (lambda (to) - (eword-decode-string - (if wl-use-petname - (or - (funcall - wl-summary-get-petname-function to) - (car - (std11-extract-address-components to)) - to) - to)))) - (wl-parse-addresses tos) + (lambda (to) + (if wl-use-petname + (or + (funcall + wl-summary-get-petname-function to) + (car + (std11-extract-address-components to)) + to) + to)) + tos ",")))) ((setq ng (elmo-message-entity-field wl-message-entity 'newsgroups)) @@ -965,11 +961,9 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." (defun wl-summary-overview-entity-compare-by-date (x y) "Compare entity X and Y by date." (condition-case nil - (string< - (timezone-make-date-sortable - (elmo-message-entity-field x 'date)) - (timezone-make-date-sortable - (elmo-message-entity-field y 'date))) + (elmo-time< + (elmo-message-entity-field x 'date) + (elmo-message-entity-field y 'date)) (error))) ;; ignore error. (defun wl-summary-overview-entity-compare-by-number (x y) @@ -981,9 +975,9 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." (defun wl-summary-overview-entity-compare-by-from (x y) "Compare entity X and Y by from." (string< - (or (elmo-message-entity-field x 'from t) + (or (elmo-message-entity-field x 'from) wl-summary-no-from-message) - (or (elmo-message-entity-field y 'from t) + (or (elmo-message-entity-field y 'from) wl-summary-no-from-message))) (defun wl-summary-overview-entity-compare-by-subject (x y) @@ -993,38 +987,42 @@ 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." - (let (sequence ml-name ml-count subject return-path delivered-to mailing-list) - (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 t)) - (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))))) - (and (setq delivered-to - (elmo-message-entity-field entity 'delivered-to)) - (string-match "^mailing list \\([^@]+\\)@" delivered-to) - (or ml-name (setq ml-name (match-string 1 delivered-to)))) - (and (setq mailing-list - (elmo-message-entity-field entity 'mailing-list)) - ;; *-help@, *-owner@, etc. - (string-match "\\(^\\|; \\)contact \\([^@]+\\)-[^-@]+@" mailing-list) - (or ml-name (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))))) + (or (elmo-message-entity-field entity 'ml-info) + (let (sequence ml-name ml-count subject + return-path delivered-to mailing-list) + (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))))) + (and (setq delivered-to + (elmo-message-entity-field entity 'delivered-to)) + (string-match "^mailing list \\([^@]+\\)@" delivered-to) + (or ml-name (setq ml-name (match-string 1 delivered-to)))) + (and (setq mailing-list + (elmo-message-entity-field entity 'mailing-list)) + ;; *-help@, *-owner@, etc. + (string-match "\\(^\\|; \\)contact \\([^@]+\\)-[^-@]+@" + mailing-list) + (or ml-name (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)))))) (defun wl-summary-overview-entity-compare-by-list-info (x y) "Compare entity X and Y by mailing-list info." @@ -1154,7 +1152,7 @@ Entering Folder mode calls the value of `wl-summary-mode-hook'." (defun wl-summary-rescan-message (number &optional reparent) "Rescan current message without updating." - (interactive (list (wl-summary-message-number))) + (interactive (list (wl-summary-message-number) current-prefix-arg)) (let ((start-number (wl-summary-message-number)) (start-column (current-column))) (when (wl-summary-jump-to-msg number) @@ -1615,7 +1613,7 @@ If ARG is non-nil, checking is omitted." (or (elmo-message-entity-field wl-message-entity - 'from t) + 'from) "??"))))) " ]") size)))) @@ -2660,7 +2658,7 @@ If ARG, without confirm." (` (elmo-get-hash-val (format "#%d" (wl-count-lines)) wl-summary-alike-hashtb))) -(defun wl-summary-insert-headers (folder func mime-decode) +(defun wl-summary-insert-headers (folder func &optional mime-decode) (let ((numbers (elmo-folder-list-messages folder 'visible t)) ov this last alike) (buffer-disable-undo (current-buffer)) @@ -2704,12 +2702,10 @@ If ARG, without confirm." (function (lambda (x) (funcall wl-summary-subject-filter-function - (elmo-message-entity-field x 'subject)))) - t) + (elmo-message-entity-field x 'subject))))) (message "Creating subject cache...done")) (setq match (funcall wl-summary-subject-filter-function - (elmo-message-entity-field entity 'subject - 'decode))) + (elmo-message-entity-field entity 'subject))) (if (string= match "") (setq match "\n")) (goto-char (point-max)) @@ -2799,10 +2795,9 @@ If ARG, without confirm." (if (and parent-number wl-summary-divide-thread-when-subject-changed (not (wl-summary-subject-equal - (or (elmo-message-entity-field entity - 'subject t) "") + (or (elmo-message-entity-field entity 'subject) "") (or (elmo-message-entity-field parent-entity - 'subject t) "")))) + 'subject) "")))) (setq parent-number nil)) (setq retval (wl-thread-insert-message entity @@ -3500,18 +3495,16 @@ Return non-nil if the mark is updated" (elmo-delete-char ?\n (or (elmo-message-entity-field wl-message-entity - 'subject t) + 'subject) wl-summary-no-subject-message))) (setq parent-raw-subject - (elmo-message-entity-field wl-parent-message-entity - 'subject t)) + (elmo-message-entity-field wl-parent-message-entity 'subject)) (setq parent-subject (if parent-raw-subject (elmo-delete-char ?\n parent-raw-subject))) (if (or no-parent (null parent-subject) - (not (wl-summary-subject-equal - subject parent-subject))) + (not (wl-summary-subject-equal subject parent-subject))) (funcall wl-summary-subject-function subject) ""))) @@ -3520,7 +3513,7 @@ Return non-nil if the mark is updated" (funcall wl-summary-from-function (elmo-message-entity-field wl-message-entity - 'from t)))) + 'from)))) (defun wl-summary-line-list-info () (let ((list-info (wl-summary-get-list-info wl-message-entity))) @@ -3568,12 +3561,12 @@ Return non-nil if the mark is updated" wl-cached)) (elmo-mime-charset wl-summary-buffer-mime-charset) (elmo-lang wl-summary-buffer-weekday-name-lang) - (wl-datevec (or (ignore-errors (timezone-fix-time - (elmo-message-entity-field - wl-message-entity - 'date) - nil - wl-summary-fix-timezone)) + (wl-datevec (or (ignore-errors + (timezone-fix-time + (elmo-time-make-date-string + (elmo-message-entity-field wl-message-entity 'date)) + nil + wl-summary-fix-timezone)) (make-vector 5 0))) (entity wl-message-entity) ; backward compatibility. line mark) @@ -4863,14 +4856,15 @@ If ARG is numeric number, decode message as following: (wl-summary-message-number)))) (wl-ps-subject (and entity - (or (elmo-message-entity-field entity 'subject t) + (or (elmo-message-entity-field entity 'subject) ""))) (wl-ps-from (and entity - (or (elmo-message-entity-field entity 'from t) ""))) + (or (elmo-message-entity-field entity 'from) ""))) (wl-ps-date (and entity - (or (elmo-message-entity-field entity 'date) "")))) + (or (elmo-time-make-date-string + (elmo-message-entity-field entity 'date)) "")))) (run-hooks 'wl-ps-preprint-hook) (set-buffer wl-message-buffer) (copy-to-buffer buffer (point-min) (point-max)) diff --git a/wl/wl-util.el b/wl/wl-util.el index 04d180c..71e8da1 100644 --- a/wl/wl-util.el +++ b/wl/wl-util.el @@ -92,49 +92,7 @@ If HACK-ADDRESSES is t, then the strings are considered to be mail addresses, (defalias 'wl-string-assoc 'elmo-string-assoc) (defalias 'wl-string-rassoc 'elmo-string-rassoc) -(defun wl-parse-addresses (string) - (if (null string) - () - (elmo-set-work-buf - ;;(unwind-protect - (let (list start s char) - (insert string) - (goto-char (point-min)) - (skip-chars-forward "\t\f\n\r ") - (setq start (point)) - (while (not (eobp)) - (skip-chars-forward "^\"\\,(") - (setq char (following-char)) - (cond ((= char ?\\) - (forward-char 1) - (if (not (eobp)) - (forward-char 1))) - ((= char ?,) - (setq s (buffer-substring start (point))) - (if (or (null (string-match "^[\t\f\n\r ]+$" s)) - (not (string= s ""))) - (setq list (cons s list))) - (skip-chars-forward ",\t\f\n\r ") - (setq start (point))) - ((= char ?\") - (re-search-forward "[^\\]\"" nil 0)) - ((= char ?\() - (let ((parens 1)) - (forward-char 1) - (while (and (not (eobp)) (not (zerop parens))) - (re-search-forward "[()]" nil 0) - (cond ((or (eobp) - (= (char-after (- (point) 2)) ?\\))) - ((= (preceding-char) ?\() - (setq parens (1+ parens))) - (t - (setq parens (1- parens))))))))) - (setq s (buffer-substring start (point))) - (if (and (null (string-match "^[\t\f\n\r ]+$" s)) - (not (string= s ""))) - (setq list (cons s list))) - (nreverse list)) ; jwz: fixed order - ))) +(defalias 'wl-parse-addresses 'elmo-parse-addresses) (defun wl-append-element (list element) (if element -- 1.7.10.4