Browse Source

Consolidate capture targets and allow outline path in datetree targets

* doc/org.texi: Document the new capture templates target.
* lisp/org-capture.el (org-capture-upgrade-templates): New function.
(org-capture-templates): Implement the new file+olp+datetree target.
(org-capture): Document the C-1 prefix.
(org-capture-sanitize-olp): New function.
(org-capture-select-template): Make sure upgraded version of templates
variable is used.
* lisp/org-datetree.el (org-datetree-find-date-create): Accept
`subtree-at-point' as a value for the KEEP-RESTRICTION argument.
(org-datetree-find-iso-week-create): Accept `subtree-at-point'
as a value for the KEEP-RESTRICTION argument.
* lisp/org.el (org-find-olp): Throw an error when called in a
buffer that is not in Org mode.
* lisp/org-capture.el (org-capture-fill-template): Use overriding time
also in `?<>' escapes.
Carsten Dominik 8 years ago
parent
commit
0f1b5ec496
4 changed files with 176 additions and 115 deletions
  1. 24 16
      doc/org.texi
  2. 115 81
      lisp/org-capture.el
  3. 35 18
      lisp/org-datetree.el
  4. 2 0
      lisp/org.el

+ 24 - 16
doc/org.texi

@@ -7070,7 +7070,7 @@ would look like:
 (setq org-capture-templates
 (setq org-capture-templates
  '(("t" "Todo" entry (file+headline "~/org/gtd.org" "Tasks")
  '(("t" "Todo" entry (file+headline "~/org/gtd.org" "Tasks")
         "* TODO %?\n  %i\n  %a")
         "* 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")))
         "* %?\nEntered on %U\n  %i\n  %a")))
 @end group
 @end group
 @end smalllisp
 @end smalllisp
@@ -7178,21 +7178,19 @@ For non-unique headings, the full path is safer.
 @item (file+regexp  "path/to/file" "regexp to find location")
 @item (file+regexp  "path/to/file" "regexp to find location")
 Use a regular expression to position the cursor.
 Use a regular expression to position the cursor.
 
 
-@item (file+datetree "path/to/file")
-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.
+@item (file+olp+datetree "path/to/file" [ "Level 1 heading" ....])
+This target@footnote{Org used to offer four different targets for date/week
+tree capture.  Now, Org automatically translates these to use
+@code{file+olp+datetree}, applying the @code{:time-prompt} and
+@code{:tree-type} properties.  Please rewrite your date/week-tree targets
+using @code{file+olp+datetree} since the older targets are now deprecated.}
+will create a heading in a date tree@footnote{A date tree is an outline
+structure with years on the highest level, months or ISO-weeks as sublevels
+and then dates on the lowest level.  Tags are allowed in the tree structure.}
+for today's date.  If the optional outline path is given, the tree will be
+built under the node it is pointing to, instead of at top level.  Check out
+the @code{:time-prompt} and @code{:tree-type} properties below for additional
+options.
 
 
 @item (file+function "path/to/file" function-finding-location)
 @item (file+function "path/to/file" function-finding-location)
 A function to find the right location in the file.
 A function to find the right location in the file.
@@ -7244,6 +7242,16 @@ with the capture.  Note that @code{:clock-keep} has precedence over
 @code{:clock-resume}.  When setting both to @code{t}, the current clock will
 @code{:clock-resume}.  When setting both to @code{t}, the current clock will
 run and the previous one will not be resumed.
 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.  Without this property, capture uses the current date and time.
+Even if this property has not been set, you can force the same behavior by
+calling @code{org-capture} with a @kbd{C-1} prefix argument.
+
+@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
 @item :unnarrowed
 Do not narrow the target buffer, simply show the full buffer.  Default is to
 Do not narrow the target buffer, simply show the full buffer.  Default is to
 narrow it so that you only see the new material.
 narrow it so that you only see the new material.

+ 115 - 81
lisp/org-capture.el

@@ -84,6 +84,36 @@
   :tag "Org Capture"
   :tag "Org Capture"
   :group 'org)
   :group 'org)
 
 
+(defun org-capture-upgrade-templates (templates)
+  "Update the template list to the new format.
+TEMPLATES is a template list, as in `org-capture-templates'. 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 ((modified-templates
+	 (mapcar
+	  (lambda (entry)
+	    (pcase entry
+	      ;; Match templates with an obsolete "tree" target type. Replace
+	      ;; it with common `file+olp-datetree'.  Add new properties
+	      ;; (i.e., `:time-prompt' and `:tree-type') if needed.
+	      (`(,key ,desc ,type (file+datetree . ,path) ,tpl . ,props)
+	       `(,key ,desc ,type (file+olp+datetree ,@path) ,tpl ,@props))
+	      (`(,key ,desc ,type (file+datetree+prompt . ,path) ,tpl . ,props)
+	       `(,key ,desc ,type (file+olp+datetree ,@path) ,tpl
+		      :time-prompt t ,@props))
+	      (`(,key ,desc ,type (file+weektree . ,path) ,tpl . ,props)
+	       `(,key ,desc ,type (file+olp+datetree ,@path) ,tpl
+		      :tree-type week ,@props))
+	      (`(,key ,desc ,type (file+weektree+prompt . ,path) ,tpl . ,props)
+	       `(,key ,desc ,type (file+olp+datetree ,@path) ,tpl
+		      :tree-type week :time-prompt t ,@props))
+	      ;; Other templates are left unchanged.
+	      (_ entry)))
+	  templates)))
+    (unless (equal modified-templates templates)
+      (message "Deprecated date/weektree capture templates changed to `file+olp+datetree'."))
+    modified-templates))
+
 (defcustom org-capture-templates nil
 (defcustom org-capture-templates nil
   "Templates for the creation of new entries.
   "Templates for the creation of new entries.
 
 
@@ -141,22 +171,17 @@ target       Specification of where the captured item should be placed.
                  Fast configuration if the target heading is unique in the file
                  Fast configuration if the target heading is unique in the file
 
 
              (file+olp \"path/to/file\" \"Level 1 heading\" \"Level 2\" ...)
              (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+regexp  \"path/to/file\" \"regexp to find location\")
                  File to the entry matching regexp
                  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 heading is 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)
              (file+function \"path/to/file\" function-finding-location)
                  A function to find the right location in the file
                  A function to find the right location in the file
@@ -214,6 +239,11 @@ properties are:
                      When setting both to t, the current clock will run and
                      When setting both to t, the current clock will run and
                      the previous one will not be resumed.
                      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
  :unnarrowed         Do not narrow the target buffer, simply show the
                      full buffer.  Default is to narrow it so that you
                      full buffer.  Default is to narrow it so that you
                      only see the new stuff.
                      only see the new stuff.
@@ -297,6 +327,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."
 you can escape ambiguous cases with a backward slash, e.g., \\%i."
   :group 'org-capture
   :group 'org-capture
   :version "24.1"
   :version "24.1"
+  :set (lambda (s v) (set s (org-capture-upgrade-templates v)))
   :type
   :type
   (let ((file-variants '(choice :tag "Filename       "
   (let ((file-variants '(choice :tag "Filename       "
 				(file :tag "Literal")
 				(file :tag "Literal")
@@ -337,18 +368,11 @@ you can escape ambiguous cases with a backward slash, e.g., \\%i."
 				(const :format "" file+regexp)
 				(const :format "" file+regexp)
 				,file-variants
 				,file-variants
 				(regexp :tag "  Regexp"))
 				(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
+				(option (repeat :tag "Outline path" :inline t
+						(string :tag "Headline"))))
 			  (list :tag "File & function"
 			  (list :tag "File & function"
 				(const :format "" file+function)
 				(const :format "" file+function)
 				,file-variants
 				,file-variants
@@ -377,8 +401,10 @@ you can escape ambiguous cases with a backward slash, e.g., \\%i."
 				   ((const :format "%v " :clock-in) (const t))
 				   ((const :format "%v " :clock-in) (const t))
 				   ((const :format "%v " :clock-keep) (const t))
 				   ((const :format "%v " :clock-keep) (const t))
 				   ((const :format "%v " :clock-resume) (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 " :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)))))))))
 				   ((const :format "%v " :kill-buffer) (const t)))))))))
 
 
 (defcustom org-capture-before-finalize-hook nil
 (defcustom org-capture-before-finalize-hook nil
@@ -562,6 +588,9 @@ the last note stored.
 
 
 When called with a `C-0' (zero) prefix, insert a template at point.
 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
 ELisp programs can set KEYS to a string associated with a template
 in `org-capture-templates'.  In this case, interactive selection
 in `org-capture-templates'.  In this case, interactive selection
 will be bypassed.
 will be bypassed.
@@ -579,7 +608,6 @@ of the day at point (if any) or the current HH:MM time."
    ((equal goto '(4)) (org-capture-goto-target))
    ((equal goto '(4)) (org-capture-goto-target))
    ((equal goto '(16)) (org-capture-goto-last-stored))
    ((equal goto '(16)) (org-capture-goto-last-stored))
    (t
    (t
-    ;; FIXME: Are these needed?
     (let* ((orig-buf (current-buffer))
     (let* ((orig-buf (current-buffer))
 	   (annotation (if (and (boundp 'org-capture-link-is-already-stored)
 	   (annotation (if (and (boundp 'org-capture-link-is-already-stored)
 				org-capture-link-is-already-stored)
 				org-capture-link-is-already-stored)
@@ -930,59 +958,64 @@ Store them in the capture property list."
 	   (org-capture-put :exact-position (point))
 	   (org-capture-put :exact-position (point))
 	   (setq target-entry-p
 	   (setq target-entry-p
 		 (and (derived-mode-p 'org-mode) (org-at-heading-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)
+	 (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))
+	      ((or (org-capture-get :time-prompt)
+		   (equal current-prefix-arg 1))
+	       ;; 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)
 	(`(file+function ,path ,function)
 	 (set-buffer (org-capture-target-buffer path))
 	 (set-buffer (org-capture-target-buffer path))
 	 (org-capture-put-target-region-and-position)
 	 (org-capture-put-target-region-and-position)
@@ -1534,7 +1567,8 @@ is selected, only the bare key is returned."
 Lisp programs can force the template by setting KEYS to a string."
 Lisp programs can force the template by setting KEYS to a string."
   (let ((org-capture-templates
   (let ((org-capture-templates
 	 (or (org-contextualize-keys
 	 (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")
 	     '(("t" "Task" entry (file+headline "" "Tasks")
 		"* TODO %?\n  %u\n  %a")))))
 		"* TODO %?\n  %u\n  %a")))))
     (if keys
     (if keys
@@ -1654,7 +1688,7 @@ The template may still contain \"%?\" for cursor positioning."
 		(let* ((inside-sexp? (org-capture-inside-embedded-elisp-p))
 		(let* ((inside-sexp? (org-capture-inside-embedded-elisp-p))
 		       (replacement
 		       (replacement
 			(pcase (string-to-char value)
 			(pcase (string-to-char value)
-			  (?< (format-time-string time-string))
+			  (?< (format-time-string time-string time))
 			  (?:
 			  (?:
 			   (or (plist-get org-store-link-plist (intern value))
 			   (or (plist-get org-store-link-plist (intern value))
 			       ""))
 			       ""))

+ 35 - 18
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.
   "Find or create an entry for date D.
 If KEEP-RESTRICTION is non-nil, do not widen the buffer.
 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
 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)
   (setq-local org-datetree-base-level 1)
-  (or keep-restriction (widen))
   (save-restriction
   (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
+	  (unless (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)))
+      (unless 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))
     (goto-char (point-min))
     (let ((year (calendar-extract-year d))
     (let ((year (calendar-extract-year d))
 	  (month (calendar-extract-month d))
 	  (month (calendar-extract-month d))
@@ -84,18 +93,26 @@ tree can be found."
   "Find or create an ISO week entry for date D.
   "Find or create an ISO week entry for date D.
 Compared to `org-datetree-find-date-create' this function creates
 Compared to `org-datetree-find-date-create' this function creates
 entries ordered by week instead of months.
 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)
   (setq-local org-datetree-base-level 1)
-  (or keep-restriction (widen))
   (save-restriction
   (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
+	  (unless (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)))
+      (unless 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))
     (goto-char (point-min))
     (require 'cal-iso)
     (require 'cal-iso)
     (let* ((year (calendar-extract-year d))
     (let* ((year (calendar-extract-year d))

+ 2 - 0
lisp/org.el

@@ -16508,6 +16508,8 @@ only headings."
 	 end found flevel)
 	 end found flevel)
     (unless buffer (error "File not found :%s" file))
     (unless buffer (error "File not found :%s" file))
     (with-current-buffer buffer
     (with-current-buffer buffer
+      (unless (derived-mode-p 'org-mode)
+	(error "Buffer %s needs to be in Org mode" buffer))
       (org-with-wide-buffer
       (org-with-wide-buffer
        (goto-char (point-min))
        (goto-char (point-min))
        (dolist (heading path)
        (dolist (heading path)