This commit was generated by cvs2svn to compensate for changes in r401,

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

diff --git a/tm-bbdb.el b/tm-bbdb.el
index 023ac84..cf0ac19 100644 (file)
--- a/tm-bbdb.el
+++ b/tm-bbdb.el
@@ -4,10 +4,11 @@
 ;;; Copyright (C) 1995,1996 KOBAYASHI Shuhei
 ;;; Copyright (C) 1996 Artur Pioro
 ;;;
-;;; Author: KOBAYASHI Shuhei <shuhei@cmpt01.phys.tohoku.ac.jp>
+;;; Author: KOBAYASHI Shuhei <shuhei-k@jaist.ac.jp>
 ;;;         Artur Pioro <artur@flugor.if.uj.edu.pl>
-;;; Maintainer: MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;;; Version: $Id: tm-bbdb.el,v 7.2 1996/03/14 13:41:48 morioka Exp $
+;;; modified by Pekka Marjola <pema@iki.fi>
+;;; Maintainer: KOBAYASHI Shuhei <shuhei-k@jaist.ac.jp>
+;;; Version: $Id: tm-bbdb.el,v 7.9 1996/05/23 16:42:14 shuhei-k Exp $
 ;;; Keywords: mail, news, MIME, multimedia, multilingual, BBDB
 ;;;
 ;;; This file is part of tm (Tools for MIME).
@@ -43,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
@@ -129,7 +130,8 @@ the user confirms the creation."
     (if bbdb-use-pop-up
         (tm-bbdb/pop-up-bbdb-buffer offer-to-create)
       (let* ((from (rfc822/get-field-body "From"))
-             (addr (car (cdr (mail-extract-address-components from)))))
+             (addr (if from
+                      (car (cdr (mail-extract-address-components from))))))
         (if (or (null from)
                 (null addr)
                 (string-match (bbdb-user-mail-names) addr))
@@ -191,39 +193,56 @@ displaying the record corresponding to the sender of the current message."
       (set-buffer b)
       record)))
 
+(define-key mime/viewer-mode-map ";" 'tm-bbdb/edit-notes)
+(define-key mime/viewer-mode-map ":" 'tm-bbdb/show-sender)
+
 
 ;;; @ 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