X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;ds=sidebyside;f=mime-bbdb.el;h=22581491eea317353c7d4ddddd069f9cb055211e;hb=1060d04a99580afcfad148ae1e527ac80e428467;hp=6ee0feb0d616a8f7a2246bcbd263e62924ed4c68;hpb=0c115c3068d06f197bf3cb99aad53c3a948a15a0;p=elisp%2Fsemi.git diff --git a/mime-bbdb.el b/mime-bbdb.el index 6ee0feb..2258149 100644 --- a/mime-bbdb.el +++ b/mime-bbdb.el @@ -21,8 +21,8 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Code: @@ -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 @@ -155,26 +152,26 @@ Creating or modifying it as necessary. A record will be created if mime-bbdb/auto-create-p is non-nil, or if OFFER-TO-CREATE is non-nil and the user confirms the creation." (save-excursion - (if (and mime-view-buffer - (get-buffer mime-view-buffer)) - (set-buffer mime-view-buffer)) + (if (and mime-preview-buffer + (get-buffer mime-preview-buffer)) + (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