From 1951c6202a092e9136a010b0f1c7592f69fc66c2 Mon Sep 17 00:00:00 2001 From: Carsten Dominik Date: Mon, 28 Dec 2009 19:43:04 +0100 Subject: [PATCH] New function `org-diary-schedule' to schedule classes with skipped weeks. This is modified from a proposal by Daniel Martins. --- lisp/ChangeLog | 4 ++++ lisp/org-agenda.el | 27 +++++++++++++++++++++++++++ 2 files changed, 31 insertions(+) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 642acfaf2..8da500c15 100755 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,7 @@ +2009-12-28 Carsten Dominik + + * org-agenda.el (org-diary-class): New function. + 2009-12-24 Carsten Dominik * org-latex.el (org-export-latex-preprocess): Do process the text diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index 13b55762b..da6031026 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -4154,6 +4154,33 @@ the documentation of `org-diary'." (push txt ee)))) (nreverse ee))) +(defun org-diary-class (m1 d1 y1 m2 d2 y2 dayname &rest skip-weeks) + "Entry applies if date is between dates on DAYNAME, but skips SKIP-WEEKS. +Order of the parameters is M1, D1, Y1, M2, D2, Y2 if +`european-calendar-style' is nil, and D1, M1, Y1, D2, M2, Y2 if +`european-calendar-style' is t. +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 + (if european-calendar-style + (list d1 m1 y1) + (list m1 d1 y1)))) + (date2 (calendar-absolute-from-gregorian + (if european-calendar-style + (list d2 m2 y2) + (list m2 d2 y2)))) + (d (calendar-absolute-from-gregorian date))) + (and + (<= date1 d) + (<= d date2) + (= (calendar-day-of-week date) dayname) + (or (not skip-weeks) + (progn + (require 'cal-iso) + (not (member (car (calendar-iso-from-absolute d)) skip-weeks)))) + entry))) + (defalias 'org-get-closed 'org-agenda-get-progress) (defun org-agenda-get-progress () "Return the logged TODO entries for agenda display." -- 2.11.4.GIT