From: ueno Date: Thu, 8 Jan 2004 01:49:36 +0000 (+0000) Subject: * lsdb.el (lsdb-fetch-fields): New function. X-Git-Tag: lsdb-0_11~2 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=dba4f579305e895943018215bad232090049ffc4;p=elisp%2Flsdb.git * lsdb.el (lsdb-fetch-fields): New function. (lsdb-fetch-field-bodies): Abolish. (lsdb-update-records): Decode field-bodies here. --- diff --git a/lsdb.el b/lsdb.el index f7c7834..48e6c50 100644 --- a/lsdb.el +++ b/lsdb.el @@ -518,17 +518,16 @@ This is the current number of slots in HASH-TABLE, whether occupied or not." (setq tables (cdr tables)))))) ;;;_. Mail Header Extraction -(defun lsdb-fetch-field-bodies (regexp) +(defun lsdb-fetch-fields (regexp) (save-excursion (goto-char (point-min)) (let ((case-fold-search t) field-bodies) (while (re-search-forward (concat "^\\(" regexp "\\):[ \t]*") nil t) - (push (funcall lsdb-decode-field-body-function - (buffer-substring (point) (std11-field-end)) - (match-string 1)) - field-bodies)) + (push (cons (match-string 1) + (buffer-substring (point) (std11-field-end))) + field-bodies)) (nreverse field-bodies)))) (defun lsdb-canonicalize-spaces-and-dots (string) @@ -681,25 +680,46 @@ This is the current number of slots in HASH-TABLE, whether occupied or not." (save-restriction (std11-narrow-to-header) (setq senders - (delq nil (mapcar #'lsdb-extract-address-components - (lsdb-fetch-field-bodies + (delq nil (mapcar (lambda (field) + (let ((components + (lsdb-extract-address-components + (cdr field)))) + (if components + (setcar + components + (funcall lsdb-decode-field-body-function + (car components) (car field)))) + components)) + (lsdb-fetch-fields lsdb-sender-headers))) recipients - (delq nil (mapcar #'lsdb-extract-address-components - (lsdb-fetch-field-bodies + (delq nil (mapcar (lambda (field) + (let ((components + (lsdb-extract-address-components + (cdr field)))) + (if components + (setcar + components + (funcall lsdb-decode-field-body-function + (car components) (car field)))) + components)) + (lsdb-fetch-fields lsdb-recipients-headers)))) (setq alist lsdb-interesting-header-alist) (while alist (setq bodies (delq nil (mapcar - (lambda (field-body) - (if (nth 1 (car alist)) - (and (string-match (nth 1 (car alist)) - field-body) - (replace-match (nth 3 (car alist)) - nil nil field-body)) - field-body)) - (lsdb-fetch-field-bodies (car (car alist)))))) + (lambda (field) + (let ((field-body + (funcall lsdb-decode-field-body-function + (cdr field) (car field)))) + (if (nth 1 (car alist)) + (and (string-match (nth 1 (car alist)) + field-body) + (replace-match (nth 3 (car alist)) + nil nil field-body)) + field-body))) + (lsdb-fetch-fields (car (car alist)))))) (when bodies (setq entry (or (nth 2 (car alist)) 'notes))