;;; org-bbdb.el --- Support for links to BBDB entries from within Org-mode
-;; Copyright (C) 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010
+;; Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>,
;; Thomas Baumann <thomas dot baumann at ch dot tum dot de>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
-;; Version: 6.02b
+;; Version: 6.35i
;;
;; This file is part of GNU Emacs.
;;
;; Org-mode loads this module by default - if this is not what you want,
;; configure the variable `org-modules'.
-
;; It also implements an interface (based on Ivar Rummelhoff's
;; bbdb-anniv.el) for those org-mode users, who do not use the diary
;; but who do want to include the anniversaries stored in the BBDB
;; %%(org-bbdb-anniversaries)
;;
;;
-;; The anniversaries are stored in BBDB in the field `anniversary'
-;; in the format
+;; To add an anniversary to a BBDB record, press `C-o' in the record.
+;; You will be prompted for the field name, in this case it must be
+;; "anniversary". If this is the first time you are using this field,
+;; you need to confirm that it should be created.
+;;
+;; The format of an anniversary field stored in BBDB is the following
+;; (items in {} are optional):
;;
-;; YYYY-MM-DD{ CLASS-OR-FORMAT-STRING}*
-;; {\nYYYY-MM-DD CLASS-OR-FORMAT-STRING}*
+;; YYYY-MM-DD{ CLASS-OR-FORMAT-STRING}
+;; {\nYYYY-MM-DD CLASS-OR-FORMAT-STRING}...
;;
;; CLASS-OR-FORMAT-STRING is one of two things:
;;
-;; * an identifier for a class of anniversaries (eg. birthday or
-;; wedding) from `org-bbdb-anniversary-format-alist'.
-;; * the (format) string displayed in the diary.
+;; - an identifier for a class of anniversaries (eg. birthday or
+;; wedding) from `org-bbdb-anniversary-format-alist' which then
+;; defines the format string for this class
+;; - the (format) string displayed in the diary.
+;;
+;; You can enter multiple anniversaries for a single BBDB record by
+;; separating them with a newline character. At the BBDB prompt for
+;; the field value, type `C-q C-j' to enter a newline between two
+;; anniversaries.
;;
-;; It defaults to the value of `org-bbdb-default-anniversary-format'
-;; ("birthday" by default).
+;; If you omit the CLASS-OR-FORMAT-STRING entirely, it defaults to the
+;; value of `org-bbdb-default-anniversary-format' ("birthday" by
+;; default).
;;
;; The substitutions in the format string are (in order):
-;; * the name of the record containing this anniversary
-;; * the number of years
-;; * an ordinal suffix (st, nd, rd, th) for the year
+;; - the name of the record containing this anniversary
+;; - the number of years
+;; - an ordinal suffix (st, nd, rd, th) for the year
;;
;; See the documentation of `org-bbdb-anniversary-format-alist' for
;; further options.
;; 1973-06-22
;; 20??-??-?? wedding
;; 1998-03-12 %s created bbdb-anniv.el %d years ago
-
+;;
+;; From Org's agenda, you can use `C-c C-o' to jump to the BBDB
+;; link from which the entry at point originates.
+;;
;;; Code:
(require 'org)
(declare-function bbdb-current-record "ext:bbdb-com"
(&optional planning-on-modifying))
(declare-function bbdb-name "ext:bbdb-com" (string elidep))
+(declare-function bbdb-completing-read-record "ext:bbdb-com"
+ (prompt &optional omit-records))
(declare-function bbdb-record-getprop "ext:bbdb" (record property))
(declare-function bbdb-record-name "ext:bbdb" (record))
(declare-function bbdb-records "ext:bbdb"
(&optional dont-check-disk already-in-db-buffer))
(declare-function bbdb-split "ext:bbdb" (string separators))
(declare-function bbdb-string-trim "ext:bbdb" (string))
+
(declare-function calendar-leap-year-p "calendar" (year))
(declare-function diary-ordinal-suffix "diary-lib" (n))
-(defvar date)
+(defvar date) ;; dynamically scoped from Org
;; Customization
:require 'bbdb)
(defcustom org-bbdb-anniversary-format-alist
- '( ("birthday" . "Birthday: %s (%d%s)")
- ("wedding" . "%s's %d%s wedding anniversary") )
+ '(("birthday" lambda
+ (name years suffix)
+ (concat "Birthday: [[bbdb:" name "][" name " ("
+ (number-to-string years)
+ suffix ")]]"))
+ ("wedding" lambda
+ (name years suffix)
+ (concat "[[bbdb:" name "][" name "'s "
+ (number-to-string years)
+ suffix " wedding anniversary]]")))
"How different types of anniversaries should be formatted.
An alist of elements (STRING . FORMAT) where STRING is the name of an
anniversary class and format is either:
anniversary, 2) the number of years, and 3) an ordinal suffix for
the year.
-Multiple anniversaries can be separated by \\n"
+Multiple anniversaries can be separated by \\n."
:type 'symbol
:group 'org-bbdb-anniversaries
:require 'bbdb)
(defcustom org-bbdb-extract-date-fun 'org-bbdb-anniv-extract-date
"How to retrieve `month date year' from the anniversary field.
-Customize if you have already filled your bbdb with dates
+Customize if you have already filled your BBDB with dates
different from YYYY-MM-DD. The function must return a list (month
-date year)"
+date year)."
:type 'function
:group 'org-bbdb-anniversaries
:require 'bbdb)
"Create the export version of a BBDB link specified by PATH or DESC.
If exporting to either HTML or LaTeX FORMAT the link will be
italicised, in all other cases it is left unchanged."
- "Create the exprt verison of a bbdb link."
(cond
((eq format 'html) (format "<i>%s</i>" (or desc path)))
((eq format 'latex) (format "\\textit{%s}" (or desc path)))
(defun org-bbdb-anniv-extract-date (time-str)
"Convert YYYY-MM-DD to (month date year).
Argument TIME-STR is the value retrieved from BBDB."
- (multiple-value-bind (y m d) (bbdb-split time-str "-")
+ (multiple-value-bind (y m d) (values-list (bbdb-split time-str "-"))
(list (string-to-number m)
(string-to-number d)
(string-to-number y))))
(defun org-bbdb-anniv-split (str)
- "Split mutliple entries in the BBDB anniversary field.
+ "Split multiple entries in the BBDB anniversary field.
Argument STR is the anniversary field in BBDB."
(let ((pos (string-match "[ \t]" str)))
(if pos (list (substring str 0 pos)
(bbdb-string-trim (substring str pos)))
(list str nil))))
+(defvar org-bbdb-anniv-hash nil
+ "A hash holding anniversaries extracted from BBDB.
+The hash table is created on first use.")
-;;;###autoload
-(defun org-bbdb-anniversaries ()
- "Extract anniversaries from BBDB for display in the agenda."
- (require 'diary-lib)
- (let ((dates (list (cons (cons (car date) ; month
- (nth 1 date)) ; day
- (nth 2 date)))) ; year
- (text ())
- annivs date years
- split class form)
+(defvar org-bbdb-updated-p t
+ "This is non-nil if BBDB has been updated since we last built the hash.")
+
+(defun org-bbdb-make-anniv-hash ()
+ "Create a hash with anniversaries extracted from BBDB, for fast access.
+The anniversaries are assumed to be stored `org-bbdb-anniversary-field'."
+
+ (let (split tmp annivs)
+ (clrhash org-bbdb-anniv-hash)
(dolist (rec (bbdb-records))
(when (setq annivs (bbdb-record-getprop
rec org-bbdb-anniversary-field))
(while annivs
(setq split (org-bbdb-anniv-split (pop annivs)))
(multiple-value-bind (m d y)
- (funcall org-bbdb-extract-date-fun (car split))
-
- (when (and (or (setq date (assoc (cons m d) dates))
- (and (= d 29)
- (= m 2)
- (setq date (assoc '(3 . 1) dates))
- (not (calendar-leap-year-p (cdr date)))))
- (< 0 (setq years (- (cdr date) y))))
- (let* ((class (or (cadr split)
- org-bbdb-default-anniversary-format))
- (form (or (cdr (assoc class
- org-bbdb-anniversary-format-alist))
- class)) ; (as format string)
- (name (bbdb-record-name rec))
- (suffix (diary-ordinal-suffix years))
- (tmp (cond
- ((functionp form)
- (funcall form name years suffix))
- ((listp form) (eval form))
- (t (format form name years suffix)))))
- (if text
- (setq text (append text (list tmp)))
- (setq text (list tmp))))
- )))))
+ (values-list (funcall org-bbdb-extract-date-fun (car split)))
+ (setq tmp (gethash (list m d) org-bbdb-anniv-hash))
+ (puthash (list m d) (cons (list y
+ (bbdb-record-name rec)
+ (cadr split))
+ tmp)
+ org-bbdb-anniv-hash))))))
+ (setq org-bbdb-updated-p nil))
+
+(defun org-bbdb-updated (rec)
+ "Record the fact that BBDB has been updated.
+This is used by Org to re-create the anniversary hash table."
+ (setq org-bbdb-updated-p t))
+
+(add-hook 'bbdb-after-change-hook 'org-bbdb-updated)
+
+;;;###autoload
+(defun org-bbdb-anniversaries()
+ "Extract anniversaries from BBDB for display in the agenda."
+ (require 'bbdb)
+ (require 'diary-lib)
+ (unless (hash-table-p org-bbdb-anniv-hash)
+ (setq org-bbdb-anniv-hash
+ (make-hash-table :test 'equal :size 366)))
+
+ (when (or org-bbdb-updated-p
+ (= 0 (hash-table-count org-bbdb-anniv-hash)))
+ (org-bbdb-make-anniv-hash))
+
+ (let* ((m (car date)) ; month
+ (d (nth 1 date)) ; day
+ (y (nth 2 date)) ; year
+ (annivs (gethash (list m d) org-bbdb-anniv-hash))
+ (text ())
+ rec recs)
+
+ ;; we don't want to miss people born on Feb. 29th
+ (when (and (= m 3) (= d 1)
+ (not (null (gethash (list 2 29) org-bbdb-anniv-hash)))
+ (not (calendar-leap-year-p y)))
+ (setq recs (gethash (list 2 29) org-bbdb-anniv-hash))
+ (while (setq rec (pop recs))
+ (push rec annivs)))
+
+ (when annivs
+ (while (setq rec (pop annivs))
+ (when rec
+ (let* ((class (or (nth 2 rec)
+ org-bbdb-default-anniversary-format))
+ (form (or (cdr (assoc class
+ org-bbdb-anniversary-format-alist))
+ class)) ; (as format string)
+ (name (nth 1 rec))
+ (years (- y (car rec)))
+ (suffix (diary-ordinal-suffix years))
+ (tmp (cond
+ ((functionp form)
+ (funcall form name years suffix))
+ ((listp form) (eval form))
+ (t (format form name years suffix)))))
+ (org-add-props tmp nil 'org-bbdb-name name)
+ (if text
+ (setq text (append text (list tmp)))
+ (setq text (list tmp)))))
+ ))
(when text
(mapconcat 'identity text "; "))))
+(defun org-bbdb-complete-link ()
+ "Read a bbdb link with name completion."
+ (require 'bbdb-com)
+ (concat "bbdb:"
+ (bbdb-record-name (car (bbdb-completing-read-record "Name: ")))))
+
+(defun org-bbdb-anniv-export-ical ()
+ "Extract anniversaries from BBDB and convert them to icalendar format."
+ (require 'bbdb)
+ (require 'diary-lib)
+ (unless (hash-table-p org-bbdb-anniv-hash)
+ (setq org-bbdb-anniv-hash
+ (make-hash-table :test 'equal :size 366)))
+ (when (or org-bbdb-updated-p
+ (= 0 (hash-table-count org-bbdb-anniv-hash)))
+ (org-bbdb-make-anniv-hash))
+ (maphash 'org-bbdb-format-vevent org-bbdb-anniv-hash))
+
+(defun org-bbdb-format-vevent (key recs)
+ (let (rec categ)
+ (while (setq rec (pop recs))
+ (setq categ (or (nth 2 rec) org-bbdb-default-anniversary-format))
+ (princ (format "BEGIN:VEVENT
+UID: ANNIV-%4i%02i%02i-%s
+DTSTART:%4i%02i%02i
+SUMMARY:%s
+DESCRIPTION:%s
+CATEGORIES:%s
+RRULE:FREQ=YEARLY
+END:VEVENT\n"
+ (nth 0 rec) (nth 0 key) (nth 1 key)
+ (mapconcat 'identity
+ (org-split-string (nth 1 rec) "[^a-zA-Z0-90]+")
+ "-")
+ (nth 0 rec) (nth 0 key) (nth 1 key)
+ (nth 1 rec)
+ (concat (capitalize categ) " " (nth 1 rec))
+ categ)))))
+
(provide 'org-bbdb)
;; arch-tag: 9e4f275d-d080-48c1-b040-62247f66b5c2
+
;;; org-bbdb.el ends here
HCoop / bpt / emacs.git / blobdiff