lisp/org-bbdb.el

   1 ;;; org-bbdb.el --- Support for links to BBDB entries from within Org-mode
   2
   3 ;; Copyright (C) 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
   4
   5 ;; Author: Carsten Dominik <carsten at orgmode dot org>
   6 ;; Keywords: outlines, hypermedia, calendar, wp
   7 ;; Homepage: http://orgmode.org
   8 ;; Version: 6.00pre-3
   9 ;;
  10 ;; This file is part of GNU Emacs.
  11 ;;
  12 ;; GNU Emacs is free software; you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 3, or (at your option)
  15 ;; any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  25 ;; Boston, MA 02110-1301, USA.
  26 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  27 ;;
  28 ;;; Commentary:
  29
  30 ;; This file implements links to BBDB database entries from within Org-mode.
  31 ;; Org-mode loads this module by default - if this is not what you want,
  32 ;; configure the variable `org-modules'.
  33
  34 ;;; Code:
  35
  36 (require 'org)
  37
  38 ;; Declare external functions and variables
  39
  40 (declare-function bbdb "ext:bbdb-com" (string elidep))
  41 (declare-function bbdb-company "ext:bbdb-com" (string elidep))
  42 (declare-function bbdb-current-record "ext:bbdb-com"
  43                   (&optional planning-on-modifying))
  44 (declare-function bbdb-name "ext:bbdb-com" (string elidep))
  45 (declare-function bbdb-record-getprop "ext:bbdb" (record property))
  46 (declare-function bbdb-record-name "ext:bbdb" (record))
  47
  48 ;; Install the link type
  49 (org-add-link-type "bbdb" 'org-bbdb-open 'org-bbdb-export)
  50 (add-hook 'org-store-link-functions 'org-bbdb-store-link)
  51
  52 ;; Implementation
  53 (defun org-bbdb-store-link ()
  54   "Store a link to a BBDB database entry."
  55   (when (eq major-mode 'bbdb-mode)
  56     ;; This is BBDB, we make this link!
  57     (let* ((name (bbdb-record-name (bbdb-current-record)))
  58            (company (bbdb-record-getprop (bbdb-current-record) 'company))
  59            (link (org-make-link "bbdb:" name)))
  60       (org-store-link-props :type "bbdb" :name name :company company
  61                             :link link :description name)
  62       link)))
  63
  64 (defun org-bbdb-export (path desc format)
  65   "Create the export version of a BBDB link specified by PATH or DESC.
  66 If exporting to either HTML or LaTeX FORMAT the link will be
  67 italicised, in all other cases it is left unchanged."
  68   "Create the exprt verison of a bbdb link."
  69   (cond
  70    ((eq format 'html) (format "<i>%s</i>" (or desc path)))
  71    ((eq format 'latex) (format "\\textit{%s}" (or desc path)))
  72    (t (or desc path))))
  73
  74 (defun org-bbdb-open (name)
  75   "Follow a BBDB link to NAME."
  76   (require 'bbdb)
  77   (let ((inhibit-redisplay (not debug-on-error))
  78         (bbdb-electric-p nil))
  79     (catch 'exit
  80       ;; Exact match on name
  81       (bbdb-name (concat "\\`" name "\\'") nil)
  82       (if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
  83       ;; Exact match on name
  84       (bbdb-company (concat "\\`" name "\\'") nil)
  85       (if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
  86       ;; Partial match on name
  87       (bbdb-name name nil)
  88       (if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
  89       ;; Partial match on company
  90       (bbdb-company name nil)
  91       (if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil))
  92       ;; General match including network address and notes
  93       (bbdb name nil)
  94       (when (= 0 (buffer-size (get-buffer "*BBDB*")))
  95         (delete-window (get-buffer-window "*BBDB*"))
  96         (error "No matching BBDB record")))))
  97
  98 (provide 'org-bbdb)
  99
 100 ;;; org-bbdb.el ends here