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 - 2012 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: <Sunday Jun 10, 2012 10:57:19 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 ;:* Make sure gnus stuff is loaded
  61 (load-file (expand-file-name ".gnus" (user-home-directory)))
  62
  63 ;:*======================
  64 ;:* Some standard stuff first
  65 (require 'bbdb)
  66 (require 'bbdb-pgp)
  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 (defun sy-bbdb-display-cx-face ()
  95   "Search for face properties and display the faces.
  96 This is from Alex Shroeder."
  97   (let ((inhibit-read-only t); edit the BBDB buffer
  98         (all-records bbdb-records)
  99         cface xface record start)
 100     (while all-records
 101       (setq record (caar all-records)
 102             cface (bbdb-record-getprop record 'cface)
 103             xface (bbdb-record-getprop record 'face)
 104             start (marker-position (nth 2 (car all-records))))
 105       (when cface
 106         (set-extent-begin-glyph
 107          (make-extent start start)
 108          (make-glyph
 109           (list (vector 'png :data (gnus-convert-face-to-png cface)))))
 110         (insert " "))
 111       (when xface
 112         (set-extent-begin-glyph
 113          (make-extent start start)
 114          (make-glyph
 115           (list (vector 'xface :data (concat "X-Face: " xface)
 116                         :foreground "black"
 117                         :background "white"))))
 118         (insert " "))
 119       (setq all-records (cddr all-records)))))
 120
 121 (setq
 122  bbdb-always-add-addresses t
 123  bbdb-canonicalize-redundant-nets-p t
 124  bbdb-canonicalize-net-hook
 125  (lambda (addr)
 126    (cond
 127     ((string-match
 128       "\\`\\([^0-9]+\\)\\(-dated-[^@]+\\|-[0-9]+\\|\\+[^@]+\\.[^@]+\\)\\(@.*\\)\\'"
 129       addr)
 130      (concat (substring addr (match-beginning 1) (match-end 1))
 131              (substring addr (match-beginning 3) (match-end 3))))
 132     (t addr)))
 133  bbdb-complete-name-allow-cycling t
 134  bbdb-completion-display-record t
 135  bbdb-completion-type 'primary-or-name
 136  bbdb-default-area-code 7
 137  bbdb-dial-local-prefix nil
 138  bbdb-display-layout 'multi-line
 139  bbdb-dwim-net-address-allow-redundancy t
 140  bbdb-electric-p nil
 141  bbdb-new-nets-always-primary 'never
 142  bbdb-north-american-phone-numbers-p nil
 143  bbdb-notice-hook 'sy-bbdb-gnus-auto-notes-hook
 144  bbdb-offer-save 'auto
 145  bbdb-pop-up-display-layout 'multi-line
 146  bbdb-pop-up-target-lines 7
 147  bbdb-quiet-about-name-mismatches nil
 148  bbdb-use-pop-up nil
 149  bbdb/gnus-score-default 25
 150  bbdb/gnus-summary-in-bbdb-format-letter "X"
 151  bbdb/mail-auto-create-p nil
 152  bbdb/news-auto-create-p nil)
 153
 154 ;:*=======================
 155 ;:* All my email addresses, well the important ones anyway.
 156 (let ((emails '("steve@steveyoungs.com"
 157                 "steve@thereadinglamp.net"
 158                 "steve@bastard.steveyoungs.com"
 159                 "steve@sxemacs.org"
 160                 "steve@emchat.org"
 161                 "sryoungs@iinet.net.au"
 162                 "jackalx@gmail.com")))
 163   (setq bbdb-user-mail-names (regexp-opt emails t)))
 164
 165 ;:*=======================
 166 ;:* Update some stuff automatically
 167 (setq bbdb-auto-notes-alist
 168       '(("Organization"
 169          (".*" company 0 'replace))
 170         ("Newsgroups"
 171          ("[^,]+" newsgroups 0))
 172         ("Subject"
 173          (".*" last-subj 0 'replace))
 174         ("User-Agent"
 175          (".*" mailer 0 'replace))
 176         ("X-Mailer"
 177          (".*" mailer 0 'replace))
 178         ("X-Newsreader"
 179          (".*" mailer 0 'replace))
 180         ("X-Attribution"
 181          (".*" attribution 0 'replace))
 182         ("X-Now-Playing"
 183          (".*" music 0 'replace))
 184         ("X-Face"
 185          (".+" face 0 'replace))
 186         ("Face"
 187          (".+" cface 0 'replace))))
 188
 189 ;:*=======================
 190 ;:* mail aliases
 191 (autoload 'bbdb-define-all-aliases "bbdb-com"
 192   "Hook mail alias feature of BBDB into message-mode." t)
 193
 194 ;:*=======================
 195 ;:* Hooks
 196 (add-hook 'bbdb-notice-hook 'bbdb-auto-notes-hook)
 197 (add-hook 'bbdb-change-hook 'bbdb-timestamp-hook)
 198 (add-hook 'bbdb-create-hook 'bbdb-creation-date-hook)
 199 (add-hook 'bbdb-list-hook 'sy-bbdb-display-cx-face)
 200 (add-hook 'message-setup-hook 'bbdb-define-all-aliases)
 201 ;:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::*
 202 (message "bbdb initialised")
 203