Re: Allowing multiple date trees in a single file

[Carsten Dominik <dominik@uva.nl>]

[-- Attachment #1.1: Type: text/plain, Size: 1668 bytes --]

Hi Nicolas,

ok, here is where I have gotten with this:

Attached is a patch that does the following:

It consolidates all four different org-capture target types that have to do
with
date/week trees into a single one, called `file+olp+datetree'.  This target
allows for an optional outline path specification to tell capture to build
the
datetree under a specific headline.  To switch to a week tree, or to force
a date prompt is now the matter of setting one of the properties in the
org-capture-template variable.

Everything works transparently, so users can update the way they
write their datetree captures, but they don't have to - the old syntax
remains
supported and will automatically switched when one uses customize to change
the variable.

After a bit more testing, I'd like to apply this patch.  Please let me know
if you agree. And additional testers would be useful.  Anyone?  Make sure
to backup your capture templates if something goes wrong.

Cheers

Carsten





On Wed, Jan 18, 2017 at 12:23 PM, Nicolas Goaziou <mail@nicolasgoaziou.fr>
wrote:

> Hello,
>
> Carsten Dominik <dominik@uva.nl> writes:
>
> > I meant
> >
> > :DATE_TREE: my_diary
> > :DATE_TREE: food_and_health
> > :DATE_TREE: movies watched
>
> It sounds less useful because we already have ways to identify uniquely
> a heading.
>
> > Another thing I was thinking is a way to force prompting for a date, for
> > example through a prefix argument, so that a single capture template
> could
> > be used for using the current date and optionally a set one.
>
> It is nice, too. It would reduce the number of new capture target types
> required.
>
> Regards,
>
> --
> Nicolas Goaziou
>

[-- Attachment #1.2: Type: text/html, Size: 2540 bytes --]

[-- Attachment #2: datetree-patch --]
[-- Type: application/octet-stream, Size: 17208 bytes --]

Changes in master
	Modified doc/org.texi
diff --git a/doc/org.texi b/doc/org.texi
index f68ef6e..3219d94 100644
--- a/doc/org.texi
+++ b/doc/org.texi
@@ -7065,7 +7065,7 @@ would look like:
 (setq org-capture-templates
  '(("t" "Todo" entry (file+headline "~/org/gtd.org" "Tasks")
         "* TODO %?\n  %i\n  %a")
-   ("j" "Journal" entry (file+datetree "~/org/journal.org")
+   ("j" "Journal" entry (file+olp+datetree "~/org/journal.org")
         "* %?\nEntered on %U\n  %i\n  %a")))
 @end group
 @end smalllisp
@@ -7173,21 +7173,13 @@ For non-unique headings, the full path is safer.
 @item (file+regexp  "path/to/file" "regexp to find location")
 Use a regular expression to position the cursor.
 
-@item (file+datetree "path/to/file")
+@item (file+olp+datetree "path/to/file" [ "Level 1 heading" ....])
 Will create a heading in a date tree for today's date@footnote{Datetree
 headlines for years accept tags, so if you use both @code{* 2013 :noexport:}
 and @code{* 2013} in your file, the capture will refile the note to the first
-one matched.}.
-
-@item (file+datetree+prompt "path/to/file")
-Will create a heading in a date tree, but will prompt for the date.
-
-@item (file+weektree "path/to/file")
-Will create a heading in a week tree for today's date.  Week trees are sorted
-by week and not by month unlike datetrees.
-
-@item (file+weektree+prompt "path/to/file")
-Will create a heading in a week tree, but will prompt for the date.
+one matched.}.  If the optional outline path is given, the tree will be built
+under the node it is pointing to. Check out the @code{:time-prompt} and
+@code{:tree-type} below for modifying the tree.
 
 @item (file+function "path/to/file" function-finding-location)
 A function to find the right location in the file.
@@ -7239,6 +7231,14 @@ with the capture.  Note that @code{:clock-keep} has precedence over
 @code{:clock-resume}.  When setting both to @code{t}, the current clock will
 run and the previous one will not be resumed.
 
+@item :time-prompt
+Prompt for a date/time to be used for date/week trees and when filling the
+template.
+
+@item :tree-type
+When `week', make a week tree instead of the month tree, i.e. place the
+headings for each day under a heading with the current iso week.
+
 @item :unnarrowed
 Do not narrow the target buffer, simply show the full buffer.  Default is to
 narrow it so that you only see the new material.
	Modified lisp/org-capture.el
diff --git a/lisp/org-capture.el b/lisp/org-capture.el
index 1a1a500..3afbe24 100644
--- a/lisp/org-capture.el
+++ b/lisp/org-capture.el
@@ -84,6 +84,25 @@
   :tag "Org Capture"
   :group 'org)
 
+(defun org-capture-upgrade-templates (templates)
+  "Update the template list to the new format.
+The new format unifies all the date/week tree targets into one that
+also allows for an optional outline path to specify a target."
+  (let (target props)
+    (mapcar
+     (lambda (ee)
+       (setq target (car (nth 3 ee)))
+       (when (memq target '(file+datetree file+datetree+prompt
+					  file+weektree file+weektree+prompt))
+	 (setq target (symbol-name target) props nil)
+	 (if (string-match "prompt" target) (setq props '(:time-prompt t)))
+	 (if (string-match "week" target)
+	     (setq props (append '(:tree-type week) props)))
+	 (setcar (nth 3 ee) 'file+olp+datetree)
+	 (setcdr (nthcdr 4 ee) (append props (nthcdr 5 ee))))
+       ee)
+     templates)))
+
 (defcustom org-capture-templates nil
   "Templates for the creation of new entries.
 
@@ -141,22 +160,17 @@ target       Specification of where the captured item should be placed.
                  Fast configuration if the target heading is unique in the file
 
              (file+olp \"path/to/file\" \"Level 1 heading\" \"Level 2\" ...)
-                 For non-unique headings, the full path is safer
+                 For non-unique headings, the full outline path is safer
 
              (file+regexp  \"path/to/file\" \"regexp to find location\")
                  File to the entry matching regexp
 
-             (file+datetree \"path/to/file\")
-                 Will create a heading in a date tree for today's date
-
-             (file+datetree+prompt \"path/to/file\")
-                 Will create a heading in a date tree, prompts for date
-
-             (file+weektree \"path/to/file\")
-                 Will create a heading in a week tree for today's date
-
-             (file+weektree+prompt \"path/to/file\")
-                 Will create a heading in a week tree, prompts for date
+             (file+olp+datetree \"path/to/file\" \"Level 1 heading\" ...)
+                 Will create a heading in a date tree for today's date.
+                 If no headings are given, the tree will be on top level.
+                 To prompt for date instead of using TODAY, use the
+                 :time-prompt property.  To create a week-tree, use the
+                 :tree-type property.
 
              (file+function \"path/to/file\" function-finding-location)
                  A function to find the right location in the file
@@ -214,6 +228,11 @@ properties are:
                      When setting both to t, the current clock will run and
                      the previous one will not be resumed.
 
+ :time-prompt        Prompt for a date/time to be used for date/week trees
+                     and when filling the template.
+
+ :tree-type          When `week', make a week tree instead of the month tree.
+
  :unnarrowed         Do not narrow the target buffer, simply show the
                      full buffer.  Default is to narrow it so that you
                      only see the new stuff.
@@ -297,6 +316,7 @@ When you need to insert a literal percent sign in the template,
 you can escape ambiguous cases with a backward slash, e.g., \\%i."
   :group 'org-capture
   :version "24.1"
+  :set (lambda (s v) (set s (org-capture-upgrade-templates v)))
   :type
   (let ((file-variants '(choice :tag "Filename       "
 				(file :tag "Literal")
@@ -337,18 +357,11 @@ you can escape ambiguous cases with a backward slash, e.g., \\%i."
 				(const :format "" file+regexp)
 				,file-variants
 				(regexp :tag "  Regexp"))
-			  (list :tag "File & Date tree"
-				(const :format "" file+datetree)
-				,file-variants)
-			  (list :tag "File & Date tree, prompt for date"
-				(const :format "" file+datetree+prompt)
-				,file-variants)
-			  (list :tag "File & Week tree"
-				(const :format "" file+weektree)
-				,file-variants)
-			  (list :tag "File & Week tree, prompt for date"
-				(const :format "" file+weektree+prompt)
-				,file-variants)
+			  (list :tag "File [ & Outline path ] & Date tree"
+				(const :format "" file+olp+datetree)
+				,file-variants
+				(repeat :tag "Outline path" :inline t
+					(string :tag "Headline")))
 			  (list :tag "File & function"
 				(const :format "" file+function)
 				,file-variants
@@ -377,8 +390,10 @@ you can escape ambiguous cases with a backward slash, e.g., \\%i."
 				   ((const :format "%v " :clock-in) (const t))
 				   ((const :format "%v " :clock-keep) (const t))
 				   ((const :format "%v " :clock-resume) (const t))
+				   ((const :format "%v " :time-prompt) (const t))
+				   ((const :format "%v " :tree-type) (const week))
 				   ((const :format "%v " :unnarrowed) (const t))
-				   ((const :format "%v " :table-line-pos) (const t))
+				   ((const :format "%v " :table-line-pos) (string))
 				   ((const :format "%v " :kill-buffer) (const t)))))))))
 
 (defcustom org-capture-before-finalize-hook nil
@@ -562,6 +577,9 @@ the last note stored.
 
 When called with a `C-0' (zero) prefix, insert a template at point.
 
+When called with a `C-1' (one) prefix, force prompting for a date when
+a datetree entry is made.
+
 ELisp programs can set KEYS to a string associated with a template
 in `org-capture-templates'.  In this case, interactive selection
 will be bypassed.
@@ -902,6 +920,7 @@ Store them in the capture property list."
 	   (insert "* " headline "\n")
 	   (beginning-of-line 0)))
 	(`(file+olp ,path . ,outline-path)
+	 (setq outline-path (org-capture-sanitize-olp outline-path))
 	 (let ((m (org-find-olp (cons (org-capture-expand-file path)
 				      outline-path))))
 	   (set-buffer (marker-buffer m))
@@ -922,59 +941,65 @@ Store them in the capture property list."
 	   (org-capture-put :exact-position (point))
 	   (setq target-entry-p
 		 (and (derived-mode-p 'org-mode) (org-at-heading-p)))))
-	(`(,(and type (or `file+datetree
-			  `file+datetree+prompt
-			  `file+weektree
-			  `file+weektree+prompt))
-	   ,path)
-	 (set-buffer (org-capture-target-buffer path))
-	 (unless (derived-mode-p 'org-mode)
-	   (error "Target buffer \"%s\" for %s should be in Org mode"
-		  (current-buffer)
-		  type))
-	 (require 'org-datetree)
-	 (org-capture-put-target-region-and-position)
-	 (widen)
-	 ;; Make a date/week tree entry, with the current date (or
-	 ;; yesterday, if we are extending dates for a couple of hours)
-	 (funcall
-	  (if (memq type '(file+weektree file+weektree+prompt))
-	      #'org-datetree-find-iso-week-create
-	    #'org-datetree-find-date-create)
-	  (calendar-gregorian-from-absolute
-	   (cond
-	    (org-overriding-default-time
-	     ;; Use the overriding default time.
-	     (time-to-days org-overriding-default-time))
-	    ((memq type '(file+datetree+prompt file+weektree+prompt))
-	     ;; Prompt for date.
-	     (let ((prompt-time (org-read-date
-				 nil t nil "Date for tree entry:"
-				 (current-time))))
-	       (org-capture-put
-		:default-time
-		(cond ((and (or (not (boundp 'org-time-was-given))
-				(not org-time-was-given))
-			    (not (= (time-to-days prompt-time) (org-today))))
-		       ;; Use 00:00 when no time is given for another
-		       ;; date than today?
-		       (apply #'encode-time
-			      (append '(0 0 0)
-				      (cl-cdddr (decode-time prompt-time)))))
-		      ((string-match "\\([^ ]+\\)--?[^ ]+[ ]+\\(.*\\)"
-				     org-read-date-final-answer)
-		       ;; Replace any time range by its start.
-		       (apply #'encode-time
-			      (org-read-date-analyze
-			       (replace-match "\\1 \\2" nil nil
-					      org-read-date-final-answer)
-			       prompt-time (decode-time prompt-time))))
-		      (t prompt-time)))
-	       (time-to-days prompt-time)))
-	    (t
-	     ;; Current date, possibly corrected for late night
-	     ;; workers.
-	     (org-today))))))
+	(`(file+olp+datetree ,path . ,outline-path)
+	 (setq outline-path (org-capture-sanitize-olp outline-path))
+	 (let ((m (if outline-path
+		      (org-find-olp (cons (org-capture-expand-file path)
+					  outline-path))
+		    (set-buffer (org-capture-target-buffer path))
+		    (move-marker (make-marker) (point)))))		    
+	   (set-buffer (marker-buffer m))
+	   (org-capture-put-target-region-and-position)
+	   (widen)
+	   (goto-char m)
+	   (set-marker m nil)
+	   (require 'org-datetree)
+	   (org-capture-put-target-region-and-position)
+	   (widen)
+	   ;; Make a date/week tree entry, with the current date (or
+	   ;; yesterday, if we are extending dates for a couple of hours)
+	   (funcall
+	    (if (eq (org-capture-get :tree-type) 'week)
+		#'org-datetree-find-iso-week-create
+	      #'org-datetree-find-date-create)
+	    (calendar-gregorian-from-absolute
+	     (cond
+	      (org-overriding-default-time
+	       ;; Use the overriding default time.
+	       (time-to-days org-overriding-default-time))
+	      ((org-capture-get :time-prompt)
+	       ;; Prompt for date.
+	       (let ((prompt-time (org-read-date
+				   nil t nil "Date for tree entry:"
+				   (current-time))))
+		 (org-capture-put
+		  :default-time
+		  (cond ((and (or (not (boundp 'org-time-was-given))
+				  (not org-time-was-given))
+			      (not (= (time-to-days prompt-time) (org-today))))
+			 ;; Use 00:00 when no time is given for another
+			 ;; date than today?
+			 (apply #'encode-time
+				(append '(0 0 0)
+					(cl-cdddr (decode-time prompt-time)))))
+			((string-match "\\([^ ]+\\)--?[^ ]+[ ]+\\(.*\\)"
+				       org-read-date-final-answer)
+			 ;; Replace any time range by its start.
+			 (apply #'encode-time
+				(org-read-date-analyze
+				 (replace-match "\\1 \\2" nil nil
+						org-read-date-final-answer)
+				 prompt-time (decode-time prompt-time))))
+			(t prompt-time)))
+		 (time-to-days prompt-time)))
+	      (t
+	       ;; Current date, possibly corrected for late night
+	       ;; workers.
+	       (org-today))))
+	    ;; the following is the keep-restriction argument for
+	    ;; org-datetree-find-date-create
+	    (if outline-path 'subtree-at-point)
+	    )))
 	(`(file+function ,path ,function)
 	 (set-buffer (org-capture-target-buffer path))
 	 (org-capture-put-target-region-and-position)
@@ -1432,6 +1457,13 @@ Use PREFIX as a prefix for the name of the indirect buffer."
   (unless (org-kill-is-subtree-p tree)
     (error "Template is not a valid Org entry or tree")))
 
+(defun org-capture-sanitize-olp (olp)
+  "Keep only non-white strings in the list OPL."
+  (let (res e)
+    (while (setq e (pop olp))
+      (and (stringp e) (string-match "\\S-" e) (push e res)))
+    (nreverse res)))
+
 (defun org-mks (table title &optional prompt specials)
   "Select a member of an alist with multiple keys.
 
@@ -1526,7 +1558,8 @@ is selected, only the bare key is returned."
 Lisp programs can force the template by setting KEYS to a string."
   (let ((org-capture-templates
 	 (or (org-contextualize-keys
-	      org-capture-templates org-capture-templates-contexts)
+	      (org-capture-upgrade-templates org-capture-templates)
+	      org-capture-templates-contexts)
 	     '(("t" "Task" entry (file+headline "" "Tasks")
 		"* TODO %?\n  %u\n  %a")))))
     (if keys
	Modified lisp/org-datetree.el
diff --git a/lisp/org-datetree.el b/lisp/org-datetree.el
index 540753d..1116377 100644
--- a/lisp/org-datetree.el
+++ b/lisp/org-datetree.el
@@ -54,16 +54,25 @@ Added time stamp is active unless value is `inactive'."
   "Find or create an entry for date D.
 If KEEP-RESTRICTION is non-nil, do not widen the buffer.
 When it is nil, the buffer will be widened to make sure an existing date
-tree can be found."
+tree can be found.  If it is the sympol `subtree-at-point', then the tree
+will be built under the headline at point."
   (setq-local org-datetree-base-level 1)
-  (or keep-restriction (widen))
   (save-restriction
-    (let ((prop (org-find-property "DATE_TREE")))
-      (when prop
-	(goto-char prop)
-	(setq-local org-datetree-base-level
-		    (org-get-valid-level (org-current-level) 1))
-	(org-narrow-to-subtree)))
+    (if (eq keep-restriction 'subtree-at-point)
+	(progn
+	  (or (org-at-heading-p) (error "Not at heading"))
+	  (widen)
+	  (org-narrow-to-subtree)
+	  (setq-local org-datetree-base-level
+		      (org-get-valid-level (org-current-level) 1)))
+      (or keep-restriction (widen))
+      ;; support the old way of tree placement, using a property
+      (let ((prop (org-find-property "DATE_TREE")))
+	(when prop
+	  (goto-char prop)
+	  (setq-local org-datetree-base-level
+		      (org-get-valid-level (org-current-level) 1))
+	  (org-narrow-to-subtree))))
     (goto-char (point-min))
     (let ((year (calendar-extract-year d))
 	  (month (calendar-extract-month d))
@@ -84,18 +93,26 @@ tree can be found."
   "Find or create an ISO week entry for date D.
 Compared to `org-datetree-find-date-create' this function creates
 entries ordered by week instead of months.
-If KEEP-RESTRICTION is non-nil, do not widen the buffer.  When it
-is nil, the buffer will be widened to make sure an existing date
-tree can be found."
+When it is nil, the buffer will be widened to make sure an existing date
+tree can be found.  If it is the sympol `subtree-at-point', then the tree
+will be built under the headline at point."
   (setq-local org-datetree-base-level 1)
-  (or keep-restriction (widen))
   (save-restriction
-    (let ((prop (org-find-property "WEEK_TREE")))
-      (when prop
-	(goto-char prop)
-	(setq-local org-datetree-base-level
-		    (org-get-valid-level (org-current-level) 1))
-	(org-narrow-to-subtree)))
+    (if (eq keep-restriction 'subtree-at-point)
+	(progn
+	  (or (org-at-heading-p) (error "Not at heading"))
+	  (widen)
+	  (org-narrow-to-subtree)
+	  (setq-local org-datetree-base-level
+		      (org-get-valid-level (org-current-level) 1)))
+      (or keep-restriction (widen))
+      ;; support the old way of tree placement, using a property
+      (let ((prop (org-find-property "WEEK_TREE")))
+	(when prop
+	  (goto-char prop)
+	  (setq-local org-datetree-base-level
+		      (org-get-valid-level (org-current-level) 1))
+	  (org-narrow-to-subtree))))
     (goto-char (point-min))
     (require 'cal-iso)
     (let* ((year (calendar-extract-year d))
	Modified lisp/org.el
diff --git a/lisp/org.el b/lisp/org.el
index 38fce70..ac56d71 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -16615,6 +16615,8 @@ only headings."
 	 end found flevel)
     (unless buffer (error "File not found :%s" file))
     (with-current-buffer buffer
+      (unless (derived-mode-p 'org-mode)
+	(error "Buffer %s needs to be in org-mode" buffer))
       (org-with-wide-buffer
        (goto-char (point-min))
        (dolist (heading path)