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