From mboxrd@z Thu Jan 1 00:00:00 1970 From: Nicolas Goaziou Subject: Re: Allowing multiple date trees in a single file Date: Sat, 04 Feb 2017 13:48:24 +0100 Message-ID: <877f56yvdz.fsf@nicolasgoaziou.fr> References: <87wpdv4fdq.fsf@nicolasgoaziou.fr> <871sw1zice.fsf@nicolasgoaziou.fr> <87y3y8zk52.fsf@nicolasgoaziou.fr> Mime-Version: 1.0 Content-Type: text/plain Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:46301) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1ca1Yy-0007Wa-Vs for emacs-orgmode@gnu.org; Sat, 04 Feb 2017 09:43:43 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1ca1Yv-0005nN-Nm for emacs-orgmode@gnu.org; Sat, 04 Feb 2017 09:43:41 -0500 Received: from relay2-d.mail.gandi.net ([217.70.183.194]:51895) by eggs.gnu.org with esmtps (TLS1.0:DHE_RSA_AES_256_CBC_SHA1:32) (Exim 4.71) (envelope-from ) id 1ca1Yv-0005n4-CI for emacs-orgmode@gnu.org; Sat, 04 Feb 2017 09:43:37 -0500 Received: from mfilter2-d.gandi.net (mfilter2-d.gandi.net [217.70.178.140]) by relay2-d.mail.gandi.net (Postfix) with ESMTP id A4F48C5A4E for ; Sat, 4 Feb 2017 15:43:35 +0100 (CET) Received: from relay2-d.mail.gandi.net ([IPv6:::ffff:217.70.183.194]) by mfilter2-d.gandi.net (mfilter2-d.gandi.net [::ffff:10.0.15.180]) (amavisd-new, port 10024) with ESMTP id oMeav4ck4ZwR for ; Sat, 4 Feb 2017 15:43:33 +0100 (CET) Received: from saiph.selenimh (unknown [37.165.17.126]) (Authenticated sender: mail@nicolasgoaziou.fr) by relay2-d.mail.gandi.net (Postfix) with ESMTPSA id BBF3CC5A55 for ; Sat, 4 Feb 2017 15:43:31 +0100 (CET) In-Reply-To: (Carsten Dominik's message of "Fri, 3 Feb 2017 15:08:43 +0100") List-Id: "General discussions about Org-mode." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org Sender: "Emacs-orgmode" To: Carsten Dominik Cc: org-mode list Hello, Carsten Dominik writes: > 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. It sounds good. Thank you. > 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. I am a bit worried by this compatibility layer. I mean, it is good to preserve compatibility with old templates, but it ought to be an ephemeral solution. I.e., no more `org-table--error-on-old-row-references' lingering around for ages. We could, for example, generate a deprecation warning when old templates are used. Then we will be able to remove this unnecessary piece of code in next major release. See for example the end of `org-open-file', although it is a bit more drastic (it raises an error, not a warning). > 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. Some comments follow. > -@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 There's a missing space above. > +(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))) I suggest the following. Less `setq', `setcar', `setcdr' makes Org a better place. (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." (mapcar (lambda (template) (pcase template ;; 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) ,template . ,props) `(,key ,desc ,type (file+olp+datetree ,@path) ,@props)) (`(,key ,desc ,type (file+datetree+prompt . ,path) ,template . ,props) `(,key ,desc ,type (file+olp+datetree ,@path) :time-prompt t ,@props)) (`(,key ,desc ,type (file+weektree . ,path) ,template . ,props) `(,key ,desc ,type (file+olp+datetree ,@path) :tree-type week ,@props)) (`(,key ,desc ,type (file+weektree+prompt . ,path) ,template . ,props) `(,key ,desc ,type (file+olp+datetree ,@path) :tree-type week :time-prompt t ,@props)) ;; Other templates are left unchanged. (_ template))) templates)) > - (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. Nitpick: It may be just me, but "If no heading is given" sounds better. > 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)) See below about `org-capture-sanitize-olp'. Also, it is better to make the `setq' a let-binding when possible. > (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))))) [...] > + (`(file+olp+datetree ,path . ,outline-path) > + (setq outline-path (org-capture-sanitize-olp outline-path)) Ditto. > + (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 ;; The following... ;; ... `org-datetree-find-date-create'. > + (if outline-path 'subtree-at-point) (and outline-path 'subtree-at-point) > + ))) These trailing parens need to be moved above. > (`(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))) This function is really a one-liner: (cl-remove-if-not #'org-string-nw-p olp) Therefore, I don't think it deserves a dedicated function. BTW is there any reason to prune non-white strings from the list? Is an empty string even invalid, since document can contain blank headlines? The outline path is provided by the user. We can assume he knows what he is doing. Another option would be to barf if the outline path contains any invalid value instead of silently "fixing" it on user's behalf. E.g., (when (cl-some #'invalid-value-check olp) (user-error "Invalid outline path in template %S" template)) for some value of #'invalid-value-check. WDYT? > 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")) Nitpick: (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))) > + (or keep-restriction (widen)) (unless keep-restriction (widen)) > + ;; support the old way of tree placement, using a property ;; Support ... 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)))) See above, since the same suggestions apply. Also, it looks like there is some code duplication involved here. Would it make sense to factor the common part out of them? > (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)) Nitpick: "Buffer %s needs to be in Org mode" Ideally, a bunch of tests in test-org-capture.el would be nice. Regards, -- Nicolas Goaziou