tm 7.70.

[elisp/tm.git] / tm-bbdb.el

diff --git a/tm-bbdb.el b/tm-bbdb.el
index 0d7e896..253c1b6 100644 (file)
--- a/tm-bbdb.el
+++ b/tm-bbdb.el
@@ -6,9 +6,9 @@
 ;;;
 ;;; Author: KOBAYASHI Shuhei <shuhei-k@jaist.ac.jp>
 ;;;         Artur Pioro <artur@flugor.if.uj.edu.pl>
-;;; modified by Pekka Marjola <marjola@bilbo.ntc.nokia.com>
+;;; modified by Pekka Marjola <pema@iki.fi>
 ;;; Maintainer: KOBAYASHI Shuhei <shuhei-k@jaist.ac.jp>
-;;; Version: $Id: tm-bbdb.el,v 7.5 1996/04/16 18:19:48 morioka Exp $
+;;; Version: $Id: tm-bbdb.el,v 7.10 1996/07/01 23:43:25 morioka Exp $
 ;;; Keywords: mail, news, MIME, multimedia, multilingual, BBDB
 ;;;
 ;;; This file is part of tm (Tools for MIME).
@@ -44,14 +44,14 @@
 (defun tm-bbdb/extract-address-components (str)
   (let* ((ret     (rfc822/extract-address-components str))
          (phrase  (car ret))
-         (address (cdr ret))
+         (address (car (cdr ret)))
          (methods tm-bbdb/canonicalize-full-name-methods))
     (while (and phrase methods)
       (setq phrase  (funcall (car methods) phrase)
             methods (cdr methods)))
-    (if (string= phrase "")
-        (setq phrase nil))
-    (cons phrase address)
+    (if (string= address "") (setq address nil))
+    (if (string= phrase "") (setq phrase nil))
+    (list phrase address)
     ))
 
 (or tm-bbdb/use-mail-extr
@@ -193,39 +193,61 @@ displaying the record corresponding to the sender of the current message."
       (set-buffer b)
       record)))
 
+(defun tm-bbdb/define-keys ()
+  (let ((mime/viewer-mode-map (current-local-map)))
+    (define-key mime/viewer-mode-map ";" 'tm-bbdb/edit-notes)
+    (define-key mime/viewer-mode-map ":" 'tm-bbdb/show-sender)
+    ))
+
+(add-hook 'mime-viewer/define-keymap-hook 'tm-bbdb/define-keys)
+
 
 ;;; @ for signature.el
 ;;;
 
-(defun signature-check-in-bbdb (address)
-  "Returns 'sigtype field from BBDB for user specified by ADDRESS"
-  (let ((addr-comp (mail-extract-address-components address))
-       full-name net-name records record sigtype)
-    (setq full-name (car addr-comp))
-    (setq net-name (mapconcat (lambda (x) x) (cdr addr-comp) "\\|"))
-    (setq records
-         (or
-          (and full-name
-               (bbdb-search (bbdb-records) full-name))
-          (and net-name
-               (bbdb-search (bbdb-records) nil nil net-name))))
-    (setq record (car records))
-    (setq records (cdr records))
-    (setq sigtype (and record (bbdb-record-getprop record 'sigtype)))
-    (while (and (not sigtype) records)
-      (setq record (car records))
-      (setq records (cdr records))
-      (setq sigtype (bbdb-record-getprop record 'sigtype)))
-    (if sigtype
-       (message (concat "Using signature for: "
-                        (bbdb-record-firstname record) " "
-                        (bbdb-record-lastname record)
-                        (and (bbdb-record-aka record)
-                             (concat " (AKA: "
-                                     (car (bbdb-record-aka record))
-                                     ")"))
-                        " <" (car (bbdb-record-net record)) ">")))
-    sigtype))
+(defun signature/get-bbdb-sigtype (addr)
+  "Extract sigtype information from BBDB."
+  (let ((record (bbdb-search-simple nil addr)))
+    (and record
+         (bbdb-record-getprop record 'sigtype))
+    ))
+
+(defun signature/set-bbdb-sigtype (sigtype addr)
+  "Add sigtype information to BBDB."
+  (let* ((bbdb-notice-hook nil)
+         (record (bbdb-annotate-message-sender 
+                  addr t
+                  (bbdb-invoke-hook-for-value 
+                   bbdb/mail-auto-create-p)
+                  t)))
+    (if record
+        (progn
+          (bbdb-record-putprop record 'sigtype sigtype)
+          (bbdb-change-record record nil))
+      )))
+
+(defun signature/get-sigtype-from-bbdb (&optional verbose)
+  (let* ((to (rfc822/get-field-body "To"))
+         (addr (and to
+                    (car (cdr (mail-extract-address-components to)))))
+         (sigtype (signature/get-bbdb-sigtype addr))
+         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)
+                )
+              return)
+          (or sigtype
+              (signature/get-signature-file-name))
+          ))
+    ))
 
 
 ;;; @ end