planner-bbdb.el

   1 ;;; planner-bbdb.el --- BBDB integration for the Emacs Planner
   2
   3 ;; Copyright (C) 2001, 2003, 2004, 2005 Free Software Foundation, Inc.
   4 ;; Parts copyright (C) 2004 Andrew J. Korty
   5
   6 ;; Author: John Wiegley <johnw@gnu.org>
   7 ;; Keywords: planner, gnus
   8 ;; URL: http://www.plannerlove.com/
   9
  10 ;; This file is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; This file is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  23 ;; Boston, MA 02110-1301, USA.
  24
  25 ;;;_ + Commentary:
  26
  27 ;; This file allows you to refer to your contacts easily from within
  28 ;; a planner page.
  29 ;;
  30 ;; Example:
  31 ;; [[bbdb://Sacha.*Chua][Sacha]] will be linked to the blog, web
  32 ;; or net fields of the first matching BBDB record.
  33
  34 ;;;_ + Contributors
  35
  36 ;; Andrew J. Korty (ajk AT iu DOT edu) had the idea to add the mailto:
  37 ;; URI and provided the initial patch for it.
  38 ;;
  39 ;; Yann Hodique helped to port this to Muse.
  40
  41 ;;; Code:
  42
  43 (require 'planner)
  44 (require 'bbdb-com)
  45
  46 (defun planner-bbdb-get-name-from-address (address)
  47   "Return the name for ADDRESS to be used in links."
  48   (let* ((addr (mail-extract-address-components address))
  49          (rec (apply 'bbdb-search-simple addr)))
  50     (if rec
  51         (bbdb-record-name rec)
  52       (or (car addr) (cadr addr)))))
  53
  54 (defvar planner-bbdb-plan-field "plan"
  55   "Field that contains a planner page associated with this record.")
  56
  57 ;;;###autoload
  58 (defun planner-bbdb-annotation-from-bbdb ()
  59   "If called from a bbdb buffer, return an annotation.
  60 Suitable for use in `planner-annotation-functions'."
  61   (when (eq major-mode 'bbdb-mode)
  62       (or (bbdb-record-getprop
  63            (bbdb-current-record) 'plan)
  64           ;; From a BBDB entry with a plan page; use that. Yay!
  65           (planner-make-link
  66            (concat "bbdb://"
  67                    (planner-replace-regexp-in-string
  68                     " " "." (bbdb-record-name (bbdb-current-record))))
  69            (bbdb-record-name (bbdb-current-record))))))
  70
  71
  72 ;;;###autoload
  73 (defun planner-bbdb-browse-url (url)
  74   "If this is a BBDB URL, jump to it."
  75   (when (string-match "^bbdb:/?/?\\(.+\\)" url)
  76     (bbdb (match-string 1 url) nil)
  77     t))
  78
  79 ;;;###autoload
  80 (defun planner-bbdb-resolve-url (id)
  81   "Replace ID with the blog, web or e-mail address of the BBDB record."
  82   (save-match-data
  83     (when (string-match "\\`bbdb:/+" id)
  84       (setq id (replace-match "" t t id)))
  85     (let ((record (car (bbdb-search (bbdb-records) id id id))))
  86       (or (and record
  87                (or (bbdb-record-getprop record 'blog)
  88                    (bbdb-record-getprop record 'web)
  89                    (when (car (bbdb-record-net record))
  90                      (concat "mailto:" (car (bbdb-record-net record))))))
  91           nil))))
  92
  93 (planner-add-protocol "bbdb:/+" 'planner-bbdb-browse-url 'planner-bbdb-resolve-url)
  94 (add-hook 'planner-annotation-functions 'planner-bbdb-annotation-from-bbdb)
  95 (custom-add-option 'planner-annotation-functions 'planner-bbdb-annotation-from-bbdb)
  96
  97 (defalias 'planner-get-name-from-address 'planner-bbdb-get-name-from-address)
  98
  99 (provide 'planner-bbdb)
 100
 101 ;;; planner-bbdb.el ends here