X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=mime-bbdb.el;h=47c1b09432e9a3daa8da22f0db28d269790d6502;hb=ab9cf4d0bf901c5b84aa36f0bdc4d0860add4d26;hp=002942a8f5a37c5d686d74135df688c6dd870fce;hpb=8ea51b80ccf22c0957a355c4edfa9745a532f5ae;p=elisp%2Fsemi.git diff --git a/mime-bbdb.el b/mime-bbdb.el index 002942a..47c1b09 100644 --- a/mime-bbdb.el +++ b/mime-bbdb.el @@ -42,8 +42,7 @@ "Returns a regexp matching the address of the logged-in user" '(or bbdb-user-mail-names (setq bbdb-user-mail-names - (concat "\\b" (regexp-quote (user-login-name)) "\\b")))) - )) + (concat "\\b" (regexp-quote (user-login-name)) "\\b")))))) ;;; @ User Variables @@ -81,8 +80,7 @@ For framepop users: If empty, `framepop-banish' is used instead.") methods (cdr methods))) (if (string= address "") (setq address nil)) (if (string= phrase "") (setq phrase nil)) - (list phrase address) - )) + (list phrase address))) (or mime-bbdb/use-mail-extr (progn @@ -91,8 +89,7 @@ For framepop users: If empty, `framepop-banish' is used instead.") (fset 'tm:mail-extract-address-components (symbol-function 'mail-extract-address-components))) (fset 'mail-extract-address-components - (symbol-function 'mime-bbdb/extract-address-components)) - )) + (symbol-function 'mime-bbdb/extract-address-components)))) ;;; @ bbdb-extract-field-value @@ -102,15 +99,19 @@ For framepop users: If empty, `framepop-banish' is used instead.") (progn ;; (require 'bbdb-hooks) ; not provided. ;; (or (fboundp 'bbdb-extract-field-value) ; defined as autoload - (or (fboundp 'bbdb-header-start) - (load "bbdb-hooks")) + + ;; almost BBDB functions are autoloaded. + ;; (or (fboundp 'bbdb-header-start) + (or (and (fboundp 'bbdb-extract-field-value) + (not (eq 'autoload (car-safe (symbol-function + 'bbdb-extract-field-value))))) + (load "bbdb-hooks")) (fset 'tm:bbdb-extract-field-value - (symbol-function 'bbdb-extract-field-value)) + (symbol-function 'bbdb-extract-field-value)) (defun bbdb-extract-field-value (field) (let ((value (tm:bbdb-extract-field-value field))) (and value - (eword-decode-string value)))) - )) + (eword-decode-string value)))))) ;;; @ full-name canonicalization methods @@ -120,25 +121,21 @@ For framepop users: If empty, `framepop-banish' is used instead.") (let (dest) (while (string-match "\\s +" str) (setq dest (cons (substring str 0 (match-beginning 0)) dest)) - (setq str (substring str (match-end 0))) - ) + (setq str (substring str (match-end 0)))) (or (string= str "") (setq dest (cons str dest))) (setq dest (nreverse dest)) - (mapconcat 'identity dest " ") - )) + (mapconcat 'identity dest " "))) (defun mime-bbdb/canonicalize-dots (str) (let (dest) (while (string-match "\\." str) (setq dest (cons (substring str 0 (match-end 0)) dest)) - (setq str (substring str (match-end 0))) - ) + (setq str (substring str (match-end 0)))) (or (string= str "") (setq dest (cons str dest))) (setq dest (nreverse dest)) - (mapconcat 'identity dest " ") - )) + (mapconcat 'identity dest " "))) (defvar mime-bbdb/canonicalize-full-name-methods '(eword-decode-string @@ -160,21 +157,21 @@ the user confirms the creation." (set-buffer mime-preview-buffer)) (if bbdb-use-pop-up (mime-bbdb/pop-up-bbdb-buffer offer-to-create) - (let* ((from (std11-field-body "From")) - (addr (if from - (car (cdr (mail-extract-address-components from)))))) - (if (or (null from) - (null addr) - (string-match (bbdb-user-mail-names) addr)) - (setq from (or (std11-field-body "To") from)) - ) + (let* ((message (get-text-property (point-min) 'mime-view-entity)) + (from (mime-entity-fetch-field message 'From)) + addr) + (if (or (null from) + (null (setq addr (car (mime-entity-read-field message 'From)))) + (string-match (bbdb-user-mail-names) + (std11-address-string addr))) + (setq from (or (mime-entity-fetch-field message 'To) + from))) (if from (bbdb-annotate-message-sender - from t + (mime-decode-field-body from 'From) t (or (bbdb-invoke-hook-for-value mime-bbdb/auto-create-p) offer-to-create) - offer-to-create)) - )))) + offer-to-create)))))) (defun mime-bbdb/annotate-sender (string) "Add a line to the end of the Notes field of the BBDB record @@ -237,10 +234,9 @@ displaying the record corresponding to the sender of the current message." (defun mime-bbdb/define-keys () (let ((mime-view-mode-map (current-local-map))) (define-key mime-view-mode-map ";" 'mime-bbdb/edit-notes) - (define-key mime-view-mode-map ":" 'mime-bbdb/show-sender) - )) + (define-key mime-view-mode-map ":" 'mime-bbdb/show-sender))) -(add-hook 'mime-view-define-keymap-hook 'mime-bbdb/define-keys) +(add-hook 'mime-view-mode-hook 'mime-bbdb/define-keys) ;;; @ for signature.el @@ -250,8 +246,7 @@ displaying the record corresponding to the sender of the current message." "Extract sigtype information from BBDB." (let ((record (bbdb-search-simple nil addr))) (and record - (bbdb-record-getprop record 'sigtype)) - )) + (bbdb-record-getprop record 'sigtype)))) (defun signature/set-bbdb-sigtype (sigtype addr) "Add sigtype information to BBDB." @@ -264,31 +259,25 @@ displaying the record corresponding to the sender of the current message." (if record (progn (bbdb-record-putprop record 'sigtype sigtype) - (bbdb-change-record record nil)) - ))) + (bbdb-change-record record nil))))) (defun signature/get-sigtype-from-bbdb (&optional verbose) (let* ((to (std11-field-body "To")) (addr (and to (car (cdr (mail-extract-address-components to))))) (sigtype (signature/get-bbdb-sigtype addr)) - return - ) + return) (if addr (if verbose (progn (setq return (signature/get-sigtype-interactively sigtype)) (if (and (not (string-equal return sigtype)) (y-or-n-p - (format "Register \"%s\" for <%s>? " return addr)) - ) - (signature/set-bbdb-sigtype return addr) - ) + (format "Register \"%s\" for <%s>? " return addr))) + (signature/set-bbdb-sigtype return addr)) return) (or sigtype - (signature/get-signature-file-name)) - )) - )) + (signature/get-signature-file-name)))))) ;;; @ end