diff options
Diffstat (limited to 'lisp/org-datetree.el')
| -rw-r--r-- | lisp/org-datetree.el | 238 |
1 files changed, 125 insertions, 113 deletions
diff --git a/lisp/org-datetree.el b/lisp/org-datetree.el index 999bc24..2a921bf 100644 --- a/lisp/org-datetree.el +++ b/lisp/org-datetree.el @@ -1,4 +1,4 @@ -;;; org-datetree.el --- Create date entries in a tree +;;; org-datetree.el --- Create date entries in a tree -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2016 Free Software Foundation, Inc. @@ -34,9 +34,10 @@ (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. @@ -49,103 +50,116 @@ Added time stamp is active unless value is `inactive'." (const :tag "Add an active time stamp" active))) ;;;###autoload -(defun org-datetree-find-date-create (date &optional keep-restriction) - "Find or create an entry for DATE. +(defun org-datetree-find-date-create (d &optional keep-restriction) + "Find or create an entry for date D. 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) + (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) - (org-set-local 'org-datetree-base-level - (org-get-valid-level (org-current-level) 1)) + (setq-local org-datetree-base-level + (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-*$\\)") - 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))) - (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))))) + (let ((year (calendar-extract-year d)) + (month (calendar-extract-month d)) + (day (calendar-extract-day d))) + (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-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) +;;;###autoload +(defun org-datetree-find-iso-week-create (d &optional keep-restriction) + "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." + (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))) (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)) + (require 'cal-iso) + (let* ((year (calendar-extract-year d)) + (month (calendar-extract-month d)) + (day (calendar-extract-day d)) + (time (encode-time 0 0 0 day month year)) + (iso-date (calendar-iso-from-absolute + (calendar-absolute-from-gregorian d))) + (weekyear (nth 2 iso-date)) + (week (nth 0 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. 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)) 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))) + (< (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 month day)) - ((= (string-to-number (match-string 1)) day) - (goto-char (point-at-bol))) + (unless (bolp) (insert "\n")) + (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 1) - (org-datetree-insert-line year month day))))) + (beginning-of-line) + (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 - (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)))))) + (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") @@ -156,9 +170,9 @@ tree can be found." (eq org-datetree-add-timestamp 'inactive)))) (beginning-of-line)) -(defun org-datetree-file-entry-under (txt date) - "Insert a node TXT into the date tree under DATE." - (org-datetree-find-date-create date) +(defun org-datetree-file-entry-under (txt d) + "Insert a node TXT into the date tree under date D." + (org-datetree-find-date-create d) (let ((level (org-get-valid-level (funcall outline-level) 1))) (org-end-of-subtree t t) (org-back-over-empty-lines) @@ -171,44 +185,42 @@ before running this command, even though the command tries to be smart." (interactive) (goto-char (point-min)) (let ((dre (concat "\\<" org-deadline-string "\\>[ \t]*\\'")) - (sre (concat "\\<" org-scheduled-string "\\>[ \t]*\\'")) - dct ts tmp date year month day pos hdl-pos) + (sre (concat "\\<" org-scheduled-string "\\>[ \t]*\\'"))) (while (re-search-forward org-ts-regexp nil t) (catch 'next - (setq ts (match-string 0)) - (setq tmp (buffer-substring - (max (point-at-bol) (- (match-beginning 0) - org-ds-keyword-length)) - (match-beginning 0))) - (if (or (string-match "-\\'" tmp) - (string-match dre tmp) - (string-match sre tmp)) + (let ((tmp (buffer-substring + (max (line-beginning-position) + (- (match-beginning 0) org-ds-keyword-length)) + (match-beginning 0)))) + (when (or (string-suffix-p "-" tmp) + (string-match dre tmp) + (string-match sre tmp)) (throw 'next nil)) - (setq dct (decode-time (org-time-string-to-time (match-string 0))) - date (list (nth 4 dct) (nth 3 dct) (nth 5 dct)) - year (nth 2 date) - month (car date) - day (nth 1 date) - pos (point)) - (org-back-to-heading t) - (setq hdl-pos (point)) - (unless (org-up-heading-safe) - ;; No parent, we are not in a date tree - (goto-char pos) - (throw 'next nil)) - (unless (looking-at "\\*+[ \t]+[0-9]+-[0-1][0-9]-[0-3][0-9]") - ;; Parent looks wrong, we are not in a date tree - (goto-char pos) - (throw 'next nil)) - (when (looking-at (format "\\*+[ \t]+%d-%02d-%02d" year month day)) - ;; At correct date already, do nothing - (progn (goto-char pos) (throw 'next nil))) - ;; OK, we need to refile this entry - (goto-char hdl-pos) - (org-cut-subtree) - (save-excursion - (save-restriction - (org-datetree-file-entry-under (current-kill 0) date))))))) + (let* ((dct (decode-time (org-time-string-to-time (match-string 0)))) + (date (list (nth 4 dct) (nth 3 dct) (nth 5 dct))) + (year (nth 2 date)) + (month (car date)) + (day (nth 1 date)) + (pos (point)) + (hdl-pos (progn (org-back-to-heading t) (point)))) + (unless (org-up-heading-safe) + ;; No parent, we are not in a date tree. + (goto-char pos) + (throw 'next nil)) + (unless (looking-at "\\*+[ \t]+[0-9]+-[0-1][0-9]-[0-3][0-9]") + ;; Parent looks wrong, we are not in a date tree. + (goto-char pos) + (throw 'next nil)) + (when (looking-at (format "\\*+[ \t]+%d-%02d-%02d" year month day)) + ;; At correct date already, do nothing. + (goto-char pos) + (throw 'next nil)) + ;; OK, we need to refile this entry. + (goto-char hdl-pos) + (org-cut-subtree) + (save-excursion + (save-restriction + (org-datetree-file-entry-under (current-kill 0) date))))))))) (provide 'org-datetree) |