7

org-mode offers a few built-in options to add birthdays/holidays to the agenda view in org-mode; however, there is no built-in support to add those dates entirely programmatically -- without manually adding diary entries or entries in the standard org file.

http://orgmode.org/manual/Weekly_002fdaily-agenda.html

Is there a way to add birthdays/holidays to the agenda view programmatically, similar to what calendar-mode offers? In calendar-mode, a user may define holidays and birthdays with a variable combined with functions such as holiday-fixed and holiday-float. The same type of set-up for org-mode seems useful.

7

The following is a modification to org-agenda-list, with additional new variables and a new function to add holidays/ birthdays. When org-agenda--show-holidays-birthdays is non-nil, birthdays and holidays will appear programmatically in the agenda view. The variables org-agenda--birthday-list and org-agenda--holiday-list can be customized by the user. An entry has been added to the org-agenda-custom-commands to try out this new feature -- the capital letter "Y" launches the year view containing holidays/birthdays. Some limited functionality has been added to support a few basic text properties, and others may be added at a later date.

For examples of how to format the holidays and birthdays that are used within the above-mentioned variables, please refer to the doc-string for the variable calendar-holidays within the library holidays.el -- e.g., holiday-fixed; holiday-float; holiday-sexp; (lunar-phases); (solar-equinoxes-solstices); holiday-hebrew; holiday-islamic; holiday-bahai; holiday-julian; holiday-chinese; etc.

How can you try out this example?:  Block/copy/paste the code into your *Scratch* buffer; and type M-x eval-buffer RET; and then type M-x org-agenda RET and then select the CAPITAL letter Y. It is a fully functional working draft, but needs a little customization to make it prettier and add ability to sort alphabetically, etc. If you decide that you don't like it after you try it, just restart Emacs and you'll be back to where you were before you tried it.

The source-code that was modified and the testing that was performed was done with the most recent public release of Emacs:  Org-mode version 8.2.10 (release_8.2.10 @ /Applications/Emacs.app/Contents/Resources/lisp/org/); and, GNU Emacs 24.4.1 (x86_64-apple-darwin10.8.0, NS apple-appkit-1038.36) of 2014-10-20 on builder10-6.porkrind.org.


THE CODE:

