emacs-orgmode@gnu.org archives
 help / color / mirror / code / Atom feed
From: "Rüdiger Sonderfeld" <ruediger@c-plusplus.net>
To: emacs-orgmode@gnu.org
Cc: mail@nicolasgoaziou.fr
Subject: [PATCH v3 2/3] org-datetree.el: Add support for ISO week trees.
Date: Tue, 29 Dec 2015 17:49:04 +0000	[thread overview]
Message-ID: <1973928.Q8QyLRG3vo@descartes> (raw)
In-Reply-To: <87h9n4hpql.fsf@nicolasgoaziou.fr>

* lisp/org-datetree.el (org-datetree-find-iso-date-create): New function.
(org-datetree--find-create): Support fixed text for insert.
(org-datetree-insert-line): Support fixed text for insert.
* testing/lisp/test-org-datetree.el (test-org-datetree/find-iso-date-create):
New test.

ISO week trees order dates by week and not by month.
---
 lisp/org-datetree.el              | 75 +++++++++++++++++++++++++------
 testing/lisp/test-org-datetree.el | 92 +++++++++++++++++++++++++++++++++++++++
 2 files changed, 153 insertions(+), 14 deletions(-)

diff --git a/lisp/org-datetree.el b/lisp/org-datetree.el
index 2c9ffdf..5d52756 100644
--- a/lisp/org-datetree.el
+++ b/lisp/org-datetree.el
@@ -34,9 +34,10 @@ (require 'org)
 
 (defvar org-datetree-base-level 1
   "The level at which years should be placed in the date tree.
-This is normally one, but if the buffer has an entry with a DATE_TREE
-property (any value), the date tree will become a subtree under that entry,
-so the base level will be properly adjusted.")
+This is normally one, but if the buffer has an entry with a
+DATE_TREE (or WEEK_TREE for ISO week entries) property (any
+value), the date tree will become a subtree under that entry, so
+the base level will be properly adjusted.")
 
 (defcustom org-datetree-add-timestamp nil
   "When non-nil, add a time stamp matching date of entry.
@@ -78,11 +79,55 @@ (defun org-datetree-find-date-create (date &optional keep-restriction)
        "^\\*+[ \t]+%d-%02d-\\([0123][0-9]\\) \\w+$"
        year month day))))
 
