cgit.sxemacs.org Git - syinit/blob - 08-bbdb-sy.el

   1 ;; 08-bbdb-sy.el --- Big Brother DataBase (BBDB)   -*- Emacs-Lisp -*-
   2
   3 ;; Copyright (C) 2007 - 2013 Steve Youngs
   4
   5 ;;     Author: Steve Youngs <steve@sxemacs.org>
   6 ;; Maintainer: Steve Youngs <steve@sxemacs.org>
   7 ;;    Created: <2007-12-02>
   8 ;; Time-stamp: <Thursday May 21, 2015 22:56:49 steve>
   9 ;;   Download: <http://bastard.steveyoungs.com/~steve/SXEmacs/inits/>
  10 ;;   HTMLised: <http://bastard.steveyoungs.com/~steve/SXEmacs/htmlinits/08-bbdb-sy.html>
  11 ;;   Git Repo: git clone http://git.sxemacs.org/syinit
  12 ;;   Keywords: init, compile
  13
  14 ;; This file is part of SYinit
  15
  16 ;; Redistribution and use in source and binary forms, with or without
  17 ;; modification, are permitted provided that the following conditions
  18 ;; are met:
  19 ;;
  20 ;; 1. Redistributions of source code must retain the above copyright
  21 ;;    notice, this list of conditions and the following disclaimer.
  22 ;;
  23 ;; 2. Redistributions in binary form must reproduce the above copyright
  24 ;;    notice, this list of conditions and the following disclaimer in the
  25 ;;    documentation and/or other materials provided with the distribution.
  26 ;;
  27 ;; 3. Neither the name of the author nor the names of any contributors
  28 ;;    may be used to endorse or promote products derived from this
  29 ;;    software without specific prior written permission.
  30 ;;
  31 ;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR
  32 ;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
  33 ;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
  34 ;; DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
  35 ;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
  36 ;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
  37 ;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
  38 ;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
  39 ;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
  40 ;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
  41 ;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  42
  43 ;;; Commentary:
  44 ;;
  45 ;;  BBDB settings.
  46 ;;
  47
  48 ;;; Credits:
  49 ;;
  50 ;;   The HTML version of this file was created with Hrvoje Niksic's
  51 ;;   htmlize.el which is part of the XEmacs "text-modes" package.
  52 ;;
  53
  54 ;;; Todo:
  55 ;;
  56 ;;
  57
  58 ;;; Code:
  59 ;:*======================
  60 ;:* Some standard stuff first
  61 (require 'bbdb)
  62 (require 'bbdb-pgp)
  63
  64 ;:*=======================
  65 ;:* Make sure gnus stuff is loaded
  66 (load-file (expand-file-name ".gnus" (user-home-directory)))
  67
  68 (bbdb-initialize 'gnus 'message 'w3 'sendmail)
  69 (bbdb-insinuate-gnus)
  70 (bbdb-insinuate-message)
  71 (bbdb-insinuate-sc)
  72 (bbdb-insinuate-sendmail)
  73 (bbdb-insinuate-w3)
  74
  75 ;; BBDB/PGP stuff
  76 (setq
  77  bbdb/pgp-method 'mml-pgpmime
  78  bbdb/pgp-default-action 'sign
  79  bbdb/pgp-quiet t)
  80
  81 (defun sy-bbdb-gnus-auto-notes-hook (record)
  82   "Runs `bbdb-auto-notes-hook' on the original article.
  83 This is so a header doesn't have to be visible for BBDB to notice
  84 any changes.
  85 Kudos to Robert Fenk <fenk@users.sf.net> for this."
  86   (save-excursion
  87     (set-buffer (get-buffer gnus-article-buffer))
  88     (set-buffer gnus-original-article-buffer)
  89     (goto-char (point-min))
  90     (bbdb-auto-notes-hook record)))
  91
  92 (autoload 'gnus-convert-face-to-png "gnus-fun")
  93
  94 ;;; FIXME: Not ideal, it currently puts cface at one end of the name,
  95 ;;; and the xface at the other.  I'd prefer both glyphs on the same
  96 ;;; side (preferrably left)
  97 (defun sy-bbdb-display-cx-face ()
  98   "Search for face properties and display the faces.
  99 This is from Alex Shroeder."
 100   (let ((inhibit-read-only t); edit the BBDB buffer
 101         (all-records bbdb-records)
 102         cface xface record start ext)
 103     (while all-records
 104       (setq record (caar all-records)
 105             cface (bbdb-record-getprop record 'cface)
 106             xface (bbdb-record-getprop record 'face)
 107             start (marker-position (nth 2 (car all-records))))
 108       (when (or cface xface)
 109         (setq ext (extent-at start)))
 110       (when cface
 111         (set-extent-begin-glyph
 112          ext
 113          (make-glyph
 114           (list (vector 'png :data (gnus-convert-face-to-png cface))))))
 115       (when xface
 116         (set-extent-end-glyph
 117          ext
 118          (make-glyph
 119           (list (vector 'xface :data (concat "X-Face: " xface)
 120                         :foreground "black"
 121                         :background "white")))))
 122       (setq all-records (cddr all-records)))))
 123
 124 (setq
 125  bbdb-always-add-addresses t
 126  bbdb-canonicalize-redundant-nets-p t
 127  bbdb-canonicalize-net-hook
 128  (lambda (addr)
 129    (cond
 130     ((string-match
 131       "\\`\\([^0-9]+\\)\\(-dated-[^@]+\\|-[0-9]+\\|\\+[^@]+\\.[^@]+\\)\\(@.*\\)\\'"
 132       addr)
 133      (concat (substring addr (match-beginning 1) (match-end 1))
 134              (substring addr (match-beginning 3) (match-end 3))))
 135     (t addr)))
 136  bbdb-complete-name-allow-cycling t
 137  bbdb-completion-display-record t
 138  bbdb-completion-type 'primary-or-name
 139  bbdb-default-area-code 7
 140  bbdb-dial-local-prefix nil
 141  bbdb-display-layout 'multi-line
 142  bbdb-dwim-net-address-allow-redundancy t
 143  bbdb-electric-p nil
 144  bbdb-new-nets-always-primary 'never
 145  bbdb-north-american-phone-numbers-p nil
 146  bbdb-notice-hook 'sy-bbdb-gnus-auto-notes-hook
 147  bbdb-offer-save 'auto
 148  bbdb-pop-up-display-layout 'multi-line
 149  bbdb-pop-up-target-lines 7
 150  bbdb-quiet-about-name-mismatches nil
 151  bbdb-use-pop-up nil
 152  bbdb/gnus-score-default 25
 153  bbdb/gnus-summary-in-bbdb-format-letter "X"
 154  bbdb/mail-auto-create-p nil
 155  bbdb/news-auto-create-p nil)
 156
 157 ;:*=======================
 158 ;:* All my email addresses, well the important ones anyway.
 159 (let ((emails '("steve@steveyoungs.com"
 160                 "steve@thereadinglamp.net"
 161                 "steve@bastard.steveyoungs.com"
 162                 "steve@bastard.no-ip.org"
 163                 "steve@sxemacs.org"
 164                 "steve@emchat.org"
 165                 "sryoungs@iinet.net.au"
 166                 "steve.r.youngs@gmail.com"
 167                 ;; The following aren't mine, but I'm using
 168                 ;; `bbdb-user-mail-names' in
 169                 ;; `gnus-ignored-from-addresses.  It's just easier.
 170                 "post@gwene.org")))
 171   (setq bbdb-user-mail-names (regexp-opt emails t)))
 172
 173 ;:*=======================
 174 ;:* Update some stuff automatically
 175 (setq bbdb-auto-notes-alist
 176       '(("Organization"
 177          (".*" company 0 'replace))
 178         ("Newsgroups"
 179          ("[^,]+" newsgroups 0))
 180         ("Subject"
 181          (".*" last-subj 0 'replace))
 182         ("User-Agent"
 183          (".*" mailer 0 'replace))
 184         ("X-Mailer"
 185          (".*" mailer 0 'replace))
 186         ("X-Newsreader"
 187          (".*" mailer 0 'replace))
 188         ("X-Attribution"
 189          (".*" attribution 0 'replace))
 190         ("X-Now-Playing"
 191          (".*" music 0 'replace))
 192         ("X-Face"
 193          (".+" face 0 'replace))
 194         ("Face"
 195          (".+" cface 0 'replace))))
 196
 197 ;:*=======================
 198 ;:* mail aliases
 199 (autoload 'bbdb-define-all-aliases "bbdb-com"
 200   "Hook mail alias feature of BBDB into message-mode." t)
 201
 202 ;:*=======================
 203 ;:* Hooks
 204 (add-hook 'bbdb-notice-hook 'bbdb-auto-notes-hook)
 205 (add-hook 'bbdb-change-hook 'bbdb-timestamp-hook)
 206 (add-hook 'bbdb-create-hook 'bbdb-creation-date-hook)
 207 (add-hook 'bbdb-list-hook 'sy-bbdb-display-cx-face)
 208 (add-hook 'message-setup-hook 'bbdb-define-all-aliases)
 209 ;:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::*
 210 (message "bbdb initialised")
 211