From mboxrd@z Thu Jan 1 00:00:00 1970 From: =?ISO-8859-1?Q?R=FCdiger?= Sonderfeld Subject: [PATCH v3 2/3] org-datetree.el: Add support for ISO week trees. Date: Tue, 29 Dec 2015 17:49:04 +0000 Message-ID: <1973928.Q8QyLRG3vo@descartes> References: <87h9n4hpql.fsf@nicolasgoaziou.fr> Mime-Version: 1.0 Content-Type: text/plain; charset="us-ascii" Content-Transfer-Encoding: 7Bit Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:56120) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1aDyOc-0006Nt-LR for emacs-orgmode@gnu.org; Tue, 29 Dec 2015 12:49:20 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1aDyOZ-0006jZ-So for emacs-orgmode@gnu.org; Tue, 29 Dec 2015 12:49:18 -0500 Received: from ptmx.org ([178.63.28.110]:47533) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1aDyOZ-0006jP-JC for emacs-orgmode@gnu.org; Tue, 29 Dec 2015 12:49:15 -0500 In-Reply-To: <87h9n4hpql.fsf@nicolasgoaziou.fr> 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-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org To: emacs-orgmode@gnu.org Cc: mail@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