Patch to add schedule propagation to org-depend

From: Andrew Hyatt <ahyatt@gmail.com>
To: emacs-orgmode@gnu.org
Subject: Patch to add schedule propagation to org-depend
Date: Tue, 3 Feb 2009 12:28:23 -0500	[thread overview]
Message-ID: <c8389b600902030928v772a558bsec62df51780c196c@mail.gmail.com> (raw)

[-- Attachment #1: Type: text/plain, Size: 325 bytes --]

I like to schedule items I'm supposed to be working on, so I like when
I complete a task that the next sibling task gets the schedule from
the previous one.  This implements that kind of workflow with the
org-depend contrib package.

I've also added a few methods to org.el to make working with schedules
& deadlines easier.

[-- Attachment #2: org-depend-scheduled.patch --]
[-- Type: application/octet-stream, Size: 5209 bytes --]

diff --git a/contrib/lisp/org-depend.el b/contrib/lisp/org-depend.el
index 079d194..0837276 100644
--- a/contrib/lisp/org-depend.el
+++ b/contrib/lisp/org-depend.el
@@ -46,7 +46,16 @@
 ;;      property, to make sure that, when *it* is DONE, the chain will
 ;;      continue.
 ;;
-;; 2) If the TRIGGER property contains any other words like
+;; 2) If an entry contains a TRIGGER property that contains the string
+;;    "chain-siblings-scheduled", then switching that entry to DONE does
+;;    the following actions, similarly to "chain-siblings(KEYWORD)":
+;;    - The sibling receives the same scheduled time as the entry
+;;      marked as DONE (or, in the case, in which there is no scheduled
+;;      time, the sibling does not get any either).
+;;    - The sibling also gets the same TRIGGER property
+;;      "chain-siblings-scheduled", so the chain can continue.
+;;
+;; 3) If the TRIGGER property contains any other words like
 ;;    XYZ(KEYWORD), these are treated as entry id's with keywords.  That
 ;;    means, Org-mode will search for an entry with the ID property XYZ
 ;;    and switch that entry to KEYWORD as well.
@@ -118,6 +127,22 @@
   :group 'org
   :type 'boolean)
 
+(defmacro org-depend-act-on-sibling (trigger-val &rest rest)
+  "Perform a set of actions on the next sibling, if it exists,
+copying the sibling spec TRIGGER-VAL to the next sibling."
+  `(catch 'exit
+     (save-excursion
+       (goto-char pos)
+       ;; find the sibling, exit if no more siblings
+       (condition-case nil
+           (outline-forward-same-level 1)
+         (error (throw 'exit t)))
+       ;; mark the sibling TODO
+       ,@rest
+       ;; make sure the sibling will continue the chain
+       (org-entry-add-to-multivalued-property
+        nil "TRIGGER" ,trigger-val))))
+
 (defun org-depend-trigger-todo (change-plist)
   "Trigger new TODO entries after the current is switched to DONE.
 This does two different kinds of triggers:
@@ -126,6 +151,10 @@ This does two different kinds of triggers:
   \"chain-siblings(KEYWORD)\", it goes to the next sibling, marks it
   KEYWORD and also installs the \"chain-sibling\" trigger to continue
   the chain.
+- If the current entry contains a TRIGGER property that contains
+  \"chain-siblings-scheduled\", we go to the next sibling and copy
+  the scheduled time from the current task, also installing the property
+  in the sibling.
 - Any other word (space-separated) like XYZ(KEYWORD) in the TRIGGER
   property is seen as an entry id.  Org-mode finds the entry with the
   corresponding ID property and switches it to the state TODO as well."
@@ -158,19 +187,8 @@ This does two different kinds of triggers:
 	 ((string-match "\\`chain-siblings(\\(.*?\\))\\'" tr)
 	  ;; This is a TODO chain of siblings
 	  (setq kwd (match-string 1 tr))
-	  (catch 'exit
-	    (save-excursion
-	      (goto-char pos)
-	      ;; find the sibling, exit if no more siblings
-	      (condition-case nil
-		  (outline-forward-same-level 1)
-		(error (throw 'exit t)))
-	      ;; mark the sibling TODO
-	      (org-todo kwd)
-	      ;; make sure the sibling will continue the chain
-	      (org-entry-add-to-multivalued-property
-	       nil "TRIGGER" (format "chain-siblings(%s)" kwd)))))
-
+          (org-depend-act-on-sibling (format "chain-siblings(%s)" kwd)
+                                     (org-todo kwd)))
 	 ((string-match "\\`\\(\\S-+\\)(\\(.*?\\))\\'" tr)
 	  ;; This seems to be ENTRY_ID(KEYWORD)
 	  (setq id (match-string 1 tr)
@@ -180,7 +198,13 @@ This does two different kinds of triggers:
 	    ;; there is an entry with this ID, mark it TODO
 	    (save-excursion
 	      (goto-char p1)
-	      (org-todo kwd)))))))))
+	      (org-todo kwd))))
+         ((string-match "\\`chain-siblings-scheduled\\'" tr)
+          (let ((time (org-get-scheduled-time pos)))
+            (when time
+              (org-depend-act-on-sibling
+               "chain-siblings-scheduled"
+               (org-schedule nil time))))))))))
 
 (defun org-depend-block-todo (change-plist)
   "Block turning an entry into a TODO.
diff --git a/lisp/org.el b/lisp/org.el
index ff0451f..84e1619 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -8951,6 +8951,22 @@ scheduling will use the corresponding date."
       (org-add-planning-info 'scheduled time 'closed)
       (message "Scheduled to %s" org-last-inserted-timestamp))))
 
+(defun org-get-scheduled-time (pom &optional inherit)
+  "Get the scheduled time as a time tuple, of a format suitable
+for calling org-schedule with, or if there is no scheduling,
+returns nil."
+  (let ((time (org-entry-get pom "SCHEDULED" inherit)))
+    (when time
+      (apply 'encode-time (org-parse-time-string time)))))
+
+(defun org-get-deadline-time (pom &optional inherit)
+  "Get the deadine as a time tuple, of a format suitable for
+calling org-deadlin with, or if there is no scheduling, returns
+nil."
+  (let ((time (org-entry-get pom "DEADLINE" inherit)))
+    (when time
+      (apply 'encode-time (org-parse-time-string time)))))
+
 (defun org-remove-timestamp-with-keyword (keyword)
   "Remove all time stamps with KEYWORD in the current entry."
   (let ((re (concat "\\<" (regexp-quote keyword) " +<[^>\n]+>[ \t]*"))

[-- Attachment #3: Type: text/plain, Size: 204 bytes --]

_______________________________________________
Emacs-orgmode mailing list
Remember: use `Reply All' to send replies to the list.
Emacs-orgmode@gnu.org
http://lists.gnu.org/mailman/listinfo/emacs-orgmode
