Jelajahi Sumber

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 tahun lalu
induk
melakukan
0f1b5ec496
4 mengubah file dengan 176 tambahan dan 115 penghapusan
  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
  '(("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
@@ -7178,21 +7178,19 @@ 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")
-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)
 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
 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
 Do not narrow the target buffer, simply show the full buffer.  Default is to
 narrow it so that you only see the new material.

+ 115 - 81
lisp/org-capture.el

@@ -84,6 +84,36 @@
   :tag "Org Capture"
   :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
   "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
 
              (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 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)
                  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
                      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 +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."
   :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 +368,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
+				(option (repeat :tag "Outline path" :inline t
+						(string :tag "Headline"))))
 			  (list :tag "File & function"
 				(const :format "" file+function)
 				,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-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 +588,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.
@@ -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 '(16)) (org-capture-goto-last-stored))
    (t
-    ;; FIXME: Are these needed?
     (let* ((orig-buf (current-buffer))
 	   (annotation (if (and (boundp '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))
 	   (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)
+	 (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)
 	 (set-buffer (org-capture-target-buffer path))
 	 (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."
   (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
@@ -1654,7 +1688,7 @@ The template may still contain \"%?\" for cursor positioning."
 		(let* ((inside-sexp? (org-capture-inside-embedded-elisp-p))
 		       (replacement
 			(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))
 			       ""))

+ 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.
 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
+	  (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))
     (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
+	  (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))
     (require 'cal-iso)
     (let* ((year (calendar-extract-year d))

+ 2 - 0
lisp/org.el

@@ -16508,6 +16508,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)