`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.
2005-03-20 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+ * 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 <yoichi@geiin.org>
(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))
(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)
(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
(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
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))
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)
(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))))
(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))
(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
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)
(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))
(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)
(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)
(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)))))
(+ (* (- (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)
(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
(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)))))
(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))
(lambda (field-name)
(or (elmo-message-entity-field entity
(intern (downcase field-name))
- 'decode)
+ 'string)
(progn
(unless buffer
(setq buffer (get-buffer-create
(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)
(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
(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)
(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.")
(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)
;; 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.
: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)
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)
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
(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
(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)
(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)
(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))
(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)
(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
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
(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)
(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))
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.")
(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
(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))))
(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
((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))
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.")
(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)
2005-03-20 Hiroya Murata <lapis-lazuli@pop06.odn.ne.jp>
+ * 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 <yoichi@geiin.org>
(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."
(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)
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)
(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
(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
(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)
(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 "")))
(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)
(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
(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)
(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)
(< 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))
(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
(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)
(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*")
(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))
(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)
(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)
(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."
(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)
(or
(elmo-message-entity-field
wl-message-entity
- 'from t)
+ 'from)
"??")))))
" ]")
size))))
(` (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))
(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))
(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
(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)
"")))
(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)))
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)
(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))
(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
projects / elisp / wanderlust.git / commitdiff