Agregue programáticamente cumpleaños / días festivos a la vista de agenda en modo org

7

org-modeofrece algunas opciones integradas para agregar cumpleaños / vacaciones a la vista de agenda en org-mode; sin embargo, no hay soporte integrado para agregar esas fechas completamente mediante programación, sin agregar manualmente entradas de diario o entradas en el archivo de organización estándar.

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

¿Hay alguna forma de agregar cumpleaños / días festivos a la vista de agenda mediante programación, similar a lo que calendar-modeofrece? En calendar-mode, un usuario puede definir días festivos y cumpleaños con una variable combinada con funciones como holiday-fixedy holiday-float. El mismo tipo de configuración org-modeparece útil.

lista de leyes
fuente

Respuestas:

7

La siguiente es una modificación a org-agenda-list, con nuevas variables adicionales y una nueva función para agregar días festivos / cumpleaños. Cuando org-agenda--show-holidays-birthdaysno es así nil, los cumpleaños y días festivos aparecerán mediante programación en la vista de agenda. Las variables org-agenda--birthday-listy org-agenda--holiday-listpueden ser personalizadas por el usuario. Se ha agregado una entrada org-agenda-custom-commandspara probar esta nueva función: la letra mayúscula "Y" inicia la vista de año que contiene días festivos / cumpleaños. Se ha agregado cierta funcionalidad limitada para admitir algunas propiedades de texto básicas, y otras se pueden agregar en una fecha posterior.

Para ver ejemplos de cómo formatear los días festivos y cumpleaños que se usan dentro de las variables mencionadas anteriormente, consulte la cadena de documentos para la variable calendar-holidaysdentro de la biblioteca holidays.el, por ejemplo holiday-fixed; holiday-float; holiday-sexp; (lunar-phases); (solar-equinoxes-solstices); holiday-hebrew; holiday-islamic; holiday-bahai; holiday-julian; holiday-chinese; etc.

¿Cómo puedes probar este ejemplo? : Bloquear / copiar / pegar el código en su *Scratch*búfer; y tipo M-x eval-buffer RET; y luego escriba M-x org-agenda RETy luego seleccione la letra CAPITAL Y. Es un borrador de trabajo completamente funcional, pero necesita un poco de personalización para hacerlo más bonito y agregar la capacidad de ordenar alfabéticamente, etc. Si decide que no le gusta después de probarlo, simplemente reinicie Emacs y volverá a donde estabas antes de probarlo.

El código fuente que se modificó y las pruebas que se realizaron se realizaron con la versión pública más reciente de Emacs:   Org-mode versión 8.2.10 (release_8.2.10 @ /Applications/Emacs.app/Contents/Resources/lisp/org /) ; y, GNU Emacs 24.4.1 (x86_64-apple-darwin10.8.0, NS apple-appkit-1038.36) de 2014-10-20 en builder10-6.porkrind.org .


EL CÓDIGO:

(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)))

Ejemplo Ejemplo

lista de leyes
fuente
¿Cómo difiere esta respuesta de la configuración org-agenda-include-diary t? ¿Esta respuesta es anterior a esa variable? Vine aquí porque establecer esa variable para mí hace org-agendaque sea lenta porque llama diary-list-entriescada vez que se muestra la agenda (por ejemplo, la paginación de la agenda es lenta). El manual sugiere cómo acelerarlo, de una manera que aún no entiendo (¿qué entradas de sexp? ¿Cómo puedo sacarlas del diario / vacaciones?) Orgmode.org/manual/… . ¿Cómo se relaciona esta respuesta con esas opciones?
Croad Langshan
@CroadLangshan: esta respuesta no utiliza los mecanismos del diario. En el momento en que se escribió esta respuesta, org-modeno tenía una solución integrada como esta. No uso las org-modeversiones 9+, por lo que no tengo idea de si se ha implementado algo nuevo en este sentido. Prefiero configurar mis vacaciones y cumpleaños de esta manera, en lugar de usar el mecanismo del diario. La biblioteca externa de terceros calfwtiene la capacidad de incorporar vacaciones desde calendar-holiday-list; y, extendí que la funcionalidad de cumpleaños en una versión modificada de calfwque no está disponible públicamente
lawlist
@CroadLangshan: aquí hay un enlace a un ejemplo que escribí sobre cómo usar un sexp para (1) org-mode; o (2) diary. Probablemente estés interesado en el # 1. emacs.stackexchange.com/a/31708/2287 . No uso la solución sexp org-mode, y solo escribí esa respuesta porque el concepto parecía interesante y quería ver cómo funcionaba.
ley
Gracias: esto es lo que terminé con: emacs.stackexchange.com/questions/44851/uk-holidays-definitions/… - eso no es completamente programático (hay una sola entrada en el archivo del modo org que se refiere a algunos código de elisp para agregar las vacaciones), así que no agregué una respuesta aquí también: ¿No estoy seguro de si eso cumple con su criterio para esta pregunta?
Croad Langshan
@CroadLangshan - solo una (1) entrada sexp en el archivo de la organización maestra - ¡Me encanta! Estoy seguro de que a otros participantes del foro que encuentren este hilo también les encantará, especialmente porque no requiere modificación del código existente. Por favor, siéntase libre de publicar esa solución aquí también.
ley