Commit | Line | Data |
---|---|---|
8bfe682a CD |
1 | ;;; org-datetree.el --- Create date entries in a tree |
2 | ||
ba318903 | 3 | ;; Copyright (C) 2009-2014 Free Software Foundation, Inc. |
8bfe682a CD |
4 | |
5 | ;; Author: Carsten Dominik <carsten at orgmode dot org> | |
6 | ;; Keywords: outlines, hypermedia, calendar, wp | |
7 | ;; Homepage: http://orgmode.org | |
8bfe682a CD |
8 | ;; |
9 | ;; This file is part of GNU Emacs. | |
10 | ;; | |
11 | ;; GNU Emacs is free software: you can redistribute it and/or modify | |
12 | ;; it under the terms of the GNU General Public License as published by | |
13 | ;; the Free Software Foundation, either version 3 of the License, or | |
14 | ;; (at your option) any later version. | |
15 | ||
16 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 | ;; GNU General Public License for more details. | |
20 | ||
21 | ;; You should have received a copy of the GNU General Public License | |
22 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | |
23 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
24 | ;; | |
25 | ;;; Commentary: | |
26 | ||
27 | ;; This file contains code to create entries in a tree where the top-level | |
28 | ;; nodes represent years, the level 2 nodes represent the months, and the | |
29 | ;; level 1 entries days. | |
30 | ||
31 | ;;; Code: | |
32 | ||
33 | (require 'org) | |
34 | ||
35 | (defvar org-datetree-base-level 1 | |
36 | "The level at which years should be placed in the date tree. | |
37 | This is normally one, but if the buffer has an entry with a DATE_TREE | |
86fbb8ca CD |
38 | property (any value), the date tree will become a subtree under that entry, |
39 | so the base level will be properly adjusted.") | |
8bfe682a | 40 | |
8223b1d2 BG |
41 | (defcustom org-datetree-add-timestamp nil |
42 | "When non-nil, add a time stamp when create a datetree entry." | |
43 | :group 'org-capture | |
44 | :version "24.3" | |
45 | :type '(choice | |
46 | (const :tag "Do not add a time stamp" nil) | |
47 | (const :tag "Add an inactive time stamp" inactive) | |
48 | (const :tag "Add an active time stamp" active))) | |
49 | ||
ed21c5c8 | 50 | ;;;###autoload |
8bfe682a CD |
51 | (defun org-datetree-find-date-create (date &optional keep-restriction) |
52 | "Find or create an entry for DATE. | |
53 | If KEEP-RESTRICTION is non-nil, do not widen the buffer. | |
ed21c5c8 | 54 | When it is nil, the buffer will be widened to make sure an existing date |
8bfe682a CD |
55 | tree can be found." |
56 | (let ((year (nth 2 date)) | |
57 | (month (car date)) | |
58 | (day (nth 1 date))) | |
59 | (org-set-local 'org-datetree-base-level 1) | |
60 | (or keep-restriction (widen)) | |
61 | (goto-char (point-min)) | |
62 | (save-restriction | |
63 | (when (re-search-forward "^[ \t]*:DATE_TREE:[ \t]+\\S-" nil t) | |
64 | (org-back-to-heading t) | |
65 | (org-set-local 'org-datetree-base-level | |
66 | (org-get-valid-level (funcall outline-level) 1)) | |
67 | (org-narrow-to-subtree)) | |
68 | (goto-char (point-min)) | |
69 | (org-datetree-find-year-create year) | |
70 | (org-datetree-find-month-create year month) | |
71 | (org-datetree-find-day-create year month day) | |
72 | (goto-char (prog1 (point) (widen)))))) | |
73 | ||
74 | (defun org-datetree-find-year-create (year) | |
271672fa BG |
75 | "Find the YEAR datetree or create it." |
76 | (let ((re "^\\*+[ \t]+\\([12][0-9]\\{3\\}\\)\\(\\s-*?\\([ \t]:[[:alnum:]:_@#%]+:\\)?\\s-*$\\)") | |
8bfe682a CD |
77 | match) |
78 | (goto-char (point-min)) | |
79 | (while (and (setq match (re-search-forward re nil t)) | |
80 | (goto-char (match-beginning 1)) | |
81 | (< (string-to-number (match-string 1)) year))) | |
82 | (cond | |
83 | ((not match) | |
84 | (goto-char (point-max)) | |
85 | (or (bolp) (newline)) | |
86 | (org-datetree-insert-line year)) | |
87 | ((= (string-to-number (match-string 1)) year) | |
88 | (goto-char (point-at-bol))) | |
89 | (t | |
90 | (beginning-of-line 1) | |
91 | (org-datetree-insert-line year))))) | |
92 | ||
93 | (defun org-datetree-find-month-create (year month) | |
271672fa | 94 | "Find the datetree for YEAR and MONTH or create it." |
8bfe682a | 95 | (org-narrow-to-subtree) |
3ab2c837 | 96 | (let ((re (format "^\\*+[ \t]+%d-\\([01][0-9]\\) \\w+$" year)) |
8bfe682a CD |
97 | match) |
98 | (goto-char (point-min)) | |
99 | (while (and (setq match (re-search-forward re nil t)) | |
100 | (goto-char (match-beginning 1)) | |
101 | (< (string-to-number (match-string 1)) month))) | |
102 | (cond | |
103 | ((not match) | |
104 | (goto-char (point-max)) | |
105 | (or (bolp) (newline)) | |
106 | (org-datetree-insert-line year month)) | |
107 | ((= (string-to-number (match-string 1)) month) | |
108 | (goto-char (point-at-bol))) | |
109 | (t | |
110 | (beginning-of-line 1) | |
111 | (org-datetree-insert-line year month))))) | |
112 | ||
113 | (defun org-datetree-find-day-create (year month day) | |
271672fa | 114 | "Find the datetree for YEAR, MONTH and DAY or create it." |
8bfe682a | 115 | (org-narrow-to-subtree) |
3ab2c837 | 116 | (let ((re (format "^\\*+[ \t]+%d-%02d-\\([0123][0-9]\\) \\w+$" year month)) |
8bfe682a CD |
117 | match) |
118 | (goto-char (point-min)) | |
119 | (while (and (setq match (re-search-forward re nil t)) | |
120 | (goto-char (match-beginning 1)) | |
121 | (< (string-to-number (match-string 1)) day))) | |
122 | (cond | |
123 | ((not match) | |
124 | (goto-char (point-max)) | |
125 | (or (bolp) (newline)) | |
126 | (org-datetree-insert-line year month day)) | |
127 | ((= (string-to-number (match-string 1)) day) | |
128 | (goto-char (point-at-bol))) | |
129 | (t | |
130 | (beginning-of-line 1) | |
131 | (org-datetree-insert-line year month day))))) | |
132 | ||
133 | (defun org-datetree-insert-line (year &optional month day) | |
8223b1d2 | 134 | (let ((pos (point)) ts-type) |
8bfe682a CD |
135 | (skip-chars-backward " \t\n") |
136 | (delete-region (point) pos) | |
137 | (insert "\n" (make-string org-datetree-base-level ?*) " \n") | |
138 | (backward-char 1) | |
139 | (if month (org-do-demote)) | |
140 | (if day (org-do-demote)) | |
141 | (insert (format "%d" year)) | |
142 | (when month | |
143 | (insert (format "-%02d" month)) | |
144 | (if day | |
145 | (insert (format "-%02d %s" | |
146 | day (format-time-string | |
147 | "%A" (encode-time 0 0 0 day month year)))) | |
148 | (insert (format " %s" | |
149 | (format-time-string | |
150 | "%B" (encode-time 0 0 0 1 month year)))))) | |
8223b1d2 BG |
151 | (when (and day (setq ts-type org-datetree-add-timestamp)) |
152 | (insert "\n") | |
153 | (org-indent-line) | |
154 | (org-insert-time-stamp (encode-time 0 0 0 day month year) nil ts-type)) | |
8bfe682a CD |
155 | (beginning-of-line 1))) |
156 | ||
157 | (defun org-datetree-file-entry-under (txt date) | |
158 | "Insert a node TXT into the date tree under DATE." | |
159 | (org-datetree-find-date-create date) | |
160 | (let ((level (org-get-valid-level (funcall outline-level) 1))) | |
161 | (org-end-of-subtree t t) | |
162 | (org-back-over-empty-lines) | |
163 | (org-paste-subtree level txt))) | |
164 | ||
165 | (defun org-datetree-cleanup () | |
166 | "Make sure all entries in the current tree are under the correct date. | |
167 | It may be useful to restrict the buffer to the applicable portion | |
168 | before running this command, even though the command tries to be smart." | |
169 | (interactive) | |
170 | (goto-char (point-min)) | |
171 | (let ((dre (concat "\\<" org-deadline-string "\\>[ \t]*\\'")) | |
172 | (sre (concat "\\<" org-scheduled-string "\\>[ \t]*\\'")) | |
173 | dct ts tmp date year month day pos hdl-pos) | |
8223b1d2 BG |
174 | (while (re-search-forward org-ts-regexp nil t) |
175 | (catch 'next | |
176 | (setq ts (match-string 0)) | |
177 | (setq tmp (buffer-substring | |
178 | (max (point-at-bol) (- (match-beginning 0) | |
179 | org-ds-keyword-length)) | |
180 | (match-beginning 0))) | |
181 | (if (or (string-match "-\\'" tmp) | |
182 | (string-match dre tmp) | |
183 | (string-match sre tmp)) | |
184 | (throw 'next nil)) | |
185 | (setq dct (decode-time (org-time-string-to-time (match-string 0))) | |
186 | date (list (nth 4 dct) (nth 3 dct) (nth 5 dct)) | |
187 | year (nth 2 date) | |
188 | month (car date) | |
189 | day (nth 1 date) | |
190 | pos (point)) | |
191 | (org-back-to-heading t) | |
192 | (setq hdl-pos (point)) | |
193 | (unless (org-up-heading-safe) | |
194 | ;; No parent, we are not in a date tree | |
195 | (goto-char pos) | |
196 | (throw 'next nil)) | |
197 | (unless (looking-at "\\*+[ \t]+[0-9]+-[0-1][0-9]-[0-3][0-9]") | |
198 | ;; Parent looks wrong, we are not in a date tree | |
199 | (goto-char pos) | |
8bfe682a | 200 | (throw 'next nil)) |
8223b1d2 BG |
201 | (when (looking-at (format "\\*+[ \t]+%d-%02d-%02d" year month day)) |
202 | ;; At correct date already, do nothing | |
8bfe682a | 203 | (progn (goto-char pos) (throw 'next nil))) |
8223b1d2 BG |
204 | ;; OK, we need to refile this entry |
205 | (goto-char hdl-pos) | |
206 | (org-cut-subtree) | |
207 | (save-excursion | |
208 | (save-restriction | |
209 | (org-datetree-file-entry-under (current-kill 0) date))))))) | |
8bfe682a CD |
210 | |
211 | (provide 'org-datetree) | |
212 | ||
bdebdb64 BG |
213 | ;; Local variables: |
214 | ;; generated-autoload-file: "org-loaddefs.el" | |
215 | ;; End: | |
216 | ||
8bfe682a | 217 | ;;; org-datetree.el ends here |