-(defun org-datetree--find-create (regex year &optional month day)
+;;;###autoload
+(defun org-datetree-find-iso-week-create (date &optional keep-restriction)
+  "Find or create an ISO week entry for DATE.
+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."
+  (org-set-local 'org-datetree-base-level 1)
+  (or keep-restriction (widen))
+  (save-restriction
+    (let ((prop (org-find-property "WEEK_TREE")))
+      (when prop
+	(goto-char prop)
+	(org-set-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 date))
+	   (month (calendar-extract-month date))
+	   (day (calendar-extract-day date))
+	   (time (encode-time 0 0 0 day month year))
+	   (iso-date (calendar-iso-from-absolute
+		      (calendar-absolute-from-gregorian date)))
+	   (weekyear (nth 2 iso-date))
+	   (week (nth 0 iso-date))
+	   (weekday (nth 1 iso-date)))
+      ;; ISO 8601 week format is %G-W%V(-%u)
+      (org-datetree--find-create
+       "^\\*+[ \t]+\\([12][0-9]\\{3\\}\\)\\(\\s-*?\
+\\([ \t]:[[:alnum:]:_@#%%]+:\\)?\\s-*$\\)"
+       weekyear nil nil
+       (format-time-string "%G" time))
+      (org-datetree--find-create
+       "^\\*+[ \t]+%d-W\\([0-5][0-9]\\)$"
+       weekyear week nil
+       (format-time-string "%G-W%V" time))
+      ;; For the actual day we use the regular date instead of ISO week.
+      (org-datetree--find-create
+       "^\\*+[ \t]+%d-%02d-\\([0123][0-9]\\) \\w+$"
+       year month day))))
+
+(defun org-datetree--find-create (regex year &optional month day insert)
   "Find the datetree matched by REGEX for YEAR, MONTH, or DAY.
 REGEX is passed to `format' with YEAR, MONTH, and DAY as
 arguments.  Match group 1 is compared against the specified date
-component."
+component.  If INSERT is non-nil and there is no match then it is
+inserted into the buffer."
   (when (or month day)
     (org-narrow-to-subtree))
   (let ((re (format regex year month day))
@@ -95,25 +140,27 @@ (defun org-datetree--find-create (regex year &optional month day)
      ((not match)
       (goto-char (point-max))
       (unless (bolp) (insert "\n"))
-      (org-datetree-insert-line year month day))
+      (org-datetree-insert-line year month day insert))
      ((= (string-to-number (match-string 1)) (or day month year))
       (beginning-of-line))
      (t
       (beginning-of-line)
-      (org-datetree-insert-line year month day)))))
+      (org-datetree-insert-line year month day insert)))))
 
-(defun org-datetree-insert-line (year &optional month day)
+(defun org-datetree-insert-line (year &optional month day text)
   (delete-region (save-excursion (skip-chars-backward " \t\n") (point)) (point))
   (insert "\n" (make-string org-datetree-base-level ?*) " \n")
   (backward-char)
   (when month (org-do-demote))
   (when day (org-do-demote))
-  (insert (format "%d" year))
-  (when month
-    (insert
-     (if day
-	 (format-time-string "-%m-%d %A" (encode-time 0 0 0 day month year))
-       (format-time-string "-%m %B" (encode-time 0 0 0 1 month year)))))
+  (if text
+      (insert text)
+    (insert (format "%d" year))
+    (when month
+      (insert
+       (if day
+	   (format-time-string "-%m-%d %A" (encode-time 0 0 0 day month year))
+	 (format-time-string "-%m %B" (encode-time 0 0 0 1 month year))))))
   (when (and day org-datetree-add-timestamp)
     (save-excursion
       (insert "\n")
diff --git a/testing/lisp/test-org-datetree.el b/testing/lisp/test-org-datetree.el
index bbc8e14..dab54ba 100644
--- a/testing/lisp/test-org-datetree.el
+++ b/testing/lisp/test-org-datetree.el
@@ -113,5 +113,97 @@ (ert-deftest test-org-datetree/find-date-create ()
 	(org-datetree-find-date-create '(3 29 2012)))
       (buffer-substring (point) (line-end-position))))))
 
+(ert-deftest test-org-datetree/find-iso-week-create ()
+  "Test `org-datetree-find-iso-date-create' specificaiton."
+  ;; When date is missing, create it.
+  (should
+   (string-match
+    "\\`\\* 2015\n\\*\\* 2015-W01\n\\*\\*\\* 2014-12-31 .*\\'"
+    (org-test-with-temp-text ""
+      (let ((org-datetree-add-timestamp nil))
+	(org-datetree-find-iso-week-create '(12 31 2014)))
+      (org-trim (buffer-string)))))
+  ;; Do not create new year node when one exists.
+  (should
+   (string-match
+    "\\`\\* 2015\n\\*\\* 2015-W01\n\\*\\*\\* 2014-12-31 .*\\'"
+    (org-test-with-temp-text "* 2015\n"
+      (let ((org-datetree-add-timestamp nil))
+	(org-datetree-find-iso-week-create '(12 31 2014)))
+      (org-trim (buffer-string)))))
+  ;; Do not create new month node when one exists.
+  (should
+   (string-match
+    "\\`\\* 2015\n\\*\\* 2015-W01\n\\*\\*\\* 2014-12-31 .*\\'"
+    (org-test-with-temp-text "* 2015\n** 2015-W01"
+      (let ((org-datetree-add-timestamp nil))
+	(org-datetree-find-iso-week-create '(12 31 2014)))
+      (org-trim (buffer-string)))))
+  ;; Do not create new day node when one exists.
+  (should
+   (string-match
+    "\\`\\* 2015\n\\*\\* 2015-W01\n\\*\\*\\* 2014-12-31 .*\\'"
+    (org-test-with-temp-text "* 2015\n** 2015-W01\n*** 2014-12-31 day"
+      (let ((org-datetree-add-timestamp nil))
+	(org-datetree-find-iso-week-create '(12 31 2014)))
+      (org-trim (buffer-string)))))
+  ;; Sort new entry in right place.
+  (should
+   (string-match
+    "\\`\\* 2015\n\\*\\* 2015-W01\n\\*\\*\\* 2014-12-31 .*\n\n\\*\\* 2015-W36\n\\*\\*\\* 2015-09-01 .*\\'"
+    (org-test-with-temp-text "* 2015"
+      (let ((org-datetree-add-timestamp nil))
+	(org-datetree-find-iso-week-create '(9 1 2015))
+	(org-datetree-find-iso-week-create '(12 31 2014)))
+      (org-trim (buffer-string)))))
+  ;; When `org-datetree-add-timestamp' is non-nil, insert a timestamp
+  ;; in entry.  When set to `inactive', insert an inactive one.
+  (should
+   (string-match
+    "\\`\\* 2015\n\\*\\* 2015-W01\n\\*\\*\\* \\(2014-12-31\\) .*\n[ \t]*<\\1.*?>\\'"
+    (org-test-with-temp-text "* 2015\n"
+      (let ((org-datetree-add-timestamp t))
+	(org-datetree-find-iso-week-create '(12 31 2014)))
+      (org-trim (buffer-string)))))
+  (should
+   (string-match
+    "\\`\\* 2015\n\\*\\* 2015-W01\n\\*\\*\\* \\(2014-12-31\\) .*\n[ \t]*\\[\\1.*?\\]\\'"
+    (org-test-with-temp-text "* 2015\n"
+      (let ((org-datetree-add-timestamp 'inactive))
+	(org-datetree-find-iso-week-create '(12 31 2014)))
+      (org-trim (buffer-string)))))
+  ;; Insert at top level, unless some node has DATE_WEEK_TREE
+  ;; property.  In this case, date tree becomes one of its sub-trees.
+  (should
+   (string-match
+    "\\* 2015"
+    (org-test-with-temp-text "* Top"
+      (let ((org-datetree-add-timestamp nil))
+	(org-datetree-find-iso-week-create '(12 31 2014)))
+      (org-trim (buffer-string)))))
+  (should
+   (string-match
+    "\\*\\* H1.1\n:PROPERTIES:\n:DATE_WEEK_TREE: t\n:END:\n\\*\\*\\* 2015"
+    (org-test-with-temp-text
+	"* H1\n** H1.1\n:PROPERTIES:\n:DATE_WEEK_TREE: t\n:END:\n* H2"
+      (let ((org-datetree-add-timestamp nil))
+	(org-datetree-find-iso-week-create '(12 31 2014)))
+      (org-trim (buffer-string)))))
+  ;; Always leave point at beginning of day entry.
+  (should
+   (string-match
+    "\\*\\*\\* 2014-12-31"
+    (org-test-with-temp-text "* 2015\n** 2015-W01\n*** 2014-12-31 day"
+      (let ((org-datetree-add-timestamp nil))
+	(org-datetree-find-iso-week-create '(12 31 2014)))
+      (buffer-substring (point) (line-end-position)))))
+  (should
+   (string-match
+    "\\*\\*\\* 2014-12-31"
+    (org-test-with-temp-text "* 2015\n** 2015-W01\n*** 2014-12-31 day"
+      (let ((org-datetree-add-timestamp t))
+	(org-datetree-find-iso-week-create '(12 31 2014)))
+      (buffer-substring (point) (line-end-position))))))
+
 (provide 'test-org-datetree)
 ;;; test-org-datetree.el ends here
-- 
2.6.4

  parent reply	other threads:[~2015-12-29 17:49 UTC|newest]

Thread overview: 19+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
     [not found] <cover.1441180730.git.ruediger@c-plusplus.net>
2015-09-02  8:06 ` [PATCH 1/3] org-datetree.el: Code cleanup Rüdiger Sonderfeld
2015-09-02 19:48   ` Nicolas Goaziou
2015-09-02  8:06 ` [PATCH 2/3] org-datetree.el: Add support for ISO week trees Rüdiger Sonderfeld
2015-09-02 19:58   ` Nicolas Goaziou
2015-09-03  0:14     ` Rüdiger Sonderfeld
2015-09-03  5:55       ` Nicolas Goaziou
2015-09-07 22:24         ` [PATCH v2 1/3] org-datetree.el: Code cleanup Rüdiger Sonderfeld
2015-09-07 22:24         ` [PATCH v2 2/3] org-datetree.el: Add support for ISO week trees Rüdiger Sonderfeld
2015-09-07 22:24         ` [PATCH v2 3/3] org-capture.el: Add support for " Rüdiger Sonderfeld
2015-09-07 22:27         ` [PATCH 2/3] org-datetree.el: Add support for ISO " Rüdiger Sonderfeld
2015-09-08 15:53           ` Nicolas Goaziou
2015-12-29 17:48             ` [PATCH v3 1/3] org-datetree.el: Code cleanup Rüdiger Sonderfeld
2015-12-29 20:58               ` Nicolas Goaziou
2015-12-29 17:49             ` Rüdiger Sonderfeld [this message]
2015-12-29 20:59               ` [PATCH v3 2/3] org-datetree.el: Add support for ISO week trees Nicolas Goaziou
2015-12-29 17:49             ` [PATCH v3 3/3] org-capture.el: Add support for " Rüdiger Sonderfeld
2015-12-29 20:59               ` Nicolas Goaziou
2015-09-02  8:06 ` [PATCH " Rüdiger Sonderfeld
2015-09-02 19:59   ` Nicolas Goaziou

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.orgmode.org/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=1973928.Q8QyLRG3vo@descartes \
    --to=ruediger@c-plusplus.net \
    --cc=emacs-orgmode@gnu.org \
    --cc=mail@nicolasgoaziou.fr \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).