From: "Rüdiger Sonderfeld" <ruediger@c-plusplus.net>
To: emacs-orgmode@gnu.org
Subject: [PATCH 2/3] org-datetree.el: Add support for ISO week trees.
Date: Mon, 31 Aug 2015 21:15:09 +0100 [thread overview]
Message-ID: <2230186.OUpc83sjSu@descartes> (raw)
In-Reply-To: <cover.1441051750.git.ruediger@c-plusplus.net>
* 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 | 64 ++++++++++++++++++++++-----
testing/lisp/test-org-datetree.el | 92 +++++++++++++++++++++++++++++++++++++++
2 files changed, 145 insertions(+), 11 deletions(-)
diff --git a/lisp/org-datetree.el b/lisp/org-datetree.el
index 3620bbd..a5a542e 100644
--- a/lisp/org-datetree.el
+++ b/lisp/org-datetree.el
@@ -74,8 +74,48 @@ (defun org-datetree-find-date-create (date &optional keep-restriction)
(org-datetree--find-create "^\\*+[ \t]+%d-%02d-\\([0123][0-9]\\) \\w+$"
year month day))))
-(defun org-datetree--find-create (regex year &optional month day)
- "Find the datetree matched by REGEX for YEAR, MONTH, or 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 "DATE_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 (car iso-date))
+ (weekday (cadr 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.
+If INSERT is non-nil insert the text if not found."
(let ((re (format regex year month day))
match)
(goto-char (point-min))
@@ -86,25 +126,27 @@ (defun org-datetree--find-create (regex year &optional month day)
((not match)
(goto-char (point-max))
(unless (bolp) (newline))
- (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))
(goto-char (point-at-bol)))
(t
(beginning-of-line 1)
- (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 0135ab9..9b839ca 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-date-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.5.1
next prev parent reply other threads:[~2015-08-31 20:15 UTC|newest]
Thread overview: 9+ messages / expand[flat|nested] mbox.gz Atom feed top
[not found] <cover.1441051750.git.ruediger@c-plusplus.net>
2015-08-31 20:14 ` [PATCH 1/3] org-datetree.el: Code cleanup Rüdiger Sonderfeld
2015-08-31 20:15 ` Rüdiger Sonderfeld [this message]
2015-08-31 20:15 ` [PATCH 3/3] org-capture.el: Add support for week trees Rüdiger Sonderfeld
[not found] <cover.1441180730.git.ruediger@c-plusplus.net>
2015-09-02 8:06 ` [PATCH 2/3] org-datetree.el: Add support for ISO " 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:27 ` Rüdiger Sonderfeld
2015-09-08 15:53 ` 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=2230186.OUpc83sjSu@descartes \
--to=ruediger@c-plusplus.net \
--cc=emacs-orgmode@gnu.org \
/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).