Mercurial > hg > xemacs-beta

comparison lisp/tm/tm-bbdb.el @ 8:4b173ad71786 r19-15b5

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b5
author cvs
date Mon, 13 Aug 2007 08:47:35 +0200
parents b82b59fe008d
children 131b0175ea99
comparison
equal deleted inserted replaced
7:c153ca296910 8:4b173ad71786
4 ;; Copyright (C) 1996 Artur Pioro 4 ;; Copyright (C) 1996 Artur Pioro
5 5
6 ;; Author: Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp> 6 ;; Author: Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp>
7 ;; Artur Pioro <artur@flugor.if.uj.edu.pl> 7 ;; Artur Pioro <artur@flugor.if.uj.edu.pl>
8 ;; Maintainer: Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp> 8 ;; Maintainer: Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp>
9 ;; Version: $Id: tm-bbdb.el,v 1.1.1.1 1996/12/18 03:55:31 steve Exp $ 9 ;; Version: $Id: tm-bbdb.el,v 1.2 1996/12/22 00:29:37 steve Exp $
10 ;; Keywords: mail, news, MIME, multimedia, multilingual, BBDB 10 ;; Keywords: mail, news, MIME, multimedia, multilingual, BBDB
11 11
12 ;; This file is part of tm (Tools for MIME). 12 ;; This file is part of tm (Tools for MIME).
13 13
14 ;; This program is free software; you can redistribute it and/or 14 ;; This program is free software; you can redistribute it and/or
29 ;;; Code: 29 ;;; Code:
30 30
31 (require 'std11) 31 (require 'std11)
32 (require 'tm-ew-d) 32 (require 'tm-ew-d)
33 (require 'tm-view) 33 (require 'tm-view)
34 (require 'bbdb-com) ; (require 'bbdb) implicitly 34 (if (module-installed-p 'bbdb-com)
35 (require 'bbdb-com)
36 (eval-when-compile
37 ;; imported from bbdb-1.51
38 (defmacro bbdb-pop-up-elided-display ()
39 '(if (boundp 'bbdb-pop-up-elided-display)
40 bbdb-pop-up-elided-display
41 bbdb-elided-display))
42 (defmacro bbdb-user-mail-names ()
43 "Returns a regexp matching the address of the logged-in user"
44 '(or bbdb-user-mail-names
45 (setq bbdb-user-mail-names
46 (concat "\\b" (regexp-quote (user-login-name)) "\\b"))))
47 ))
48
49
50 ;;; @ User Variables
51 ;;;
52
53 (defvar tm-bbdb/use-mail-extr t
54 "*If non-nil, `mail-extract-address-components' is used.
55 Otherwise `tm-bbdb/extract-address-components' overrides it.")
56
57 (defvar tm-bbdb/auto-create-p nil
58 "*If t, create new BBDB records automatically.
59 If function, then it is called with no arguments to decide whether an
60 entry should be automatically creaded.
61
62 tm-bbdb uses this variable instead of `bbdb/mail-auto-create-p' or
63 `bbdb/news-auto-create-p' unless other tm-MUA overrides it.")
64
65 (defvar tm-bbdb/delete-empty-window nil
66 "*If non-nil, delete empty BBDB window.
67 All bbdb-MUAs but bbdb-gnus display BBDB window even if it is empty.
68 If you prefer behavior of bbdb-gnus, set this variable to t.
69
70 For framepop users: If empty, `framepop-banish' is used instead.")
35 71
36 ;;; @ mail-extr 72 ;;; @ mail-extr
37 ;;; 73 ;;;
38
39 (defvar tm-bbdb/use-mail-extr t)
40 74
41 (defun tm-bbdb/extract-address-components (str) 75 (defun tm-bbdb/extract-address-components (str)
42 (let* ((ret (std11-extract-address-components str)) 76 (let* ((ret (std11-extract-address-components str))
43 (phrase (car ret)) 77 (phrase (car ret))
44 (address (car (cdr ret))) 78 (address (car (cdr ret)))
113 tm-bbdb/canonicalize-spaces)) 147 tm-bbdb/canonicalize-spaces))
114 148
115 149
116 ;;; @ BBDB functions for mime/viewer-mode 150 ;;; @ BBDB functions for mime/viewer-mode
117 ;;; 151 ;;;
118
119 (defvar tm-bbdb/auto-create-p nil)
120 152
121 (defun tm-bbdb/update-record (&optional offer-to-create) 153 (defun tm-bbdb/update-record (&optional offer-to-create)
122 "Return the record corresponding to the current MIME previewing message. 154 "Return the record corresponding to the current MIME previewing message.
123 Creating or modifying it as necessary. A record will be created if 155 Creating or modifying it as necessary. A record will be created if
124 tm-bbdb/auto-create-p is non-nil, or if OFFER-TO-CREATE is non-nil and 156 tm-bbdb/auto-create-p is non-nil, or if OFFER-TO-CREATE is non-nil and
195 (if framepop 227 (if framepop
196 (if record 228 (if record
197 (bbdb-display-records (list record)) 229 (bbdb-display-records (list record))
198 (framepop-banish)) 230 (framepop-banish))
199 (bbdb-display-records (if record (list record) nil)) 231 (bbdb-display-records (if record (list record) nil))
200 (if (not record) 232 (if (and (null record)
201 (progn 233 tm-bbdb/delete-empty-window)
202 (set-buffer "*BBDB*") 234 (delete-windows-on (get-buffer "*BBDB*"))))
203 (delete-window))))
204 (set-buffer b) 235 (set-buffer b)
205 record)))) 236 record))))
206 237
207 (defun tm-bbdb/define-keys () 238 (defun tm-bbdb/define-keys ()
208 (let ((mime/viewer-mode-map (current-local-map))) 239 (let ((mime/viewer-mode-map (current-local-map)))