mirror/org-mode
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs/org-mode.git synced 2025-01-20 19:24:20 +00:00
Code

Use a new function to mark anniversaries in Org diary files

Browse Source 
* lisp/org-agenda.el (org-agenda-add-entry-to-org-agenda-diary-file):
Use stable internal `org-anniversary' instead of diary-anniversary.
(org-class): New function.
(org-diary-class): Use `org-class'.
(org-anniversary, org-cyclic, org-date, org-block): New functions.

This patch provides stable alternatives for a number of diary
functions to be used in diary sexp entries. The corresponding diary-*
functions swap around their input arguments depending on
`calendar-date-style', which is unstable and evil.  The functions
provided here have a fixed order of arguments, the ISO order: year
month day.

Also, the `i a' key in the agenda now uses `org-anniversary' instead of
diary-anniversary.
This commit is contained in:
Carsten Dominik 2011-06-16 11:05:17 +02:00
parent 01ebf445aa
commit 12d51dad7b
1 changed files with 54 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

74
lisp/org-agenda.el
View File

@ -4816,19 +4816,40 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
(push txt ee)))))
(nreverse ee)))
(defun org-diary-class (m1 d1 y1 m2 d2 y2 dayname &rest skip-weeks)
;; Calendar sanity: define some functions that are independent of
;; `calendar-date-style'.
;; Normally I would like to use ISO format when calling the diary functions,
;; but to make sure we still have Emacs 22 compatibility we bind
;; also `european-calendar-style' and use european format
(defun org-anniversary (year month day &optional mark)
"Like `diary-anniversary', but with fixed (ISO) order of arguments."
(org-no-warnings
(let ((calendar-date-style 'european) (european-calendar-style t))
(diary-anniversary day month year mark))))
(defun org-cyclic (N year month day &optional mark)
"Like `diary-cyclic', but with fixed (ISO) order of arguments."
(org-no-warnings
(let ((calendar-date-style 'european) (european-calendar-style t))
(diary-cyclic N day month year mark))))
(defun org-block (Y1 M1 D1 Y2 M2 D2 &optional mark)
"Like `diary-block', but with fixed (ISO) order of arguments."
(org-no-warnings
(let ((calendar-date-style 'european) (european-calendar-style t))
(diary-block D1 M1 Y1 D2 M2 Y2 mark))))
(defun org-date (year month day &optional mark)
"Like `diary-date', but with fixed (ISO) order of arguments."
(org-no-warnings
(let ((calendar-date-style 'european) (european-calendar-style t))
(diary-date day month year mark))))
;; Define the` org-class' function
(defun org-class (y1 m1 d1 y2 m2 d2 dayname &rest skip-weeks)
"Entry applies if date is between dates on DAYNAME, but skips SKIP-WEEKS.
The order of the first 2 times 3 arguments depends on the variable
`calendar-date-style' or, if that is not defined, on `european-calendar-style'.
So for American calendars, give this as MONTH DAY YEAR, for European as
DAY MONTH YEAR, and for ISO as YEAR MONTH DAY.
DAYNAME is a number between 0 (Sunday) and 6 (Saturday). SKIP-WEEKS
is any number of ISO weeks in the block period for which the item should
be skipped."
(let* ((date1 (calendar-absolute-from-gregorian
(org-order-calendar-date-args m1 d1 y1)))
(date2 (calendar-absolute-from-gregorian
(org-order-calendar-date-args m2 d2 y2)))
(let* ((date1 (calendar-absolute-from-gregorian (list m1 d1 y1)))
(date2 (calendar-absolute-from-gregorian (list m2 d2 y2)))
(d (calendar-absolute-from-gregorian date)))
(and
(<= date1 d)
@ -4840,6 +4861,28 @@ be skipped."
(not (member (car (calendar-iso-from-absolute d)) skip-weeks))))
entry)))
(defun org-diary-class (m1 d1 y1 m2 d2 y2 dayname &rest skip-weeks)
"Like `org-class', but honor `calendar-date-style'.
The order of the first 2 times 3 arguments depends on the variable
`calendar-date-style' or, if that is not defined, on `european-calendar-style'.
So for American calendars, give this as MONTH DAY YEAR, for European as
DAY MONTH YEAR, and for ISO as YEAR MONTH DAY.
DAYNAME is a number between 0 (Sunday) and 6 (Saturday). SKIP-WEEKS
is any number of ISO weeks in the block period for which the item should
be skipped.
This function is here only for backward compatibility and it is deprecated,
please use `org-class' instead."
(let* ((date1 (calendar-absolute-from-gregorian
(org-order-calendar-date-args m1 d1 y1)))
(date2 (calendar-absolute-from-gregorian
(org-order-calendar-date-args m2 d2 y2)))
(d (calendar-absolute-from-gregorian date)))
(org-class
(nth 2 date1) (car date1) (nth 1 date1)
(nth 2 date2) (car date2) (nth 1 date2)
dayname skip-weeks)))
(defalias 'org-get-closed 'org-agenda-get-progress)
(defun org-agenda-get-progress ()
"Return the logged TODO entries for agenda display."
@ -7768,17 +7811,8 @@ the resulting entry will not be shown. When TEXT is empty, switch to
(org-back-over-empty-lines)
(backward-char 1)
(insert "\n")
(require 'diary-lib)
(let ((calendar-date-display-form
(if (if (boundp 'calendar-date-style)
(eq calendar-date-style 'european)
(with-no-warnings ;; european-calendar-style is obsolete as of version 23.1
(org-bound-and-true-p european-calendar-style))) ; Emacs 22
'(day " " month " " year)
'(month " " day " " year))))
(insert (format "%%%%(diary-anniversary %s) %s"
(calendar-date-string d1 nil t) text))))
(insert (format "%%%%(org-anniversary %d %2d %2d) %s"
(nth 2 d1) (car d1) (nth 1 d1) text)))
((eq type 'day)
(let ((org-prefix-has-time t)
(org-agenda-time-leading-zero t)