diff options
Diffstat (limited to 'elpa/org-9.5.2/org-datetree.el')
| -rw-r--r-- | elpa/org-9.5.2/org-datetree.el | 270 |
1 files changed, 270 insertions, 0 deletions
diff --git a/elpa/org-9.5.2/org-datetree.el b/elpa/org-9.5.2/org-datetree.el new file mode 100644 index 0000000..74442b0 --- /dev/null +++ b/elpa/org-9.5.2/org-datetree.el @@ -0,0 +1,270 @@ +;;; org-datetree.el --- Create date entries in a tree -*- lexical-binding: t; -*- + +;; Copyright (C) 2009-2021 Free Software Foundation, Inc. + +;; Author: Carsten Dominik <carsten.dominik@gmail.com> +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: https://orgmode.org +;; +;; This file is part of GNU Emacs. +;; +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Commentary: + +;; This file contains code to create entries in a tree where the top-level +;; nodes represent years, the level 2 nodes represent the months, and the +;; level 1 entries days. + +;;; Code: + +(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 (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. +Added time stamp is active unless value is `inactive'." + :group 'org-capture + :version "24.3" + :type '(choice + (const :tag "Do not add a time stamp" nil) + (const :tag "Add an inactive time stamp" inactive) + (const :tag "Add an active time stamp" active))) + +;;;###autoload +(defun org-datetree-find-date-create (d &optional keep-restriction) + "Find or create a day 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. If it is the symbol `subtree-at-point', then the tree +will be built under the headline at point." + (org-datetree--find-create-group d 'day keep-restriction)) + +;;;###autoload +(defun org-datetree-find-month-create (d &optional keep-restriction) + "Find or create a month entry for date D. +Compared to `org-datetree-find-date-create' this function creates +entries grouped by month instead of days. +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. If it is the symbol `subtree-at-point', then the tree +will be built under the headline at point." + (org-datetree--find-create-group d 'month keep-restriction)) + +(defun org-datetree--find-create-group + (d time-grouping &optional keep-restriction) + "Find or create an entry for date D. +If time-period is day, group entries by day. +If time-period is month, then group entries by month." + (setq-local org-datetree-base-level 1) + (save-restriction + (if (eq keep-restriction 'subtree-at-point) + (progn + (unless (org-at-heading-p) (error "Not at heading")) + (widen) + (org-narrow-to-subtree) + (setq-local org-datetree-base-level + (org-get-valid-level (org-current-level) 1))) + (unless keep-restriction (widen)) + ;; Support the old way of tree placement, using a property + (let ((prop (org-find-property "DATE_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)) + (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) + (when (eq time-grouping 'day) + (org-datetree--find-create + "^\\*+[ \t]+%d-%02d-\\([0123][0-9]\\) \\w+$" + year month day))))) + +;;;###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. +When it is nil, the buffer will be widened to make sure an existing date +tree can be found. If it is the symbol `subtree-at-point', then the tree +will be built under the headline at point." + (setq-local org-datetree-base-level 1) + (save-restriction + (if (eq keep-restriction 'subtree-at-point) + (progn + (unless (org-at-heading-p) (error "Not at heading")) + (widen) + (org-narrow-to-subtree) + (setq-local org-datetree-base-level + (org-get-valid-level (org-current-level) 1))) + (unless keep-restriction (widen)) + ;; Support the old way of tree placement, using a property + (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)) + (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-template year &optional month day insert) + "Find the datetree matched by REGEX-TEMPLATE for YEAR, MONTH, or DAY. +REGEX-TEMPLATE 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-template 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)) (or day month year)))) + (cond + ((not match) + (goto-char (point-max)) + (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) + (org-datetree-insert-line year month day insert))))) + +(defun org-datetree-insert-line (year &optional month day text) + (delete-region (save-excursion (skip-chars-backward " \t\n") (point)) (point)) + (when (assq 'heading org-blank-before-new-entry) + (insert "\n")) + (insert "\n" (make-string org-datetree-base-level ?*) " \n") + (backward-char) + (when month (org-do-demote)) + (when day (org-do-demote)) + (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") + (org-indent-line) + (org-insert-time-stamp + (encode-time 0 0 0 day month year) + nil + (eq org-datetree-add-timestamp 'inactive)))) + (beginning-of-line)) + +(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) + (org-paste-subtree level txt))) + +(defun org-datetree-cleanup () + "Make sure all entries in the current tree are under the correct date. +It may be useful to restrict the buffer to the applicable portion +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]*\\'"))) + (while (re-search-forward org-ts-regexp nil t) + (catch 'next + (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)) + (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) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + +;;; org-datetree.el ends here |