Function: org-bbdb-anniversaries

org-bbdb-anniversaries is an autoloaded and byte-compiled function defined in ol-bbdb.el.gz.

Signature

(org-bbdb-anniversaries)

Documentation

Extract anniversaries from BBDB for display in the agenda.

When called programmatically, this function expects the date variable to be globally bound.

Source Code

;; Defined in /usr/src/emacs/lisp/org/ol-bbdb.el.gz
;;;###autoload
(defun org-bbdb-anniversaries ()
  "Extract anniversaries from BBDB for display in the agenda.
When called programmatically, this function expects the `date'
variable to be globally bound."
  (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-string
				 class org-bbdb-anniversary-format-alist t))
                           class))	; (as format string)
                 (name (nth 1 rec))
                 (years (if (eq (car rec) nil)
                            "unknown"
                          (- y (car rec))))
                 (suffix (if (eq (car rec) nil)
                             ""
                           (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)))))
        ))
    text))