Re: Add anniversary and org-mode

[Thomas Baumann <dtbaumann@yahoo.de>]

Bastien Guerry <bzg@altern.org> writes:
>
> I use this:
>
> (add-hook 'list-diary-entries-hook 'bbdb-include-anniversaries)
>
> -- 
> Bastien


For those who hardly use the diary (like me), here's a
wrapper/replacement to bbdb-anniv.el.

Add 

%%(org-bbdb-anniversaries) 

somewhere in your org-file and all the anniversaries from the bbdb will
be included in the diary. The format for birthdays, weddings, ... , can
be customized in bbdb-anniv.

Thomas



;;; org-bbdb-anniv.el --- Get anniversaries from BBDB

;; Copyright (C) 2008 Thomas Baumann

;; Author: Thomas Baumann <thomas.baumann@ch.tum.de>
;;         based on bbdb-anniv.el by Ivar Rummelhoff <ivarru@math.uio.no>
;; Maintainer: Thomas Baumann <thomas.baumann@ch.tum.de>
;; Created: 21 March 2008
;; Keywords: calendar org

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; If you have not received a copy of the GNU General Public License
;; along with this software, it can be obtained from the GNU Project's
;; World Wide Web server (http://www.gnu.org/copyleft/gpl.html), from
;; its FTP server (ftp://ftp.gnu.org/pub/gnu/GPL), by sending an electronic
;; mail to this program's maintainer or by writing to the Free Software
;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.

;;; Commentary:

;; (require 'org-bbdb-anniv)
;; %%(org-bbdb-anniversaries)
;;
;; will include BBDB-anniversaries in the agenda view
;;
;; From bbdb-anniv.el
;; The anniversaries are stored in BBDB in the field `anniversary'
;; in the format
;;
;;     [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 `bbdb-anniversary-format-alist'.
;;  * the (format) string displayed in the diary.
;;
;; It defaults to the value of `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
;;
;; See the documentation of `bbdb-anniversary-format-alist' for
;; further options.
;;
;; Example (my own record):
;;
;;       1973-06-22 
;;       20??-??-?? wedding
;;       1998-03-12 %s created bbdb-anniv.el %d years ago
;;
;; If you use the hook `sort-diary-entries', you should make sure that
;; it is executed after `bbdb-include-anniversaries'.
;;

(require 'bbdb-anniv)

;;;###autoload
(defun org-bbdb-anniversaries ()
  "Extract anniversaries from BBDB for display in the agenda." 
  (let ((dates (list (cons (cons (extract-calendar-month date)
                                 (extract-calendar-day date))
                           (extract-calendar-year date))))
        (text ())
        annivs date years
        split class form)
    (dolist (rec (bbdb-records))
      (when (setq annivs (bbdb-record-getprop
                          rec bbdb-anniversary-field))
        (setq annivs (bbdb-split annivs "\n"))
        (while annivs
          (setq split (bbdb-anniv-split (pop annivs)))
          (multiple-value-bind (m d y)
              (funcall 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)
                                bbdb-default-anniversary-format))
                     (form (or (cdr (assoc class
                                           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))))
              )))))
    (when text
      (mapconcat 'identity text "; "))))
  
(provide 'org-bbdb-anniv)

;;; org-bbdb-anniv.el ends here