* [PATCH 1/3] org-datetree.el: Code cleanup.
[not found] <cover.1441051750.git.ruediger@c-plusplus.net>
@ 2015-08-31 20:14 ` Rüdiger Sonderfeld
2015-08-31 20:15 ` [PATCH 2/3] org-datetree.el: Add support for ISO week trees Rüdiger Sonderfeld
2015-08-31 20:15 ` [PATCH 3/3] org-capture.el: Add support for " Rüdiger Sonderfeld
2 siblings, 0 replies; 5+ messages in thread
From: Rüdiger Sonderfeld @ 2015-08-31 20:14 UTC (permalink / raw)
To: emacs-orgmode
* lisp/org-datetree.el (org-datetree--find-create): New function.
(org-datetree-find-year-create, org-datetree-find-month-create,
org-datetree-find-day-create): Removed functions
(org-datetree-find-date-create): Use `org-datetree--find-create' instead
of removed functions. Use calendar extract functions.
(org-datetree-insert-line): Do more formatting in `format-time-string'
since we call it anyway
* testing/lisp/test-org-datetree.el (test-org-datetree/find-date-create):
Test if new entries are put at the right place.
---
lisp/org-datetree.el | 77 +++++++++------------------------------
testing/lisp/test-org-datetree.el | 9 +++++
2 files changed, 27 insertions(+), 59 deletions(-)
diff --git a/lisp/org-datetree.el b/lisp/org-datetree.el
index a97a9d0..3620bbd 100644
--- a/lisp/org-datetree.el
+++ b/lisp/org-datetree.el
@@ -64,67 +64,30 @@ (defun org-datetree-find-date-create (date &optional keep-restriction)
(org-get-valid-level (org-current-level) 1))
(org-narrow-to-subtree)))
(goto-char (point-min))
- (let ((year (nth 2 date))
- (month (car date))
- (day (nth 1 date)))
- (org-datetree-find-year-create year)
- (org-datetree-find-month-create year month)
- (org-datetree-find-day-create year month day))))
-
-(defun org-datetree-find-year-create (year)
- "Find the YEAR datetree or create it."
- (let ((re "^\\*+[ \t]+\\([12][0-9]\\{3\\}\\)\\(\\s-*?\\([ \t]:[[:alnum:]:_@#%]+:\\)?\\s-*$\\)")
+ (let ((year (calendar-extract-year date))
+ (month (calendar-extract-month date))
+ (day (calendar-extract-day date)))
+ (org-datetree--find-create "^\\*+[ \t]+\\([12][0-9]\\{3\\}\\)\\(\\s-*?\\([ \t]:[[:alnum:]:_@#%%]+:\\)?\\s-*$\\)"
+ year)
+ (org-datetree--find-create "^\\*+[ \t]+%d-\\([01][0-9]\\) \\w+$"
+ year month)
+ (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."
+ (let ((re (format regex year month day))
match)
(goto-char (point-min))
(while (and (setq match (re-search-forward re nil t))
(goto-char (match-beginning 1))
- (< (string-to-number (match-string 1)) year)))
+ (< (string-to-number (match-string 1)) (or day month year))))
(cond
((not match)
(goto-char (point-max))
- (or (bolp) (newline))
- (org-datetree-insert-line year))
- ((= (string-to-number (match-string 1)) year)
- (goto-char (point-at-bol)))
- (t
- (beginning-of-line 1)
- (org-datetree-insert-line year)))))
-
-(defun org-datetree-find-month-create (year month)
- "Find the datetree for YEAR and MONTH or create it."
- (org-narrow-to-subtree)
- (let ((re (format "^\\*+[ \t]+%d-\\([01][0-9]\\) \\w+$" year))
- match)
- (goto-char (point-min))
- (while (and (setq match (re-search-forward re nil t))
- (goto-char (match-beginning 1))
- (< (string-to-number (match-string 1)) month)))
- (cond
- ((not match)
- (goto-char (point-max))
- (or (bolp) (newline))
- (org-datetree-insert-line year month))
- ((= (string-to-number (match-string 1)) month)
- (goto-char (point-at-bol)))
- (t
- (beginning-of-line 1)
- (org-datetree-insert-line year month)))))
-
-(defun org-datetree-find-day-create (year month day)
- "Find the datetree for YEAR, MONTH and DAY or create it."
- (org-narrow-to-subtree)
- (let ((re (format "^\\*+[ \t]+%d-%02d-\\([0123][0-9]\\) \\w+$" year month))
- match)
- (goto-char (point-min))
- (while (and (setq match (re-search-forward re nil t))
- (goto-char (match-beginning 1))
- (< (string-to-number (match-string 1)) day)))
- (cond
- ((not match)
- (goto-char (point-max))
- (or (bolp) (newline))
+ (unless (bolp) (newline))
(org-datetree-insert-line year month day))
- ((= (string-to-number (match-string 1)) day)
+ ((= (string-to-number (match-string 1)) (or day month year))
(goto-char (point-at-bol)))
(t
(beginning-of-line 1)
@@ -139,13 +102,9 @@ (defun org-datetree-insert-line (year &optional month day)
(insert (format "%d" year))
(when month
(insert
- (format "-%02d" month)
(if day
- (format "-%02d %s"
- day
- (format-time-string "%A" (encode-time 0 0 0 day month year)))
- (format " %s"
- (format-time-string "%B" (encode-time 0 0 0 1 month year))))))
+ (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 d500130..0135ab9 100644
--- a/testing/lisp/test-org-datetree.el
+++ b/testing/lisp/test-org-datetree.el
@@ -55,6 +55,15 @@ (ert-deftest test-org-datetree/find-date-create ()
(let ((org-datetree-add-timestamp nil))
(org-datetree-find-date-create '(3 29 2012)))
(org-trim (buffer-string)))))
+ ;; Sort new entry in right place
+ (should
+ (string-match
+ "\\`\\* 2012\n\\*\\* 2012-02 .*\n\\*\\*\\* 2012-02-01 .*\n\n\\*\\* 2012-03 .*\n\\*\\*\\* 2012-03-29 .*\\'"
+ (org-test-with-temp-text "* 2012\n** 2012-03 month\n*** 2012-03-29 day"
+ (let ((org-datetree-add-timestamp nil))
+ (org-datetree-find-date-create '(3 29 2012))
+ (org-datetree-find-date-create '(2 1 2012)))
+ (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
--
2.5.1
^ permalink raw reply related [flat|nested] 5+ messages in thread* [PATCH 2/3] org-datetree.el: Add support for ISO week trees.
[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
2015-08-31 20:15 ` [PATCH 3/3] org-capture.el: Add support for " Rüdiger Sonderfeld
2 siblings, 0 replies; 5+ messages in thread
From: Rüdiger Sonderfeld @ 2015-08-31 20:15 UTC (permalink / raw)
To: emacs-orgmode
* 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
^ permalink raw reply related [flat|nested] 5+ messages in thread* [PATCH 3/3] org-capture.el: Add support for week trees.
[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 ` [PATCH 2/3] org-datetree.el: Add support for ISO week trees Rüdiger Sonderfeld
@ 2015-08-31 20:15 ` Rüdiger Sonderfeld
2 siblings, 0 replies; 5+ messages in thread
From: Rüdiger Sonderfeld @ 2015-08-31 20:15 UTC (permalink / raw)
To: emacs-orgmode
* lisp/org-capture.el (org-capture-templates): Add
file+weektree(+prompt) options.
(org-capture-set-target-location): Add support for week trees.
* doc/org.texi (Template elements): Document file+weektree(+prompt)
options.
---
doc/org.texi | 7 +++++++
lisp/org-capture.el | 26 +++++++++++++++++++++-----
2 files changed, 28 insertions(+), 5 deletions(-)
diff --git a/doc/org.texi b/doc/org.texi
index ed808be..d894f91 100644
--- a/doc/org.texi
+++ b/doc/org.texi
@@ -7187,6 +7187,13 @@
@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+function "path/to/file" function-finding-location)
A function to find the right location in the file.
diff --git a/lisp/org-capture.el b/lisp/org-capture.el
index 93a7f2a..320954e 100644
--- a/lisp/org-capture.el
+++ b/lisp/org-capture.el
@@ -149,6 +149,12 @@ (defcustom org-capture-templates nil
(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+function \"path/to/file\" function-finding-location)
A function to find the right location in the file
@@ -321,6 +327,12 @@ (defcustom org-capture-templates nil
(list :tag "File & Date tree, prompt for date"
(const :format "" file+datetree+prompt)
(file :tag " File"))
+ (list :tag "File & Week tree"
+ (const :format "" file+weektree)
+ (file :tag " File"))
+ (list :tag "File & Week tree, prompt for date"
+ (const :format "" file+weektree+prompt)
+ (file :tag " File"))
(list :tag "File & function"
(const :format "" file+function)
(file :tag " File ")
@@ -895,21 +907,25 @@ (defun org-capture-set-target-location (&optional target)
(setq target-entry-p (and (derived-mode-p 'org-mode) (org-at-heading-p))))
(error "No match for target regexp in file %s" (nth 1 target))))
- ((memq (car target) '(file+datetree file+datetree+prompt))
+ ((memq (car target) '(file+datetree file+datetree+prompt file+weektree file+weektree+prompt))
(require 'org-datetree)
(set-buffer (org-capture-target-buffer (nth 1 target)))
(org-capture-put-target-region-and-position)
(widen)
- ;; Make a date tree entry, with the current date (or yesterday,
- ;; if we are extending dates for a couple of hours)
- (org-datetree-find-date-create
+ ;; Make a date/week tree entry, with the current date (or
+ ;; yesterday, if we are extending dates for a couple of hours)
+ (funcall
+ (cond
+ ((memq (car target) '(file+weektree file+weektree+prompt))
+ #'org-datetree-find-iso-week-create)
+ (t #'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))
- ((eq (car target) 'file+datetree+prompt)
+ ((memq (car target) '(file+datetree+prompt file+weektree+prompt))
;; prompt for date
(let ((prompt-time (org-read-date
nil t nil "Date for tree entry:"
--
2.5.1
^ permalink raw reply related [flat|nested] 5+ messages in thread