(require 'org-agenda)
(require 'holidays)

(add-to-list 'org-agenda-custom-commands '(
  "Y" "365 Days -- holidays/birthdays" agenda "Year View" (
  (org-agenda-span 365)
  (org-agenda-time-grid nil)
  (org-agenda--show-holidays-birthdays t) )))

(defcustom org-agenda--show-holidays-birthdays nil
  "When non-`nil`, show holidays/birthdays in the agenda view."
  :group 'holidays)

(defcustom org-agenda--birthday-list (mapcar 'purecopy '(
  (holiday-fixed 1 2 "Jane Doe -- 01/02/1940")
  (holiday-fixed 2 15 "John Doe -- 02/15/1963")
  (holiday-fixed 3 2 "Seymoure Hersh -- 03/03/1999")
  (holiday-fixed 3 3 "Jashua Smith -- 03/03/1964")
  (holiday-fixed 3 5 "Frederick Holmes -- 03/05/1966")
  (holiday-fixed 4 7 "Fannie Mae -- 04/07/1970")
  (holiday-fixed 4 25 "Freddie Mack -- 04/25/1952")
  (holiday-float 5 0 2 "Mother's Day -- the second Sunday in May")
  (holiday-fixed 5 11 "George Lucas -- 05/11/1976")
  (holiday-fixed 5 18 "Harry Potter -- 05/18")
  (holiday-fixed 5 30 "Darth Vader -- 05/30/1972")
  (holiday-fixed 6 7 "Jabba the Hut -- 06/07/2007")
  (holiday-fixed 6 19 "Princess Lea -- 06/19/1983")
  (holiday-fixed 7 14 "Super Man -- 07/14/1970")
  (holiday-fixed 7 18 "Wonder Woman -- 07/18/1993")
  (holiday-fixed 10 3 "Jenifer Lopez (DOB:  10/03/2011)")
  (holiday-fixed 10 8 "Samuel Jacks (10/08/1965)")
  (holiday-fixed 10 25 "C3PO -- 10/25/2007")
  (holiday-fixed 11 14 "R2D2 -- 11/14/1981")
  (holiday-fixed 12 21 "Yoda -- 12/21/1958")
  (holiday-fixed 12 22 "Wookie -- 12/22/1967") ))
  "Birthdays."
  :type 'sexp
  :group 'holidays)

(defcustom org-agenda--holiday-list (mapcar 'purecopy '(
  (holiday-fixed 1 1 "New Year's Day")
  (holiday-float 1 1 3 "Martin Luther King Day")
  (holiday-float 2 1 3 "President's Day")
  (holiday-float 5 1 -1 "Memorial Day")
  (holiday-fixed 7 4 "Independence Day")
  (holiday-float 9 1 1 "Labor Day")
  (holiday-float 10 1 2 "Columbus Day")
  (holiday-fixed 11 11 "Veteran's Day")
  (holiday-float 11 4 4 "Thanksgiving")
  (holiday-fixed 12 25 "Christmas")
  (solar-equinoxes-solstices)
  (holiday-sexp calendar-daylight-savings-starts
    (format "Daylight Saving Time Begins %s"
      (solar-time-string
        (/ calendar-daylight-savings-starts-time (float 60))
        calendar-standard-time-zone-name)))
  (holiday-sexp calendar-daylight-savings-ends
      (format "Daylight Saving Time Ends %s"
       (solar-time-string
         (/ calendar-daylight-savings-ends-time (float 60))
         calendar-daylight-time-zone-name))) ))
  "Custom holidays defined by the user."
  :type 'sexp
  :group 'holidays)

(defface org-agenda--holiday-face
  '((t (:foreground "red")))
  "Face for `org-agenda--holiday-face`."
  :group 'org-agenda)

(defface org-agenda--birthday-face
  '((t (:foreground "magenta")))
  "Face for `org-agenda--birthday-face`."
  :group 'org-agenda)

(defun org-agenda-list (&optional arg start-day span with-hour)
  "Produce a daily/weekly view from all files in variable `org-agenda-files'.
The view will be for the current day or week, but from the overview buffer
you will be able to go to other days/weeks.

With a numeric prefix argument in an interactive call, the agenda will
span ARG days.  Lisp programs should instead specify SPAN to change
the number of days.  SPAN defaults to `org-agenda-span'.

START-DAY defaults to TODAY, or to the most recent match for the weekday
given in `org-agenda-start-on-weekday'.

When WITH-HOUR is non-nil, only include scheduled and deadline
items if they have an hour specification like [h]h:mm."
  (interactive "P")
  (if org-agenda-overriding-arguments
      (setq arg (car org-agenda-overriding-arguments)
      start-day (nth 1 org-agenda-overriding-arguments)
      span (nth 2 org-agenda-overriding-arguments)))
  (if (and (integerp arg) (> arg 0))
      (setq span arg arg nil))
  (catch 'exit
    (setq org-agenda-buffer-name
    (or org-agenda-buffer-tmp-name
        (if org-agenda-sticky
      (cond ((and org-keys (stringp org-match))
       (format "*Org Agenda(%s:%s)*" org-keys org-match))
      (org-keys
       (format "*Org Agenda(%s)*" org-keys))
      (t "*Org Agenda(a)*")))
        org-agenda-buffer-name))
    (org-agenda-prepare "Day/Week")
    (setq start-day (or start-day org-agenda-start-day))
    (if (stringp start-day)
  ;; Convert to an absolute day number
  (setq start-day (time-to-days (org-read-date nil t start-day))))
    (org-compile-prefix-format 'agenda)
    (org-set-sorting-strategy 'agenda)
    (let* ((span (org-agenda-ndays-to-span
      (or span org-agenda-ndays org-agenda-span)))
     (today (org-today))
     (sd (or start-day today))
     (ndays (org-agenda-span-to-ndays span sd))
     (org-agenda-start-on-weekday
      (if (or (eq ndays 7) (eq ndays 14))
    org-agenda-start-on-weekday))
     (thefiles (org-agenda-files nil 'ifmode))
     (files thefiles)
     (start (if (or (null org-agenda-start-on-weekday)
        (< ndays 7))
          sd
        (let* ((nt (calendar-day-of-week
        (calendar-gregorian-from-absolute sd)))
         (n1 org-agenda-start-on-weekday)
         (d (- nt n1)))
          (- sd (+ (if (< d 0) 7 0) d)))))
     (day-numbers (list start))
     (day-cnt 0)
     (inhibit-redisplay (not debug-on-error))
     (org-agenda-show-log-scoped org-agenda-show-log)
     s e rtn rtnall file date d start-pos end-pos todayp
     clocktable-start clocktable-end filter)
      (setq org-agenda-redo-command
      (list 'org-agenda-list (list 'quote arg) start-day (list 'quote span) with-hour))
      (dotimes (n (1- ndays))
  (push (1+ (car day-numbers)) day-numbers))
      (setq day-numbers (nreverse day-numbers))
      (setq clocktable-start (car day-numbers)
      clocktable-end (1+ (or (org-last day-numbers) 0)))
      (org-set-local 'org-starting-day (car day-numbers))
      (org-set-local 'org-arg-loc arg)
      (org-set-local 'org-agenda-current-span (org-agenda-ndays-to-span span))
      (unless org-agenda-compact-blocks
  (let* ((d1 (car day-numbers))
         (d2 (org-last day-numbers))
         (w1 (org-days-to-iso-week d1))
         (w2 (org-days-to-iso-week d2)))
    (setq s (point))
    (if org-agenda-overriding-header
        (insert (org-add-props (copy-sequence org-agenda-overriding-header)
        nil 'face 'org-agenda-structure) "\n")
      (insert (org-agenda-span-name span)
        "-agenda"
        (if (< (- d2 d1) 350)
      (if (= w1 w2)
          (format " (W%02d)" w1)
        (format " (W%02d-W%02d)" w1 w2))
          "")
        ":\n")))
  (add-text-properties s (1- (point)) (list 'face 'org-agenda-structure
              'org-date-line t))
  (org-agenda-mark-header-line s))
      (while (setq d (pop day-numbers))
  (setq date (calendar-gregorian-from-absolute d)
        s (point))
  (if (or (setq todayp (= d today))
    (and (not start-pos) (= d sd)))
      (setq start-pos (point))
    (if (and start-pos (not end-pos))
        (setq end-pos (point))))
  (setq files thefiles
        rtnall nil)
  (while (setq file (pop files))
    (catch 'nextfile
      (org-check-agenda-file file)
      (let ((org-agenda-entry-types org-agenda-entry-types))
        ;; Starred types override non-starred equivalents
        (when (member :deadline* org-agenda-entry-types)
    (setq org-agenda-entry-types
          (delq :deadline org-agenda-entry-types)))
        (when (member :scheduled* org-agenda-entry-types)
    (setq org-agenda-entry-types
          (delq :scheduled org-agenda-entry-types)))
        ;; Honor with-hour
        (when with-hour
    (when (member :deadline org-agenda-entry-types)
      (setq org-agenda-entry-types
      (delq :deadline org-agenda-entry-types))
      (push :deadline* org-agenda-entry-types))
    (when (member :scheduled org-agenda-entry-types)
      (setq org-agenda-entry-types
      (delq :scheduled org-agenda-entry-types))
      (push :scheduled* org-agenda-entry-types)))
        (unless org-agenda-include-deadlines
    (setq org-agenda-entry-types
          (delq :deadline* (delq :deadline org-agenda-entry-types))))
        (cond
         ((memq org-agenda-show-log-scoped '(only clockcheck))
    (setq rtn (org-agenda-get-day-entries
         file date :closed)))
         (org-agenda-show-log-scoped
    (setq rtn (apply 'org-agenda-get-day-entries
         file date
         (append '(:closed) org-agenda-entry-types))))
         (t
    (setq rtn (apply 'org-agenda-get-day-entries
         file date
         org-agenda-entry-types)))))
      (setq rtnall (append rtnall rtn)))) ;; all entries
  (if org-agenda-include-diary
      (let ((org-agenda-search-headline-for-time t))
        (require 'diary-lib)
        (setq rtn (org-get-entries-from-diary date))
        (setq rtnall (append rtnall rtn))))
  ;; BEGIN -- MODIFICATION
  (when org-agenda--show-holidays-birthdays
    (setq rtn (org-agenda--get-birthdays-holidays))
    (setq rtnall (append rtnall rtn)))
  ;; END -- MODIFICATION
  (if (or rtnall org-agenda-show-all-dates)
      (progn
        (setq day-cnt (1+ day-cnt))
        (insert
         (if (stringp org-agenda-format-date)
       (format-time-string org-agenda-format-date
               (org-time-from-absolute date))
     (funcall org-agenda-format-date date))
         "\n")
        (put-text-property s (1- (point)) 'face
         (org-agenda-get-day-face date))
        (put-text-property s (1- (point)) 'org-date-line t)
        (put-text-property s (1- (point)) 'org-agenda-date-header t)
        (put-text-property s (1- (point)) 'org-day-cnt day-cnt)
        (when todayp
    (put-text-property s (1- (point)) 'org-today t))
        (setq rtnall
        (org-agenda-add-time-grid-maybe rtnall ndays todayp))
        (if rtnall (insert ;; all entries
        (org-agenda-finalize-entries rtnall 'agenda)
        "\n"))
        (put-text-property s (1- (point)) 'day d)
        (put-text-property s (1- (point)) 'org-day-cnt day-cnt))))
      (when (and org-agenda-clockreport-mode clocktable-start)
  (let ((org-agenda-files (org-agenda-files nil 'ifmode))
        ;; the above line is to ensure the restricted range!
        (p (copy-sequence org-agenda-clockreport-parameter-plist))
        tbl)
    (setq p (org-plist-delete p :block))
    (setq p (plist-put p :tstart clocktable-start))
    (setq p (plist-put p :tend clocktable-end))
    (setq p (plist-put p :scope 'agenda))
    (setq tbl (apply 'org-clock-get-clocktable p))
    (insert tbl)))
      (goto-char (point-min))
      (or org-agenda-multi (org-agenda-fit-window-to-buffer))
      (unless (and (pos-visible-in-window-p (point-min))
       (pos-visible-in-window-p (point-max)))
  (goto-char (1- (point-max)))
  (recenter -1)
  (if (not (pos-visible-in-window-p (or start-pos 1)))
      (progn
        (goto-char (or start-pos 1))
        (recenter 1))))
      (goto-char (or start-pos 1))
      (add-text-properties (point-min) (point-max)
         `(org-agenda-type agenda
               org-last-args (,arg ,start-day ,span)
               org-redo-cmd ,org-agenda-redo-command
               org-series-cmd ,org-cmd))
      (if (eq org-agenda-show-log-scoped 'clockcheck)
    (org-agenda-show-clocking-issues))
      (org-agenda-finalize)
      (setq buffer-read-only t)
      (message ""))))

(defun org-agenda--get-birthdays-holidays ()
  "Add holidays/birthdays to the agenda view."
  (let* (
      (props (list
        'mouse-face 'highlight
        'org-not-done-regexp org-not-done-regexp
        'org-todo-regexp org-todo-regexp
        'org-complex-heading-regexp org-complex-heading-regexp
        'help-echo "Birthdays and Holidays"))
      (d1 (calendar-absolute-from-gregorian date))
      ee
      res-holidays
      res-birthdays
      (displayed-month (nth 0 date))
      (displayed-year (nth 2 date))
      (holiday-list
        (dolist (p org-agenda--holiday-list res-holidays)
          (let* (h)
           (when (setq h (eval p))
             (setq res-holidays (append h res-holidays))))))
      (birthday-list
        (dolist (p org-agenda--birthday-list res-birthdays)
          (let* (h)
           (when (setq h (eval p))
             (setq res-birthdays (append h res-birthdays)))))) )
    (when org-agenda--show-holidays-birthdays
      (mapcar
        (lambda (x)
          (let ((txt (format "%s -- holiday -- %s" (car x) (car (cdr x)))))
            (when (eq d1 (calendar-absolute-from-gregorian (car x)))
              (org-add-props txt props
                'ts-date d1
                ;; (char-to-string 65) = A; 66 = B; 67 = C; 68 = D; 69 = E
                'priority 65
                'type "holiday"
                'date d1
                'face 'org-agenda--holiday-face
                 ;; RESERVED FOR POTENTIAL FUTURE USE.
                'org-hd-marker nil
                'org-marker nil
                'warntime nil
                'level nil
                'org-category nil
                'org-category-position nil
                'todo-state nil
                'undone-face nil
                'done-face nil)
              (push txt ee))))
        holiday-list)
      (mapcar
        (lambda (x)
          (let ((txt (format "%s -- birthday -- %s" (car x) (car (cdr x)))))
            (when (eq d1 (calendar-absolute-from-gregorian (car x)))
              (org-add-props txt props
                'ts-date d1
                ;; (char-to-string 65) = A; 66 = B; 67 = C; 68 = D; 69 = E
                'priority 65
                'type "birthday"
                'date d1
                'face 'org-agenda--birthday-face
                 ;; RESERVED FOR POTENTIAL FUTURE USE.
                'org-hd-marker nil
                'org-marker nil
                'warntime nil
                'level nil
                'org-category nil
                'org-category-position nil
                'todo-state nil
                'undone-face nil
                'done-face nil)
              (push txt ee))))
        birthday-list))
    (nreverse ee)))

Example Example

  • How does this answer differ from setting org-agenda-include-diary t? Does this answer predate that variable? I came here because setting that variable for me causes org-agenda to be slow because it calls diary-list-entries every time the agenda is displayed (so for example paging through the agenda is slow). The manual suggests how to speed it up, in a way I don't yet understand (what sexp entries? how do I get those out of diary/holiday?) orgmode.org/manual/… . How does this answer relate to those options? – Croad Langshan Oct 13 '18 at 9:35
  • @CroadLangshan -- This answer does not use the diary mechanisms. At the time this answer was written, org-mode did not have a built-in solution such as this. I don't use org-mode versions 9+, so I have no idea if something new has been implemented along these lines. I prefer setting my holidays and birthdays like this, rather than using the diary mechanism. The external third-party library calfw does have the ability to incorporate holidays from the calendar-holiday-list; and, I extended that functionality to birthdays in a modified version of calfw that is not publicly available – lawlist Oct 13 '18 at 16:01
  • @CroadLangshan -- Here is a link to an example that I wrote up of how to use a sexp for (1) org-mode; or, (2) diary. You are probably interested in #1. emacs.stackexchange.com/a/31708/2287 . I don't use the sexp solution in org-mode, and only wrote up that answer because the concept seemed interesting and I wanted to see how it worked. – lawlist Oct 13 '18 at 16:05
  • Thanks: here is what I ended up with: emacs.stackexchange.com/questions/44851/uk-holidays-definitions/… -- that isn't entirely programmatic (there is a single entry in the org mode file which refers to some elisp code to add the holidays) so I didn't add an answer here too: I'm not sure whether that meets your criterion for this question? – Croad Langshan Oct 14 '18 at 11:14
  • @CroadLangshan -- just one (1) sexp entry in the master org file -- I love it! I am sure that other forum participants who find this thread would love it too, especially since it requires no modification to existing code. Please feel free to post that solution here also. – lawlist Oct 14 '18 at 17:33

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.