Commit | Line | Data |
---|---|---|
58c7641d | 1 | ;;; Todos.el --- facilities for making and maintaining Todo lists |
3f031767 | 2 | |
0e89c3fc | 3 | ;; Copyright (C) 1997, 1999, 2001-2012 Free Software Foundation, Inc. |
3f031767 SB |
4 | |
5 | ;; Author: Oliver Seidel <privat@os10000.net> | |
58c7641d | 6 | ;; Stephen Berman <stephen.berman@gmx.net> |
3f031767 SB |
7 | ;; Maintainer: Stephen Berman <stephen.berman@gmx.net> |
8 | ;; Created: 2 Aug 1997 | |
9 | ;; Keywords: calendar, todo | |
10 | ||
0e89c3fc | 11 | ;; This file is [not yet] part of GNU Emacs. |
3f031767 SB |
12 | |
13 | ;; GNU Emacs is free software: you can redistribute it and/or modify | |
14 | ;; it under the terms of the GNU General Public License as published by | |
15 | ;; the Free Software Foundation, either version 3 of the License, or | |
16 | ;; (at your option) any later version. | |
17 | ||
18 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
19 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
20 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
21 | ;; GNU General Public License for more details. | |
22 | ||
23 | ;; You should have received a copy of the GNU General Public License | |
24 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | |
25 | ||
3f031767 SB |
26 | ;;; Commentary: |
27 | ||
3f031767 SB |
28 | ;;; Code: |
29 | ||
b28025ed | 30 | (require 'diary-lib) |
6be04162 | 31 | ;; For remove-duplicates in todos-insertion-commands-args. |
0e89c3fc | 32 | (eval-when-compile (require 'cl)) |
3f031767 | 33 | |
2c173503 | 34 | ;; --------------------------------------------------------------------------- |
58c7641d | 35 | ;;; User options |
ee7412e4 | 36 | |
3f031767 | 37 | (defgroup todos nil |
58c7641d | 38 | "Create and maintain categorized lists of todo items." |
3f031767 | 39 | :link '(emacs-commentary-link "todos") |
0e89c3fc | 40 | :version "24.2" |
3f031767 SB |
41 | :group 'calendar) |
42 | ||
0e89c3fc SB |
43 | (defcustom todos-files-directory (locate-user-emacs-file "todos/") |
44 | "Directory where user's Todos files are saved." | |
45 | :type 'directory | |
46 | :group 'todos) | |
47 | ||
48 | (defun todos-files (&optional archives) | |
49 | "Default value of `todos-files-function'. | |
50 | This returns the case-insensitive alphabetically sorted list of | |
51 | file truenames in `todos-files-directory' with the extension | |
52 | \".todo\". With non-nil ARCHIVES return the list of archive file | |
53 | truenames (those with the extension \".toda\")." | |
54 | (let ((files (if (file-exists-p todos-files-directory) | |
55 | (mapcar 'file-truename | |
56 | (directory-files todos-files-directory t | |
57 | (if archives "\.toda$" "\.todo$") t))))) | |
58 | (sort files (lambda (s1 s2) (let ((cis1 (upcase s1)) | |
59 | (cis2 (upcase s2))) | |
60 | (string< cis1 cis2)))))) | |
61 | ||
62 | (defcustom todos-files-function 'todos-files | |
63 | "Function returning the value of the variable `todos-files'. | |
64 | This function should take an optional argument that, if non-nil, | |
65 | makes it return the value of the variable `todos-archives'." | |
66 | :type 'function | |
67 | :group 'todos) | |
68 | ||
69 | (defun todos-short-file-name (file) | |
70 | "Return short form of Todos FILE. | |
71 | This lacks the extension and directory components." | |
72 | (file-name-sans-extension (file-name-nondirectory file))) | |
73 | ||
74 | (defcustom todos-default-todos-file (car (funcall todos-files-function)) | |
75 | "Todos file visited by first session invocation of `todos-show'." | |
76 | :type `(radio ,@(mapcar (lambda (f) (list 'const f)) | |
77 | (mapcar 'todos-short-file-name | |
78 | (funcall todos-files-function)))) | |
79 | :group 'todos) | |
80 | ||
81 | ;; FIXME: is there a better alternative to this? | |
82 | (defun todos-reevaluate-default-file-defcustom () | |
83 | "Reevaluate defcustom of `todos-default-todos-file'. | |
84 | Called after adding or deleting a Todos file." | |
85 | (eval (defcustom todos-default-todos-file (car (funcall todos-files-function)) | |
86 | "Todos file visited by first session invocation of `todos-show'." | |
87 | :type `(radio ,@(mapcar (lambda (f) (list 'const f)) | |
88 | (mapcar 'todos-short-file-name | |
89 | (funcall todos-files-function)))) | |
90 | :group 'todos))) | |
91 | ||
92 | (defcustom todos-show-current-file t | |
93 | "Non-nil to make `todos-show' visit the current Todos file. | |
94 | Otherwise, `todos-show' always visits `todos-default-todos-file'." | |
95 | :type 'boolean | |
96 | :initialize 'custom-initialize-default | |
3af3cd0b | 97 | :set 'todos-set-show-current-file |
0e89c3fc SB |
98 | :group 'todos) |
99 | ||
3af3cd0b | 100 | (defun todos-set-show-current-file (symbol value) |
0e89c3fc SB |
101 | "The :set function for user option `todos-show-current-file'." |
102 | (custom-set-default symbol value) | |
103 | (if value | |
104 | (add-hook 'pre-command-hook 'todos-show-current-file nil t) | |
105 | (remove-hook 'pre-command-hook 'todos-show-current-file t))) | |
106 | ||
107 | (defcustom todos-visit-files-commands (list 'find-file 'dired-find-file) | |
6be04162 | 108 | "List of file finding commands for `todos-display-as-todos-file'. |
0e89c3fc SB |
109 | Invoking these commands to visit a Todos or Todos Archive file |
110 | calls `todos-show' or `todos-show-archive', so that the file is | |
111 | displayed correctly." | |
112 | :type '(repeat function) | |
113 | :group 'todos) | |
114 | ||
115 | (defcustom todos-initial-file "Todo" | |
116 | "Default file name offered on adding first Todos file." | |
117 | :type 'string | |
118 | :group 'todos) | |
119 | ||
d04d6b95 SB |
120 | (defcustom todos-initial-category "Todo" |
121 | "Default category name offered on initializing a new Todos file." | |
122 | :type 'string | |
123 | :group 'todos) | |
124 | ||
125 | (defcustom todos-display-categories-first nil | |
126 | "Non-nil to display category list on first visit to a Todos file." | |
127 | :type 'boolean | |
128 | :group 'todos) | |
129 | ||
130 | (defcustom todos-prefix "" | |
b28025ed SB |
131 | "String prefixed to todo items for visual distinction." |
132 | :type 'string | |
133 | :initialize 'custom-initialize-default | |
134 | :set 'todos-reset-prefix | |
135 | :group 'todos) | |
2c173503 | 136 | |
3af3cd0b | 137 | (defcustom todos-number-priorities t |
58c7641d | 138 | "Non-nil to prefix items with consecutively increasing integers. |
d04d6b95 | 139 | These reflect the priorities of the items in each category." |
2c173503 SB |
140 | :type 'boolean |
141 | :initialize 'custom-initialize-default | |
142 | :set 'todos-reset-prefix | |
143 | :group 'todos) | |
144 | ||
0e89c3fc | 145 | (defun todos-reset-prefix (symbol value) |
3af3cd0b | 146 | "The :set function for `todos-prefix' and `todos-number-priorities'." |
0e89c3fc SB |
147 | (let ((oldvalue (symbol-value symbol)) |
148 | (files (append todos-files todos-archives))) | |
149 | (custom-set-default symbol value) | |
150 | (when (not (equal value oldvalue)) | |
151 | (dolist (f files) | |
152 | (with-current-buffer (find-file-noselect f) | |
153 | (save-window-excursion | |
154 | (todos-show) | |
155 | (save-excursion | |
156 | (widen) | |
157 | (goto-char (point-min)) | |
158 | (while (not (eobp)) | |
159 | (remove-overlays (point) (point)); 'before-string prefix) | |
160 | (forward-line))) | |
161 | ;; Activate the new setting (save-restriction does not help). | |
162 | (save-excursion (todos-category-select)))))))) | |
163 | ||
58c7641d SB |
164 | ;; FIXME: Update when window-width changes. Add todos-reset-separator to |
165 | ;; window-configuration-change-hook in todos-mode? But this depends on the | |
166 | ;; value being window-width instead of a constant length. | |
0e89c3fc | 167 | (defcustom todos-done-separator (make-string (window-width) ?_) |
3af3cd0b | 168 | "String used to visually separate done from not done items. |
0833689a | 169 | Displayed as an overlay instead of `todos-category-done' when |
3af3cd0b | 170 | done items are shown." |
2c173503 SB |
171 | :type 'string |
172 | :initialize 'custom-initialize-default | |
0e89c3fc | 173 | :set 'todos-reset-separator |
2c173503 SB |
174 | :group 'todos) |
175 | ||
3af3cd0b | 176 | ;; (defun todos-reset-done-separator (symbol value) |
0e89c3fc SB |
177 | ;; "The :set function for `todos-done-separator' |
178 | ;; Also added to `window-configuration-change-hook' in Todos mode." | |
179 | ;; (let ((oldvalue (symbol-value symbol))) | |
180 | ;; (custom-set-default symbol value) | |
181 | ;; (when (not (equal value oldvalue)) | |
182 | ;; (make-string (window-width) ?_) | |
183 | ;; ;; (save-excursion (todos-category-select)) | |
184 | ;; ))) | |
185 | ||
2c173503 SB |
186 | (defcustom todos-done-string "DONE " |
187 | "Identifying string appended to the front of done todos items." | |
188 | :type 'string | |
58c7641d SB |
189 | :initialize 'custom-initialize-default |
190 | :set 'todos-reset-done-string | |
191 | :group 'todos) | |
192 | ||
0e89c3fc SB |
193 | (defun todos-reset-done-string (symbol value) |
194 | "The :set function for user option `todos-done-string'." | |
195 | (let ((oldvalue (symbol-value symbol)) | |
196 | (files (append todos-files todos-archives))) | |
197 | (custom-set-default symbol value) | |
198 | ;; Need to reset this to get font-locking right. | |
199 | (setq todos-done-string-start | |
200 | (concat "^\\[" (regexp-quote todos-done-string))) | |
201 | (when (not (equal value oldvalue)) | |
202 | (dolist (f files) | |
203 | (with-current-buffer (find-file-noselect f) | |
204 | (let (buffer-read-only) | |
205 | (widen) | |
206 | (goto-char (point-min)) | |
207 | (while (not (eobp)) | |
208 | (if (re-search-forward | |
209 | (concat "^" (regexp-quote todos-nondiary-start) | |
210 | "\\(" (regexp-quote oldvalue) "\\)") | |
211 | nil t) | |
212 | (replace-match value t t nil 1) | |
213 | (forward-line))) | |
214 | (todos-category-select))))))) | |
215 | ||
58c7641d SB |
216 | (defcustom todos-comment-string "COMMENT" |
217 | "String inserted before optional comment appended to done item." | |
218 | :type 'string | |
219 | :initialize 'custom-initialize-default | |
220 | :set 'todos-reset-comment-string | |
2c173503 SB |
221 | :group 'todos) |
222 | ||
0e89c3fc SB |
223 | (defun todos-reset-comment-string (symbol value) |
224 | "The :set function for user option `todos-comment-string'." | |
225 | (let ((oldvalue (symbol-value symbol)) | |
226 | (files (append todos-files todos-archives))) | |
227 | (custom-set-default symbol value) | |
228 | (when (not (equal value oldvalue)) | |
229 | (dolist (f files) | |
230 | (with-current-buffer (find-file-noselect f) | |
231 | (let (buffer-read-only) | |
232 | (save-excursion | |
233 | (widen) | |
234 | (goto-char (point-min)) | |
235 | (while (not (eobp)) | |
236 | (if (re-search-forward | |
237 | (concat | |
238 | "\\[\\(" (regexp-quote oldvalue) "\\): [^]]*\\]") | |
239 | nil t) | |
240 | (replace-match value t t nil 1) | |
241 | (forward-line))) | |
242 | (todos-category-select)))))))) | |
243 | ||
2c173503 SB |
244 | (defcustom todos-show-with-done nil |
245 | "Non-nil to display done items in all categories." | |
246 | :type 'boolean | |
247 | :group 'todos) | |
248 | ||
58c7641d SB |
249 | (defun todos-mode-line-control (cat) |
250 | "Return a mode line control for Todos buffers. | |
251 | Argument CAT is the name of the current Todos category. | |
252 | This function is the value of the user variable | |
253 | `todos-mode-line-function'." | |
0e89c3fc SB |
254 | (let ((file (todos-short-file-name todos-current-todos-file))) |
255 | (format "%s category %d: %s" file todos-category-number cat))) | |
58c7641d SB |
256 | |
257 | (defcustom todos-mode-line-function 'todos-mode-line-control | |
258 | "Function that returns a mode line control for Todos buffers. | |
0e89c3fc SB |
259 | The function expects one argument holding the name of the current |
260 | Todos category. The resulting control becomes the local value of | |
261 | `mode-line-buffer-identification' in each Todos buffer." | |
d04d6b95 | 262 | :type 'function |
2c173503 SB |
263 | :group 'todos) |
264 | ||
6be04162 | 265 | (defcustom todos-skip-archived-categories nil |
7464f422 SB |
266 | "Non-nil to skip categories with only archived items when browsing. |
267 | ||
6be04162 SB |
268 | Moving by category todos or archive file (with |
269 | \\[todos-forward-category] and \\[todos-backward-category]) skips | |
270 | categories that contain only archived items. Other commands | |
271 | still recognize these categories. In Todos Categories | |
272 | mode (reached with \\[todos-display-categories]) these categories | |
273 | shown in `todos-archived-only' face and clicking them in Todos | |
274 | Categories mode visits the archived categories." | |
2c173503 SB |
275 | :type 'boolean |
276 | :group 'todos) | |
277 | ||
58c7641d SB |
278 | (defcustom todos-use-only-highlighted-region t |
279 | "Non-nil to enable inserting only highlighted region as new item." | |
280 | :type 'boolean | |
d04d6b95 SB |
281 | :group 'todos) |
282 | ||
283 | (defcustom todos-include-in-diary nil | |
284 | "Non-nil to allow new Todo items to be included in the diary." | |
285 | :type 'boolean | |
286 | :group 'todos) | |
287 | ||
58c7641d SB |
288 | (defcustom todos-diary-nonmarking nil |
289 | "Non-nil to insert new Todo diary items as nonmarking by default. | |
290 | This appends `diary-nonmarking-symbol' to the front of an item on | |
291 | insertion provided it doesn't begin with `todos-nondiary-marker'." | |
292 | :type 'boolean | |
293 | :group 'todos) | |
294 | ||
d04d6b95 SB |
295 | (defcustom todos-nondiary-marker '("[" "]") |
296 | "List of strings surrounding item date to block diary inclusion. | |
297 | The first string is inserted before the item date and must be a | |
298 | non-empty string that does not match a diary date in order to | |
299 | have its intended effect. The second string is inserted after | |
300 | the diary date." | |
301 | :type '(list string string) | |
2c173503 | 302 | :group 'todos |
d04d6b95 SB |
303 | :initialize 'custom-initialize-default |
304 | :set 'todos-reset-nondiary-marker) | |
2c173503 | 305 | |
0e89c3fc SB |
306 | (defun todos-reset-nondiary-marker (symbol value) |
307 | "The :set function for user option `todos-nondiary-marker'." | |
308 | (let ((oldvalue (symbol-value symbol)) | |
309 | (files (append todos-files todos-archives))) | |
310 | (custom-set-default symbol value) | |
311 | ;; Need to reset these to get font-locking right. | |
312 | (setq todos-nondiary-start (nth 0 todos-nondiary-marker) | |
313 | todos-nondiary-end (nth 1 todos-nondiary-marker) | |
314 | todos-date-string-start | |
315 | ;; See comment in defvar of `todos-date-string-start'. | |
316 | (concat "^\\(" (regexp-quote todos-nondiary-start) "\\|" | |
317 | (regexp-quote diary-nonmarking-symbol) "\\)?")) | |
318 | (when (not (equal value oldvalue)) | |
319 | (dolist (f files) | |
320 | (with-current-buffer (find-file-noselect f) | |
321 | (let (buffer-read-only) | |
322 | (widen) | |
323 | (goto-char (point-min)) | |
324 | (while (not (eobp)) | |
325 | (if (re-search-forward | |
326 | (concat "^\\(" todos-done-string-start "[^][]+] \\)?" | |
327 | "\\(?1:" (regexp-quote (car oldvalue)) | |
328 | "\\)" todos-date-pattern "\\( " | |
329 | diary-time-regexp "\\)?\\(?2:" | |
330 | (regexp-quote (cadr oldvalue)) "\\)") | |
331 | nil t) | |
332 | (progn | |
333 | (replace-match (nth 0 value) t t nil 1) | |
334 | (replace-match (nth 1 value) t t nil 2)) | |
335 | (forward-line))) | |
336 | (todos-category-select))))))) | |
337 | ||
6be04162 SB |
338 | (defcustom todos-always-add-time-string nil |
339 | "Non-nil adds current time to a new item's date header by default. | |
340 | When the Todos insertion commands have a non-nil \"maybe-notime\" | |
341 | argument, this reverses the effect of | |
342 | `todos-always-add-time-string': if t, these commands omit the | |
343 | current time, if nil, they include it." | |
344 | :type 'boolean | |
3f031767 | 345 | :group 'todos) |
2c173503 | 346 | |
0e89c3fc SB |
347 | (defcustom todos-completion-ignore-case nil |
348 | "Non-nil means case of user input in `todos-read-*' is ignored." | |
349 | :type 'boolean | |
3f031767 | 350 | :group 'todos) |
2c173503 | 351 | |
0e89c3fc SB |
352 | (defcustom todos-highlight-item nil |
353 | "Non-nil means highlight items at point." | |
db2c5d34 | 354 | :type 'boolean |
0e89c3fc SB |
355 | :initialize 'custom-initialize-default |
356 | :set 'todos-reset-highlight-item | |
db2c5d34 | 357 | :group 'todos) |
3f031767 | 358 | |
0e89c3fc SB |
359 | (defun todos-reset-highlight-item (symbol value) |
360 | "The :set function for `todos-highlight-item'." | |
361 | (let ((oldvalue (symbol-value symbol)) | |
362 | (files (append todos-files todos-archives))) | |
363 | (custom-set-default symbol value) | |
364 | (when (not (equal value oldvalue)) | |
365 | (dolist (f files) | |
6be04162 | 366 | (let ((buf (find-buffer-visiting f))) |
0e89c3fc SB |
367 | (when buf |
368 | (with-current-buffer buf | |
369 | (require 'hl-line) | |
370 | (if value | |
371 | (hl-line-mode 1) | |
372 | (hl-line-mode -1))))))))) | |
373 | ||
2c173503 | 374 | (defcustom todos-wrap-lines t |
0e89c3fc | 375 | "Non-nil to wrap long lines via `todos-line-wrapping-function'." |
2c173503 SB |
376 | :group 'todos |
377 | :type 'boolean) | |
378 | ||
379 | (defcustom todos-line-wrapping-function 'todos-wrap-and-indent | |
0e89c3fc | 380 | "Line wrapping function used with non-nil `todos-wrap-lines'." |
2c173503 SB |
381 | :group 'todos |
382 | :type 'function) | |
383 | ||
0e89c3fc SB |
384 | (defun todos-wrap-and-indent () |
385 | "Use word wrapping on long lines and indent with a wrap prefix. | |
386 | The amount of indentation is given by user option | |
387 | `todos-indent-to-here'." | |
388 | (set (make-local-variable 'word-wrap) t) | |
389 | (set (make-local-variable 'wrap-prefix) (make-string todos-indent-to-here 32)) | |
390 | (unless (member '(continuation) fringe-indicator-alist) | |
391 | (push '(continuation) fringe-indicator-alist))) | |
392 | ||
3af3cd0b SB |
393 | ;; FIXME: :set function (otherwise change takes effect only after killing and |
394 | ;; revisiting file) | |
0e89c3fc SB |
395 | (defcustom todos-indent-to-here 6 |
396 | "Number of spaces `todos-line-wrapping-function' indents to." | |
397 | :type '(integer :validate | |
398 | (lambda (widget) | |
399 | (unless (> (widget-value widget) 0) | |
400 | (widget-put widget :error | |
401 | "Invalid value: must be a positive integer") | |
402 | widget))) | |
403 | :group 'todos) | |
404 | ||
405 | (defun todos-indent () | |
406 | "Indent from point to `todos-indent-to-here'." | |
407 | (indent-to todos-indent-to-here todos-indent-to-here)) | |
408 | ||
409 | (defcustom todos-todo-mode-date-time-regexp | |
410 | (concat "\\(?1:[0-9]\\{4\\}\\)-\\(?2:[0-9]\\{2\\}\\)-" | |
411 | "\\(?3:[0-9]\\{2\\}\\) \\(?4:[0-9]\\{2\\}:[0-9]\\{2\\}\\)") | |
412 | "Regexp matching legacy todo-mode.el item date-time strings. | |
413 | In order for `todos-convert-legacy-files' to correctly convert this | |
414 | string to the current Todos format, the regexp must contain four | |
415 | explicitly numbered groups (see `(elisp) Regexp Backslash'), | |
416 | where group 1 matches a string for the year, group 2 a string for | |
417 | the month, group 3 a string for the day and group 4 a string for | |
418 | the time. The default value converts date-time strings built | |
419 | using the default value of `todo-time-string-format' from | |
420 | todo-mode.el." | |
421 | :type 'regexp | |
ee7412e4 | 422 | :group 'todos) |
3f031767 | 423 | |
6be04162 SB |
424 | (defcustom todos-print-function 'ps-print-buffer-with-faces |
425 | "Function called to print buffer content; see `todos-print'." | |
426 | :type 'symbol | |
427 | :group 'todos) | |
428 | ||
429 | (defgroup todos-filtered nil | |
430 | "User options for Todos Filter Items mode." | |
431 | :version "24.2" | |
432 | :group 'todos) | |
433 | ||
434 | (defcustom todos-filter-buffer "Todos filtered items" | |
435 | "Initial name of buffer in Todos Filter Items mode." | |
436 | :type 'string | |
437 | :group 'todos-filtered) | |
438 | ||
439 | (defcustom todos-top-priorities-buffer "Todos top priorities" | |
440 | "Buffer type string for `todos-special-buffer-name'." | |
441 | :type 'string | |
442 | :group 'todos-filtered) | |
443 | ||
444 | (defcustom todos-diary-items-buffer "Todos diary items" | |
445 | "Buffer type string for `todos-special-buffer-name'." | |
446 | :type 'string | |
447 | :group 'todos-filtered) | |
448 | ||
449 | (defcustom todos-regexp-items-buffer "Todos regexp items" | |
450 | "Buffer type string for `todos-special-buffer-name'." | |
451 | :type 'string | |
452 | :group 'todos-filtered) | |
453 | ||
454 | (defcustom todos-priorities-rules nil | |
455 | "List of rules giving how many items `todos-top-priorities' shows. | |
456 | This variable should be set interactively by | |
457 | `\\[todos-set-top-priorities-in-file]' or | |
458 | `\\[todos-set-top-priorities-in-category]'. | |
459 | ||
460 | Each rule is a list of the form (FILE NUM ALIST), where FILE is a | |
461 | member of `todos-files', NUM is a number specifying the default | |
462 | number of top priority items for each category in that file, and | |
463 | ALIST, when non-nil, consists of conses of a category name in | |
464 | FILE and a number specifying the default number of top priority | |
465 | items in that category, which overrides NUM." | |
466 | :type 'list | |
467 | :group 'todos-filtered) | |
468 | ||
469 | (defcustom todos-show-priorities 1 | |
470 | "Default number of top priorities shown by `todos-top-priorities'." | |
471 | :type 'integer | |
472 | :group 'todos-filtered) | |
473 | ||
474 | (defcustom todos-filter-files nil | |
475 | "List of default files for multifile item filtering." | |
476 | :type `(set ,@(mapcar (lambda (f) (list 'const f)) | |
477 | (mapcar 'todos-short-file-name | |
478 | (funcall todos-files-function)))) | |
479 | :group 'todos-filtered) | |
480 | ||
481 | ;; FIXME: is there a better alternative to this? | |
482 | (defun todos-reevaluate-filter-files-defcustom () | |
483 | "Reevaluate defcustom of `todos-filter-files'. | |
484 | Called after adding or deleting a Todos file." | |
485 | (eval (defcustom todos-filter-files nil | |
486 | "List of files for multifile item filtering." | |
487 | :type `(set ,@(mapcar (lambda (f) (list 'const f)) | |
488 | (mapcar 'todos-short-file-name | |
489 | (funcall todos-files-function)))) | |
490 | :group 'todos))) | |
491 | ||
492 | (defcustom todos-filter-done-items nil | |
493 | "Non-nil to include done items when processing regexp filters. | |
494 | Done items from corresponding archive files are also included." | |
495 | :type 'boolean | |
496 | :group 'todos-filtered) | |
497 | ||
0e89c3fc | 498 | (defgroup todos-categories nil |
6be04162 | 499 | "User options for Todos Categories mode." |
0e89c3fc SB |
500 | :version "24.2" |
501 | :group 'todos) | |
502 | ||
503 | (defcustom todos-categories-category-label "Category" | |
504 | "Category button label in Todos Categories mode." | |
505 | :type 'string | |
506 | :group 'todos-categories) | |
507 | ||
508 | (defcustom todos-categories-todo-label "Todo" | |
509 | "Todo button label in Todos Categories mode." | |
510 | :type 'string | |
511 | :group 'todos-categories) | |
512 | ||
513 | (defcustom todos-categories-diary-label "Diary" | |
514 | "Diary button label in Todos Categories mode." | |
515 | :type 'string | |
516 | :group 'todos-categories) | |
517 | ||
518 | (defcustom todos-categories-done-label "Done" | |
519 | "Done button label in Todos Categories mode." | |
520 | :type 'string | |
521 | :group 'todos-categories) | |
522 | ||
523 | (defcustom todos-categories-archived-label "Archived" | |
524 | "Archived button label in Todos Categories mode." | |
525 | :type 'string | |
526 | :group 'todos-categories) | |
527 | ||
528 | (defcustom todos-categories-totals-label "Totals" | |
529 | "String to label total item counts in Todos Categories mode." | |
530 | :type 'string | |
531 | :group 'todos-categories) | |
532 | ||
533 | (defcustom todos-categories-number-separator " | " | |
534 | "String between number and category in Todos Categories mode. | |
535 | This separates the number from the category name in the default | |
536 | categories display according to priority." | |
537 | :type 'string | |
538 | :group 'todos-categories) | |
539 | ||
540 | (defcustom todos-categories-align 'center | |
541 | "Alignment of category names in Todos Categories mode." | |
542 | :type '(radio (const left) (const center) (const right)) | |
543 | :group 'todos-categories) | |
544 | ||
ee7412e4 | 545 | ;; --------------------------------------------------------------------------- |
2c173503 | 546 | ;;; Faces |
ee7412e4 | 547 | |
d04d6b95 SB |
548 | (defgroup todos-faces nil |
549 | "Faces for the Todos modes." | |
0e89c3fc | 550 | :version "24.2" |
d04d6b95 SB |
551 | :group 'todos) |
552 | ||
db2c5d34 | 553 | (defface todos-prefix-string |
0e89c3fc SB |
554 | ;; '((t :inherit font-lock-constant-face)) |
555 | '((((class grayscale) (background light)) | |
556 | (:foreground "LightGray" :weight bold :underline t)) | |
557 | (((class grayscale) (background dark)) | |
558 | (:foreground "Gray50" :weight bold :underline t)) | |
559 | (((class color) (min-colors 88) (background light)) (:foreground "dark cyan")) | |
560 | (((class color) (min-colors 88) (background dark)) (:foreground "Aquamarine")) | |
561 | (((class color) (min-colors 16) (background light)) (:foreground "CadetBlue")) | |
562 | (((class color) (min-colors 16) (background dark)) (:foreground "Aquamarine")) | |
563 | (((class color) (min-colors 8)) (:foreground "magenta")) | |
564 | (t (:weight bold :underline t))) | |
db2c5d34 | 565 | "Face for Todos prefix string." |
d04d6b95 | 566 | :group 'todos-faces) |
db2c5d34 | 567 | |
58c7641d | 568 | (defface todos-mark |
0e89c3fc SB |
569 | ;; '((t :inherit font-lock-warning-face)) |
570 | '((((class color) | |
571 | (min-colors 88) | |
572 | (background light)) | |
573 | (:weight bold :foreground "Red1")) | |
574 | (((class color) | |
575 | (min-colors 88) | |
576 | (background dark)) | |
577 | (:weight bold :foreground "Pink")) | |
578 | (((class color) | |
579 | (min-colors 16) | |
580 | (background light)) | |
581 | (:weight bold :foreground "Red1")) | |
582 | (((class color) | |
583 | (min-colors 16) | |
584 | (background dark)) | |
585 | (:weight bold :foreground "Pink")) | |
586 | (((class color) | |
587 | (min-colors 8)) | |
588 | (:foreground "red")) | |
589 | (t | |
590 | (:weight bold :inverse-video t))) | |
58c7641d SB |
591 | "Face for marks on Todos items." |
592 | :group 'todos-faces) | |
593 | ||
ee7412e4 | 594 | (defface todos-button |
0e89c3fc SB |
595 | ;; '((t :inherit widget-field)) |
596 | '((((type tty)) | |
597 | (:foreground "black" :background "yellow3")) | |
598 | (((class grayscale color) | |
599 | (background light)) | |
600 | (:background "gray85")) | |
601 | (((class grayscale color) | |
602 | (background dark)) | |
603 | (:background "dim gray")) | |
604 | (t | |
605 | (:slant italic))) | |
ee7412e4 | 606 | "Face for buttons in todos-display-categories." |
d04d6b95 SB |
607 | :group 'todos-faces) |
608 | ||
609 | (defface todos-sorted-column | |
0e89c3fc SB |
610 | ;; '((t :inherit fringe)) |
611 | '((((class color) | |
612 | (background light)) | |
613 | (:foreground "grey95")) | |
614 | (((class color) | |
615 | (background dark)) | |
616 | (:foreground "grey10")) | |
617 | (t | |
618 | (:foreground "gray"))) | |
d04d6b95 SB |
619 | "Face for buttons in todos-display-categories." |
620 | :group 'todos-faces) | |
621 | ||
622 | (defface todos-archived-only | |
0e89c3fc SB |
623 | ;; '((t (:inherit (shadow)))) |
624 | '((((class color) | |
625 | (background light)) | |
626 | (:foreground "grey50")) | |
627 | (((class color) | |
628 | (background dark)) | |
629 | (:foreground "grey70")) | |
630 | (t | |
631 | (:foreground "gray"))) | |
d04d6b95 SB |
632 | "Face for archived-only categories in todos-display-categories." |
633 | :group 'todos-faces) | |
634 | ||
635 | (defface todos-search | |
0e89c3fc SB |
636 | ;; '((t :inherit match)) |
637 | '((((class color) | |
638 | (min-colors 88) | |
639 | (background light)) | |
640 | (:background "yellow1")) | |
641 | (((class color) | |
642 | (min-colors 88) | |
643 | (background dark)) | |
644 | (:background "RoyalBlue3")) | |
645 | (((class color) | |
646 | (min-colors 8) | |
647 | (background light)) | |
648 | (:foreground "black" :background "yellow")) | |
649 | (((class color) | |
650 | (min-colors 8) | |
651 | (background dark)) | |
652 | (:foreground "white" :background "blue")) | |
653 | (((type tty) | |
654 | (class mono)) | |
655 | (:inverse-video t)) | |
656 | (t | |
657 | (:background "gray"))) | |
d04d6b95 SB |
658 | "Face for matches found by todos-search." |
659 | :group 'todos-faces) | |
ee7412e4 | 660 | |
0e89c3fc SB |
661 | (defface todos-diary-expired |
662 | ;; '((t :inherit font-lock-warning-face)) | |
663 | '((((class color) | |
664 | (min-colors 16)) | |
665 | (:weight bold :foreground "DarkOrange")) | |
666 | (((class color)) | |
667 | (:weight bold :foreground "yellow")) | |
668 | (t | |
669 | (:weight bold))) | |
670 | "Face for expired dates of diary items." | |
671 | :group 'todos-faces) | |
672 | (defvar todos-diary-expired-face 'todos-diary-expired) | |
673 | ||
b28025ed | 674 | (defface todos-date |
58c7641d | 675 | '((t :inherit diary)) |
0e89c3fc | 676 | "Face for the date string of a Todos item." |
d04d6b95 | 677 | :group 'todos-faces) |
b28025ed SB |
678 | (defvar todos-date-face 'todos-date) |
679 | ||
680 | (defface todos-time | |
58c7641d | 681 | '((t :inherit diary-time)) |
0e89c3fc | 682 | "Face for the time string of a Todos item." |
d04d6b95 | 683 | :group 'todos-faces) |
b28025ed SB |
684 | (defvar todos-time-face 'todos-time) |
685 | ||
2c173503 | 686 | (defface todos-done |
0e89c3fc SB |
687 | ;; '((t :inherit font-lock-comment-face)) |
688 | '((((class grayscale) | |
689 | (background light)) | |
690 | (:slant italic :weight bold :foreground "DimGray")) | |
691 | (((class grayscale) | |
692 | (background dark)) | |
693 | (:slant italic :weight bold :foreground "LightGray")) | |
694 | (((class color) | |
695 | (min-colors 88) | |
696 | (background light)) | |
697 | (:foreground "Firebrick")) | |
698 | (((class color) | |
699 | (min-colors 88) | |
700 | (background dark)) | |
701 | (:foreground "chocolate1")) | |
702 | (((class color) | |
703 | (min-colors 16) | |
704 | (background light)) | |
705 | (:foreground "red")) | |
706 | (((class color) | |
707 | (min-colors 16) | |
708 | (background dark)) | |
709 | (:foreground "red1")) | |
710 | (((class color) | |
711 | (min-colors 8) | |
712 | (background light)) | |
713 | (:foreground "red")) | |
714 | (((class color) | |
715 | (min-colors 8) | |
716 | (background dark)) | |
717 | (:foreground "yellow")) | |
718 | (t | |
719 | (:slant italic :weight bold))) | |
2c173503 | 720 | "Face for done Todos item header string." |
d04d6b95 | 721 | :group 'todos-faces) |
2c173503 | 722 | (defvar todos-done-face 'todos-done) |
b28025ed | 723 | |
58c7641d | 724 | (defface todos-comment |
0e89c3fc | 725 | '((t :inherit todos-done)) |
58c7641d SB |
726 | "Face for comments appended to done Todos items." |
727 | :group 'todos-faces) | |
728 | (defvar todos-comment-face 'todos-comment) | |
729 | ||
2c173503 | 730 | (defface todos-done-sep |
0e89c3fc SB |
731 | ;; '((t :inherit font-lock-type-face)) |
732 | '((((class grayscale) | |
733 | (background light)) | |
734 | (:weight bold :foreground "Gray90")) | |
735 | (((class grayscale) | |
736 | (background dark)) | |
737 | (:weight bold :foreground "DimGray")) | |
738 | (((class color) | |
739 | (min-colors 88) | |
740 | (background light)) | |
741 | (:foreground "ForestGreen")) | |
742 | (((class color) | |
743 | (min-colors 88) | |
744 | (background dark)) | |
745 | (:foreground "PaleGreen")) | |
746 | (((class color) | |
747 | (min-colors 16) | |
748 | (background light)) | |
749 | (:foreground "ForestGreen")) | |
750 | (((class color) | |
751 | (min-colors 16) | |
752 | (background dark)) | |
753 | (:foreground "PaleGreen")) | |
754 | (((class color) | |
755 | (min-colors 8)) | |
756 | (:foreground "green")) | |
757 | (t | |
758 | (:underline t :weight bold))) | |
2c173503 | 759 | "Face for separator string bewteen done and not done Todos items." |
d04d6b95 | 760 | :group 'todos-faces) |
2c173503 | 761 | (defvar todos-done-sep-face 'todos-done-sep) |
db2c5d34 | 762 | |
78fe7289 SB |
763 | (defun todos-date-string-matcher (lim) |
764 | "Search for Todos date string within LIM for font-locking." | |
765 | (re-search-forward | |
766 | (concat todos-date-string-start "\\(?1:" todos-date-pattern "\\)") lim t)) | |
767 | ||
768 | (defun todos-time-string-matcher (lim) | |
769 | "Search for Todos time string within LIM for font-locking." | |
770 | (re-search-forward (concat todos-date-string-start todos-date-pattern | |
771 | " \\(?1:" diary-time-regexp "\\)") lim t)) | |
772 | ||
773 | (defun todos-nondiary-marker-matcher (lim) | |
774 | "Search for Todos nondiary markers within LIM for font-locking." | |
775 | (re-search-forward (concat "^\\(?1:" (regexp-quote todos-nondiary-start) "\\)" | |
776 | todos-date-pattern "\\(?: " diary-time-regexp | |
777 | "\\)?\\(?2:" (regexp-quote todos-nondiary-end) "\\)") | |
778 | lim t)) | |
779 | ||
780 | (defun todos-diary-nonmarking-matcher (lim) | |
781 | "Search for diary nonmarking symbol within LIM for font-locking." | |
782 | (re-search-forward (concat "^\\(?1:" (regexp-quote diary-nonmarking-symbol) | |
783 | "\\)" todos-date-pattern) lim t)) | |
784 | ||
785 | (defun todos-diary-expired-matcher (lim) | |
786 | "Search for expired diary item date within LIM for font-locking." | |
787 | (when (re-search-forward (concat "^\\(?:" | |
788 | (regexp-quote diary-nonmarking-symbol) | |
789 | "\\)?\\(?1:" todos-date-pattern "\\) \\(?2:" | |
790 | diary-time-regexp "\\)?") lim t) | |
791 | (let* ((date (match-string-no-properties 1)) | |
792 | (time (match-string-no-properties 2)) | |
6be04162 | 793 | ;; Function days-between requires a non-empty time string. |
78fe7289 SB |
794 | (date-time (concat date " " (or time "00:00")))) |
795 | (or (and (not (string-match ".+day\\|\\*" date)) | |
796 | (< (days-between date-time (current-time-string)) 0)) | |
797 | (todos-diary-expired-matcher lim))))) | |
798 | ||
799 | (defun todos-done-string-matcher (lim) | |
800 | "Search for Todos done header within LIM for font-locking." | |
801 | (re-search-forward (concat todos-done-string-start | |
802 | "[^][]+]") | |
803 | lim t)) | |
804 | ||
805 | (defun todos-comment-string-matcher (lim) | |
806 | "Search for Todos done comment within LIM for font-locking." | |
807 | (re-search-forward (concat "\\[\\(?1:" todos-comment-string "\\):") | |
808 | lim t)) | |
809 | ||
810 | ;; (defun todos-category-string-matcher (lim) | |
811 | ;; "Search for Todos category name within LIM for font-locking. | |
812 | ;; This is for fontifying category names appearing in Todos filter | |
813 | ;; mode." | |
814 | ;; (if (eq major-mode 'todos-filter-items-mode) | |
815 | ;; (re-search-forward | |
816 | ;; (concat "^\\(?:" todos-date-string-start "\\)?" todos-date-pattern | |
817 | ;; "\\(?: " diary-time-regexp "\\)?\\(?:" | |
818 | ;; (regexp-quote todos-nondiary-end) "\\)? \\(?1:\\[.+\\]\\)") | |
819 | ;; lim t))) | |
820 | ||
821 | (defun todos-category-string-matcher-1 (lim) | |
822 | "Search for Todos category name within LIM for font-locking. | |
823 | This is for fontifying category names appearing in Todos filter | |
824 | mode following done items." | |
825 | (if (eq major-mode 'todos-filter-items-mode) | |
826 | (re-search-forward (concat todos-done-string-start todos-date-pattern | |
827 | "\\(?: " diary-time-regexp | |
828 | ;; Use non-greedy operator to prevent | |
829 | ;; capturing possible following non-diary | |
830 | ;; date string. | |
831 | "\\)?] \\(?1:\\[.+?\\]\\)") | |
832 | lim t))) | |
833 | ||
834 | (defun todos-category-string-matcher-2 (lim) | |
835 | "Search for Todos category name within LIM for font-locking. | |
836 | This is for fontifying category names appearing in Todos filter | |
837 | mode following todo (not done) items." | |
838 | (if (eq major-mode 'todos-filter-items-mode) | |
839 | (re-search-forward (concat todos-date-string-start todos-date-pattern | |
840 | "\\(?: " diary-time-regexp "\\)?\\(?:" | |
841 | (regexp-quote todos-nondiary-end) | |
842 | "\\)? \\(?1:\\[.+\\]\\)") | |
843 | lim t))) | |
844 | ||
db2c5d34 SB |
845 | (defvar todos-font-lock-keywords |
846 | (list | |
0e89c3fc SB |
847 | '(todos-nondiary-marker-matcher 1 todos-done-sep-face t) |
848 | '(todos-nondiary-marker-matcher 2 todos-done-sep-face t) | |
849 | ;; This is the face used by diary-lib.el. | |
850 | '(todos-diary-nonmarking-matcher 1 font-lock-constant-face t) | |
58c7641d SB |
851 | '(todos-date-string-matcher 1 todos-date-face t) |
852 | '(todos-time-string-matcher 1 todos-time-face t) | |
853 | '(todos-done-string-matcher 0 todos-done-face t) | |
854 | '(todos-comment-string-matcher 1 todos-done-face t) | |
0e89c3fc SB |
855 | ;; '(todos-category-string-matcher 1 todos-done-sep-face t) |
856 | '(todos-category-string-matcher-1 1 todos-done-sep-face t t) | |
857 | '(todos-category-string-matcher-2 1 todos-done-sep-face t t) | |
858 | '(todos-diary-expired-matcher 1 todos-diary-expired-face t) | |
859 | '(todos-diary-expired-matcher 2 todos-diary-expired-face t t) | |
860 | ) | |
861 | "Font-locking for Todos modes.") | |
db2c5d34 | 862 | |
3f031767 | 863 | ;; --------------------------------------------------------------------------- |
0e89c3fc | 864 | ;;; Todos mode local variables and hook functions |
3f031767 | 865 | |
58c7641d SB |
866 | (defvar todos-current-todos-file nil |
867 | "Variable holding the name of the currently active Todos file.") | |
58c7641d | 868 | |
0e89c3fc SB |
869 | (defun todos-show-current-file () |
870 | "Visit current instead of default Todos file with `todos-show'. | |
871 | This function is added to `pre-command-hook' when user option | |
872 | `todos-show-current-file' is set to non-nil." | |
873 | (setq todos-global-current-todos-file todos-current-todos-file)) | |
0e89c3fc | 874 | |
6be04162 | 875 | (defun todos-display-as-todos-file () |
0e89c3fc SB |
876 | "Show Todos files correctly when visited from outside of Todos mode." |
877 | (and (member this-command todos-visit-files-commands) | |
878 | (= (- (point-max) (point-min)) (buffer-size)) | |
879 | (member major-mode '(todos-mode todos-archive-mode)) | |
880 | (todos-category-select))) | |
58c7641d | 881 | |
6be04162 SB |
882 | (defun todos-add-to-buffer-list () |
883 | "Add name of just visited Todos file to `todos-file-buffers'. | |
884 | This function is added to `find-file-hook' in Todos mode." | |
885 | (let ((filename (file-truename (buffer-file-name)))) | |
886 | (when (member filename todos-files) | |
887 | (add-to-list 'todos-file-buffers filename)))) | |
888 | ||
889 | (defun todos-update-buffer-list () | |
890 | "Make current Todos mode buffer file car of `todos-file-buffers'. | |
891 | This function is added to `post-command-hook' in Todos mode." | |
892 | (let ((filename (file-truename (buffer-file-name)))) | |
893 | (unless (eq (car todos-file-buffers) filename) | |
894 | (setq todos-file-buffers | |
895 | (cons filename (delete filename todos-file-buffers)))))) | |
896 | ||
58c7641d | 897 | (defun todos-reset-global-current-todos-file () |
0e89c3fc SB |
898 | "Update the value of `todos-global-current-todos-file'. |
899 | This becomes the latest existing Todos file or, if there is none, | |
900 | the value of `todos-default-todos-file'. | |
901 | This function is added to `kill-buffer-hook' in Todos mode." | |
6be04162 SB |
902 | (let ((filename (file-truename (buffer-file-name)))) |
903 | (setq todos-file-buffers (delete filename todos-file-buffers)) | |
904 | (setq todos-global-current-todos-file (or (car todos-file-buffers) | |
905 | todos-default-todos-file)))) | |
58c7641d | 906 | |
0e89c3fc SB |
907 | (defvar todos-categories nil |
908 | "Alist of categories in the current Todos file. | |
909 | The elements are cons cells whose car is a category name and | |
910 | whose cdr is a vector of the category's item counts. These are, | |
3af3cd0b SB |
911 | in order, the numbers of todo items, of todo items included in |
912 | the Diary, of done items and of archived items.") | |
0e89c3fc | 913 | |
0e89c3fc SB |
914 | (defvar todos-categories-with-marks nil |
915 | "Alist of categories and number of marked items they contain.") | |
916 | ||
58c7641d SB |
917 | (defvar todos-category-number 1 |
918 | "Variable holding the number of the current Todos category. | |
0e89c3fc | 919 | Todos categories are numbered starting from 1.") |
58c7641d SB |
920 | |
921 | (defvar todos-first-visit t | |
922 | "Non-nil if first display of this file in the current session. | |
923 | See `todos-display-categories-first'.") | |
924 | ||
0e89c3fc SB |
925 | (defvar todos-show-done-only nil |
926 | "If non-nil display only done items in current category. | |
3af3cd0b | 927 | Set by the command `todos-show-done-only' and used by |
0e89c3fc | 928 | `todos-category-select'.") |
58c7641d | 929 | |
0e89c3fc SB |
930 | ;; --------------------------------------------------------------------------- |
931 | ;;; Global variables and helper functions | |
58c7641d | 932 | |
6be04162 SB |
933 | (defvar todos-files (funcall todos-files-function) |
934 | "List of truenames of user's Todos files.") | |
935 | ||
936 | (defvar todos-archives (funcall todos-files-function t) | |
937 | "List of truenames of user's Todos archives.") | |
938 | ||
939 | (defvar todos-file-buffers nil | |
940 | "List of file names of live Todos mode buffers.") | |
941 | ||
0e89c3fc SB |
942 | (defvar todos-global-current-todos-file nil |
943 | "Variable holding name of current Todos file. | |
944 | Used by functions called from outside of Todos mode to visit the | |
945 | current Todos file rather than the default Todos file (i.e. when | |
946 | users option `todos-show-current-file' is non-nil).") | |
947 | ||
948 | (defun todos-reevaluate-defcustoms () | |
3af3cd0b | 949 | "Reevaluate defcustoms that provide choice list of Todos files." |
0e89c3fc SB |
950 | (custom-set-default 'todos-default-todos-file |
951 | (symbol-value 'todos-default-todos-file)) | |
952 | (todos-reevaluate-default-file-defcustom) | |
953 | (custom-set-default 'todos-filter-files (symbol-value 'todos-filter-files)) | |
954 | (todos-reevaluate-filter-files-defcustom)) | |
955 | ||
956 | (defvar todos-edit-buffer "*Todos Edit*" | |
957 | "Name of current buffer in Todos Edit mode.") | |
958 | ||
959 | (defvar todos-categories-buffer "*Todos Categories*" | |
960 | "Name of buffer in Todos Categories mode.") | |
961 | ||
962 | (defvar todos-print-buffer "*Todos Print*" | |
963 | "Name of buffer containing printable Todos text.") | |
964 | ||
965 | (defvar todos-date-pattern | |
966 | (let ((dayname (diary-name-pattern calendar-day-name-array nil t))) | |
967 | (concat "\\(?:" dayname "\\|" | |
968 | (let ((dayname) | |
969 | ;; FIXME: how to choose between abbreviated and unabbreviated | |
970 | ;; month name? | |
971 | (monthname (format "\\(?:%s\\|\\*\\)" | |
972 | (diary-name-pattern | |
973 | calendar-month-name-array | |
974 | calendar-month-abbrev-array t))) | |
975 | (month "\\(?:[0-9]+\\|\\*\\)") | |
976 | (day "\\(?:[0-9]+\\|\\*\\)") | |
977 | (year "-?\\(?:[0-9]+\\|\\*\\)")) | |
978 | (mapconcat 'eval calendar-date-display-form "")) | |
979 | "\\)")) | |
980 | "Regular expression matching a Todos date header.") | |
58c7641d SB |
981 | |
982 | (defvar todos-nondiary-start (nth 0 todos-nondiary-marker) | |
983 | "String inserted before item date to block diary inclusion.") | |
984 | ||
985 | (defvar todos-nondiary-end (nth 1 todos-nondiary-marker) | |
986 | "String inserted after item date matching `todos-nondiary-start'.") | |
987 | ||
0e89c3fc SB |
988 | ;; By itself this matches anything, because of the `?'; however, it's only |
989 | ;; used in the context of `todos-date-pattern' (but Emacs Lisp lacks | |
990 | ;; lookahead). | |
991 | (defvar todos-date-string-start | |
992 | (concat "^\\(" (regexp-quote todos-nondiary-start) "\\|" | |
993 | (regexp-quote diary-nonmarking-symbol) "\\)?") | |
994 | "Regular expression matching part of item header before the date.") | |
58c7641d | 995 | |
0e89c3fc SB |
996 | (defvar todos-done-string-start |
997 | (concat "^\\[" (regexp-quote todos-done-string)) | |
998 | "Regular expression matching start of done item.") | |
58c7641d | 999 | |
0e89c3fc SB |
1000 | (defun todos-category-number (cat) |
1001 | "Return the number of category CAT in this Todos file. | |
1002 | The buffer-local variable `todos-category-number' holds this | |
1003 | number as its value." | |
1004 | (let ((categories (mapcar 'car todos-categories))) | |
1005 | (setq todos-category-number | |
1006 | ;; Increment by one, so that the highest priority category in Todos | |
1007 | ;; Categories mode is numbered one rather than zero. | |
1008 | (1+ (- (length categories) | |
1009 | (length (member cat categories))))))) | |
58c7641d | 1010 | |
0e89c3fc SB |
1011 | (defun todos-current-category () |
1012 | "Return the name of the current category." | |
1013 | (car (nth (1- todos-category-number) todos-categories))) | |
58c7641d | 1014 | |
0e89c3fc SB |
1015 | (defconst todos-category-beg "--==-- " |
1016 | "String marking beginning of category (inserted with its name).") | |
58c7641d | 1017 | |
0e89c3fc SB |
1018 | (defconst todos-category-done "==--== DONE " |
1019 | "String marking beginning of category's done items.") | |
2c173503 | 1020 | |
0e89c3fc SB |
1021 | (defun todos-category-select () |
1022 | "Display the current category correctly." | |
1023 | (let ((name (todos-current-category)) | |
1024 | cat-begin cat-end done-start done-sep-start done-end) | |
1025 | (widen) | |
1026 | (goto-char (point-min)) | |
1027 | (re-search-forward | |
1028 | (concat "^" (regexp-quote (concat todos-category-beg name)) "$") nil t) | |
1029 | (setq cat-begin (1+ (line-end-position))) | |
1030 | (setq cat-end (if (re-search-forward | |
1031 | (concat "^" (regexp-quote todos-category-beg)) nil t) | |
1032 | (match-beginning 0) | |
1033 | (point-max))) | |
1034 | (setq mode-line-buffer-identification | |
1035 | (funcall todos-mode-line-function name)) | |
1036 | (narrow-to-region cat-begin cat-end) | |
1037 | (todos-prefix-overlays) | |
1038 | (goto-char (point-min)) | |
1039 | (if (re-search-forward (concat "\n\\(" (regexp-quote todos-category-done) | |
1040 | "\\)") nil t) | |
1041 | (progn | |
1042 | (setq done-start (match-beginning 0)) | |
1043 | (setq done-sep-start (match-beginning 1)) | |
1044 | (setq done-end (match-end 0))) | |
1045 | (error "Category %s is missing todos-category-done string" name)) | |
1046 | (if todos-show-done-only | |
1047 | (narrow-to-region (1+ done-end) (point-max)) | |
1048 | (when (and todos-show-with-done | |
1049 | (re-search-forward todos-done-string-start nil t)) | |
1050 | ;; Now we want to see the done items, so reset displayed end to end of | |
1051 | ;; done items. | |
1052 | (setq done-start cat-end) | |
1053 | ;; Make display overlay for done items separator string, unless there | |
1054 | ;; already is one. | |
1055 | (let* ((done-sep todos-done-separator) | |
1056 | (ovs (overlays-at done-sep-start)) | |
1057 | ov-sep) | |
1058 | (unless (and ovs (string= (overlay-get (car ovs) 'display) done-sep)) | |
1059 | (setq ov-sep (make-overlay done-sep-start done-end)) | |
1060 | (overlay-put ov-sep 'display done-sep)))) | |
1061 | (narrow-to-region (point-min) done-start) | |
1062 | ;; Loading this from todos-mode, or adding it to the mode hook, causes | |
520d912e | 1063 | ;; Emacs to hang in todos-item-start, at (looking-at todos-item-start). |
0e89c3fc SB |
1064 | (when todos-highlight-item |
1065 | (require 'hl-line) | |
1066 | (hl-line-mode 1))))) | |
3f031767 | 1067 | |
0e89c3fc SB |
1068 | (defun todos-get-count (type &optional category) |
1069 | "Return count of TYPE items in CATEGORY. | |
1070 | If CATEGORY is nil, default to the current category." | |
1071 | (let* ((cat (or category (todos-current-category))) | |
1072 | (counts (cdr (assoc cat todos-categories))) | |
1073 | (idx (cond ((eq type 'todo) 0) | |
1074 | ((eq type 'diary) 1) | |
1075 | ((eq type 'done) 2) | |
1076 | ((eq type 'archived) 3)))) | |
1077 | (aref counts idx))) | |
ee7412e4 | 1078 | |
3af3cd0b SB |
1079 | (defun todos-update-count (type increment &optional category) |
1080 | "Change count of TYPE items in CATEGORY by integer INCREMENT. | |
1081 | With nil or omitted CATEGORY, default to the current category." | |
0e89c3fc SB |
1082 | (let* ((cat (or category (todos-current-category))) |
1083 | (counts (cdr (assoc cat todos-categories))) | |
1084 | (idx (cond ((eq type 'todo) 0) | |
1085 | ((eq type 'diary) 1) | |
1086 | ((eq type 'done) 2) | |
1087 | ((eq type 'archived) 3)))) | |
1088 | (aset counts idx (+ increment (aref counts idx))))) | |
d04d6b95 | 1089 | |
7464f422 | 1090 | (defun todos-set-categories () ;FIXME: need this? |
0e89c3fc SB |
1091 | "Set `todos-categories' from the sexp at the top of the file." |
1092 | ;; New archive files created by `todos-move-category' are empty, which would | |
1093 | ;; make the sexp test fail and raise an error, so in this case we skip it. | |
1094 | (unless (zerop (buffer-size)) | |
1095 | (save-excursion | |
1096 | (save-restriction | |
1097 | (widen) | |
1098 | (goto-char (point-min)) | |
7464f422 | 1099 | (setq todos-categories |
0e89c3fc SB |
1100 | (if (looking-at "\(\(\"") |
1101 | (read (buffer-substring-no-properties | |
1102 | (line-beginning-position) | |
1103 | (line-end-position))) | |
7464f422 | 1104 | (error "Invalid or missing todos-categories sexp"))))))) |
d04d6b95 | 1105 | |
0e89c3fc SB |
1106 | (defun todos-update-categories-sexp () |
1107 | "Update the `todos-categories' sexp at the top of the file." | |
1108 | (let (buffer-read-only) | |
1109 | (save-excursion | |
1110 | (save-restriction | |
1111 | (widen) | |
1112 | (goto-char (point-min)) | |
1113 | (if (looking-at (concat "^" (regexp-quote todos-category-beg))) | |
459c6e93 SB |
1114 | (progn (newline) (goto-char (point-min)) ; Make space for sexp. |
1115 | ;; No categories sexp means the first item was just added | |
1116 | ;; to this file, so have to initialize Todos file and | |
1117 | ;; categories variables in order e.g. to enable categories | |
1118 | ;; display. | |
1119 | (setq todos-default-todos-file (buffer-file-name)) | |
7464f422 | 1120 | (setq todos-categories (todos-make-categories-list t))) |
0e89c3fc SB |
1121 | ;; With empty buffer (e.g. with new archive in |
1122 | ;; `todos-move-category') `kill-line' signals end of buffer. | |
1123 | (kill-region (line-beginning-position) (line-end-position))) | |
7464f422 | 1124 | (prin1 todos-categories (current-buffer)))))) |
d04d6b95 | 1125 | |
0e89c3fc SB |
1126 | (defun todos-make-categories-list (&optional force) |
1127 | "Return an alist of Todos categories and their item counts. | |
1128 | With non-nil argument FORCE parse the entire file to build the | |
1129 | list; otherwise, get the value by reading the sexp at the top of | |
1130 | the file." | |
1131 | (setq todos-categories nil) | |
1132 | (save-excursion | |
1133 | (save-restriction | |
1134 | (widen) | |
1135 | (goto-char (point-min)) | |
1136 | (let (counts cat archive) | |
6be04162 SB |
1137 | ;; If the file is a todo file and has archived items, identify the |
1138 | ;; archive, in order to count its items. But skip this with | |
1139 | ;; `todos-convert-legacy-files', since that converts filed items to | |
1140 | ;; archived items. | |
1141 | (when buffer-file-name ; During conversion there is no file yet. | |
1142 | ;; If the file is an archive, it doesn't have an archive. | |
0e89c3fc | 1143 | ;; FIXME: can todos-archives be too old here? |
6be04162 SB |
1144 | (unless (member (file-truename buffer-file-name) |
1145 | (funcall todos-files-function t)) | |
0e89c3fc SB |
1146 | (setq archive (concat (file-name-sans-extension |
1147 | todos-current-todos-file) ".toda")))) | |
1148 | (while (not (eobp)) | |
1149 | (cond ((looking-at (concat (regexp-quote todos-category-beg) | |
1150 | "\\(.*\\)\n")) | |
1151 | (setq cat (match-string-no-properties 1)) | |
1152 | ;; Counts for each category: [todo diary done archive] | |
1153 | (setq counts (make-vector 4 0)) | |
1154 | (setq todos-categories | |
1155 | (append todos-categories (list (cons cat counts)))) | |
6be04162 SB |
1156 | ;; Add archived item count to the todo file item counts. |
1157 | ;; Make sure to include newly created archives, e.g. due to | |
1158 | ;; todos-move-category. | |
0e89c3fc SB |
1159 | (when (member archive (funcall todos-files-function t)) |
1160 | (let ((archive-count 0)) | |
1161 | (with-current-buffer (find-file-noselect archive) | |
1162 | (widen) | |
1163 | (goto-char (point-min)) | |
1164 | (when (re-search-forward | |
1165 | (concat (regexp-quote todos-category-beg) cat) | |
1166 | (point-max) t) | |
1167 | (forward-line) | |
1168 | (while (not (or (looking-at | |
1169 | (concat | |
1170 | (regexp-quote todos-category-beg) | |
1171 | "\\(.*\\)\n")) | |
1172 | (eobp))) | |
1173 | (when (looking-at todos-done-string-start) | |
1174 | (setq archive-count (1+ archive-count))) | |
1175 | (forward-line)))) | |
3af3cd0b | 1176 | (todos-update-count 'archived archive-count cat)))) |
0e89c3fc | 1177 | ((looking-at todos-done-string-start) |
3af3cd0b | 1178 | (todos-update-count 'done 1 cat)) |
0e89c3fc SB |
1179 | ((looking-at (concat "^\\(" |
1180 | (regexp-quote diary-nonmarking-symbol) | |
1181 | "\\)?" todos-date-pattern)) | |
3af3cd0b SB |
1182 | (todos-update-count 'diary 1 cat) |
1183 | (todos-update-count 'todo 1 cat)) | |
0e89c3fc | 1184 | ((looking-at (concat todos-date-string-start todos-date-pattern)) |
3af3cd0b | 1185 | (todos-update-count 'todo 1 cat)) |
0e89c3fc SB |
1186 | ;; If first line is todos-categories list, use it and end loop |
1187 | ;; -- unless FORCEd to scan whole file. | |
1188 | ((bobp) | |
1189 | (unless force | |
1190 | (setq todos-categories (read (buffer-substring-no-properties | |
1191 | (line-beginning-position) | |
1192 | (line-end-position)))) | |
1193 | (goto-char (1- (point-max)))))) | |
1194 | (forward-line))))) | |
1195 | todos-categories) | |
3f031767 | 1196 | |
0e89c3fc SB |
1197 | (defun todos-check-format () |
1198 | "Signal an error if the current Todos file is ill-formatted. | |
1199 | Otherwise return t. The error message gives the line number | |
1200 | where the invalid formatting was found." | |
1201 | (save-excursion | |
1202 | (save-restriction | |
1203 | (widen) | |
1204 | (goto-char (point-min)) | |
1205 | ;; Check for `todos-categories' sexp as the first line | |
7464f422 | 1206 | (let ((cats (prin1-to-string todos-categories))) |
0e89c3fc SB |
1207 | (unless (looking-at (regexp-quote cats)) |
1208 | (error "Invalid or missing todos-categories sexp"))) | |
1209 | (forward-line) | |
1210 | (let ((legit (concat "\\(^" (regexp-quote todos-category-beg) "\\)" | |
1211 | "\\|\\(" todos-date-string-start todos-date-pattern "\\)" | |
1212 | "\\|\\(^[ \t]+[^ \t]*\\)" | |
1213 | "\\|^$" | |
1214 | "\\|\\(^" (regexp-quote todos-category-done) "\\)" | |
1215 | "\\|\\(" todos-done-string-start "\\)"))) | |
1216 | (while (not (eobp)) | |
1217 | (unless (looking-at legit) | |
1218 | (error "Illegitimate Todos file format at line %d" | |
1219 | (line-number-at-pos (point)))) | |
1220 | (forward-line))))) | |
1221 | ;; (message "This Todos file is well-formatted.") | |
1222 | t) | |
d04d6b95 | 1223 | |
0e89c3fc | 1224 | (defun todos-repair-categories-sexp () |
520d912e SB |
1225 | "Repair corrupt Todos categories sexp. |
1226 | This should only be needed as a consequence of careless manual | |
1227 | editing or a bug in todos.el." | |
0e89c3fc | 1228 | (interactive) |
7464f422 | 1229 | (let ((todos-categories (todos-make-categories-list t))) |
0e89c3fc | 1230 | (todos-update-categories-sexp))) |
ee7412e4 | 1231 | |
0e89c3fc SB |
1232 | (defvar todos-item-start (concat "\\(" todos-date-string-start "\\|" |
1233 | todos-done-string-start "\\)" | |
1234 | todos-date-pattern) | |
1235 | "String identifying start of a Todos item.") | |
58c7641d | 1236 | |
0e89c3fc SB |
1237 | (defun todos-item-start () |
1238 | "Move to start of current Todos item and return its position." | |
6be04162 | 1239 | (unless (or ;FIXME: bad comment |
0e89c3fc SB |
1240 | ;; Point is either on last item in this category or on the empty |
1241 | ;; line between done and not done items. | |
1242 | (looking-at "^$") | |
6be04162 | 1243 | ;; FIXME: bad comment, why this sexp? |
0e89c3fc SB |
1244 | ;; There are no done items in this category yet. |
1245 | (looking-at (regexp-quote todos-category-beg))) | |
1246 | (goto-char (line-beginning-position)) | |
1247 | (while (not (looking-at todos-item-start)) | |
1248 | (forward-line -1)) | |
1249 | (point))) | |
d04d6b95 | 1250 | |
0e89c3fc SB |
1251 | (defun todos-item-end () |
1252 | "Move to end of current Todos item and return its position." | |
1253 | ;; Items cannot end with a blank line. | |
1254 | (unless (looking-at "^$") | |
0833689a SB |
1255 | (let* ((done (todos-done-item-p)) |
1256 | (to-lim nil) | |
1257 | ;; For todo items, end is before the done items section, for done | |
1258 | ;; items, end is before the next category. If these limits are | |
1259 | ;; missing or inaccessible, end it before the end of the buffer. | |
1260 | (lim (if (save-excursion | |
1261 | (re-search-forward | |
1262 | (concat "^" (regexp-quote (if done | |
1263 | todos-category-beg | |
1264 | todos-category-done))) | |
1265 | nil t)) | |
1266 | (progn (setq to-lim t) (match-beginning 0)) | |
1267 | (point-max)))) | |
1268 | (when (bolp) (forward-char)) ; Find start of next item. | |
1269 | (goto-char (if (re-search-forward todos-item-start lim t) | |
1270 | (match-beginning 0) | |
1271 | (if to-lim lim (point-max)))) | |
1272 | ;; For last todo item, skip back over the empty line before the done | |
1273 | ;; items section, else just back to the end of the previous line. | |
1274 | (backward-char (when (and to-lim (not done) (eq (point) lim)) 2)) | |
1275 | (point)))) | |
ee7412e4 | 1276 | |
0e89c3fc SB |
1277 | (defun todos-item-string () |
1278 | "Return bare text of current item as a string." | |
1279 | (let ((opoint (point)) | |
1280 | (start (todos-item-start)) | |
1281 | (end (todos-item-end))) | |
1282 | (goto-char opoint) | |
1283 | (and start end (buffer-substring-no-properties start end)))) | |
3f031767 | 1284 | |
0e89c3fc SB |
1285 | (defun todos-remove-item () |
1286 | "Internal function called in editing, deleting or moving items." | |
1287 | (let* ((beg (todos-item-start)) | |
1288 | (end (progn (todos-item-end) (1+ (point)))) | |
1289 | (ovs (overlays-in beg beg))) | |
1290 | ;; There can be both prefix/number and mark overlays. | |
1291 | (while ovs (delete-overlay (car ovs)) (pop ovs)) | |
1292 | (delete-region beg end))) | |
ee7412e4 | 1293 | |
0e89c3fc | 1294 | (defun todos-diary-item-p () |
3af3cd0b | 1295 | "Return non-nil if item at point has diary entry format." |
0e89c3fc SB |
1296 | (save-excursion |
1297 | (todos-item-start) | |
0e89c3fc | 1298 | (not (looking-at (regexp-quote todos-nondiary-start))))) |
58c7641d | 1299 | |
0e89c3fc SB |
1300 | (defun todos-done-item-p () |
1301 | "Return non-nil if item at point is a done item." | |
1302 | (save-excursion | |
1303 | (todos-item-start) | |
1304 | (looking-at todos-done-string-start))) | |
d04d6b95 | 1305 | |
0e89c3fc SB |
1306 | (defvar todos-item-mark (propertize (if (equal todos-prefix "*") "@" "*") |
1307 | 'face 'todos-mark) | |
1308 | "String used to mark items.") | |
2c173503 | 1309 | |
0e89c3fc | 1310 | (defun todos-marked-item-p () |
3af3cd0b | 1311 | "If this item begins with `todos-item-mark', return mark overlay." |
0e89c3fc SB |
1312 | (let ((ovs (overlays-in (line-beginning-position) (line-beginning-position))) |
1313 | (mark todos-item-mark) | |
1314 | ov marked) | |
1315 | (catch 'stop | |
1316 | (while ovs | |
1317 | (setq ov (pop ovs)) | |
1318 | (and (equal (overlay-get ov 'before-string) mark) | |
1319 | (throw 'stop (setq marked t))))) | |
1320 | (when marked ov))) | |
3f031767 | 1321 | |
0e89c3fc SB |
1322 | (defun todos-insert-with-overlays (item) |
1323 | "Insert ITEM at point and update prefix/priority number overlays." | |
1324 | (todos-item-start) | |
1325 | (insert item "\n") | |
1326 | (todos-backward-item) | |
1327 | (todos-prefix-overlays)) | |
2c173503 | 1328 | |
0e89c3fc SB |
1329 | (defun todos-prefix-overlays () |
1330 | "Put before-string overlay in front of this category's items. | |
1331 | The overlay's value is the string `todos-prefix' or with non-nil | |
3af3cd0b SB |
1332 | `todos-number-priorities' an integer in the sequence from 1 to |
1333 | the number of todo or done items in the category indicating the | |
0e89c3fc SB |
1334 | item's priority. Todo and done items are numbered independently |
1335 | of each other." | |
3af3cd0b | 1336 | (when (or todos-number-priorities |
0e89c3fc SB |
1337 | (not (string-match "^[[:space:]]*$" todos-prefix))) |
1338 | (let ((prefix (propertize (concat todos-prefix " ") | |
1339 | 'face 'todos-prefix-string)) | |
1340 | (num 0)) | |
1341 | (save-excursion | |
1342 | (goto-char (point-min)) | |
1343 | (while (not (eobp)) | |
1344 | (when (or (todos-date-string-matcher (line-end-position)) | |
1345 | (todos-done-string-matcher (line-end-position))) | |
1346 | (goto-char (match-beginning 0)) | |
3af3cd0b | 1347 | (when todos-number-priorities |
0e89c3fc SB |
1348 | (setq num (1+ num)) |
1349 | ;; Reset number to 1 for first done item. | |
1350 | (when (and (looking-at todos-done-string-start) | |
1351 | (looking-back (concat "^" | |
1352 | (regexp-quote todos-category-done) | |
1353 | "\n"))) | |
1354 | (setq num 1)) | |
1355 | (setq prefix (propertize (concat (number-to-string num) " ") | |
1356 | 'face 'todos-prefix-string))) | |
1357 | (let ((ovs (overlays-in (point) (point))) | |
1358 | marked ov-pref) | |
1359 | (if ovs | |
1360 | (dolist (ov ovs) | |
1361 | (let ((val (overlay-get ov 'before-string))) | |
1362 | (if (equal val "*") | |
1363 | (setq marked t) | |
1364 | (setq ov-pref val))))) | |
1365 | (unless (equal ov-pref prefix) | |
1366 | ;; Why doesn't this work? | |
1367 | ;; (remove-overlays (point) (point) 'before-string) | |
1368 | (remove-overlays (point) (point)) | |
1369 | (overlay-put (make-overlay (point) (point)) | |
1370 | 'before-string prefix) | |
1371 | (and marked (overlay-put (make-overlay (point) (point)) | |
1372 | 'before-string todos-item-mark))))) | |
1373 | (forward-line)))))) | |
2c173503 | 1374 | |
0e89c3fc SB |
1375 | (defun todos-read-file-name (prompt &optional archive mustmatch) |
1376 | "Choose and return the name of a Todos file, prompting with PROMPT. | |
ee7412e4 | 1377 | |
0e89c3fc SB |
1378 | Show completions with TAB or SPC; the names are shown in short |
1379 | form but the absolute truename is returned. With non-nil ARCHIVE | |
1380 | return the absolute truename of a Todos archive file. With non-nil | |
1381 | MUSTMATCH the name of an existing file must be chosen; | |
1382 | otherwise, a new file name is allowed." | |
459c6e93 SB |
1383 | (let* ((completion-ignore-case todos-completion-ignore-case) |
1384 | (files (mapcar 'todos-short-file-name | |
1385 | (if archive todos-archives todos-files))) | |
1386 | (file (completing-read prompt files nil mustmatch nil nil | |
1387 | (unless files | |
1388 | ;; Trigger prompt for initial file. | |
1389 | "")))) | |
1390 | (unless (file-exists-p todos-files-directory) | |
1391 | (make-directory todos-files-directory)) | |
0e89c3fc | 1392 | (unless mustmatch |
459c6e93 SB |
1393 | (setq file (todos-validate-name file 'file))) |
1394 | (setq file (file-truename (concat todos-files-directory file | |
1395 | (if archive ".toda" ".todo")))))) | |
d04d6b95 | 1396 | |
2a9e69d6 | 1397 | (defun todos-read-category (prompt &optional mustmatch added) |
0e89c3fc SB |
1398 | "Choose and return a category name, prompting with PROMPT. |
1399 | Show completions with TAB or SPC. With non-nil MUSTMATCH the | |
1400 | name must be that of an existing category; otherwise, a new | |
2a9e69d6 SB |
1401 | category name is allowed, after checking its validity. Non-nil |
1402 | argument ADDED means the caller is todos-add-category, so don't | |
1403 | ask whether to add the category." | |
0e89c3fc SB |
1404 | ;; Allow SPC to insert spaces, for adding new category names. |
1405 | (let ((map minibuffer-local-completion-map)) | |
1406 | (define-key map " " nil) | |
1407 | ;; Make a copy of todos-categories in case history-delete-duplicates is | |
1408 | ;; non-nil, which makes completing-read alter todos-categories. | |
7464f422 | 1409 | (let* ((categories (copy-sequence todos-categories)) |
0e89c3fc SB |
1410 | (history (cons 'todos-categories (1+ todos-category-number))) |
1411 | (completion-ignore-case todos-completion-ignore-case) | |
1412 | (cat (completing-read prompt todos-categories nil | |
1413 | mustmatch nil history | |
1414 | ;; Default for existing categories is the | |
1415 | ;; current category. | |
1416 | (if todos-categories | |
1417 | (todos-current-category) | |
459c6e93 | 1418 | ;; Trigger prompt for initial category. |
7464f422 SB |
1419 | "")))) |
1420 | (unless (or mustmatch (assoc cat todos-categories)) | |
2a9e69d6 SB |
1421 | (todos-validate-name cat 'category) |
1422 | (unless added | |
0e89c3fc SB |
1423 | (if (y-or-n-p (format (concat "There is no category \"%s\" in " |
1424 | "this file; add it? ") cat)) | |
7464f422 SB |
1425 | (todos-add-category cat) |
1426 | (keyboard-quit)))) | |
2a9e69d6 SB |
1427 | ;; Restore the original value of todos-categories unless a new category |
1428 | ;; was added (since todos-add-category changes todos-categories). | |
7464f422 | 1429 | (unless added (setq todos-categories categories)) |
0e89c3fc | 1430 | cat))) |
3f031767 | 1431 | |
0e89c3fc SB |
1432 | (defun todos-validate-name (name type) |
1433 | "Prompt for new NAME for TYPE until it is valid, then return it. | |
1434 | TYPE can be either a file or a category" | |
7464f422 SB |
1435 | (let ((categories todos-categories) |
1436 | (files (mapcar 'todos-short-file-name todos-files)) | |
1437 | prompt) | |
0e89c3fc SB |
1438 | (while |
1439 | (and (cond ((string= "" name) | |
1440 | (setq prompt | |
1441 | (cond ((eq type 'file) | |
459c6e93 | 1442 | (if todos-files |
0e89c3fc SB |
1443 | "Enter a non-empty file name: " |
1444 | ;; Empty string passed by todos-show to | |
1445 | ;; prompt for initial Todos file. | |
1446 | (concat "Initial file name [" | |
1447 | todos-initial-file "]: "))) | |
1448 | ((eq type 'category) | |
1449 | (if todos-categories | |
1450 | "Enter a non-empty category name: " | |
1451 | ;; Empty string passed by todos-show to | |
1452 | ;; prompt for initial category of a new | |
1453 | ;; Todos file. | |
1454 | (concat "Initial category name [" | |
1455 | todos-initial-category "]: ")))))) | |
1456 | ((string-match "\\`\\s-+\\'" name) | |
1457 | (setq prompt | |
1458 | "Enter a name that does not contain only white space: ")) | |
1459 | ((and (eq type 'file) (member name todos-files)) | |
1460 | (setq prompt "Enter a non-existing file name: ")) | |
1461 | ((and (eq type 'category) (assoc name todos-categories)) | |
1462 | (setq prompt "Enter a non-existing category name: "))) | |
1463 | (setq name (if (or (and (eq type 'file) todos-files) | |
2a9e69d6 | 1464 | (and (eq type 'category) todos-categories)) |
7464f422 SB |
1465 | (completing-read prompt (cond ((eq type 'file) |
1466 | todos-files) | |
1467 | ((eq type 'category) | |
1468 | todos-categories))) | |
0e89c3fc | 1469 | ;; Offer default initial name. |
7464f422 SB |
1470 | (completing-read prompt (if (eq type 'file) |
1471 | todos-files | |
1472 | todos-categories) | |
1473 | nil nil (if (eq type 'file) | |
1474 | todos-initial-file | |
1475 | todos-initial-category)))))) | |
1476 | name)) | |
0e89c3fc SB |
1477 | |
1478 | ;; Adapted from calendar-read-date and calendar-date-string. | |
1479 | (defun todos-read-date () | |
1480 | "Prompt for Gregorian date and return it in the current format. | |
1481 | Also accepts `*' as an unspecified month, day, or year." | |
1482 | (let* ((year (calendar-read | |
1483 | ;; FIXME: maybe better like monthname with RET for current month | |
1484 | "Year (>0 or * for any year): " | |
1485 | (lambda (x) (or (eq x '*) (> x 0))) | |
1486 | (number-to-string (calendar-extract-year | |
1487 | (calendar-current-date))))) | |
1488 | (month-array (vconcat calendar-month-name-array (vector "*"))) | |
1489 | (abbrevs (vconcat calendar-month-abbrev-array (vector "*"))) | |
1490 | (completion-ignore-case todos-completion-ignore-case) | |
1491 | (monthname (completing-read | |
1492 | "Month name (RET for current month, * for any month): " | |
1493 | (mapcar 'list (append month-array nil)) | |
1494 | nil t nil nil | |
1495 | (calendar-month-name (calendar-extract-month | |
1496 | (calendar-current-date)) t))) | |
1497 | (month (cdr (assoc-string | |
1498 | monthname (calendar-make-alist month-array nil nil | |
1499 | abbrevs)))) | |
1500 | (last (if (= month 13) | |
1501 | 31 ; FIXME: what about shorter months? | |
1502 | (let ((yr (if (eq year '*) | |
1503 | 1999 ; FIXME: no Feb. 29 | |
1504 | year))) | |
1505 | (calendar-last-day-of-month month yr)))) | |
1506 | day dayname) | |
1507 | (while (if (numberp day) (or (< day 0) (< last day)) (not (eq day '*))) | |
1508 | (setq day (read-from-minibuffer | |
1509 | (format "Day (1-%d or RET for today or * for any day): " last) | |
1510 | nil nil t nil | |
1511 | (number-to-string | |
1512 | (calendar-extract-day (calendar-current-date)))))) | |
1513 | (setq year (if (eq year '*) (symbol-name '*) (number-to-string year))) | |
1514 | (setq day (if (eq day '*) (symbol-name '*) (number-to-string day))) | |
1515 | ;; FIXME: make abbreviation customizable | |
1516 | (setq monthname | |
1517 | (or (and (= month 13) "*") | |
1518 | (calendar-month-name (calendar-extract-month (list month day year)) | |
1519 | t))) | |
1520 | (mapconcat 'eval calendar-date-display-form ""))) | |
2c173503 | 1521 | |
0e89c3fc SB |
1522 | (defun todos-read-dayname () |
1523 | "Choose name of a day of the week with completion and return it." | |
1524 | (let ((completion-ignore-case todos-completion-ignore-case)) | |
1525 | (completing-read "Enter a day name: " | |
1526 | (append calendar-day-name-array nil) | |
1527 | nil t))) | |
1528 | ||
1529 | (defun todos-read-time () | |
1530 | "Prompt for and return a valid clock time as a string. | |
58c7641d | 1531 | |
0e89c3fc SB |
1532 | Valid time strings are those matching `diary-time-regexp'. |
1533 | Typing `<return>' at the prompt returns the current time, if the | |
1534 | user option `todos-always-add-time-string' is non-nil, otherwise | |
1535 | the empty string (i.e., no time string)." | |
1536 | (let (valid answer) | |
1537 | (while (not valid) | |
1538 | (setq answer (read-string "Enter a clock time: " nil nil | |
1539 | (when todos-always-add-time-string | |
1540 | (substring (current-time-string) 11 16)))) | |
1541 | (when (or (string= "" answer) | |
1542 | (string-match diary-time-regexp answer)) | |
1543 | (setq valid t))) | |
1544 | answer)) | |
58c7641d | 1545 | |
0e89c3fc SB |
1546 | (defun todos-convert-legacy-date-time () |
1547 | "Return converted date-time string. | |
1548 | Helper function for `todos-convert-legacy-files'." | |
1549 | (let* ((year (match-string 1)) | |
1550 | (month (match-string 2)) | |
1551 | (monthname (calendar-month-name (string-to-number month) t)) | |
1552 | (day (match-string 3)) | |
1553 | (time (match-string 4)) | |
1554 | dayname) | |
1555 | (replace-match "") | |
1556 | (insert (mapconcat 'eval calendar-date-display-form "") | |
1557 | (when time (concat " " time))))) | |
58c7641d | 1558 | |
0e89c3fc SB |
1559 | ;; --------------------------------------------------------------------------- |
1560 | ;;; Item filtering | |
2c173503 | 1561 | |
0e89c3fc | 1562 | (defvar todos-multiple-files nil |
520d912e | 1563 | "List of files selected from `todos-multiple-files' widget.") |
58c7641d | 1564 | |
0e89c3fc SB |
1565 | (defvar todos-multiple-files-widget nil |
1566 | "Variable holding widget created by `todos-multiple-files'.") | |
58c7641d | 1567 | |
0e89c3fc SB |
1568 | (defun todos-multiple-files () |
1569 | "Pop to a buffer with a widget for choosing multiple filter files." | |
1570 | (require 'widget) | |
1571 | (eval-when-compile | |
1572 | (require 'wid-edit)) | |
520d912e SB |
1573 | (with-current-buffer (get-buffer-create "*Todos Filter Files*") |
1574 | (pop-to-buffer (current-buffer)) | |
1575 | (erase-buffer) | |
1576 | (kill-all-local-variables) | |
1577 | (widget-insert "Select files for generating the top priorities list.\n\n") | |
1578 | (setq todos-multiple-files-widget | |
1579 | (widget-create | |
1580 | `(set ,@(mapcar (lambda (x) (list 'const x)) | |
1581 | (mapcar 'todos-short-file-name | |
1582 | (funcall todos-files-function)))))) | |
1583 | (widget-insert "\n") | |
1584 | (widget-create 'push-button | |
1585 | :notify (lambda (widget &rest ignore) | |
1586 | (setq todos-multiple-files 'quit) | |
1587 | (quit-window t) | |
1588 | (exit-recursive-edit)) | |
1589 | "Cancel") | |
1590 | (widget-insert " ") | |
1591 | (widget-create 'push-button | |
1592 | :notify (lambda (&rest ignore) | |
1593 | (setq todos-multiple-files | |
1594 | (mapcar (lambda (f) | |
1595 | (concat todos-files-directory | |
1596 | f ".todo")) | |
1597 | (widget-value | |
1598 | todos-multiple-files-widget))) | |
1599 | (quit-window t) | |
1600 | (exit-recursive-edit)) | |
1601 | "Apply") | |
1602 | (use-local-map widget-keymap) | |
1603 | (widget-setup)) | |
0e89c3fc SB |
1604 | (message "Click \"Apply\" after selecting files.") |
1605 | (recursive-edit)) | |
1606 | ||
0e89c3fc SB |
1607 | (defun todos-filter-items (filter &optional multifile) |
1608 | "Build and display a list of items from different categories. | |
1609 | ||
1610 | The items are selected according to the value of FILTER, which | |
1611 | can be `top' for top priority items, `diary' for diary items, | |
1612 | `regexp' for items matching a regular expresion entered by the | |
520d912e SB |
1613 | user, or a cons cell of one of these symbols and a number set by |
1614 | the calling command, which overrides `todos-show-priorities'. | |
0e89c3fc SB |
1615 | |
1616 | With non-nil argument MULTIFILE list top priorities of multiple | |
1617 | Todos files, by default those in `todos-filter-files'." | |
58c7641d | 1618 | (let ((num (if (consp filter) (cdr filter) todos-show-priorities)) |
0e89c3fc | 1619 | (buf (get-buffer-create todos-filter-buffer)) |
d04d6b95 | 1620 | (files (list todos-current-todos-file)) |
58c7641d | 1621 | regexp fname bufstr cat beg end done) |
0e89c3fc | 1622 | (when multifile |
520d912e SB |
1623 | (setq files (or todos-multiple-files ; Passed from todos-*-multifile. |
1624 | (if (or (consp filter) | |
1625 | (null todos-filter-files)) | |
1626 | (progn (todos-multiple-files) todos-multiple-files) | |
1627 | todos-filter-files)) | |
0e89c3fc SB |
1628 | todos-multiple-files nil)) |
1629 | (if (eq files 'quit) (keyboard-quit)) | |
1630 | (if (null files) | |
1631 | (error "No files have been chosen for filtering") | |
1632 | (with-current-buffer buf | |
1633 | (erase-buffer) | |
1634 | (kill-all-local-variables) | |
1635 | (todos-filter-items-mode)) | |
1636 | (when (eq filter 'regexp) | |
1637 | (setq regexp (read-string "Enter a regular expression: "))) | |
1638 | (save-current-buffer | |
1639 | (dolist (f files) | |
1640 | ;; Before inserting file contents into temp buffer, save a modified | |
1641 | ;; buffer visiting it. | |
1642 | (let ((bf (find-buffer-visiting f))) | |
1643 | (when (buffer-modified-p bf) | |
1644 | (with-current-buffer bf (save-buffer)))) | |
1645 | (setq fname (todos-short-file-name f)) | |
1646 | (with-temp-buffer | |
520d912e SB |
1647 | (when (and todos-filter-done-items (eq filter 'regexp)) |
1648 | ;; If there is a corresponding archive file for the Todos file, | |
1649 | ;; insert it first and add identifiers for todos-jump-to-item. | |
1650 | (let ((arch (concat (file-name-sans-extension f) ".toda"))) | |
1651 | (when (file-exists-p arch) | |
1652 | (insert-file-contents arch) | |
1653 | ;; Delete Todos archive file categories sexp. | |
1654 | (delete-region (line-beginning-position) | |
1655 | (1+ (line-end-position))) | |
1656 | (save-excursion | |
1657 | (while (not (eobp)) | |
1658 | (when (re-search-forward | |
1659 | (concat (if todos-filter-done-items | |
1660 | (concat "\\(?:" todos-done-string-start | |
1661 | "\\|" todos-date-string-start | |
1662 | "\\)") | |
1663 | todos-date-string-start) | |
1664 | todos-date-pattern "\\(?: " | |
1665 | diary-time-regexp "\\)?" | |
1666 | (if todos-filter-done-items | |
1667 | "\\]" | |
1668 | (regexp-quote todos-nondiary-end)) "?") | |
1669 | nil t) | |
1670 | (insert "(archive) ")) | |
1671 | (forward-line)))))) | |
0e89c3fc | 1672 | (insert-file-contents f) |
520d912e SB |
1673 | ;; Delete Todos file categories sexp. |
1674 | (delete-region (line-beginning-position) (1+ (line-end-position))) | |
0e89c3fc SB |
1675 | (let (fnum) |
1676 | ;; Unless the number of items to show was supplied by prefix | |
1677 | ;; argument of caller, override `todos-show-priorities' with the | |
1678 | ;; file-wide value from `todos-priorities-rules'. | |
1679 | (unless (consp filter) | |
1680 | (setq fnum (nth 1 (assoc f todos-priorities-rules)))) | |
0e89c3fc SB |
1681 | (while (re-search-forward |
1682 | (concat "^" (regexp-quote todos-category-beg) "\\(.+\\)\n") | |
1683 | nil t) | |
1684 | (setq cat (match-string 1)) | |
1685 | (let (cnum) | |
1686 | ;; Unless the number of items to show was supplied by prefix | |
1687 | ;; argument of caller, override the file-wide value from | |
1688 | ;; `todos-priorities-rules' if set, else | |
1689 | ;; `todos-show-priorities' with non-nil category-wide value | |
1690 | ;; from `todos-priorities-rules'. | |
1691 | (unless (consp filter) | |
1692 | (let ((cats (nth 2 (assoc f todos-priorities-rules)))) | |
1693 | (setq cnum (or (cdr (assoc cat cats)) | |
1694 | fnum | |
1695 | ;; FIXME: need this? | |
1696 | todos-show-priorities)))) | |
1697 | (delete-region (match-beginning 0) (match-end 0)) | |
520d912e | 1698 | (setq beg (point)) ; First item in the current category. |
0e89c3fc SB |
1699 | (setq end (if (re-search-forward |
1700 | (concat "^" (regexp-quote todos-category-beg)) | |
1701 | nil t) | |
1702 | (match-beginning 0) | |
1703 | (point-max))) | |
1704 | (goto-char beg) | |
1705 | (setq done | |
1706 | (if (re-search-forward | |
1707 | (concat "\n" (regexp-quote todos-category-done)) | |
1708 | end t) | |
1709 | (match-beginning 0) | |
1710 | end)) | |
520d912e SB |
1711 | (unless (and todos-filter-done-items (eq filter 'regexp)) |
1712 | ;; Leave done items. | |
0e89c3fc SB |
1713 | (delete-region done end) |
1714 | (setq end done)) | |
520d912e | 1715 | (narrow-to-region beg end) ; Process only current category. |
0e89c3fc SB |
1716 | (goto-char (point-min)) |
1717 | ;; Apply the filter. | |
1718 | (cond ((eq filter 'diary) | |
1719 | (while (not (eobp)) | |
1720 | (if (looking-at (regexp-quote todos-nondiary-start)) | |
1721 | (todos-remove-item) | |
1722 | (todos-forward-item)))) | |
1723 | ((eq filter 'regexp) | |
1724 | (while (not (eobp)) | |
1725 | (if (looking-at todos-item-start) | |
1726 | (if (string-match regexp (todos-item-string)) | |
1727 | (todos-forward-item) | |
1728 | (todos-remove-item)) | |
1729 | ;; Kill lines that aren't part of a todo or done | |
1730 | ;; item (empty or todos-category-done). | |
1731 | (delete-region (line-beginning-position) | |
1732 | (1+ (line-end-position)))) | |
1733 | ;; If last todo item in file matches regexp and | |
1734 | ;; there are no following done items, | |
1735 | ;; todos-category-done string is left dangling, | |
1736 | ;; because todos-forward-item jumps over it. | |
520d912e SB |
1737 | (if (and (eobp) |
1738 | (looking-back | |
1739 | (concat (regexp-quote todos-done-string) | |
1740 | "\n"))) | |
0e89c3fc SB |
1741 | (delete-region (point) (progn |
1742 | (forward-line -2) | |
1743 | (point)))))) | |
0e89c3fc SB |
1744 | (t ; Filter top priority items. |
1745 | (setq num (or cnum fnum num)) | |
1746 | (unless (zerop num) | |
1747 | (todos-forward-item num)))) | |
1748 | (setq beg (point)) | |
520d912e SB |
1749 | ;; Delete non-top-priority items. |
1750 | (unless (member filter '(diary regexp)) | |
0e89c3fc SB |
1751 | (delete-region beg end)) |
1752 | (goto-char (point-min)) | |
1753 | ;; Add file (if using multiple files) and category tags to | |
1754 | ;; item. | |
1755 | (while (not (eobp)) | |
1756 | (when (re-search-forward | |
520d912e SB |
1757 | (concat (if todos-filter-done-items |
1758 | (concat "\\(?:" todos-done-string-start | |
1759 | "\\|" todos-date-string-start | |
1760 | "\\)") | |
1761 | todos-date-string-start) | |
1762 | todos-date-pattern "\\(?: " diary-time-regexp | |
1763 | "\\)?" (if todos-filter-done-items | |
1764 | "\\]" | |
1765 | (regexp-quote todos-nondiary-end)) | |
1766 | "?") | |
0e89c3fc | 1767 | nil t) |
520d912e SB |
1768 | (insert " [") |
1769 | (when (looking-at "(archive) ") (goto-char (match-end 0))) | |
1770 | (insert (if multifile (concat fname ":") "") cat "]")) | |
0e89c3fc SB |
1771 | (forward-line)) |
1772 | (widen))) | |
1773 | (setq bufstr (buffer-string)) | |
1774 | (with-current-buffer buf | |
1775 | (let (buffer-read-only) | |
1776 | (insert bufstr))))))) | |
0e89c3fc SB |
1777 | (set-window-buffer (selected-window) (set-buffer buf)) |
1778 | (todos-prefix-overlays) | |
520d912e | 1779 | (goto-char (point-min))))) |
0e89c3fc SB |
1780 | |
1781 | (defun todos-set-top-priorities (&optional arg) | |
1782 | "Set number of top priorities shown by `todos-top-priorities'. | |
1783 | With non-nil ARG, set the number only for the current Todos | |
1784 | category; otherwise, set the number for all categories in the | |
1785 | current Todos file. | |
1786 | ||
1787 | Calling this function via either of the commands | |
1788 | `todos-set-top-priorities-in-file' or | |
1789 | `todos-set-top-priorities-in-category' is the recommended way to | |
1790 | set the user customizable option `todos-priorities-rules'." | |
1791 | (let* ((cat (todos-current-category)) | |
1792 | (file todos-current-todos-file) | |
1793 | (rules todos-priorities-rules) | |
1794 | (frule (assoc-string file rules)) | |
1795 | (crule (assoc-string cat (nth 2 frule))) | |
1796 | (cur (or (if arg (cdr crule) (nth 1 frule)) | |
1797 | todos-show-priorities)) | |
1798 | (prompt (concat "Current number of top priorities in this " | |
1799 | (if arg "category" "file") ": %d; " | |
1800 | "enter new number: ")) | |
1801 | (new "-1") | |
1802 | nrule) | |
1803 | (while (or (not (string-match "[0-9]+" new)) ; Don't accept "" or "bla". | |
1804 | (< (string-to-number new) 0)) | |
1805 | (let ((cur0 cur)) | |
1806 | (setq new (read-string (format prompt cur0) nil nil cur0) | |
1807 | prompt "Enter a non-negative number: " | |
1808 | cur0 nil))) | |
1809 | (setq new (string-to-number new)) | |
1810 | (setq nrule (if arg | |
1811 | (append (nth 2 (delete crule frule)) (list (cons cat new))) | |
1812 | (append (list file new) (list (nth 2 frule))))) | |
1813 | (setq rules (cons (if arg | |
1814 | (list file cur nrule) | |
1815 | nrule) | |
1816 | (delete frule rules))) | |
1817 | (customize-save-variable 'todos-priorities-rules rules))) | |
2c173503 | 1818 | |
6be04162 SB |
1819 | (defun todos-special-buffer-name (buffer-type file-list) ;FIXME: rename to `filtered' |
1820 | "Rename Todos special buffer using BUFFER-TYPE and FILE-LIST. | |
1821 | ||
1822 | The new name is constructed from the string BUFFER-TYPE, which | |
1823 | refers to one of the top priorities, diary or regexp item | |
1824 | filters, and the names of the filtered files in FILE-LIST. Used | |
1825 | in Todos Filter Items mode." | |
1826 | (let* ((flist (if (listp file-list) file-list (list file-list))) | |
1827 | (multi (> (length flist) 1)) | |
1828 | (fnames (mapconcat (lambda (f) (todos-short-file-name f)) | |
1829 | flist ", "))) | |
1830 | (rename-buffer (format (concat "%s for file" (if multi "s" "") | |
1831 | " \"%s\"") buffer-type fnames)))) | |
d04d6b95 | 1832 | |
0e89c3fc SB |
1833 | ;; --------------------------------------------------------------------------- |
1834 | ;;; Sorting and display routines for Todos Categories mode. | |
58c7641d | 1835 | |
0e89c3fc SB |
1836 | (defun todos-longest-category-name-length (categories) |
1837 | "Return the length of the longest name in list CATEGORIES." | |
1838 | (let ((longest 0)) | |
1839 | (dolist (c categories longest) | |
1840 | (setq longest (max longest (length c)))))) | |
58c7641d | 1841 | |
0e89c3fc SB |
1842 | (defun todos-padded-string (str) |
1843 | "Return string STR padded with spaces. | |
1844 | The placement of the padding is determined by the value of user | |
1845 | option `todos-categories-align'." | |
1846 | (let* ((categories (mapcar 'car todos-categories)) | |
1847 | (len (max (todos-longest-category-name-length categories) | |
1848 | (length todos-categories-category-label))) | |
1849 | (strlen (length str)) | |
1850 | (strlen-odd (eq (logand strlen 1) 1)) ; oddp from cl.el | |
1851 | (padding (max 0 (/ (- len strlen) 2))) | |
1852 | (padding-left (cond ((eq todos-categories-align 'left) 0) | |
1853 | ((eq todos-categories-align 'center) padding) | |
1854 | ((eq todos-categories-align 'right) | |
1855 | (if strlen-odd (1+ (* padding 2)) (* padding 2))))) | |
1856 | (padding-right (cond ((eq todos-categories-align 'left) | |
1857 | (if strlen-odd (1+ (* padding 2)) (* padding 2))) | |
1858 | ((eq todos-categories-align 'center) | |
1859 | (if strlen-odd (1+ padding) padding)) | |
1860 | ((eq todos-categories-align 'right) 0)))) | |
1861 | (concat (make-string padding-left 32) str (make-string padding-right 32)))) | |
58c7641d | 1862 | |
0e89c3fc SB |
1863 | (defvar todos-descending-counts nil |
1864 | "List of keys for category counts sorted in descending order.") | |
58c7641d | 1865 | |
0e89c3fc SB |
1866 | (defun todos-sort (list &optional key) |
1867 | "Return a copy of LIST, possibly sorted according to KEY." | |
1868 | (let* ((l (copy-sequence list)) | |
1869 | (fn (if (eq key 'alpha) | |
1870 | (lambda (x) (upcase x)) ; Alphabetize case insensitively. | |
1871 | (lambda (x) (todos-get-count key x)))) | |
1872 | (descending (member key todos-descending-counts)) | |
1873 | (cmp (if (eq key 'alpha) | |
1874 | 'string< | |
1875 | (if descending '< '>))) | |
1876 | (pred (lambda (s1 s2) (let ((t1 (funcall fn (car s1))) | |
1877 | (t2 (funcall fn (car s2)))) | |
1878 | (funcall cmp t1 t2))))) | |
1879 | (when key | |
1880 | (setq l (sort l pred)) | |
1881 | (if descending | |
1882 | (setq todos-descending-counts | |
1883 | (delete key todos-descending-counts)) | |
1884 | (push key todos-descending-counts))) | |
1885 | l)) | |
58c7641d | 1886 | |
0e89c3fc SB |
1887 | (defun todos-display-sorted (type) |
1888 | "Keep point on the TYPE count sorting button just clicked." | |
1889 | (let ((opoint (point))) | |
1890 | (todos-update-categories-display type) | |
1891 | (goto-char opoint))) | |
d04d6b95 | 1892 | |
0e89c3fc SB |
1893 | (defun todos-label-to-key (label) |
1894 | "Return symbol for sort key associated with LABEL." | |
1895 | (let (key) | |
1896 | (cond ((string= label todos-categories-category-label) | |
1897 | (setq key 'alpha)) | |
1898 | ((string= label todos-categories-todo-label) | |
1899 | (setq key 'todo)) | |
1900 | ((string= label todos-categories-diary-label) | |
1901 | (setq key 'diary)) | |
1902 | ((string= label todos-categories-done-label) | |
1903 | (setq key 'done)) | |
1904 | ((string= label todos-categories-archived-label) | |
1905 | (setq key 'archived))) | |
1906 | key)) | |
ee7412e4 | 1907 | |
0e89c3fc SB |
1908 | (defun todos-insert-sort-button (label) |
1909 | "Insert button for displaying categories sorted by item counts. | |
1910 | LABEL determines which type of count is sorted." | |
1911 | (setq str (if (string= label todos-categories-category-label) | |
1912 | (todos-padded-string label) | |
1913 | label)) | |
1914 | (setq beg (point)) | |
1915 | (setq end (+ beg (length str))) | |
1916 | (insert-button str 'face nil | |
1917 | 'action | |
1918 | `(lambda (button) | |
1919 | (let ((key (todos-label-to-key ,label))) | |
1920 | (if (and (member key todos-descending-counts) | |
1921 | (eq key 'alpha)) | |
1922 | (progn | |
1923 | ;; If display is alphabetical, switch back to | |
1924 | ;; category order. | |
1925 | (todos-display-sorted nil) | |
1926 | (setq todos-descending-counts | |
1927 | (delete key todos-descending-counts))) | |
1928 | (todos-display-sorted key))))) | |
1929 | (setq ovl (make-overlay beg end)) | |
1930 | (overlay-put ovl 'face 'todos-button)) | |
ee7412e4 | 1931 | |
0e89c3fc SB |
1932 | (defun todos-total-item-counts () |
1933 | "Return a list of total item counts for the current file." | |
1934 | (mapcar (lambda (i) (apply '+ (mapcar (lambda (l) (aref l i)) | |
1935 | (mapcar 'cdr todos-categories)))) | |
1936 | (list 0 1 2 3))) | |
ee7412e4 | 1937 | |
7464f422 SB |
1938 | (defvar todos-categories-category-number 0 |
1939 | "Variable for numbering categories in Todos Categories mode.") | |
459c6e93 | 1940 | |
0e89c3fc | 1941 | (defun todos-insert-category-line (cat &optional nonum) |
459c6e93 | 1942 | "Insert button with category CAT's name and item counts. |
0e89c3fc SB |
1943 | With non-nil argument NONUM show only these; otherwise, insert a |
1944 | number in front of the button indicating the category's priority. | |
1945 | The number and the category name are separated by the string | |
1946 | which is the value of the user option | |
1947 | `todos-categories-number-separator'." | |
459c6e93 | 1948 | (let ((archive (member todos-current-todos-file todos-archives)) |
7464f422 | 1949 | (num todos-categories-category-number) |
0e89c3fc SB |
1950 | (str (todos-padded-string cat)) |
1951 | (opoint (point))) | |
7464f422 | 1952 | (setq num (1+ num) todos-categories-category-number num) |
0e89c3fc SB |
1953 | (insert-button |
1954 | (concat (if nonum | |
1955 | (make-string (+ 4 (length todos-categories-number-separator)) | |
1956 | 32) | |
1957 | (format " %3d%s" num todos-categories-number-separator)) | |
1958 | str | |
1959 | (mapconcat (lambda (elt) | |
1960 | (concat | |
1961 | (make-string (1+ (/ (length (car elt)) 2)) 32) ; label | |
1962 | (format "%3d" (todos-get-count (cdr elt) cat)) ; count | |
1963 | ;; Add an extra space if label length is odd | |
1964 | ;; (using def of oddp from cl.el). | |
1965 | (if (eq (logand (length (car elt)) 1) 1) " "))) | |
1966 | (if archive | |
1967 | (list (cons todos-categories-done-label 'done)) | |
1968 | (list (cons todos-categories-todo-label 'todo) | |
1969 | (cons todos-categories-diary-label 'diary) | |
1970 | (cons todos-categories-done-label 'done) | |
1971 | (cons todos-categories-archived-label | |
1972 | 'archived))) | |
1973 | "")) | |
6be04162 | 1974 | 'face (if (and todos-skip-archived-categories |
0e89c3fc SB |
1975 | (zerop (todos-get-count 'todo cat)) |
1976 | (zerop (todos-get-count 'done cat)) | |
1977 | (not (zerop (todos-get-count 'archived cat)))) | |
1978 | 'todos-archived-only | |
1979 | nil) | |
1980 | 'action `(lambda (button) (let ((buf (current-buffer))) | |
1981 | (todos-jump-to-category ,cat) | |
1982 | (kill-buffer buf)))) | |
1983 | ;; Highlight the sorted count column. | |
1984 | (let* ((beg (+ opoint 6 (length str))) | |
1985 | end ovl) | |
1986 | (cond ((eq nonum 'todo) | |
1987 | (setq beg (+ beg 1 (/ (length todos-categories-todo-label) 2)))) | |
1988 | ((eq nonum 'diary) | |
1989 | (setq beg (+ beg 1 (length todos-categories-todo-label) | |
1990 | 2 (/ (length todos-categories-diary-label) 2)))) | |
1991 | ((eq nonum 'done) | |
1992 | (setq beg (+ beg 1 (length todos-categories-todo-label) | |
1993 | 2 (length todos-categories-diary-label) | |
1994 | 2 (/ (length todos-categories-done-label) 2)))) | |
1995 | ((eq nonum 'archived) | |
1996 | (setq beg (+ beg 1 (length todos-categories-todo-label) | |
1997 | 2 (length todos-categories-diary-label) | |
1998 | 2 (length todos-categories-done-label) | |
1999 | 2 (/ (length todos-categories-archived-label) 2))))) | |
2000 | (unless (= beg (+ opoint 6 (length str))) | |
2001 | (setq end (+ beg 4)) | |
2002 | (setq ovl (make-overlay beg end)) | |
2003 | (overlay-put ovl 'face 'todos-sorted-column))) | |
2004 | (newline))) | |
d04d6b95 | 2005 | |
0e89c3fc SB |
2006 | (defun todos-display-categories-1 () |
2007 | "Prepare buffer for displaying table of categories and item counts." | |
2008 | (unless (eq major-mode 'todos-categories-mode) | |
2009 | (setq todos-global-current-todos-file (or todos-current-todos-file | |
2010 | todos-default-todos-file)) | |
2011 | (set-window-buffer (selected-window) | |
2012 | (set-buffer (get-buffer-create todos-categories-buffer))) | |
2013 | (kill-all-local-variables) | |
2014 | (todos-categories-mode) | |
6be04162 SB |
2015 | (let ((archive (member todos-current-todos-file todos-archives)) |
2016 | buffer-read-only) | |
0e89c3fc SB |
2017 | (erase-buffer) |
2018 | ;; FIXME: add usage tips? | |
6be04162 SB |
2019 | (insert (format (concat "Category counts for Todos " |
2020 | (if archive "archive" "file") | |
2021 | " \"%s\".") | |
0e89c3fc SB |
2022 | (todos-short-file-name todos-current-todos-file))) |
2023 | (newline 2) | |
2024 | ;; Make space for the column of category numbers. | |
2025 | (insert (make-string (+ 4 (length todos-categories-number-separator)) 32)) | |
2026 | ;; Add the category and item count buttons (if this is the list of | |
2027 | ;; categories in an archive, show only done item counts). | |
2028 | (todos-insert-sort-button todos-categories-category-label) | |
6be04162 SB |
2029 | (if archive |
2030 | (progn | |
2031 | (insert (make-string 3 32)) | |
2032 | (todos-insert-sort-button todos-categories-done-label)) | |
0e89c3fc SB |
2033 | (insert (make-string 3 32)) |
2034 | (todos-insert-sort-button todos-categories-todo-label) | |
2035 | (insert (make-string 2 32)) | |
2036 | (todos-insert-sort-button todos-categories-diary-label) | |
2037 | (insert (make-string 2 32)) | |
2038 | (todos-insert-sort-button todos-categories-done-label) | |
2039 | (insert (make-string 2 32)) | |
2040 | (todos-insert-sort-button todos-categories-archived-label)) | |
2041 | (newline 2)))) | |
2042 | ||
2043 | (defun todos-update-categories-display (sortkey) | |
2044 | "" | |
7464f422 | 2045 | (let* ((cats0 todos-categories) |
459c6e93 SB |
2046 | (cats (todos-sort cats0 sortkey)) |
2047 | (archive (member todos-current-todos-file todos-archives)) | |
7464f422 | 2048 | (todos-categories-category-number 0) |
459c6e93 SB |
2049 | ;; Find start of Category button if we just entered Todos Categories |
2050 | ;; mode. | |
2051 | (pt (if (eq (point) (point-max)) | |
2052 | (save-excursion | |
2053 | (forward-line -2) | |
2054 | (goto-char (next-single-char-property-change | |
2055 | (point) 'face nil (line-end-position)))))) | |
2056 | (buffer-read-only)) | |
2057 | (forward-line 2) | |
2058 | (delete-region (point) (point-max)) | |
2059 | ;; Fill in the table with buttonized lines, each showing a category and | |
2060 | ;; its item counts. | |
2061 | (mapc (lambda (cat) (todos-insert-category-line cat sortkey)) | |
2062 | (mapcar 'car cats)) | |
2063 | (newline) | |
2064 | ;; Add a line showing item count totals. | |
2065 | (insert (make-string (+ 4 (length todos-categories-number-separator)) 32) | |
2066 | (todos-padded-string todos-categories-totals-label) | |
2067 | (mapconcat | |
2068 | (lambda (elt) | |
2069 | (concat | |
2070 | (make-string (1+ (/ (length (car elt)) 2)) 32) | |
2071 | (format "%3d" (nth (cdr elt) (todos-total-item-counts))) | |
2072 | ;; Add an extra space if label length is odd (using | |
2073 | ;; definition of oddp from cl.el). | |
2074 | (if (eq (logand (length (car elt)) 1) 1) " "))) | |
2075 | (if archive | |
2076 | (list (cons todos-categories-done-label 2)) | |
2077 | (list (cons todos-categories-todo-label 0) | |
2078 | (cons todos-categories-diary-label 1) | |
2079 | (cons todos-categories-done-label 2) | |
2080 | (cons todos-categories-archived-label 3))) | |
2081 | "")) | |
2082 | ;; Put cursor on Category button initially. | |
2083 | (if pt (goto-char pt)) | |
2084 | (setq buffer-read-only t))) | |
ee7412e4 | 2085 | |
0e89c3fc | 2086 | ;; --------------------------------------------------------------------------- |
6be04162 | 2087 | ;;; Routines for generating Todos insertion commands and key bindings |
ee7412e4 | 2088 | |
0e89c3fc | 2089 | ;; Can either of these be included in Emacs? The originals are GFDL'd. |
7464f422 | 2090 | |
0e89c3fc SB |
2091 | ;; Slightly reformulated from |
2092 | ;; http://rosettacode.org/wiki/Power_set#Common_Lisp. | |
2093 | (defun powerset-recursive (l) | |
2094 | (cond ((null l) | |
2095 | (list nil)) | |
2096 | (t | |
520d912e SB |
2097 | (let ((prev (powerset-recursive (cdr l)))) |
2098 | (append (mapcar (lambda (elt) (cons (car l) elt)) | |
2099 | prev) | |
0e89c3fc | 2100 | prev))))) |
7464f422 | 2101 | |
0e89c3fc SB |
2102 | ;; Elisp implementation of http://rosettacode.org/wiki/Power_set#C |
2103 | (defun powerset-bitwise (l) | |
2104 | (let ((binnum (lsh 1 (length l))) | |
2105 | pset elt) | |
2106 | (dotimes (i binnum) | |
2107 | (let ((bits i) | |
2108 | (ll l)) | |
2109 | (while (not (zerop bits)) | |
2110 | (let ((arg (pop ll))) | |
2111 | (unless (zerop (logand bits 1)) | |
2112 | (setq elt (append elt (list arg)))) | |
2113 | (setq bits (lsh bits -1)))) | |
2114 | (setq pset (append pset (list elt))) | |
2115 | (setq elt nil))) | |
2116 | pset)) | |
2117 | ||
2118 | ;; (defalias 'todos-powerset 'powerset-recursive) | |
2119 | (defalias 'todos-powerset 'powerset-bitwise) | |
ee7412e4 | 2120 | |
0e89c3fc SB |
2121 | ;; Return list of lists of non-nil atoms produced from ARGLIST. The elements |
2122 | ;; of ARGLIST may be atoms or lists. | |
2123 | (defun todos-gen-arglists (arglist) | |
2124 | (let (arglists) | |
2125 | (while arglist | |
2126 | (let ((arg (pop arglist))) | |
2127 | (cond ((symbolp arg) | |
2128 | (setq arglists (if arglists | |
2129 | (mapcar (lambda (l) (push arg l)) arglists) | |
2130 | (list (push arg arglists))))) | |
2131 | ((listp arg) | |
2132 | (setq arglists | |
2133 | (mapcar (lambda (a) | |
2134 | (if (= 1 (length arglists)) | |
2135 | (apply (lambda (l) (push a l)) arglists) | |
2136 | (mapcar (lambda (l) (push a l)) arglists))) | |
2137 | arg)))))) | |
2138 | (setq arglists (mapcar 'reverse (apply 'append (mapc 'car arglists)))))) | |
d04d6b95 | 2139 | |
0e89c3fc SB |
2140 | (defvar todos-insertion-commands-args-genlist |
2141 | '(diary nonmarking (calendar date dayname) time (here region)) | |
2142 | "Generator list for argument lists of Todos insertion commands.") | |
ee7412e4 | 2143 | |
0e89c3fc SB |
2144 | (defvar todos-insertion-commands-args |
2145 | (let ((argslist (todos-gen-arglists todos-insertion-commands-args-genlist)) | |
2146 | res new) | |
2147 | (setq res (remove-duplicates | |
2148 | (apply 'append (mapcar 'todos-powerset argslist)) :test 'equal)) | |
2149 | (dolist (l res) | |
2150 | (unless (= 5 (length l)) | |
2151 | (let ((v (make-vector 5 nil)) elt) | |
2152 | (while l | |
2153 | (setq elt (pop l)) | |
2154 | (cond ((eq elt 'diary) | |
2155 | (aset v 0 elt)) | |
2156 | ((eq elt 'nonmarking) | |
2157 | (aset v 1 elt)) | |
2158 | ((or (eq elt 'calendar) | |
2159 | (eq elt 'date) | |
2160 | (eq elt 'dayname)) | |
2161 | (aset v 2 elt)) | |
2162 | ((eq elt 'time) | |
2163 | (aset v 3 elt)) | |
2164 | ((or (eq elt 'here) | |
2165 | (eq elt 'region)) | |
2166 | (aset v 4 elt)))) | |
2167 | (setq l (append v nil)))) | |
2168 | (setq new (append new (list l)))) | |
2169 | new) | |
2170 | "List of all argument lists for Todos insertion commands.") | |
3f031767 | 2171 | |
0e89c3fc SB |
2172 | (defun todos-insertion-command-name (arglist) |
2173 | "Generate Todos insertion command name from ARGLIST." | |
2174 | (replace-regexp-in-string | |
2175 | "-\\_>" "" | |
2176 | (replace-regexp-in-string | |
2177 | "-+" "-" | |
2178 | (concat "todos-item-insert-" | |
2179 | (mapconcat (lambda (e) (if e (symbol-name e))) arglist "-"))))) | |
d04d6b95 | 2180 | |
0e89c3fc SB |
2181 | (defvar todos-insertion-commands-names |
2182 | (mapcar (lambda (l) | |
2183 | (todos-insertion-command-name l)) | |
2184 | todos-insertion-commands-args) | |
2185 | "List of names of Todos insertion commands.") | |
d04d6b95 | 2186 | |
0e89c3fc SB |
2187 | (defmacro todos-define-insertion-command (&rest args) |
2188 | (let ((name (intern (todos-insertion-command-name args))) | |
2189 | (arg0 (nth 0 args)) | |
2190 | (arg1 (nth 1 args)) | |
2191 | (arg2 (nth 2 args)) | |
2192 | (arg3 (nth 3 args)) | |
2193 | (arg4 (nth 4 args))) | |
2194 | `(defun ,name (&optional arg) | |
3af3cd0b | 2195 | "Todos item insertion command generated from ARGS." |
0e89c3fc SB |
2196 | (interactive) |
2197 | (todos-insert-item arg ',arg0 ',arg1 ',arg2 ',arg3 ',arg4)))) | |
3f031767 | 2198 | |
0e89c3fc SB |
2199 | (defvar todos-insertion-commands |
2200 | (mapcar (lambda (c) | |
2201 | (eval `(todos-define-insertion-command ,@c))) | |
2202 | todos-insertion-commands-args) | |
2203 | "List of Todos insertion commands.") | |
db2c5d34 | 2204 | |
0e89c3fc SB |
2205 | (defvar todos-insertion-commands-arg-key-list |
2206 | '(("diary" "y" "yy") | |
2207 | ("nonmarking" "k" "kk") | |
2208 | ("calendar" "c" "cc") | |
2209 | ("date" "d" "dd") | |
2210 | ("dayname" "n" "nn") | |
2211 | ("time" "t" "tt") | |
2212 | ("here" "h" "h") | |
2213 | ("region" "r" "r")) | |
2214 | "") | |
db2c5d34 | 2215 | |
0e89c3fc SB |
2216 | (defun todos-insertion-key-bindings (map) |
2217 | "" | |
2218 | (dolist (c todos-insertion-commands) | |
2219 | (let* ((key "") | |
2220 | (cname (symbol-name c))) | |
2221 | (mapc (lambda (l) | |
2222 | (let ((arg (nth 0 l)) | |
2223 | (key1 (nth 1 l)) | |
2224 | (key2 (nth 2 l))) | |
2225 | (if (string-match (concat (regexp-quote arg) "\\_>") cname) | |
2226 | (setq key (concat key key2))) | |
2227 | (if (string-match (concat (regexp-quote arg) ".+") cname) | |
2228 | (setq key (concat key key1))))) | |
2229 | todos-insertion-commands-arg-key-list) | |
2230 | (if (string-match (concat (regexp-quote "todos-item-insert") "\\_>") cname) | |
2231 | (setq key (concat key "i"))) | |
2232 | (define-key map key c)))) | |
ee7412e4 | 2233 | |
0e89c3fc SB |
2234 | (defvar todos-insertion-map |
2235 | (let ((map (make-keymap))) | |
2236 | (todos-insertion-key-bindings map) | |
2237 | map) | |
2238 | "Keymap for Todos mode insertion commands.") | |
ee7412e4 | 2239 | |
6be04162 SB |
2240 | ;;; Key maps and menus |
2241 | ||
0e89c3fc SB |
2242 | ;; ??FIXME: use easy-mmode-define-keymap and easy-mmode-defmap |
2243 | (defvar todos-key-bindings | |
2244 | `( | |
2245 | ;; display | |
2246 | ("Cd" . todos-display-categories) ;FIXME: Cs todos-show-categories? | |
2247 | ;("" . todos-display-categories-alphabetically) | |
2248 | ("H" . todos-highlight-item) | |
3af3cd0b | 2249 | ("N" . todos-hide-show-item-numbering) |
78fe7289 SB |
2250 | ("D" . todos-hide-show-date-time) |
2251 | ("*" . todos-mark-unmark-item) | |
0e89c3fc SB |
2252 | ("C*" . todos-mark-category) |
2253 | ("Cu" . todos-unmark-category) | |
2254 | ("PP" . todos-print) | |
2255 | ("PF" . todos-print-to-file) | |
3af3cd0b SB |
2256 | ("v" . todos-hide-show-done-items) |
2257 | ("V" . todos-show-done-only) | |
0e89c3fc SB |
2258 | ("As" . todos-show-archive) |
2259 | ("Ac" . todos-choose-archive) | |
2260 | ("Y" . todos-diary-items) | |
2261 | ;;("" . todos-update-filter-files) | |
2262 | ("Fe" . todos-edit-multiline) | |
2263 | ("Fh" . todos-highlight-item) | |
3af3cd0b | 2264 | ("Fn" . todos-hide-show-item-numbering) |
78fe7289 | 2265 | ("Fd" . todos-hide-show-date-time) |
0e89c3fc SB |
2266 | ("Ftt" . todos-top-priorities) |
2267 | ("Ftm" . todos-top-priorities-multifile) | |
2268 | ("Fts" . todos-set-top-priorities-in-file) | |
2269 | ("Cts" . todos-set-top-priorities-in-category) | |
2270 | ("Fyy" . todos-diary-items) | |
2271 | ("Fym" . todos-diary-items-multifile) | |
2272 | ("Fxx" . todos-regexp-items) | |
2273 | ("Fxm" . todos-regexp-items-multifile) | |
0e89c3fc SB |
2274 | ;;("" . todos-save-top-priorities) |
2275 | ;; navigation | |
2276 | ("f" . todos-forward-category) | |
2277 | ("b" . todos-backward-category) | |
2278 | ("j" . todos-jump-to-category) | |
2279 | ("J" . todos-jump-to-category-other-file) | |
2280 | ("n" . todos-forward-item) | |
2281 | ("p" . todos-backward-item) | |
2282 | ("S" . todos-search) | |
2283 | ("X" . todos-clear-matches) | |
2284 | ;; editing | |
2285 | ("Fa" . todos-add-file) | |
2286 | ("Ca" . todos-add-category) | |
2287 | ("Cr" . todos-rename-category) | |
2288 | ("Cg" . todos-merge-category) | |
2289 | ;;("" . todos-merge-categories) | |
2290 | ("Cm" . todos-move-category) | |
2291 | ("Ck" . todos-delete-category) | |
2292 | ("d" . todos-item-done) | |
2293 | ("ee" . todos-edit-item) | |
2294 | ("em" . todos-edit-multiline-item) | |
2295 | ("eh" . todos-edit-item-header) | |
2296 | ("edd" . todos-edit-item-date) | |
2297 | ("edc" . todos-edit-item-date-from-calendar) | |
2298 | ("edt" . todos-edit-item-date-is-today) | |
2299 | ("et" . todos-edit-item-time) | |
2300 | ("eyy" . todos-edit-item-diary-inclusion) | |
2301 | ;; ("" . todos-edit-category-diary-inclusion) | |
2302 | ("eyn" . todos-edit-item-diary-nonmarking) | |
2303 | ;;("" . todos-edit-category-diary-nonmarking) | |
47011bed | 2304 | ("ec" . todos-done-item-add-or-edit-comment) ;FIXME: or just "c"? |
0e89c3fc | 2305 | ("i" . ,todos-insertion-map) |
7464f422 | 2306 | ("k" . todos-delete-item) ;FIXME: not single letter? |
0e89c3fc SB |
2307 | ("m" . todos-move-item) |
2308 | ("M" . todos-move-item-to-file) | |
2309 | ;; FIXME: This binding prevents `-' from being used in a numerical prefix | |
2310 | ;; argument without typing C-u | |
2311 | ;; ("-" . todos-raise-item-priority) | |
2312 | ("r" . todos-raise-item-priority) | |
2313 | ;; ("+" . todos-lower-item-priority) | |
2314 | ("l" . todos-lower-item-priority) | |
2315 | ("#" . todos-set-item-priority) | |
2316 | ("u" . todos-item-undo) | |
2a9e69d6 | 2317 | ("Ad" . todos-archive-done-item) ;FIXME |
0e89c3fc SB |
2318 | ("AD" . todos-archive-category-done-items) ;FIXME |
2319 | ("Au" . todos-unarchive-items) | |
2320 | ("AU" . todos-unarchive-category) | |
2321 | ("s" . todos-save) | |
2322 | ("q" . todos-quit) | |
2323 | ([remap newline] . newline-and-indent) | |
2324 | ) | |
2325 | "Alist pairing keys defined in Todos modes and their bindings.") | |
2326 | ||
2327 | (defvar todos-mode-map | |
2328 | (let ((map (make-keymap))) | |
2329 | ;; Don't suppress digit keys, so they can supply prefix arguments. | |
2330 | (suppress-keymap map) | |
2331 | (dolist (ck todos-key-bindings) | |
2332 | (define-key map (car ck) (cdr ck))) | |
2333 | map) | |
2334 | "Todos mode keymap.") | |
d04d6b95 | 2335 | |
58c7641d | 2336 | ;; FIXME |
0e89c3fc SB |
2337 | (easy-menu-define |
2338 | todos-menu todos-mode-map "Todos Menu" | |
2339 | '("Todos" | |
2340 | ("Navigation" | |
2341 | ["Next Item" todos-forward-item t] | |
2342 | ["Previous Item" todos-backward-item t] | |
2343 | "---" | |
2344 | ["Next Category" todos-forward-category t] | |
2345 | ["Previous Category" todos-backward-category t] | |
2346 | ["Jump to Category" todos-jump-to-category t] | |
2347 | ["Jump to Category in Other File" todos-jump-to-category-other-file t] | |
2348 | "---" | |
2349 | ["Search Todos File" todos-search t] | |
2350 | ["Clear Highlighting on Search Matches" todos-category-done t]) | |
2351 | ("Display" | |
2352 | ["List Current Categories" todos-display-categories t] | |
2353 | ;; ["List Categories Alphabetically" todos-display-categories-alphabetically t] | |
2354 | ["Turn Item Highlighting on/off" todos-highlight-item t] | |
3af3cd0b | 2355 | ["Turn Item Numbering on/off" todos-hide-show-item-numbering t] |
78fe7289 | 2356 | ["Turn Item Time Stamp on/off" todos-hide-show-date-time t] |
3af3cd0b | 2357 | ["View/Hide Done Items" todos-hide-show-done-items t] |
0e89c3fc SB |
2358 | "---" |
2359 | ["View Diary Items" todos-diary-items t] | |
2360 | ["View Top Priority Items" todos-top-priorities t] | |
2361 | ["View Multifile Top Priority Items" todos-top-priorities-multifile t] | |
2362 | "---" | |
0e89c3fc SB |
2363 | ["Print Category" todos-print t]) |
2364 | ("Editing" | |
2365 | ["Insert New Item" todos-insert-item t] | |
2366 | ["Insert Item Here" todos-insert-item-here t] | |
2367 | ("More Insertion Commands") | |
2368 | ["Edit Item" todos-edit-item t] | |
2369 | ["Edit Multiline Item" todos-edit-multiline t] | |
2370 | ["Edit Item Header" todos-edit-item-header t] | |
2371 | ["Edit Item Date" todos-edit-item-date t] | |
2372 | ["Edit Item Time" todos-edit-item-time t] | |
2373 | "---" | |
2374 | ["Lower Item Priority" todos-lower-item-priority t] | |
2375 | ["Raise Item Priority" todos-raise-item-priority t] | |
2376 | ["Set Item Priority" todos-set-item-priority t] | |
2377 | ["Move (Recategorize) Item" todos-move-item t] | |
2378 | ["Delete Item" todos-delete-item t] | |
2379 | ["Undo Done Item" todos-item-undo t] | |
2380 | ["Mark/Unmark Item for Diary" todos-toggle-item-diary-inclusion t] | |
2381 | ["Mark/Unmark Items for Diary" todos-edit-item-diary-inclusion t] | |
2382 | ["Mark & Hide Done Item" todos-item-done t] | |
2383 | ["Archive Done Items" todos-archive-category-done-items t] | |
2384 | "---" | |
2385 | ["Add New Todos File" todos-add-file t] | |
2386 | ["Add New Category" todos-add-category t] | |
2387 | ["Delete Current Category" todos-delete-category t] | |
2388 | ["Rename Current Category" todos-rename-category t] | |
2389 | "---" | |
2390 | ["Save Todos File" todos-save t] | |
2391 | ["Save Top Priorities" todos-save-top-priorities t]) | |
2392 | "---" | |
2393 | ["Quit" todos-quit t] | |
2394 | )) | |
2395 | ||
2396 | (defvar todos-archive-mode-map | |
2397 | (let ((map (make-sparse-keymap))) | |
2398 | (suppress-keymap map t) | |
2399 | ;; navigation commands | |
2400 | (define-key map "f" 'todos-forward-category) | |
2401 | (define-key map "b" 'todos-backward-category) | |
2402 | (define-key map "j" 'todos-jump-to-category) | |
2403 | (define-key map "n" 'todos-forward-item) | |
2404 | (define-key map "p" 'todos-backward-item) | |
2405 | ;; display commands | |
2406 | (define-key map "C" 'todos-display-categories) | |
2407 | (define-key map "H" 'todos-highlight-item) | |
3af3cd0b | 2408 | (define-key map "N" 'todos-hide-show-item-numbering) |
78fe7289 | 2409 | ;; (define-key map "" 'todos-hide-show-date-time) |
0e89c3fc SB |
2410 | (define-key map "P" 'todos-print) |
2411 | (define-key map "q" 'todos-quit) | |
2412 | (define-key map "s" 'todos-save) | |
2413 | (define-key map "S" 'todos-search) | |
2a9e69d6 | 2414 | (define-key map "t" 'todos-show) |
0e89c3fc SB |
2415 | (define-key map "u" 'todos-unarchive-item) |
2416 | (define-key map "U" 'todos-unarchive-category) | |
2417 | map) | |
2418 | "Todos Archive mode keymap.") | |
2419 | ||
2420 | (defvar todos-edit-mode-map | |
2421 | (let ((map (make-sparse-keymap))) | |
2422 | (define-key map "\C-x\C-q" 'todos-edit-quit) | |
2423 | (define-key map [remap newline] 'newline-and-indent) | |
2424 | map) | |
2425 | "Todos Edit mode keymap.") | |
2426 | ||
2427 | (defvar todos-categories-mode-map | |
2428 | (let ((map (make-sparse-keymap))) | |
2429 | (suppress-keymap map t) | |
2430 | ;; (define-key map "a" 'todos-display-categories-alphabetically) | |
2431 | (define-key map "c" 'todos-display-categories) | |
2a9e69d6 SB |
2432 | (define-key map "l" 'todos-lower-category-priority) |
2433 | (define-key map "+" 'todos-lower-category-priority) | |
2434 | (define-key map "r" 'todos-raise-category-priority) | |
2435 | (define-key map "-" 'todos-raise-category-priority) | |
0e89c3fc SB |
2436 | (define-key map "n" 'forward-button) |
2437 | (define-key map "p" 'backward-button) | |
2438 | (define-key map [tab] 'forward-button) | |
2439 | (define-key map [backtab] 'backward-button) | |
2440 | (define-key map "q" 'todos-quit) | |
2441 | ;; (define-key map "A" 'todos-add-category) | |
2442 | ;; (define-key map "D" 'todos-delete-category) | |
2443 | ;; (define-key map "R" 'todos-rename-category) | |
2444 | map) | |
2445 | "Todos Categories mode keymap.") | |
2446 | ||
2447 | (defvar todos-filter-items-mode-map | |
2448 | (let ((map (make-keymap))) | |
2449 | (suppress-keymap map t) | |
2450 | ;; navigation commands | |
2451 | (define-key map "j" 'todos-jump-to-item) | |
2452 | (define-key map [remap newline] 'todos-jump-to-item) | |
2453 | (define-key map "n" 'todos-forward-item) | |
2454 | (define-key map "p" 'todos-backward-item) | |
2455 | (define-key map "H" 'todos-highlight-item) | |
3af3cd0b | 2456 | (define-key map "N" 'todos-hide-show-item-numbering) |
78fe7289 | 2457 | (define-key map "D" 'todos-hide-show-date-time) |
0e89c3fc SB |
2458 | (define-key map "P" 'todos-print) |
2459 | (define-key map "q" 'todos-quit) | |
2460 | (define-key map "s" 'todos-save) | |
2461 | ;; (define-key map "S" 'todos-save-top-priorities) | |
2462 | ;; editing commands | |
2463 | (define-key map "l" 'todos-lower-item-priority) | |
2464 | (define-key map "r" 'todos-raise-item-priority) | |
2a9e69d6 | 2465 | (define-key map "#" 'todos-set-item-top-priority) |
0e89c3fc SB |
2466 | map) |
2467 | "Todos Top Priorities mode keymap.") | |
2468 | ||
6be04162 SB |
2469 | ;;; Mode definitions |
2470 | ||
0e89c3fc SB |
2471 | (defun todos-modes-set-1 () |
2472 | "" | |
2473 | (set (make-local-variable 'font-lock-defaults) '(todos-font-lock-keywords t)) | |
2474 | (set (make-local-variable 'indent-line-function) 'todos-indent) | |
2475 | (when todos-wrap-lines (funcall todos-line-wrapping-function))) | |
2476 | ||
2477 | (defun todos-modes-set-2 () | |
2478 | "" | |
2479 | (add-to-invisibility-spec 'todos) | |
2480 | (setq buffer-read-only t) | |
2481 | (set (make-local-variable 'hl-line-range-function) | |
2482 | (lambda() (when (todos-item-end) | |
2483 | (cons (todos-item-start) (todos-item-end)))))) | |
2484 | ||
2485 | (defun todos-modes-set-3 () | |
7464f422 | 2486 | ;; FIXME: is this right? |
0e89c3fc SB |
2487 | (set (make-local-variable 'todos-categories) (todos-set-categories)) |
2488 | (set (make-local-variable 'todos-category-number) 1) | |
2489 | (set (make-local-variable 'todos-first-visit) t) | |
6be04162 | 2490 | (add-hook 'find-file-hook 'todos-display-as-todos-file nil t)) |
0e89c3fc SB |
2491 | |
2492 | (put 'todos-mode 'mode-class 'special) | |
2493 | ||
2494 | ;; Autoloading isn't needed if files are identified by auto-mode-alist | |
2495 | ;; ;; As calendar reads included Todos file before todos-mode is loaded. | |
2496 | ;; ;;;###autoload | |
2497 | (define-derived-mode todos-mode special-mode "Todos" () | |
2498 | "Major mode for displaying, navigating and editing Todo lists. | |
2499 | ||
2500 | \\{todos-mode-map}" | |
2501 | (easy-menu-add todos-menu) | |
2502 | (todos-modes-set-1) | |
2503 | (todos-modes-set-2) | |
2504 | (todos-modes-set-3) | |
2505 | ;; Initialize todos-current-todos-file. | |
2506 | (when (member (file-truename (buffer-file-name)) | |
2507 | (funcall todos-files-function)) | |
2508 | (set (make-local-variable 'todos-current-todos-file) | |
2509 | (file-truename (buffer-file-name)))) | |
2510 | (set (make-local-variable 'todos-first-visit) t) | |
2511 | (set (make-local-variable 'todos-show-done-only) nil) | |
2a9e69d6 | 2512 | (set (make-local-variable 'todos-categories-with-marks) nil) |
6be04162 SB |
2513 | (add-hook 'find-file-hook 'todos-add-to-buffer-list nil t) |
2514 | (add-hook 'post-command-hook 'todos-update-buffer-list nil t) | |
0e89c3fc SB |
2515 | (when todos-show-current-file |
2516 | (add-hook 'pre-command-hook 'todos-show-current-file nil t)) | |
2517 | ;; FIXME: works more or less, but should be tied to the defcustom | |
2518 | (add-hook 'window-configuration-change-hook | |
2519 | (lambda () | |
2520 | (setq todos-done-separator (make-string (window-width) ?_))) | |
2521 | nil t) | |
2522 | (add-hook 'kill-buffer-hook 'todos-reset-global-current-todos-file nil t)) | |
2523 | ||
2524 | ;; FIXME: need this? | |
2525 | (defun todos-unload-hook () | |
2526 | "" | |
2527 | (remove-hook 'pre-command-hook 'todos-show-current-file t) | |
6be04162 SB |
2528 | (remove-hook 'post-command-hook 'todos-update-buffer-list t) |
2529 | (remove-hook 'find-file-hook 'todos-display-as-todos-file t) | |
2530 | (remove-hook 'find-file-hook 'todos-add-to-buffer-list t) | |
0e89c3fc SB |
2531 | (remove-hook 'window-configuration-change-hook |
2532 | (lambda () | |
2533 | (setq todos-done-separator | |
2534 | (make-string (window-width) ?_))) t) | |
2535 | (remove-hook 'kill-buffer-hook 'todos-reset-global-current-todos-file t)) | |
2536 | ||
2537 | (put 'todos-archive-mode 'mode-class 'special) | |
2538 | ||
2539 | (define-derived-mode todos-archive-mode todos-mode "Todos-Arch" () | |
2540 | "Major mode for archived Todos categories. | |
2541 | ||
2542 | \\{todos-archive-mode-map}" | |
2543 | (todos-modes-set-1) | |
2544 | (todos-modes-set-2) | |
2545 | (todos-modes-set-3) | |
2546 | (set (make-local-variable 'todos-current-todos-file) | |
2547 | (file-truename (buffer-file-name))) | |
2548 | (set (make-local-variable 'todos-show-done-only) t)) | |
2549 | ||
2550 | (defun todos-mode-external-set () | |
d04d6b95 | 2551 | "" |
0e89c3fc SB |
2552 | (set (make-local-variable 'todos-current-todos-file) |
2553 | todos-global-current-todos-file) | |
6be04162 | 2554 | (let ((cats (with-current-buffer (find-buffer-visiting todos-current-todos-file) |
7464f422 SB |
2555 | ;; FIXME: or just todos-categories? |
2556 | (todos-set-categories)))) | |
0e89c3fc | 2557 | (set (make-local-variable 'todos-categories) cats))) |
d04d6b95 | 2558 | |
0e89c3fc SB |
2559 | (define-derived-mode todos-edit-mode text-mode "Todos-Ed" () |
2560 | "Major mode for editing multiline Todo items. | |
58c7641d | 2561 | |
7464f422 | 2562 | \\{todos-edit-mode-map}" |
0e89c3fc SB |
2563 | (todos-modes-set-1) |
2564 | (todos-mode-external-set)) | |
58c7641d | 2565 | |
0e89c3fc | 2566 | (put 'todos-categories-mode 'mode-class 'special) |
58c7641d | 2567 | |
0e89c3fc SB |
2568 | (define-derived-mode todos-categories-mode special-mode "Todos-Cats" () |
2569 | "Major mode for displaying and editing Todos categories. | |
58c7641d | 2570 | |
0e89c3fc SB |
2571 | \\{todos-categories-mode-map}" |
2572 | (todos-mode-external-set)) | |
58c7641d | 2573 | |
0e89c3fc | 2574 | (put 'todos-filter-mode 'mode-class 'special) |
58c7641d | 2575 | |
0e89c3fc SB |
2576 | (define-derived-mode todos-filter-items-mode special-mode "Todos-Fltr" () |
2577 | "Mode for displaying and reprioritizing top priority Todos. | |
58c7641d | 2578 | |
0e89c3fc SB |
2579 | \\{todos-filter-items-mode-map}" |
2580 | (todos-modes-set-1) | |
2581 | (todos-modes-set-2)) | |
2582 | ||
2583 | ;; FIXME: need this? | |
2584 | (defun todos-save () | |
2585 | "Save the current Todos file." | |
2586 | (interactive) | |
2587 | (save-buffer) | |
2588 | ;; (if todos-save-top-priorities-too (todos-save-top-priorities)) | |
2589 | ) | |
2590 | ||
2591 | (defun todos-quit () | |
2592 | "Exit the current Todos-related buffer. | |
2593 | Depending on the specific mode, this either kills the buffer or | |
2594 | buries it and restores state as needed." | |
2595 | (interactive) | |
2596 | (cond ((eq major-mode 'todos-categories-mode) | |
2597 | (kill-buffer) | |
2598 | (setq todos-descending-counts nil) | |
6be04162 SB |
2599 | ;; FIXME: this jumps to todo file even when todos-display-categories |
2600 | ;; was called from archive | |
0e89c3fc SB |
2601 | (todos-show)) |
2602 | ((eq major-mode 'todos-filter-items-mode) | |
2603 | (kill-buffer) | |
2604 | (todos-show)) | |
2605 | ((member major-mode (list 'todos-mode 'todos-archive-mode)) | |
2606 | ;; Have to write previously nonexistant archives to file. | |
2607 | (unless (file-exists-p (buffer-file-name)) (todos-save)) | |
2a9e69d6 SB |
2608 | ;; FIXME: make this customizable? |
2609 | (todos-save) | |
0e89c3fc SB |
2610 | (bury-buffer)))) |
2611 | ||
2612 | ;; --------------------------------------------------------------------------- | |
2613 | ;;; Display Commands | |
2614 | ||
2615 | ;;;###autoload | |
2616 | (defun todos-show (&optional solicit-file) | |
2617 | "Visit the current Todos file and display one of its categories. | |
2618 | ||
2619 | With non-nil prefix argument SOLICIT-FILE ask for file to visit. | |
2620 | Otherwise, the first invocation of this command in a session | |
2621 | visits `todos-default-todos-file' (creating it if it does not yet | |
2622 | exist); subsequent invocations from outside of Todos mode revisit | |
2623 | this file or, if user option `todos-show-current-file' is | |
2624 | non-nil, whichever Todos file was visited last. | |
2625 | ||
2626 | The category displayed on initial invocation is the first member | |
2627 | of `todos-categories' for the current Todos file, on subsequent | |
2628 | invocations whichever category was displayed last. If | |
2629 | `todos-display-categories-first' is non-nil, then the first | |
2630 | invocation of `todos-show' displays a clickable listing of the | |
2631 | categories in the current Todos file. | |
2632 | ||
2633 | In Todos mode just the category's unfinished todo items are shown | |
2634 | by default. The done items are hidden, but typing | |
3af3cd0b | 2635 | `\\[todos-hide-show-done-items]' displays them below the todo |
0e89c3fc | 2636 | items. With non-nil user option `todos-show-with-done' both todo |
2a9e69d6 SB |
2637 | and done items are always shown on visiting a category. |
2638 | ||
2639 | If this command is invoked in Todos Archive mode, it visits the | |
2640 | corresponding Todos file, displaying the corresponding category." | |
3f031767 | 2641 | (interactive "P") |
2a9e69d6 SB |
2642 | (let* ((cat) |
2643 | (file (cond (solicit-file | |
459c6e93 SB |
2644 | (if (funcall todos-files-function) |
2645 | (todos-read-file-name "Choose a Todos file to visit: " | |
2646 | nil t) | |
2647 | (error "There are no Todos files"))) | |
6be04162 SB |
2648 | ((and (eq major-mode 'todos-archive-mode) |
2649 | ;; Called noninteractively via todos-quit from | |
2650 | ;; Todos Categories mode to return to archive file. | |
2651 | (called-interactively-p 'any)) | |
459c6e93 SB |
2652 | (setq cat (todos-current-category)) |
2653 | (concat (file-name-sans-extension todos-current-todos-file) | |
2654 | ".todo")) | |
2655 | (t | |
2656 | ;; FIXME: If an archive is value of | |
7464f422 | 2657 | ;; todos-current-todos-file, todos-show will revisit it |
459c6e93 SB |
2658 | ;; rather than the corresponding todo file -- ok or make |
2659 | ;; it customizable? | |
2660 | (or todos-current-todos-file | |
2661 | (and todos-show-current-file | |
2662 | todos-global-current-todos-file) | |
2663 | todos-default-todos-file | |
2664 | (todos-add-file)))))) | |
0e89c3fc SB |
2665 | (if (and todos-first-visit todos-display-categories-first) |
2666 | (todos-display-categories) | |
2667 | (set-window-buffer (selected-window) | |
2668 | (set-buffer (find-file-noselect file))) | |
2a9e69d6 SB |
2669 | ;; If called from archive file, show corresponding category in Todos |
2670 | ;; file, if it exists. | |
2671 | (when (assoc cat todos-categories) | |
2672 | (setq todos-category-number (todos-category-number cat))) | |
0e89c3fc | 2673 | ;; If no Todos file exists, initialize one. |
2a9e69d6 SB |
2674 | (when (zerop (buffer-size)) |
2675 | ;; Call with empty category name to get initial prompt. | |
2676 | (setq todos-category-number (todos-add-category ""))) | |
0e89c3fc SB |
2677 | (save-excursion (todos-category-select))) |
2678 | (setq todos-first-visit nil))) | |
d04d6b95 | 2679 | |
0e89c3fc SB |
2680 | (defun todos-display-categories () |
2681 | "Display a table of the current file's categories and item counts. | |
2682 | ||
2683 | In the initial display the categories are numbered, indicating | |
2684 | their current order for navigating by \\[todos-forward-category] | |
2685 | and \\[todos-backward-category]. You can persistantly change the | |
2a9e69d6 SB |
2686 | order of the category at point by typing |
2687 | \\[todos-raise-category-priority] or | |
2688 | \\[todos-lower-category-priority]. | |
0e89c3fc SB |
2689 | |
2690 | The labels above the category names and item counts are buttons, | |
2691 | and clicking these changes the display: sorted by category name | |
2692 | or by the respective item counts (alternately descending or | |
2693 | ascending). In these displays the categories are not numbered | |
2a9e69d6 SB |
2694 | and \\[todos-raise-category-priority] and |
2695 | \\[todos-lower-category-priority] are | |
0e89c3fc SB |
2696 | disabled. (Programmatically, the sorting is triggered by passing |
2697 | a non-nil SORTKEY argument.) | |
2698 | ||
2699 | In addition, the lines with the category names and item counts | |
2700 | are buttonized, and pressing one of these button jumps to the | |
2701 | category in Todos mode (or Todos Archive mode, for categories | |
2702 | containing only archived items, provided user option | |
6be04162 | 2703 | `todos-skip-archived-categories' is non-nil. These categories |
0e89c3fc | 2704 | are shown in `todos-archived-only' face." |
2c173503 | 2705 | (interactive) |
0e89c3fc SB |
2706 | (todos-display-categories-1) |
2707 | (let (sortkey) | |
2708 | (todos-update-categories-display sortkey))) | |
2c173503 | 2709 | |
0e89c3fc SB |
2710 | ;; ;; FIXME: make this toggle with todos-display-categories |
2711 | ;; (defun todos-display-categories-alphabetically () | |
2712 | ;; "" | |
2713 | ;; (interactive) | |
2714 | ;; (todos-display-sorted 'alpha)) | |
3f031767 | 2715 | |
0e89c3fc SB |
2716 | ;; ;; FIXME: provide key bindings for these or delete them |
2717 | ;; (defun todos-display-categories-sorted-by-todo () | |
2718 | ;; "" | |
2719 | ;; (interactive) | |
2720 | ;; (todos-display-sorted 'todo)) | |
58c7641d | 2721 | |
0e89c3fc SB |
2722 | ;; (defun todos-display-categories-sorted-by-diary () |
2723 | ;; "" | |
2724 | ;; (interactive) | |
2725 | ;; (todos-display-sorted 'diary)) | |
58c7641d | 2726 | |
0e89c3fc SB |
2727 | ;; (defun todos-display-categories-sorted-by-done () |
2728 | ;; "" | |
2729 | ;; (interactive) | |
2730 | ;; (todos-display-sorted 'done)) | |
2731 | ||
2732 | ;; (defun todos-display-categories-sorted-by-archived () | |
2733 | ;; "" | |
2734 | ;; (interactive) | |
2735 | ;; (todos-display-sorted 'archived)) | |
2736 | ||
0e89c3fc | 2737 | (defun todos-show-archive (&optional ask) |
3af3cd0b SB |
2738 | "Visit the archive of the current Todos category, if it exists. |
2739 | If the category has no archived items, prompt to visit the | |
2740 | archive anyway. If there is no archive for this file or with | |
2741 | non-nil argument ASK, prompt to visit another archive. | |
2742 | ||
0e89c3fc SB |
2743 | With non-nil argument ASK prompt to choose an archive to visit; |
2744 | see `todos-choose-archive'. The buffer showing the archive is in | |
2745 | Todos Archive mode. The first visit in a session displays the | |
2746 | first category in the archive, subsequent visits return to the | |
3af3cd0b | 2747 | last category displayed." ;FIXME |
0e89c3fc | 2748 | (interactive) |
3af3cd0b SB |
2749 | (let* ((cat (todos-current-category)) |
2750 | (count (todos-get-count 'archived cat)) | |
2751 | (archive (concat (file-name-sans-extension todos-current-todos-file) | |
2752 | ".toda")) | |
47011bed SB |
2753 | place) |
2754 | (setq place (cond (ask 'other-archive) | |
2755 | ((file-exists-p archive) 'this-archive) | |
2756 | (t (when (y-or-n-p (concat "This file has no archive; " | |
2757 | "visit another archive? ")) | |
2758 | 'other-archive)))) | |
2759 | (when (eq place 'other-archive) | |
2760 | (setq archive (todos-read-file-name "Choose a Todos archive: " t t))) | |
2761 | (when (and (eq place 'this-archive) (zerop count)) | |
2762 | (setq place (when (y-or-n-p | |
2763 | (concat "This category has no archived items;" | |
2764 | " visit archive anyway? ")) | |
2765 | 'other-cat))) | |
2766 | (when place | |
3af3cd0b SB |
2767 | (set-window-buffer (selected-window) |
2768 | (set-buffer (find-file-noselect archive))) | |
47011bed SB |
2769 | (if (member place '(other-archive other-cat)) |
2770 | (setq todos-category-number 1) | |
2771 | (todos-category-number cat)) | |
2772 | (todos-category-select)))) | |
58c7641d | 2773 | |
0e89c3fc SB |
2774 | (defun todos-choose-archive () |
2775 | "Choose an archive and visit it." | |
2776 | (interactive) | |
2777 | (todos-show-archive t)) | |
58c7641d | 2778 | |
6be04162 SB |
2779 | (defun todos-hide-show-item-numbering () |
2780 | "" | |
2781 | (interactive) | |
2782 | (todos-reset-prefix 'todos-number-priorities (not todos-number-priorities))) | |
2783 | ||
2784 | (defun todos-hide-show-done-items () | |
2785 | "Show hidden or hide visible done items in current category." | |
2786 | (interactive) | |
2787 | (if (zerop (todos-get-count 'done (todos-current-category))) | |
2788 | (message "There are no done items in this category.") | |
2789 | (save-excursion | |
2790 | (goto-char (point-min)) | |
2791 | (let ((todos-show-with-done (not (re-search-forward | |
2792 | todos-done-string-start nil t)))) | |
2793 | (todos-category-select))))) | |
2794 | ||
2795 | (defun todos-show-done-only () | |
2796 | "Switch between displaying only done or only todo items." | |
2797 | (interactive) | |
2798 | (setq todos-show-done-only (not todos-show-done-only)) | |
2799 | (todos-category-select)) | |
2800 | ||
0e89c3fc SB |
2801 | (defun todos-highlight-item () |
2802 | "Toggle highlighting the todo item the cursor is on." | |
2c173503 | 2803 | (interactive) |
0e89c3fc SB |
2804 | (require 'hl-line) |
2805 | (if hl-line-mode | |
2806 | (hl-line-mode -1) | |
2807 | (hl-line-mode 1))) | |
2808 | ||
78fe7289 | 2809 | (defun todos-hide-show-date-time () ;(&optional all) |
0e89c3fc SB |
2810 | "Hide or show date-time header of todo items.";; in current category. |
2811 | ;; With non-nil prefix argument ALL do this in the whole file." | |
2812 | (interactive "P") | |
2813 | (save-excursion | |
2814 | (save-restriction | |
2815 | (goto-char (point-min)) | |
2816 | (let ((ovs (overlays-in (point) (1+ (point)))) | |
2817 | ov hidden) | |
2818 | (while ovs | |
2819 | (setq ov (pop ovs)) | |
2820 | (if (equal (overlay-get ov 'display) "") | |
2821 | (setq ovs nil hidden t))) | |
2822 | ;; (when all | |
2823 | (widen) | |
2824 | (goto-char (point-min));) | |
2825 | (if hidden | |
2826 | (remove-overlays (point-min) (point-max) 'display "") | |
2827 | (while (not (eobp)) | |
2828 | (when (re-search-forward | |
2829 | (concat todos-date-string-start todos-date-pattern | |
2830 | "\\( " diary-time-regexp "\\)?" | |
2831 | (regexp-quote todos-nondiary-end) "? ") | |
2832 | nil t) | |
2833 | (unless (save-match-data (todos-done-item-p)) | |
2834 | (setq ov (make-overlay (match-beginning 0) (match-end 0) nil t)) | |
2835 | (overlay-put ov 'display ""))) | |
2836 | (todos-forward-item))))))) | |
2837 | ||
78fe7289 | 2838 | (defun todos-mark-unmark-item (&optional n all) |
0e89c3fc SB |
2839 | "Mark item at point if unmarked, or unmark it if marked. |
2840 | ||
2841 | With a positive numerical prefix argument N, change the | |
2842 | markedness of the next N items. With non-nil argument ALL, mark | |
2843 | all visible items in the category (depending on visibility, all | |
2844 | todo and done items, or just todo or just done items). | |
2845 | ||
2846 | The mark is the character \"*\" inserted in front of the item's | |
2847 | priority number or the `todos-prefix' string; if `todos-prefix' | |
2848 | is \"*\", then the mark is \"@\"." | |
2849 | (interactive "p") | |
2850 | (if all (goto-char (point-min))) | |
2851 | (unless (> n 0) (setq n 1)) | |
2852 | (let ((i 0)) | |
2853 | (while (or (and all (not (eobp))) | |
2854 | (< i n)) | |
2855 | (let* ((cat (todos-current-category)) | |
2856 | (ov (todos-marked-item-p)) | |
2857 | (marked (assoc cat todos-categories-with-marks))) | |
2858 | (if (and ov (not all)) | |
2859 | (progn | |
2860 | (delete-overlay ov) | |
2861 | (if (= (cdr marked) 1) ; Deleted last mark in this category. | |
2862 | (setq todos-categories-with-marks | |
2863 | (assq-delete-all cat todos-categories-with-marks)) | |
2864 | (setcdr marked (1- (cdr marked))))) | |
2865 | (when (todos-item-start) | |
2866 | (unless (and all (todos-marked-item-p)) | |
2867 | (setq ov (make-overlay (point) (point))) | |
2868 | (overlay-put ov 'before-string todos-item-mark) | |
2869 | (if marked | |
2870 | (setcdr marked (1+ (cdr marked))) | |
2871 | (push (cons cat 1) todos-categories-with-marks)))))) | |
2872 | (todos-forward-item) | |
2873 | (setq i (1+ i))))) | |
d04d6b95 | 2874 | |
0e89c3fc SB |
2875 | (defun todos-mark-category () |
2876 | "Put the \"*\" mark on all items in this category. | |
2877 | \(If `todos-prefix' is \"*\", then the mark is \"@\".)" | |
d04d6b95 | 2878 | (interactive) |
78fe7289 | 2879 | (todos-mark-unmark-item 0 t)) |
d04d6b95 | 2880 | |
0e89c3fc SB |
2881 | (defun todos-unmark-category () |
2882 | "Remove the \"*\" mark from all items in this category. | |
2883 | \(If `todos-prefix' is \"*\", then the mark is \"@\".)" | |
d04d6b95 | 2884 | (interactive) |
0e89c3fc SB |
2885 | (remove-overlays (point-min) (point-max) 'before-string todos-item-mark) |
2886 | (setq todos-categories-with-marks | |
2887 | (delq (assoc (todos-current-category) todos-categories-with-marks) | |
2888 | todos-categories-with-marks))) | |
2889 | ||
2890 | (defun todos-set-top-priorities-in-file () | |
2891 | "Set number of top priorities for this file. | |
2892 | See `todos-set-top-priorities' for more details." | |
d04d6b95 | 2893 | (interactive) |
0e89c3fc | 2894 | (todos-set-top-priorities)) |
d04d6b95 | 2895 | |
0e89c3fc SB |
2896 | (defun todos-set-top-priorities-in-category () |
2897 | "Set number of top priorities for this category. | |
2898 | See `todos-set-top-priorities' for more details." | |
3f031767 | 2899 | (interactive) |
0e89c3fc | 2900 | (todos-set-top-priorities t)) |
3f031767 | 2901 | |
0e89c3fc SB |
2902 | (defun todos-top-priorities (&optional num) |
2903 | "List top priorities of each category in `todos-filter-files'. | |
2904 | Number of entries for each category is given by NUM, which | |
2905 | defaults to `todos-show-priorities'." | |
2906 | (interactive "P") | |
2907 | (let ((arg (if num (cons 'top num) 'top)) | |
2908 | (buf todos-top-priorities-buffer) | |
2909 | (file todos-current-todos-file)) | |
2910 | (todos-filter-items arg) | |
2911 | (todos-special-buffer-name buf file))) | |
2912 | ||
2913 | (defun todos-top-priorities-multifile (&optional arg) | |
2914 | "List top priorities of each category in `todos-filter-files'. | |
2915 | ||
2916 | If the prefix argument ARG is a number, this is the maximum | |
2917 | number of top priorities to list in each category. If the prefix | |
2918 | argument is `C-u', prompt for which files to filter and use | |
2919 | `todos-show-priorities' as the number of top priorities to list | |
2920 | in each category. If the prefix argument is `C-uC-u', prompt | |
2921 | both for which files to filter and for how many top priorities to | |
2922 | list in each category." | |
2923 | (interactive "P") | |
2924 | (let* ((buf todos-top-priorities-buffer) | |
2925 | files | |
2926 | (pref (if (numberp arg) | |
2927 | (cons 'top arg) | |
2928 | (setq files (if (or (consp arg) | |
2929 | (null todos-filter-files)) | |
520d912e SB |
2930 | (progn (todos-multiple-files) |
2931 | todos-multiple-files) | |
0e89c3fc SB |
2932 | todos-filter-files)) |
2933 | (if (equal arg '(16)) | |
2934 | (cons 'top (read-number | |
2935 | "Enter number of top priorities to show: " | |
2936 | todos-show-priorities)) | |
2937 | 'top)))) | |
2938 | (todos-filter-items pref t) | |
2939 | (todos-special-buffer-name buf files))) | |
2940 | ||
2941 | (defun todos-diary-items () | |
2942 | "Display todo items for diary inclusion in this Todos file." | |
3f031767 | 2943 | (interactive) |
0e89c3fc SB |
2944 | (let ((buf todos-diary-items-buffer) |
2945 | (file todos-current-todos-file)) | |
2946 | (todos-filter-items 'diary) | |
2947 | (todos-special-buffer-name buf file))) | |
58c7641d | 2948 | |
0e89c3fc SB |
2949 | (defun todos-diary-items-multifile (&optional arg) |
2950 | "Display todo items for diary inclusion in one or more Todos file. | |
2951 | The files are those listed in `todos-filter-files'." | |
2952 | (interactive "P") | |
2953 | (let ((buf todos-diary-items-buffer) | |
2954 | (files (if (or arg (null todos-filter-files)) | |
520d912e SB |
2955 | (progn (todos-multiple-files) |
2956 | todos-multiple-files) | |
0e89c3fc SB |
2957 | todos-filter-files))) |
2958 | (todos-filter-items 'diary t) | |
2959 | (todos-special-buffer-name buf files))) | |
d04d6b95 | 2960 | |
0e89c3fc SB |
2961 | (defun todos-regexp-items () |
2962 | "Display todo items matching a user-entered regular expression. | |
2963 | The items are those in the current Todos file." | |
2964 | (interactive) | |
2965 | (let ((buf todos-regexp-items-buffer) | |
2966 | (file todos-current-todos-file)) | |
2967 | (todos-filter-items 'regexp) | |
2968 | (todos-special-buffer-name buf file))) | |
db2c5d34 | 2969 | |
0e89c3fc SB |
2970 | (defun todos-regexp-items-multifile (&optional arg) |
2971 | "Display todo items matching a user-entered regular expression. | |
2972 | The items are those in the files listed in `todos-filter-files'." | |
2973 | (interactive "P") | |
2974 | (let ((buf todos-regexp-items-buffer) | |
2975 | (files (if (or arg (null todos-filter-files)) | |
520d912e SB |
2976 | (progn (todos-multiple-files) |
2977 | todos-multiple-files) | |
0e89c3fc SB |
2978 | todos-filter-files))) |
2979 | (todos-filter-items 'regexp t) | |
2980 | (todos-special-buffer-name buf files))) | |
d04d6b95 | 2981 | |
0e89c3fc SB |
2982 | (defun todos-print (&optional to-file) |
2983 | "Produce a printable version of the current Todos buffer. | |
2984 | This converts overlays and soft line wrapping and, depending on | |
2985 | the value of `todos-print-function', includes faces. With | |
2986 | non-nil argument TO-FILE write the printable version to a file; | |
2987 | otherwise, send it to the default printer." | |
db2c5d34 | 2988 | (interactive) |
0e89c3fc SB |
2989 | (let ((buf todos-print-buffer) |
2990 | (header (cond | |
2991 | ((eq major-mode 'todos-mode) | |
2992 | (concat "Todos File: " | |
2993 | (todos-short-file-name todos-current-todos-file) | |
2994 | "\nCategory: " (todos-current-category))) | |
2995 | ((eq major-mode 'todos-filter-items-mode) | |
2996 | "Todos Top Priorities"))) | |
2997 | (prefix (propertize (concat todos-prefix " ") | |
2998 | 'face 'todos-prefix-string)) | |
2999 | (num 0) | |
3000 | (fill-prefix (make-string todos-indent-to-here 32)) | |
3001 | (content (buffer-string)) | |
3002 | file) | |
3003 | (with-current-buffer (get-buffer-create buf) | |
3004 | (insert content) | |
3005 | (goto-char (point-min)) | |
3006 | (while (not (eobp)) | |
3007 | (let ((beg (point)) | |
3008 | (end (save-excursion (todos-item-end)))) | |
3af3cd0b | 3009 | (when todos-number-priorities |
0e89c3fc SB |
3010 | (setq num (1+ num)) |
3011 | (setq prefix (propertize (concat (number-to-string num) " ") | |
3012 | 'face 'todos-prefix-string))) | |
3013 | (insert prefix) | |
3014 | (fill-region beg end)) | |
3015 | ;; Calling todos-forward-item infloops at todos-item-start due to | |
3016 | ;; non-overlay prefix, so search for item start instead. | |
3017 | (if (re-search-forward todos-item-start nil t) | |
3018 | (beginning-of-line) | |
3019 | (goto-char (point-max)))) | |
3020 | (if (re-search-backward (concat "^" (regexp-quote todos-category-done)) | |
3021 | nil t) | |
3022 | (replace-match todos-done-separator)) | |
3023 | (goto-char (point-min)) | |
3024 | (insert header) | |
3025 | (newline 2) | |
3026 | (if to-file | |
3027 | (let ((file (read-file-name "Print to file: "))) | |
3028 | (funcall todos-print-function file)) | |
3029 | (funcall todos-print-function))) | |
3030 | (kill-buffer buf))) | |
2c173503 | 3031 | |
0e89c3fc SB |
3032 | (defun todos-print-to-file () |
3033 | "Save printable version of this Todos buffer to a file." | |
d04d6b95 | 3034 | (interactive) |
0e89c3fc | 3035 | (todos-print t)) |
d04d6b95 | 3036 | |
0e89c3fc SB |
3037 | (defun todos-convert-legacy-files () |
3038 | "Convert legacy Todo files to the current Todos format. | |
3039 | The files `todo-file-do' and `todo-file-done' are converted and | |
3040 | saved (the latter as a Todos Archive file) with a new name in | |
3041 | `todos-files-directory'. See also the documentation string of | |
3042 | `todos-todo-mode-date-time-regexp' for further details." | |
3043 | (interactive) | |
3044 | (if (fboundp 'todo-mode) | |
3045 | (require 'todo-mode) | |
3046 | (error "Void function `todo-mode'")) | |
3047 | ;; Convert `todo-file-do'. | |
3048 | (if (file-exists-p todo-file-do) | |
3049 | (let ((default "todo-do-conv") | |
3050 | file archive-sexp) | |
3051 | (with-temp-buffer | |
3052 | (insert-file-contents todo-file-do) | |
3053 | (let ((end (search-forward ")" (line-end-position) t)) | |
3054 | (beg (search-backward "(" (line-beginning-position) t))) | |
3055 | (setq todo-categories | |
3056 | (read (buffer-substring-no-properties beg end)))) | |
3057 | (todo-mode) | |
3058 | (delete-region (line-beginning-position) (1+ (line-end-position))) | |
3059 | (while (not (eobp)) | |
3060 | (cond | |
3061 | ((looking-at (regexp-quote (concat todo-prefix todo-category-beg))) | |
3062 | (replace-match todos-category-beg)) | |
3063 | ((looking-at (regexp-quote todo-category-end)) | |
3064 | (replace-match "")) | |
3065 | ((looking-at (regexp-quote (concat todo-prefix " " | |
3066 | todo-category-sep))) | |
3067 | (replace-match todos-category-done)) | |
3068 | ((looking-at (concat (regexp-quote todo-prefix) " " | |
3069 | todos-todo-mode-date-time-regexp " " | |
3070 | (regexp-quote todo-initials) ":")) | |
3071 | (todos-convert-legacy-date-time))) | |
3072 | (forward-line)) | |
3073 | (setq file (concat todos-files-directory | |
3074 | (read-string | |
3075 | (format "Save file as (default \"%s\"): " default) | |
3076 | nil nil default) | |
3077 | ".todo")) | |
3078 | (write-region (point-min) (point-max) file nil 'nomessage nil t)) | |
3079 | (with-temp-buffer | |
3080 | (insert-file-contents file) | |
3081 | (let ((todos-categories (todos-make-categories-list t))) | |
3082 | (todos-update-categories-sexp)) | |
3083 | (write-region (point-min) (point-max) file nil 'nomessage)) | |
3084 | ;; Convert `todo-file-done'. | |
3085 | (when (file-exists-p todo-file-done) | |
3086 | (with-temp-buffer | |
3087 | (insert-file-contents todo-file-done) | |
3088 | (let ((beg (make-marker)) | |
3089 | (end (make-marker)) | |
3090 | cat cats comment item) | |
3091 | (while (not (eobp)) | |
3092 | (when (looking-at todos-todo-mode-date-time-regexp) | |
3093 | (set-marker beg (point)) | |
3094 | (todos-convert-legacy-date-time) | |
3095 | (set-marker end (point)) | |
3096 | (goto-char beg) | |
3097 | (insert "[" todos-done-string) | |
3098 | (goto-char end) | |
3099 | (insert "]") | |
3100 | (forward-char) | |
3101 | (when (looking-at todos-todo-mode-date-time-regexp) | |
3102 | (todos-convert-legacy-date-time)) | |
3103 | (when (looking-at (concat " " (regexp-quote todo-initials) ":")) | |
3104 | (replace-match ""))) | |
3105 | (if (re-search-forward | |
3106 | (concat "^" todos-todo-mode-date-time-regexp) nil t) | |
3107 | (goto-char (match-beginning 0)) | |
3108 | (goto-char (point-max))) | |
3109 | (backward-char) | |
3110 | (when (looking-back "\\[\\([^][]+\\)\\]") | |
3111 | (setq cat (match-string 1)) | |
3112 | (goto-char (match-beginning 0)) | |
3113 | (replace-match "")) | |
3114 | ;; If the item ends with a non-comment parenthesis not | |
3115 | ;; followed by a period, we lose (but we inherit that problem | |
3116 | ;; from todo-mode.el). | |
3117 | (when (looking-back "(\\(.*\\)) ") | |
3118 | (setq comment (match-string 1)) | |
3119 | (replace-match "") | |
3120 | (insert "[" todos-comment-string ": " comment "]")) | |
3121 | (set-marker end (point)) | |
3122 | (if (member cat cats) | |
3123 | ;; If item is already in its category, leave it there. | |
3124 | (unless (save-excursion | |
3125 | (re-search-backward | |
3126 | (concat "^" (regexp-quote todos-category-beg) | |
3127 | "\\(.*\\)$") nil t) | |
3128 | (string= (match-string 1) cat)) | |
3129 | ;; Else move it to its category. | |
3130 | (setq item (buffer-substring-no-properties beg end)) | |
3131 | (delete-region beg (1+ end)) | |
3132 | (set-marker beg (point)) | |
3133 | (re-search-backward | |
3134 | (concat "^" (regexp-quote (concat todos-category-beg cat))) | |
3135 | nil t) | |
3136 | (forward-line) | |
3137 | (if (re-search-forward | |
3138 | (concat "^" (regexp-quote todos-category-beg) | |
3139 | "\\(.*\\)$") nil t) | |
3140 | (progn (goto-char (match-beginning 0)) | |
3141 | (newline) | |
3142 | (forward-line -1)) | |
3143 | (goto-char (point-max))) | |
3144 | (insert item "\n") | |
3145 | (goto-char beg)) | |
3146 | (push cat cats) | |
3147 | (goto-char beg) | |
3148 | (insert todos-category-beg cat "\n\n" todos-category-done "\n")) | |
3149 | (forward-line)) | |
3150 | (set-marker beg nil) | |
3151 | (set-marker end nil)) | |
3152 | (setq file (concat (file-name-sans-extension file) ".toda")) | |
3153 | (write-region (point-min) (point-max) file nil 'nomessage nil t)) | |
3154 | (with-temp-buffer | |
3155 | (insert-file-contents file) | |
3156 | (let ((todos-categories (todos-make-categories-list t))) | |
3157 | (todos-update-categories-sexp)) | |
3158 | (write-region (point-min) (point-max) file nil 'nomessage) | |
3159 | (setq archive-sexp (read (buffer-substring-no-properties | |
3160 | (line-beginning-position) | |
3161 | (line-end-position))))) | |
3162 | (setq file (concat (file-name-sans-extension file) ".todo")) | |
3163 | ;; Update categories sexp of converted Todos file again, adding | |
3164 | ;; counts of archived items. | |
3165 | (with-temp-buffer | |
3166 | (insert-file-contents file) | |
3167 | (let ((sexp (read (buffer-substring-no-properties | |
3168 | (line-beginning-position) | |
3169 | (line-end-position))))) | |
3170 | (dolist (cat sexp) | |
3171 | (let ((archive-cat (assoc (car cat) archive-sexp))) | |
3172 | (if archive-cat | |
3173 | (aset (cdr cat) 3 (aref (cdr archive-cat) 2))))) | |
3174 | (delete-region (line-beginning-position) (line-end-position)) | |
3175 | (prin1 sexp (current-buffer))) | |
3176 | (write-region (point-min) (point-max) file nil 'nomessage))) | |
3177 | (todos-reevaluate-defcustoms) | |
3178 | (message "Format conversion done.")) | |
3179 | (error "No legacy Todo file exists"))) | |
2c173503 | 3180 | |
0e89c3fc SB |
3181 | ;; --------------------------------------------------------------------------- |
3182 | ;;; Navigation Commands | |
3183 | ||
3184 | (defun todos-forward-category (&optional back) | |
3185 | "Visit the numerically next category in this Todos file. | |
3186 | If the current category is the highest numbered, visit the first | |
3187 | category. With non-nil argument BACK, visit the numerically | |
3188 | previous category (the highest numbered one, if the current | |
3189 | category is the first)." | |
58c7641d | 3190 | (interactive) |
0e89c3fc SB |
3191 | (setq todos-category-number |
3192 | (1+ (mod (- todos-category-number (if back 2 0)) | |
3193 | (length todos-categories)))) | |
6be04162 | 3194 | (when todos-skip-archived-categories |
7464f422 SB |
3195 | (while (and (zerop (todos-get-count 'todo)) |
3196 | (zerop (todos-get-count 'done)) | |
3197 | (not (zerop (todos-get-count 'archive)))) | |
3198 | (setq todos-category-number | |
3199 | (apply (if back '1- '1+) (list todos-category-number))))) | |
0e89c3fc SB |
3200 | (todos-category-select) |
3201 | (goto-char (point-min))) | |
58c7641d | 3202 | |
0e89c3fc SB |
3203 | (defun todos-backward-category () |
3204 | "Visit the numerically previous category in this Todos file. | |
3205 | If the current category is the highest numbered, visit the first | |
3206 | category." | |
3207 | (interactive) | |
3208 | (todos-forward-category t)) | |
58c7641d | 3209 | |
0e89c3fc SB |
3210 | (defun todos-jump-to-category (&optional cat other-file) |
3211 | "Jump to a category in this or another Todos file. | |
3212 | ||
3213 | Programmatically, optional argument CAT provides the category | |
3214 | name. When nil (as in interactive calls), prompt for the | |
3215 | category, with TAB completion on existing categories. If a | |
3216 | non-existing category name is entered, ask whether to add a new | |
3217 | category with this name; if affirmed, add it, then jump to that | |
3218 | category. With non-nil argument OTHER-FILE, prompt for a Todos | |
3219 | file, otherwise jump within the current Todos file." | |
2c173503 | 3220 | (interactive) |
0e89c3fc SB |
3221 | (let ((file (or (and other-file |
3222 | (todos-read-file-name "Choose a Todos file: " nil t)) | |
520d912e SB |
3223 | ;; Jump to archived-only Categories from Todos Categories |
3224 | ;; mode. | |
0e89c3fc | 3225 | (and cat |
6be04162 | 3226 | todos-skip-archived-categories |
0e89c3fc SB |
3227 | (zerop (todos-get-count 'todo cat)) |
3228 | (zerop (todos-get-count 'done cat)) | |
3229 | (not (zerop (todos-get-count 'archived cat))) | |
3230 | (concat (file-name-sans-extension | |
3231 | todos-current-todos-file) ".toda")) | |
3232 | todos-current-todos-file | |
520d912e SB |
3233 | ;; If invoked from outside of Todos mode before |
3234 | ;; todos-show... | |
0e89c3fc | 3235 | todos-default-todos-file))) |
520d912e SB |
3236 | (with-current-buffer (find-file-noselect file) |
3237 | (and other-file (setq todos-current-todos-file file)) | |
3238 | (let ((category (or (and (assoc cat todos-categories) cat) | |
3239 | (todos-read-category "Jump to category: ")))) | |
3240 | ;; Clean up after selecting category in Todos Categories mode. | |
3241 | (if (string= (buffer-name) todos-categories-buffer) | |
3242 | (kill-buffer)) | |
3243 | (if (or cat other-file) | |
3244 | (set-window-buffer (selected-window) | |
6be04162 | 3245 | (set-buffer (find-buffer-visiting file)))) |
520d912e SB |
3246 | (unless todos-global-current-todos-file |
3247 | (setq todos-global-current-todos-file todos-current-todos-file)) | |
2a9e69d6 SB |
3248 | (todos-category-number category) ; (1+ (length t-c)) if new category. |
3249 | ;; (if (> todos-category-number (length todos-categories)) | |
3250 | ;; (setq todos-category-number (todos-add-category category))) | |
520d912e SB |
3251 | (todos-category-select) |
3252 | (goto-char (point-min)))))) | |
58c7641d | 3253 | |
0e89c3fc SB |
3254 | (defun todos-jump-to-category-other-file () |
3255 | "Jump to a category in another Todos file. | |
3256 | The category is chosen by prompt, with TAB completion." | |
3257 | (interactive) | |
3258 | (todos-jump-to-category nil t)) | |
58c7641d | 3259 | |
0e89c3fc SB |
3260 | (defun todos-jump-to-item () |
3261 | "Jump to the file and category of the filtered item at point." | |
d04d6b95 | 3262 | (interactive) |
0e89c3fc SB |
3263 | (let ((str (todos-item-string)) |
3264 | (buf (current-buffer)) | |
520d912e SB |
3265 | cat file archive beg) |
3266 | (string-match (concat (if todos-filter-done-items | |
3267 | (concat "\\(?:" todos-done-string-start "\\|" | |
3268 | todos-date-string-start "\\)") | |
3269 | todos-date-string-start) | |
3270 | todos-date-pattern "\\(?: " diary-time-regexp "\\)?" | |
3271 | (if todos-filter-done-items | |
3272 | "\\]" | |
3273 | (regexp-quote todos-nondiary-end)) "?" | |
3274 | "\\(?4: \\[\\(?3:(archive) \\)?\\(?2:.*:\\)?" | |
3275 | "\\(?1:.*\\)\\]\\).*$") str) | |
0e89c3fc SB |
3276 | (setq cat (match-string 1 str)) |
3277 | (setq file (match-string 2 str)) | |
520d912e SB |
3278 | (setq archive (string= (match-string 3 str) "(archive) ")) |
3279 | (setq str (replace-match "" nil nil str 4)) | |
0e89c3fc | 3280 | (setq file (if file |
520d912e SB |
3281 | (concat todos-files-directory (substring file 0 -1) |
3282 | (if archive ".toda" ".todo")) | |
3283 | (if archive | |
3284 | (concat (file-name-sans-extension | |
3285 | todos-global-current-todos-file) ".toda") | |
3286 | todos-global-current-todos-file))) | |
0e89c3fc | 3287 | (find-file-noselect file) |
6be04162 | 3288 | (with-current-buffer (find-buffer-visiting file) |
0e89c3fc SB |
3289 | (widen) |
3290 | (goto-char (point-min)) | |
3291 | (re-search-forward | |
3292 | (concat "^" (regexp-quote (concat todos-category-beg cat))) nil t) | |
3293 | (search-forward str) | |
3294 | (setq beg (match-beginning 0))) | |
3295 | (kill-buffer buf) | |
6be04162 | 3296 | (set-window-buffer (selected-window) (set-buffer (find-buffer-visiting file))) |
0e89c3fc SB |
3297 | (setq todos-current-todos-file file) |
3298 | (setq todos-category-number (todos-category-number cat)) | |
520d912e SB |
3299 | (let ((todos-show-with-done (if todos-filter-done-items t |
3300 | todos-show-with-done))) | |
3301 | (todos-category-select)) | |
0e89c3fc SB |
3302 | (goto-char beg))) |
3303 | ||
3304 | ;; FIXME ? disallow prefix arg value < 1 (re-search-* allows these) | |
3305 | (defun todos-forward-item (&optional count) | |
3306 | "Move point down to start of item with next lower priority. | |
3307 | With numerical prefix COUNT, move point COUNT items downward," | |
3308 | (interactive "P") | |
3309 | (let* ((not-done (not (or (todos-done-item-p) (looking-at "^$")))) | |
3310 | (start (line-end-position))) | |
3311 | (goto-char start) | |
3312 | (if (re-search-forward todos-item-start nil t (or count 1)) | |
3313 | (goto-char (match-beginning 0)) | |
3314 | (goto-char (point-max))) | |
3315 | ;; If points advances by one from a todo to a done item, go back to the | |
3316 | ;; space above todos-done-separator, since that is a legitimate place to | |
3317 | ;; insert an item. But skip this space if count > 1, since that should | |
3318 | ;; only stop on an item (FIXME: or not?) | |
3319 | (when (and not-done (todos-done-item-p)) | |
3320 | (if (or (not count) (= count 1)) | |
0833689a SB |
3321 | (re-search-backward "^$" start t))))) |
3322 | ;; FIXME: The preceding sexp is insufficient when buffer is not narrowed, | |
3323 | ;; since there could be no done items in this category, so the search puts | |
3324 | ;; us on first todo item of next category. Does this ever happen? If so: | |
3325 | ;; (let ((opoint) (point)) | |
3326 | ;; (forward-line -1) | |
3327 | ;; (when (or (not count) (= count 1)) | |
3328 | ;; (cond ((looking-at (concat "^" (regexp-quote todos-category-beg))) | |
3329 | ;; (forward-line -2)) | |
3330 | ;; ((looking-at (concat "^" (regexp-quote todos-category-done))) | |
3331 | ;; (forward-line -1)) | |
3332 | ;; (t | |
3333 | ;; (goto-char opoint))))))) | |
58c7641d | 3334 | |
0e89c3fc SB |
3335 | (defun todos-backward-item (&optional count) |
3336 | "Move point up to start of item with next higher priority. | |
3337 | With numerical prefix COUNT, move point COUNT items upward," | |
3338 | (interactive "P") | |
3339 | (let* ((done (todos-done-item-p))) | |
3340 | ;; FIXME ? this moves to bob if on the first item (but so does previous-line) | |
3341 | (todos-item-start) | |
3342 | (unless (bobp) | |
3343 | (re-search-backward todos-item-start nil t (or count 1))) | |
78fe7289 SB |
3344 | ;; Unless this is a regexp filtered items buffer (which can contain |
3345 | ;; intermixed todo and done items), if points advances by one from a done | |
3346 | ;; to a todo item, go back to the space above todos-done-separator, since | |
3347 | ;; that is a legitimate place to insert an item. But skip this space if | |
3348 | ;; count > 1, since that should only stop on an item (FIXME: or not?) | |
3349 | (when (and done (not (todos-done-item-p)) (or (not count) (= count 1)) | |
3350 | (not (equal (buffer-name) todos-regexp-items-buffer))) | |
3351 | (re-search-forward (concat "^" (regexp-quote todos-category-done)) nil t) | |
3352 | (forward-line -1)))) | |
0e89c3fc SB |
3353 | |
3354 | ;; FIXME: (i) Extend search to other Todos files. (ii) Allow navigating among | |
2a9e69d6 SB |
3355 | ;; hits. (But these are available in another form with |
3356 | ;; todos-regexp-items-multifile.) | |
0e89c3fc SB |
3357 | (defun todos-search () |
3358 | "Search for a regular expression in this Todos file. | |
3359 | The search runs through the whole file and encompasses all and | |
3360 | only todo and done items; it excludes category names. Multiple | |
3361 | matches are shown sequentially, highlighted in `todos-search' | |
3362 | face." | |
58c7641d | 3363 | (interactive) |
0e89c3fc SB |
3364 | (let ((regex (read-from-minibuffer "Enter a search string (regexp): ")) |
3365 | (opoint (point)) | |
3366 | matches match cat in-done ov mlen msg) | |
3367 | (widen) | |
3368 | (goto-char (point-min)) | |
3369 | (while (not (eobp)) | |
3370 | (setq match (re-search-forward regex nil t)) | |
3371 | (goto-char (line-beginning-position)) | |
3372 | (unless (or (equal (point) 1) | |
3373 | (looking-at (concat "^" (regexp-quote todos-category-beg)))) | |
3374 | (if match (push match matches))) | |
3375 | (forward-line)) | |
3376 | (setq matches (reverse matches)) | |
3377 | (if matches | |
3378 | (catch 'stop | |
3379 | (while matches | |
3380 | (setq match (pop matches)) | |
3381 | (goto-char match) | |
3382 | (todos-item-start) | |
3383 | (when (looking-at todos-done-string-start) | |
3384 | (setq in-done t)) | |
3385 | (re-search-backward (concat "^" (regexp-quote todos-category-beg) | |
3386 | "\\(.*\\)\n") nil t) | |
3387 | (setq cat (match-string-no-properties 1)) | |
3388 | (todos-category-number cat) | |
3389 | (todos-category-select) | |
3390 | (if in-done | |
3af3cd0b | 3391 | (unless todos-show-with-done (todos-hide-show-done-items))) |
0e89c3fc SB |
3392 | (goto-char match) |
3393 | (setq ov (make-overlay (- (point) (length regex)) (point))) | |
3394 | (overlay-put ov 'face 'todos-search) | |
3395 | (when matches | |
3396 | (setq mlen (length matches)) | |
3397 | (if (y-or-n-p | |
3398 | (if (> mlen 1) | |
3399 | (format "There are %d more matches; go to next match? " | |
3400 | mlen) | |
3401 | "There is one more match; go to it? ")) | |
3402 | (widen) | |
3403 | (throw 'stop (setq msg (if (> mlen 1) | |
3404 | (format "There are %d more matches." | |
3405 | mlen) | |
3406 | "There is one more match.")))))) | |
3407 | (setq msg "There are no more matches.")) | |
3408 | (todos-category-select) | |
3409 | (goto-char opoint) | |
3410 | (message "No match for \"%s\"" regex)) | |
3411 | (when msg | |
3412 | (if (y-or-n-p (concat msg "\nUnhighlight matches? ")) | |
3413 | (todos-clear-matches) | |
3414 | (message "You can unhighlight the matches later by typing %s" | |
3415 | (key-description (car (where-is-internal | |
3416 | 'todos-clear-matches)))))))) | |
d04d6b95 | 3417 | |
0e89c3fc SB |
3418 | (defun todos-clear-matches () |
3419 | "Remove highlighting on matches found by todos-search." | |
3420 | (interactive) | |
3421 | (remove-overlays 1 (1+ (buffer-size)) 'face 'todos-search)) | |
58c7641d | 3422 | |
0e89c3fc SB |
3423 | ;; --------------------------------------------------------------------------- |
3424 | ;;; Editing Commands | |
58c7641d | 3425 | |
0e89c3fc SB |
3426 | (defun todos-add-file () |
3427 | "Name and add a new Todos file. | |
3428 | Interactively, prompt for a category and display it. | |
3429 | Noninteractively, return the name of the new file." | |
d04d6b95 | 3430 | (interactive) |
2a9e69d6 | 3431 | (let ((prompt (concat "Enter name of new Todos file " |
0e89c3fc | 3432 | "(TAB or SPC to see current names): ")) |
459c6e93 SB |
3433 | file) |
3434 | (setq file (todos-read-file-name prompt)) | |
0e89c3fc SB |
3435 | (with-current-buffer (get-buffer-create file) |
3436 | (erase-buffer) | |
3437 | (write-region (point-min) (point-max) file nil 'nomessage nil t) | |
3438 | (kill-buffer file)) | |
3439 | (todos-reevaluate-defcustoms) | |
3440 | (if (called-interactively-p) | |
3441 | (progn | |
2a9e69d6 SB |
3442 | (set-window-buffer (selected-window) |
3443 | (set-buffer (find-file-noselect file))) | |
0e89c3fc SB |
3444 | (setq todos-current-todos-file file) |
3445 | (todos-show)) | |
3446 | file))) | |
3447 | ||
3448 | (defun todos-add-category (&optional cat) | |
3449 | "Add a new category to the current Todos file. | |
2a9e69d6 | 3450 | Called interactively, prompts for category name, then visits the |
0e89c3fc | 3451 | category in Todos mode. Non-interactively, argument CAT provides |
2a9e69d6 | 3452 | the category name and the return value is the category number." |
0e89c3fc SB |
3453 | (interactive) |
3454 | (let* ((buffer-read-only) | |
0e89c3fc SB |
3455 | (num (1+ (length todos-categories))) |
3456 | (counts (make-vector 4 0))) ; [todo diary done archived] | |
2a9e69d6 SB |
3457 | (if cat |
3458 | (setq cat (todos-validate-name cat 'category)) ;FIXME: need this? | |
3459 | (setq cat (todos-read-category "Enter new category name: " nil t))) | |
3460 | (setq todos-categories (append todos-categories (list (cons cat counts)))) | |
2a9e69d6 SB |
3461 | (widen) |
3462 | (goto-char (point-max)) | |
3463 | (save-excursion ; Save point for todos-category-select. | |
3464 | (insert todos-category-beg cat "\n\n" todos-category-done "\n")) | |
3465 | (todos-update-categories-sexp) | |
3466 | ;; If called by command, display the newly added category, else return | |
3467 | ;; the category number to the caller. | |
3468 | (if (called-interactively-p 'any) ; FIXME? | |
3469 | (progn | |
3470 | (setq todos-category-number num) | |
3471 | (todos-category-select)) | |
3472 | num))) | |
0e89c3fc SB |
3473 | |
3474 | (defun todos-rename-category () | |
3475 | "Rename current Todos category. | |
3476 | If this file has an archive containing this category, rename the | |
3477 | category there as well." | |
3478 | (interactive) | |
3479 | (let* ((cat (todos-current-category)) | |
3480 | (new (read-from-minibuffer (format "Rename category \"%s\" to: " cat)))) | |
3481 | (setq new (todos-validate-name new 'category)) | |
3482 | (let* ((ofile todos-current-todos-file) | |
3483 | (archive (concat (file-name-sans-extension ofile) ".toda")) | |
3484 | (buffers (append (list ofile) | |
3485 | (unless (zerop (todos-get-count 'archived cat)) | |
3486 | (list archive))))) | |
3487 | (dolist (buf buffers) | |
3488 | (with-current-buffer (find-file-noselect buf) | |
58c7641d | 3489 | (let (buffer-read-only) |
0e89c3fc SB |
3490 | (setq todos-categories (todos-set-categories)) |
3491 | (save-excursion | |
3492 | (save-restriction | |
3493 | (setcar (assoc cat todos-categories) new) | |
3494 | (widen) | |
3495 | (goto-char (point-min)) | |
3496 | (todos-update-categories-sexp) | |
3497 | (re-search-forward (concat (regexp-quote todos-category-beg) | |
3498 | "\\(" (regexp-quote cat) "\\)\n") | |
58c7641d | 3499 | nil t) |
0e89c3fc | 3500 | (replace-match new t t nil 1))))))) |
2a9e69d6 | 3501 | (force-mode-line-update)) |
0e89c3fc SB |
3502 | (save-excursion (todos-category-select))) |
3503 | ||
3504 | (defun todos-delete-category (&optional arg) | |
3505 | "Delete current Todos category provided it is empty. | |
3506 | With ARG non-nil delete the category unconditionally, | |
3507 | i.e. including all existing todo and done items." | |
3508 | (interactive "P") | |
2a9e69d6 SB |
3509 | (let* ((file todos-current-todos-file) |
3510 | (cat (todos-current-category)) | |
0e89c3fc SB |
3511 | (todo (todos-get-count 'todo cat)) |
3512 | (done (todos-get-count 'done cat)) | |
3513 | (archived (todos-get-count 'archived cat))) | |
2a9e69d6 SB |
3514 | (if (and (not arg) |
3515 | (or (> todo 0) (> done 0))) | |
3516 | (message "%s" (substitute-command-keys | |
3517 | (concat "To delete a non-empty category, " | |
3518 | "type C-u \\[todos-delete-category]."))) | |
3519 | (when (cond ((= (length todos-categories) 1) | |
3520 | (y-or-n-p (concat "This is the only category in this file; " | |
3521 | "deleting it will also delete the file.\n" | |
3522 | "Do you want to proceed? "))) | |
3523 | ((> archived 0) | |
3524 | (y-or-n-p (concat "This category has archived items; " | |
3525 | "the archived category will remain\n" | |
3526 | "after deleting the todo category. " | |
3527 | "Do you still want to delete it\n" | |
6be04162 | 3528 | "(see 'todos-skip-archived-categories' " |
2a9e69d6 SB |
3529 | "for another option)? "))) |
3530 | (t | |
3531 | (y-or-n-p (concat "Permanently remove category \"" cat | |
3532 | "\"" (and arg " and all its entries") | |
3533 | "? ")))) | |
3534 | (widen) | |
3535 | (let ((buffer-read-only) | |
3536 | (beg (re-search-backward | |
3537 | (concat "^" (regexp-quote (concat todos-category-beg cat)) | |
3538 | "\n") nil t)) | |
3539 | (end (if (re-search-forward | |
3540 | (concat "\n\\(" (regexp-quote todos-category-beg) | |
3541 | ".*\n\\)") nil t) | |
3542 | (match-beginning 1) | |
3543 | (point-max)))) | |
3544 | (remove-overlays beg end) | |
3545 | (delete-region beg end) | |
3546 | (if (= (length todos-categories) 1) | |
3547 | ;; If deleted category was the only one, delete the file. | |
3548 | (progn | |
3549 | (todos-reevaluate-defcustoms) | |
3550 | ;; Skip confirming killing the archive buffer if it has been | |
3551 | ;; modified and not saved. | |
3552 | (set-buffer-modified-p nil) | |
3553 | (delete-file file) | |
3554 | (kill-buffer) | |
3555 | (message "Deleted Todos file %s." file)) | |
7464f422 SB |
3556 | (setq todos-categories (delete (assoc cat todos-categories) |
3557 | todos-categories)) | |
2a9e69d6 SB |
3558 | (todos-update-categories-sexp) |
3559 | (setq todos-category-number | |
3560 | (1+ (mod todos-category-number (length todos-categories)))) | |
3561 | (todos-category-select) | |
3562 | (goto-char (point-min)) | |
3563 | (message "Deleted category %s." cat))))))) | |
3f031767 | 3564 | |
2a9e69d6 | 3565 | (defun todos-raise-category-priority (&optional lower) |
0e89c3fc SB |
3566 | "Raise priority of category point is on in Todos Categories buffer. |
3567 | With non-nil argument LOWER, lower the category's priority." | |
d04d6b95 | 3568 | (interactive) |
0833689a SB |
3569 | (save-excursion |
3570 | (forward-line 0) | |
3571 | (skip-chars-forward " ") | |
3572 | (setq todos-categories-category-number (number-at-point))) | |
3573 | (when (if lower | |
3574 | (< todos-categories-category-number (length todos-categories)) | |
3575 | (> todos-categories-category-number 1)) | |
3576 | (let* ((col (current-column)) | |
3577 | ;; The line we're raising to, or lowering from... | |
3578 | (beg (progn (forward-line (if lower 0 -1)) (point))) | |
3579 | ;; ...and its number. | |
3580 | (num1 (progn (skip-chars-forward " ") (1- (number-at-point)))) | |
3581 | ;; The number of the line we're exchanging with. | |
3582 | (num2 (1+ num1)) | |
3583 | ;; The start of the line below the one we're exchanging with. | |
3584 | (end (progn (forward-line 2) (point))) | |
3585 | (catvec (vconcat todos-categories)) | |
3586 | ;; Category names and item counts of the two lines being exchanged. | |
3587 | (cat1-list (aref catvec num1)) | |
3588 | (cat2-list (aref catvec num2)) | |
3589 | (cat1 (car cat1-list)) | |
3590 | (cat2 (car cat2-list)) | |
3591 | buffer-read-only newcats) | |
3592 | (delete-region beg end) | |
3593 | (setq num1 (1+ num1)) | |
3594 | (setq num2 (1- num2)) | |
3595 | ;; Exchange the lines and rebuttonize them. | |
3596 | (setq todos-categories-category-number num2) | |
3597 | (todos-insert-category-line cat2) | |
3598 | (setq todos-categories-category-number num1) | |
3599 | (todos-insert-category-line cat1) | |
3600 | ;; Update todos-categories alist. | |
3601 | (aset catvec num2 (cons cat2 (cdr cat2-list))) | |
3602 | (aset catvec num1 (cons cat1 (cdr cat1-list))) | |
3603 | (setq todos-categories (append catvec nil)) | |
3604 | (setq newcats todos-categories) | |
6be04162 | 3605 | (with-current-buffer (find-buffer-visiting todos-current-todos-file) |
0833689a SB |
3606 | (setq todos-categories newcats) |
3607 | (todos-update-categories-sexp)) | |
3608 | (forward-line (if lower -1 -2)) | |
3609 | (forward-char col)))) | |
d04d6b95 | 3610 | |
2a9e69d6 | 3611 | (defun todos-lower-category-priority () |
0e89c3fc | 3612 | "Lower priority of category point is on in Todos Categories buffer." |
d04d6b95 | 3613 | (interactive) |
2a9e69d6 SB |
3614 | (todos-raise-category-priority t)) |
3615 | ||
3616 | (defun todos-set-category-priority () | |
3617 | "" | |
3618 | (interactive) | |
3619 | ;; FIXME | |
3620 | ) | |
2c173503 | 3621 | |
0e89c3fc SB |
3622 | (defun todos-move-category () |
3623 | "Move current category to a different Todos file. | |
3624 | If current category has archived items, also move those to the | |
3625 | archive of the file moved to, creating it if it does not exist." | |
58c7641d | 3626 | (interactive) |
0e89c3fc SB |
3627 | (when (or (> (length todos-categories) 1) |
3628 | (y-or-n-p (concat "This is the only category in this file; " | |
3629 | "moving it will also delete the file.\n" | |
3630 | "Do you want to proceed? "))) | |
3631 | (let* ((ofile todos-current-todos-file) | |
3632 | (cat (todos-current-category)) | |
3633 | (nfile (todos-read-file-name "Choose a Todos file: " nil t)) | |
3634 | (archive (concat (file-name-sans-extension ofile) ".toda")) | |
3635 | (buffers (append (list ofile) | |
3636 | (unless (zerop (todos-get-count 'archived cat)) | |
3637 | (list archive)))) | |
3638 | new) | |
3639 | (dolist (buf buffers) | |
3640 | (with-current-buffer (find-file-noselect buf) | |
3641 | (widen) | |
3642 | (goto-char (point-max)) | |
3643 | (let* ((beg (re-search-backward | |
3644 | (concat "^" | |
3645 | (regexp-quote (concat todos-category-beg cat))) | |
3646 | nil t)) | |
3647 | (end (if (re-search-forward | |
3648 | (concat "^" (regexp-quote todos-category-beg)) | |
3649 | nil t 2) | |
3650 | (match-beginning 0) | |
3651 | (point-max))) | |
3652 | (content (buffer-substring-no-properties beg end)) | |
3653 | (counts (cdr (assoc cat todos-categories))) | |
3654 | buffer-read-only) | |
3655 | ;; Move the category to the new file. Also update or create | |
3656 | ;; archive file if necessary. | |
3657 | (with-current-buffer | |
3658 | (find-file-noselect | |
3659 | ;; Regenerate todos-archives in case there | |
3660 | ;; is a newly created archive. | |
3661 | (if (member buf (funcall todos-files-function t)) | |
3662 | (concat (file-name-sans-extension nfile) ".toda") | |
3663 | nfile)) | |
3664 | (let* ((nfile-short (todos-short-file-name nfile)) | |
3665 | (prompt (concat | |
3666 | (format "Todos file \"%s\" already has " | |
3667 | nfile-short) | |
3668 | (format "the category \"%s\";\n" cat) | |
3669 | "enter a new category name: ")) | |
3670 | buffer-read-only) | |
3671 | (widen) | |
3672 | (goto-char (point-max)) | |
3673 | (insert content) | |
3674 | ;; If the file moved to has a category with the same | |
3675 | ;; name, rename the moved category. | |
3676 | (when (assoc cat todos-categories) | |
3677 | (unless (member (file-truename (buffer-file-name)) | |
3678 | (funcall todos-files-function t)) | |
3679 | (setq new (read-from-minibuffer prompt)) | |
3680 | (setq new (todos-validate-name new 'category)))) | |
3681 | ;; Replace old with new name in Todos and archive files. | |
3682 | (when new | |
3683 | (goto-char (point-max)) | |
3684 | (re-search-backward | |
3685 | (concat "^" (regexp-quote todos-category-beg) | |
3686 | "\\(" (regexp-quote cat) "\\)") nil t) | |
3687 | (replace-match new nil nil nil 1))) | |
3688 | (setq todos-categories | |
3689 | (append todos-categories (list (cons new counts)))) | |
3690 | (todos-update-categories-sexp) | |
3691 | ;; If archive was just created, save it to avoid "File <xyz> no | |
3692 | ;; longer exists!" message on invoking | |
3693 | ;; `todos-view-archived-items'. FIXME: maybe better to save | |
3694 | ;; unconditionally? | |
3695 | (unless (file-exists-p (buffer-file-name)) | |
3696 | (save-buffer)) | |
3697 | (todos-category-number (or new cat)) | |
3698 | (todos-category-select)) | |
3699 | ;; Delete the category from the old file, and if that was the | |
3700 | ;; last category, delete the file. Also handle archive file | |
3701 | ;; if necessary. | |
3702 | (remove-overlays beg end) | |
3703 | (delete-region beg end) | |
3704 | (goto-char (point-min)) | |
3705 | ;; Put point after todos-categories sexp. | |
3706 | (forward-line) | |
3707 | (if (eobp) ; Aside from sexp, file is empty. | |
3708 | (progn | |
3709 | ;; Skip confirming killing the archive buffer. | |
3710 | (set-buffer-modified-p nil) | |
3711 | (delete-file todos-current-todos-file) | |
3712 | (kill-buffer) | |
3713 | (when (member todos-current-todos-file todos-files) | |
3714 | (todos-reevaluate-defcustoms))) | |
7464f422 SB |
3715 | (setq todos-categories (delete (assoc cat todos-categories) |
3716 | todos-categories)) | |
0e89c3fc SB |
3717 | (todos-update-categories-sexp) |
3718 | (todos-category-select))))) | |
3719 | (set-window-buffer (selected-window) | |
3720 | (set-buffer (find-file-noselect nfile))) | |
3721 | (todos-category-number (or new cat)) | |
3722 | (todos-category-select)))) | |
2c173503 | 3723 | |
0e89c3fc SB |
3724 | (defun todos-merge-category () |
3725 | "Merge current category into another category in this file. | |
3726 | The current category's todo and done items are appended to the | |
3727 | chosen category's todo and done items, respectively, which | |
3728 | becomes the current category, and the category moved from is | |
3729 | deleted." | |
3730 | (interactive) | |
3731 | (let ((buffer-read-only nil) | |
3732 | (cat (todos-current-category)) | |
3733 | (goal (todos-read-category "Category to merge to: " t))) | |
3734 | (widen) | |
3735 | ;; FIXME: check if cat has archived items and merge those too | |
3736 | (let* ((cbeg (progn | |
3737 | (re-search-backward | |
3738 | (concat "^" (regexp-quote todos-category-beg)) nil t) | |
3739 | (point))) | |
3740 | (tbeg (progn (forward-line) (point))) | |
3741 | (dbeg (progn | |
3742 | (re-search-forward | |
3743 | (concat "^" (regexp-quote todos-category-done)) nil t) | |
3744 | (forward-line) (point))) | |
3745 | (tend (progn (forward-line -2) (point))) | |
3746 | (cend (progn | |
3747 | (if (re-search-forward | |
3748 | (concat "^" (regexp-quote todos-category-beg)) nil t) | |
3749 | (match-beginning 0) | |
3750 | (point-max)))) | |
3751 | (todo (buffer-substring-no-properties tbeg tend)) | |
3752 | (done (buffer-substring-no-properties dbeg cend)) | |
3753 | here) | |
2c173503 | 3754 | (goto-char (point-min)) |
0e89c3fc SB |
3755 | (re-search-forward |
3756 | (concat "^" (regexp-quote (concat todos-category-beg goal))) nil t) | |
3757 | (re-search-forward | |
3758 | (concat "^" (regexp-quote todos-category-done)) nil t) | |
3759 | (forward-line -1) | |
3760 | (setq here (point)) | |
3761 | (insert todo) | |
3762 | (goto-char (if (re-search-forward | |
3763 | (concat "^" (regexp-quote todos-category-beg)) nil t) | |
3764 | (match-beginning 0) | |
3765 | (point-max))) | |
3766 | (insert done) | |
3767 | (remove-overlays cbeg cend) | |
3768 | (delete-region cbeg cend) | |
3af3cd0b SB |
3769 | (todos-update-count 'todo (todos-get-count 'todo cat) goal) |
3770 | (todos-update-count 'done (todos-get-count 'done cat) goal) | |
7464f422 SB |
3771 | (setq todos-categories (delete (assoc cat todos-categories) |
3772 | todos-categories)) | |
0e89c3fc SB |
3773 | (todos-update-categories-sexp) |
3774 | (todos-category-number goal) | |
3775 | (todos-category-select) | |
3776 | ;; Put point at the start of the merged todo items. | |
3777 | ;; FIXME: what if there are no merged todo items but only done items? | |
3778 | (goto-char here)))) | |
3779 | ||
3780 | ;; FIXME | |
3781 | (defun todos-merge-categories () | |
3782 | "" | |
3783 | (interactive) | |
3784 | (let* ((cats (mapcar 'car todos-categories)) | |
3785 | (goal (todos-read-category "Category to merge to: " t)) | |
3786 | (prompt (format "Merge to %s (type C-g to finish)? " goal)) | |
3787 | (source (let ((inhibit-quit t) l) | |
3788 | (while (not (eq last-input-event 7)) | |
3789 | (dolist (c cats) | |
3790 | (when (y-or-n-p prompt) | |
3791 | (push c l) | |
3792 | (setq cats (delete c cats)))))))) | |
3793 | (widen) | |
3794 | )) | |
2c173503 | 3795 | |
0e89c3fc SB |
3796 | ;; FIXME: make insertion options customizable per category? |
3797 | ;;;###autoload | |
3798 | (defun todos-insert-item (&optional arg diary nonmarking date-type time | |
3799 | region-or-here) | |
3800 | "Add a new Todo item to a category. | |
3801 | \(See the note at the end of this document string about key | |
3802 | bindings and convenience commands derived from this command.) | |
f730d273 | 3803 | |
0e89c3fc SB |
3804 | With no (or nil) prefix argument ARG, add the item to the current |
3805 | category; with one prefix argument (C-u), prompt for a category | |
3806 | from the current Todos file; with two prefix arguments (C-u C-u), | |
3807 | first prompt for a Todos file, then a category in that file. If | |
3808 | a non-existing category is entered, ask whether to add it to the | |
3809 | Todos file; if answered affirmatively, add the category and | |
3810 | insert the item there. | |
d04d6b95 | 3811 | |
0e89c3fc SB |
3812 | When argument DIARY is non-nil, this overrides the intent of the |
3813 | user option `todos-include-in-diary' for this item: if | |
3814 | `todos-include-in-diary' is nil, include the item in the Fancy | |
3815 | Diary display, and if it is non-nil, exclude the item from the | |
3816 | Fancy Diary display. When DIARY is nil, `todos-include-in-diary' | |
3817 | has its intended effect. | |
58c7641d | 3818 | |
0e89c3fc SB |
3819 | When the item is included in the Fancy Diary display and the |
3820 | argument NONMARKING is non-nil, this overrides the intent of the | |
3821 | user option `todos-diary-nonmarking' for this item: if | |
3822 | `todos-diary-nonmarking' is nil, append `diary-nonmarking-symbol' | |
3823 | to the item, and if it is non-nil, omit `diary-nonmarking-symbol'. | |
d04d6b95 | 3824 | |
0e89c3fc SB |
3825 | The argument DATE-TYPE determines the content of the item's |
3826 | mandatory date header string and how it is added: | |
3827 | - If DATE-TYPE is the symbol `calendar', the Calendar pops up and | |
3828 | when the user puts the cursor on a date and hits RET, that | |
3829 | date, in the format set by `calendar-date-display-form', | |
3830 | becomes the date in the header. | |
3831 | - If DATE-TYPE is the symbol `date', the header contains the date | |
3832 | in the format set by `calendar-date-display-form', with year, | |
3833 | month and day individually prompted for (month with tab | |
3834 | completion). | |
3835 | - If DATE-TYPE is the symbol `dayname' the header contains a | |
3836 | weekday name instead of a date, prompted for with tab | |
3837 | completion. | |
3838 | - If DATE-TYPE has any other value (including nil or none) the | |
3839 | header contains the current date (in the format set by | |
3840 | `calendar-date-display-form'). | |
58c7641d | 3841 | |
0e89c3fc SB |
3842 | With non-nil argument TIME prompt for a time string, which must |
3843 | match `diary-time-regexp'. Typing `<return>' at the prompt | |
3844 | returns the current time, if the user option | |
3845 | `todos-always-add-time-string' is non-nil, otherwise the empty | |
3846 | string (i.e., no time string). If TIME is absent or nil, add or | |
3847 | omit the current time string according as | |
3848 | `todos-always-add-time-string' is non-nil or nil, respectively. | |
58c7641d | 3849 | |
0e89c3fc SB |
3850 | The argument REGION-OR-HERE determines the source and location of |
3851 | the new item: | |
3852 | - If the REGION-OR-HERE is the symbol `here', prompt for the text | |
3853 | of the new item and insert it directly above the todo item at | |
3854 | point (hence lowering the priority of the remaining items), or | |
3855 | if point is on the empty line below the last todo item, insert | |
3856 | the new item there. An error is signalled if | |
3857 | `todos-insert-item' is invoked with `here' outside of the | |
3858 | current category. | |
3859 | - If REGION-OR-HERE is the symbol `region', use the region of the | |
3860 | current buffer as the text of the new item, depending on the | |
3861 | value of user option `todos-use-only-highlighted-region': if | |
3862 | this is non-nil, then use the region only when it is | |
3863 | highlighted; otherwise, use the region regardless of | |
3864 | highlighting. An error is signalled if there is no region in | |
3865 | the current buffer. Prompt for the item's priority in the | |
3866 | category (an integer between 1 and one more than the number of | |
3867 | items in the category), and insert the item accordingly. | |
3868 | - If REGION-OR-HERE has any other value (in particular, nil or | |
3869 | none), prompt for the text and the item's priority, and insert | |
3870 | the item accordingly. | |
58c7641d | 3871 | |
0e89c3fc SB |
3872 | To facilitate using these arguments when inserting a new todo |
3873 | item, convenience commands have been defined for all admissible | |
78fe7289 SB |
3874 | combinations together with mnenomic key bindings based on on the |
3875 | name of the arguments and their order in the command's argument | |
3876 | list: diar_y_ - nonmar_k_ing - _c_alendar or _d_ate or day_n_ame | |
3877 | - _t_ime - _r_egion or _h_ere. These key combinations are | |
3878 | appended to the basic insertion key (i) and keys that allow a | |
3879 | following key must be doubled when used finally. For example, | |
3880 | `iyh' will insert a new item with today's date, marked according | |
3881 | to the DIARY argument described above, and with priority | |
3882 | according to the HERE argument; while `iyy' does the same except | |
3883 | the priority is not given by HERE but by prompting." | |
0e89c3fc SB |
3884 | ;; An alternative interface for customizing key |
3885 | ;; binding is also provided with the function | |
3886 | ;; `todos-insertion-bindings'." ;FIXME | |
3887 | (interactive "P") | |
3888 | (let ((region (eq region-or-here 'region)) | |
3889 | (here (eq region-or-here 'here))) | |
3890 | (when region | |
2a9e69d6 SB |
3891 | (let (use-empty-active-region) |
3892 | (unless (and todos-use-only-highlighted-region (use-region-p)) | |
3893 | (error "There is no active region")))) | |
0e89c3fc SB |
3894 | (let* ((buf (current-buffer)) |
3895 | (new-item (if region | |
3896 | ;; FIXME: or keep properties? | |
3897 | (buffer-substring-no-properties | |
3898 | (region-beginning) (region-end)) | |
3899 | (read-from-minibuffer "Todo item: "))) | |
3900 | (date-string (cond | |
3901 | ((eq date-type 'date) | |
3902 | (todos-read-date)) | |
3903 | ((eq date-type 'dayname) | |
3904 | (todos-read-dayname)) | |
3905 | ((eq date-type 'calendar) | |
3906 | (setq todos-date-from-calendar t) | |
3907 | (todos-set-date-from-calendar)) | |
3908 | (t (calendar-date-string (calendar-current-date) t t)))) | |
3909 | (time-string (or (and time (todos-read-time)) | |
3910 | (and todos-always-add-time-string | |
3911 | (substring (current-time-string) 11 16))))) | |
3912 | (setq todos-date-from-calendar nil) | |
3913 | (cond ((equal arg '(16)) ; FIXME: cf. set-mark-command | |
3914 | (todos-jump-to-category nil t) | |
3915 | (set-window-buffer | |
3916 | (selected-window) | |
6be04162 | 3917 | (set-buffer (find-buffer-visiting todos-global-current-todos-file)))) |
0e89c3fc SB |
3918 | ((equal arg '(4)) ; FIXME: just arg? |
3919 | (todos-jump-to-category) | |
3920 | (set-window-buffer | |
3921 | (selected-window) | |
6be04162 | 3922 | (set-buffer (find-buffer-visiting todos-global-current-todos-file)))) |
0e89c3fc SB |
3923 | (t |
3924 | (when (not (derived-mode-p 'todos-mode)) (todos-show)))) | |
3925 | (let (buffer-read-only) | |
3926 | (setq new-item | |
3927 | ;; Add date, time and diary marking as required. | |
3928 | (concat (if (not (and diary (not todos-include-in-diary))) | |
3929 | todos-nondiary-start | |
3930 | (when (and nonmarking (not todos-diary-nonmarking)) | |
3931 | diary-nonmarking-symbol)) | |
0833689a SB |
3932 | date-string (when (and time-string ; Can be empty string. |
3933 | (not (zerop (length time-string)))) | |
0e89c3fc SB |
3934 | (concat " " time-string)) |
3935 | (when (not (and diary (not todos-include-in-diary))) | |
3936 | todos-nondiary-end) | |
3937 | " " new-item)) | |
3938 | ;; Indent newlines inserted by C-q C-j if nonspace char follows. | |
3939 | (setq new-item (replace-regexp-in-string | |
3940 | "\\(\n\\)[^[:blank:]]" | |
3941 | (concat "\n" (make-string todos-indent-to-here 32)) | |
3942 | new-item nil nil 1)) | |
3943 | (if here | |
3944 | (cond ((not (eq major-mode 'todos-mode)) | |
3945 | (error "Cannot insert a todo item here outside of Todos mode")) | |
3946 | ((not (eq buf (current-buffer))) | |
3947 | (error "Cannot insert an item here after changing buffer")) | |
3948 | ((or (todos-done-item-p) | |
3949 | ;; Point on last blank line. | |
3950 | (save-excursion (forward-line -1) (todos-done-item-p))) | |
3951 | (error "Cannot insert a new item in the done item section")) | |
3952 | (t | |
3953 | (todos-insert-with-overlays new-item))) | |
3954 | (todos-set-item-priority new-item (todos-current-category) t)) | |
3af3cd0b SB |
3955 | (todos-update-count 'todo 1) |
3956 | (if (or diary todos-include-in-diary) (todos-update-count 'diary 1)) | |
0e89c3fc | 3957 | (todos-update-categories-sexp))))) |
d04d6b95 | 3958 | |
0e89c3fc SB |
3959 | (defvar todos-date-from-calendar nil |
3960 | "Helper variable for setting item date from the Emacs Calendar.") | |
2c173503 | 3961 | |
0e89c3fc SB |
3962 | (defun todos-set-date-from-calendar () |
3963 | "Return string of date chosen from Calendar." | |
3964 | (when todos-date-from-calendar | |
3965 | (let (calendar-view-diary-initially-flag) | |
3966 | (calendar)) | |
3967 | ;; *Calendar* is now current buffer. | |
3968 | (local-set-key (kbd "RET") 'exit-recursive-edit) | |
3969 | (message "Put cursor on a date and type <return> to set it.") | |
520d912e SB |
3970 | ;; FIXME: is there a better way than recursive-edit? Use unwind-protect? |
3971 | ;; Check recursive-depth? | |
0e89c3fc SB |
3972 | (recursive-edit) |
3973 | (setq todos-date-from-calendar | |
3974 | (calendar-date-string (calendar-cursor-to-date t) t t)) | |
3975 | (calendar-exit) | |
3976 | todos-date-from-calendar)) | |
d04d6b95 | 3977 | |
0e89c3fc SB |
3978 | (defun todos-delete-item () |
3979 | "Delete at least one item in this category. | |
ee7412e4 | 3980 | |
0e89c3fc SB |
3981 | If there are marked items, delete all of these; otherwise, delete |
3982 | the item at point." | |
3983 | (interactive) | |
3984 | (let* ((cat (todos-current-category)) | |
3985 | (marked (assoc cat todos-categories-with-marks)) | |
3986 | (item (unless marked (todos-item-string))) | |
3987 | (ov (make-overlay (save-excursion (todos-item-start)) | |
3988 | (save-excursion (todos-item-end)))) | |
2a9e69d6 | 3989 | ;; FIXME: make confirmation an option? |
0e89c3fc SB |
3990 | (answer (if marked |
3991 | (y-or-n-p "Permanently delete all marked items? ") | |
3992 | (when item | |
3993 | (overlay-put ov 'face 'todos-search) | |
3994 | (y-or-n-p (concat "Permanently delete this item? "))))) | |
3995 | (opoint (point)) | |
3996 | buffer-read-only) | |
3997 | (when answer | |
3998 | (and marked (goto-char (point-min))) | |
3999 | (catch 'done | |
4000 | (while (not (eobp)) | |
4001 | (if (or (and marked (todos-marked-item-p)) item) | |
4002 | (progn | |
4003 | (if (todos-done-item-p) | |
3af3cd0b SB |
4004 | (todos-update-count 'done -1) |
4005 | (todos-update-count 'todo -1 cat) | |
4006 | (and (todos-diary-item-p) (todos-update-count 'diary -1))) | |
0e89c3fc SB |
4007 | (delete-overlay ov) |
4008 | (todos-remove-item) | |
4009 | ;; Don't leave point below last item. | |
4010 | (and item (bolp) (eolp) (< (point-min) (point-max)) | |
4011 | (todos-backward-item)) | |
4012 | (when item | |
4013 | (throw 'done (setq item nil)))) | |
4014 | (todos-forward-item)))) | |
4015 | (when marked | |
4016 | (remove-overlays (point-min) (point-max) 'before-string todos-item-mark) | |
4017 | (setq todos-categories-with-marks | |
4018 | (assq-delete-all cat todos-categories-with-marks)) | |
4019 | (goto-char opoint)) | |
4020 | (todos-update-categories-sexp) | |
4021 | (todos-prefix-overlays)) | |
4022 | (if ov (delete-overlay ov)))) | |
4023 | ||
4024 | (defun todos-edit-item () | |
4025 | "Edit the Todo item at point. | |
4026 | If the item consists of only one logical line, edit it in the | |
4027 | minibuffer; otherwise, edit it in Todos Edit mode." | |
4028 | (interactive) | |
4029 | (when (todos-item-string) | |
4030 | (let* ((buffer-read-only) | |
4031 | (start (todos-item-start)) | |
4032 | (item-beg (progn | |
4033 | (re-search-forward | |
4034 | (concat todos-date-string-start todos-date-pattern | |
4035 | "\\( " diary-time-regexp "\\)?" | |
4036 | (regexp-quote todos-nondiary-end) "?") | |
4037 | (line-end-position) t) | |
4038 | (1+ (- (point) start)))) | |
4039 | (item (todos-item-string)) | |
4040 | (multiline (> (length (split-string item "\n")) 1)) | |
4041 | (opoint (point))) | |
4042 | (if multiline | |
4043 | (todos-edit-multiline t) | |
4044 | (let ((new (read-string "Edit: " (cons item item-beg)))) | |
4045 | (while (not (string-match | |
4046 | (concat todos-date-string-start todos-date-pattern) new)) | |
4047 | (setq new (read-from-minibuffer | |
4048 | "Item must start with a date: " new))) | |
4049 | ;; Indent newlines inserted by C-q C-j if nonspace char follows. | |
4050 | (setq new (replace-regexp-in-string | |
4051 | "\\(\n\\)[^[:blank:]]" | |
4052 | (concat "\n" (make-string todos-indent-to-here 32)) new | |
4053 | nil nil 1)) | |
4054 | ;; If user moved point during editing, make sure it moves back. | |
4055 | (goto-char opoint) | |
4056 | (todos-remove-item) | |
4057 | (todos-insert-with-overlays new) | |
4058 | (move-to-column item-beg)))))) | |
3f031767 | 4059 | |
0e89c3fc SB |
4060 | (defun todos-edit-multiline-item () |
4061 | "Edit current Todo item in Todos Edit mode. | |
4062 | Use of newlines invokes `todos-indent' to insure compliance with | |
4063 | the format of Diary entries." | |
4064 | (interactive) | |
4065 | (todos-edit-multiline t)) | |
3f031767 | 4066 | |
0e89c3fc SB |
4067 | (defun todos-edit-multiline (&optional item) |
4068 | "" | |
4069 | (interactive) | |
4070 | ;; FIXME: should there be only one live Todos Edit buffer? | |
4071 | ;; (let ((buffer-name todos-edit-buffer)) | |
4072 | (let ((buffer-name (generate-new-buffer-name todos-edit-buffer))) | |
4073 | (set-window-buffer | |
4074 | (selected-window) | |
4075 | (set-buffer (make-indirect-buffer | |
4076 | (file-name-nondirectory todos-current-todos-file) | |
4077 | buffer-name))) | |
4078 | (if item | |
4079 | (narrow-to-region (todos-item-start) (todos-item-end)) | |
4080 | (widen)) | |
4081 | (todos-edit-mode) | |
4082 | ;; (message (concat "Type %s to check file format validity and " | |
4083 | ;; "return to Todos mode.\n") | |
4084 | ;; (key-description (car (where-is-internal 'todos-edit-quit)))) | |
4085 | (message "%s" (substitute-command-keys | |
4086 | (concat "Type \\[todos-edit-quit] to check file format " | |
4087 | "validity and return to Todos mode.\n"))))) | |
3f031767 | 4088 | |
0e89c3fc SB |
4089 | (defun todos-edit-quit () |
4090 | "Return from Todos Edit mode to Todos mode. | |
d04d6b95 | 4091 | |
0e89c3fc SB |
4092 | If the whole file was in Todos Edit mode, check before returning |
4093 | whether the file is still a valid Todos file and if so, also | |
4094 | recalculate the Todos categories sexp, in case changes were made | |
4095 | in the number or names of categories." | |
4096 | (interactive) | |
4097 | ;; FIXME: worth doing this only if file was actually changed? | |
4098 | (when (eq (buffer-size) (- (point-max) (point-min))) | |
4099 | (when (todos-check-format) | |
4100 | (todos-make-categories-list t))) | |
4101 | (kill-buffer) | |
4102 | ;; In case next buffer is not the one holding todos-current-todos-file. | |
4103 | (todos-show)) | |
3f031767 | 4104 | |
0e89c3fc SB |
4105 | (defun todos-edit-item-header (&optional what) |
4106 | "Edit date/time header of at least one item. | |
2c173503 | 4107 | |
0e89c3fc SB |
4108 | Interactively, ask whether to edit year, month and day or day of |
4109 | the week, as well as time. If there are marked items, apply the | |
4110 | changes to all of these; otherwise, edit just the item at point. | |
d04d6b95 | 4111 | |
0e89c3fc SB |
4112 | Non-interactively, argument WHAT specifies whether to set the |
4113 | date from the Calendar or to today, or whether to edit only the | |
4114 | date or day, or only the time." | |
4115 | (interactive) | |
4116 | (let* ((cat (todos-current-category)) | |
4117 | (marked (assoc cat todos-categories-with-marks)) | |
4118 | (first t) ; Match only first of marked items. | |
4119 | (todos-date-from-calendar t) | |
4120 | ndate ntime nheader) | |
4121 | (save-excursion | |
4122 | (or (and marked (goto-char (point-min))) (todos-item-start)) | |
4123 | (catch 'stop | |
4124 | (while (not (eobp)) | |
4125 | (and marked | |
4126 | (while (not (todos-marked-item-p)) | |
4127 | (todos-forward-item) | |
4128 | (and (eobp) (throw 'stop nil)))) | |
4129 | (re-search-forward (concat todos-date-string-start "\\(?1:" | |
4130 | todos-date-pattern | |
4131 | "\\)\\(?2: " diary-time-regexp "\\)?") | |
4132 | (line-end-position) t) | |
4133 | (let* ((odate (match-string-no-properties 1)) | |
4134 | (otime (match-string-no-properties 2)) | |
4135 | (buffer-read-only)) | |
4136 | (cond ((eq what 'today) | |
4137 | (progn | |
4138 | (setq ndate (calendar-date-string | |
4139 | (calendar-current-date) t t)) | |
4140 | (replace-match ndate nil nil nil 1))) | |
4141 | ((eq what 'calendar) | |
4142 | (setq ndate (save-match-data (todos-set-date-from-calendar))) | |
4143 | (replace-match ndate nil nil nil 1)) | |
4144 | (t | |
4145 | (unless (eq what 'timeonly) | |
4146 | (when first | |
4147 | (setq ndate (if (save-match-data | |
4148 | (string-match "[0-9]+" odate)) | |
4149 | (if (y-or-n-p "Change date? ") | |
4150 | (todos-read-date) | |
4151 | (todos-read-dayname)) | |
4152 | (if (y-or-n-p "Change day? ") | |
4153 | (todos-read-dayname) | |
4154 | (todos-read-date))))) | |
4155 | (replace-match ndate nil nil nil 1)) | |
4156 | (unless (eq what 'dateonly) | |
4157 | (when first | |
4158 | (setq ntime (save-match-data (todos-read-time))) | |
4159 | (when (< 0 (length ntime)) | |
4160 | (setq ntime (concat " " ntime)))) | |
4161 | (if otime | |
4162 | (replace-match ntime nil nil nil 2) | |
4163 | (goto-char (match-end 1)) | |
4164 | (insert ntime))))) | |
4165 | (setq todos-date-from-calendar nil) | |
4166 | (setq first nil)) | |
4167 | (if marked | |
4168 | (todos-forward-item) | |
4169 | (goto-char (point-max)))))))) | |
58c7641d | 4170 | |
0e89c3fc SB |
4171 | (defun todos-edit-item-date () |
4172 | "Prompt for and apply changes to current item's date." | |
4173 | (interactive) | |
4174 | (todos-edit-item-header 'dateonly)) | |
58c7641d | 4175 | |
0e89c3fc SB |
4176 | (defun todos-edit-item-date-from-calendar () |
4177 | "Prompt for changes to current item's date and apply from Calendar." | |
4178 | (interactive) | |
4179 | (todos-edit-item-header 'calendar)) | |
58c7641d | 4180 | |
0e89c3fc SB |
4181 | (defun todos-edit-item-date-is-today () |
4182 | "Set item date to today's date." | |
4183 | (interactive) | |
4184 | (todos-edit-item-header 'today)) | |
4185 | ||
4186 | (defun todos-edit-item-time () | |
4187 | "Prompt For and apply changes to current item's time." | |
4188 | (interactive) | |
4189 | (todos-edit-item-header 'timeonly)) | |
58c7641d | 4190 | |
0e89c3fc SB |
4191 | (defun todos-edit-item-diary-inclusion () |
4192 | "Change diary status of one or more todo items in this category. | |
4193 | That is, insert `todos-nondiary-marker' if the candidate items | |
4194 | lack this marking; otherwise, remove it. | |
d04d6b95 | 4195 | |
0e89c3fc SB |
4196 | If there are marked todo items, change the diary status of all |
4197 | and only these, otherwise change the diary status of the item at | |
4198 | point." | |
4199 | (interactive) | |
4200 | (let ((buffer-read-only) | |
4201 | (marked (assoc (todos-current-category) | |
4202 | todos-categories-with-marks))) | |
4203 | (catch 'stop | |
4204 | (save-excursion | |
4205 | (when marked (goto-char (point-min))) | |
4206 | (while (not (eobp)) | |
4207 | (if (todos-done-item-p) | |
4208 | (throw 'stop (message "Done items cannot be edited")) | |
4209 | (unless (and marked (not (todos-marked-item-p))) | |
4210 | (let* ((beg (todos-item-start)) | |
4211 | (lim (save-excursion (todos-item-end))) | |
4212 | (end (save-excursion | |
4213 | (or (todos-time-string-matcher lim) | |
4214 | (todos-date-string-matcher lim))))) | |
4215 | (if (looking-at (regexp-quote todos-nondiary-start)) | |
4216 | (progn | |
4217 | (replace-match "") | |
4218 | (search-forward todos-nondiary-end (1+ end) t) | |
4219 | (replace-match "") | |
3af3cd0b | 4220 | (todos-update-count 'diary 1)) |
0e89c3fc SB |
4221 | (when end |
4222 | (insert todos-nondiary-start) | |
4223 | (goto-char (1+ end)) | |
4224 | (insert todos-nondiary-end) | |
3af3cd0b | 4225 | (todos-update-count 'diary -1))))) |
0e89c3fc SB |
4226 | (unless marked (throw 'stop nil)) |
4227 | (todos-forward-item))))) | |
4228 | (todos-update-categories-sexp))) | |
58c7641d | 4229 | |
0e89c3fc SB |
4230 | (defun todos-edit-category-diary-inclusion (arg) |
4231 | "Make all items in this category diary items. | |
4232 | With prefix ARG, make all items in this category non-diary | |
4233 | items." | |
4234 | (interactive "P") | |
d04d6b95 | 4235 | (save-excursion |
0e89c3fc SB |
4236 | (goto-char (point-min)) |
4237 | (let ((todo-count (todos-get-count 'todo)) | |
4238 | (diary-count (todos-get-count 'diary)) | |
4239 | (buffer-read-only)) | |
4240 | (catch 'stop | |
d04d6b95 | 4241 | (while (not (eobp)) |
0e89c3fc SB |
4242 | (if (todos-done-item-p) ; We've gone too far. |
4243 | (throw 'stop nil) | |
4244 | (let* ((beg (todos-item-start)) | |
4245 | (lim (save-excursion (todos-item-end))) | |
4246 | (end (save-excursion | |
4247 | (or (todos-time-string-matcher lim) | |
4248 | (todos-date-string-matcher lim))))) | |
4249 | (if arg | |
4250 | (unless (looking-at (regexp-quote todos-nondiary-start)) | |
4251 | (insert todos-nondiary-start) | |
4252 | (goto-char (1+ end)) | |
4253 | (insert todos-nondiary-end)) | |
4254 | (when (looking-at (regexp-quote todos-nondiary-start)) | |
4255 | (replace-match "") | |
4256 | (search-forward todos-nondiary-end (1+ end) t) | |
4257 | (replace-match ""))))) | |
4258 | (todos-forward-item)) | |
4259 | (unless (if arg (zerop diary-count) (= diary-count todo-count)) | |
3af3cd0b | 4260 | (todos-update-count 'diary (if arg |
0e89c3fc SB |
4261 | (- diary-count) |
4262 | (- todo-count diary-count)))) | |
4263 | (todos-update-categories-sexp))))) | |
d04d6b95 | 4264 | |
0e89c3fc SB |
4265 | (defun todos-edit-item-diary-nonmarking () |
4266 | "Change non-marking of one or more diary items in this category. | |
4267 | That is, insert `diary-nonmarking-symbol' if the candidate items | |
4268 | lack this marking; otherwise, remove it. | |
d04d6b95 | 4269 | |
0e89c3fc SB |
4270 | If there are marked todo items, change the non-marking status of |
4271 | all and only these, otherwise change the non-marking status of | |
4272 | the item at point." | |
4273 | (interactive) | |
4274 | (let ((buffer-read-only) | |
4275 | (marked (assoc (todos-current-category) | |
4276 | todos-categories-with-marks))) | |
4277 | (catch 'stop | |
4278 | (save-excursion | |
4279 | (when marked (goto-char (point-min))) | |
4280 | (while (not (eobp)) | |
4281 | (if (todos-done-item-p) | |
4282 | (throw 'stop (message "Done items cannot be edited")) | |
4283 | (unless (and marked (not (todos-marked-item-p))) | |
4284 | (todos-item-start) | |
4285 | (unless (looking-at (regexp-quote todos-nondiary-start)) | |
4286 | (if (looking-at (regexp-quote diary-nonmarking-symbol)) | |
4287 | (replace-match "") | |
4288 | (insert diary-nonmarking-symbol)))) | |
4289 | (unless marked (throw 'stop nil)) | |
4290 | (todos-forward-item))))))) | |
58c7641d | 4291 | |
0e89c3fc SB |
4292 | (defun todos-edit-category-diary-nonmarking (arg) |
4293 | "Add `diary-nonmarking-symbol' to all diary items in this category. | |
4294 | With prefix ARG, remove `diary-nonmarking-symbol' from all diary | |
4295 | items in this category." | |
4296 | (interactive "P") | |
4297 | (save-excursion | |
4298 | (goto-char (point-min)) | |
4299 | (let (buffer-read-only) | |
4300 | (catch 'stop | |
4301 | (while (not (eobp)) | |
4302 | (if (todos-done-item-p) ; We've gone too far. | |
4303 | (throw 'stop nil) | |
4304 | (unless (looking-at (regexp-quote todos-nondiary-start)) | |
4305 | (if arg | |
4306 | (when (looking-at (regexp-quote diary-nonmarking-symbol)) | |
4307 | (replace-match "")) | |
4308 | (unless (looking-at (regexp-quote diary-nonmarking-symbol)) | |
4309 | (insert diary-nonmarking-symbol)))) | |
4310 | (todos-forward-item))))))) | |
58c7641d | 4311 | |
0e89c3fc SB |
4312 | (defun todos-raise-item-priority (&optional lower) |
4313 | "Raise priority of current item by moving it up by one item. | |
4314 | With non-nil argument LOWER lower item's priority." | |
4315 | (interactive) | |
2a9e69d6 SB |
4316 | (unless (or (todos-done-item-p) ; Can't reprioritize done items. |
4317 | ;; Can't raise or lower todo item when it's the only one. | |
4318 | (< (todos-get-count 'todo) 2) | |
0e89c3fc | 4319 | ;; Point is between todo and done items. |
2a9e69d6 SB |
4320 | (looking-at "^$") |
4321 | ;; Can't lower final todo item. | |
4322 | (and lower | |
0e89c3fc | 4323 | (save-excursion |
0e89c3fc | 4324 | (todos-forward-item) |
2a9e69d6 SB |
4325 | (looking-at "^$"))) |
4326 | ;; Can't reprioritize filtered items other than Top Priorities. | |
4327 | (and (eq major-mode 'todos-filter-items-mode) | |
4328 | (not (string-match (regexp-quote todos-top-priorities-buffer) | |
4329 | (buffer-name))))) | |
4330 | (let ((item (todos-item-string)) | |
4331 | (marked (todos-marked-item-p)) | |
4332 | buffer-read-only) | |
4333 | ;; In Top Priorities buffer, an item's priority can be changed | |
4334 | ;; wrt items in another category, but not wrt items in the same | |
4335 | ;; category. | |
4336 | (when (eq major-mode 'todos-filter-items-mode) | |
4337 | (let* ((regexp (concat todos-date-string-start todos-date-pattern | |
4338 | "\\( " diary-time-regexp "\\)?" | |
4339 | (regexp-quote todos-nondiary-end) | |
4340 | "?\\(?1: \\[\\(.+:\\)?.+\\]\\)")) | |
4341 | (cat1 (save-excursion | |
4342 | (re-search-forward regexp nil t) | |
4343 | (match-string 1))) | |
4344 | (cat2 (save-excursion | |
4345 | (if lower | |
4346 | (todos-forward-item) | |
4347 | (todos-backward-item)) | |
4348 | (re-search-forward regexp nil t) | |
4349 | (match-string 1)))) | |
4350 | (if (string= cat1 cat2) | |
4351 | (error | |
4352 | (concat "Cannot reprioritize items in the same " | |
4353 | "category in this mode, only in Todos mode"))))) | |
4354 | (todos-remove-item) | |
4355 | (if lower (todos-forward-item) (todos-backward-item)) | |
4356 | (todos-insert-with-overlays item) | |
4357 | ;; If item was marked, retore the mark. | |
4358 | (and marked (overlay-put (make-overlay (point) (point)) | |
4359 | 'before-string todos-item-mark))))) | |
3f031767 | 4360 | |
0e89c3fc SB |
4361 | (defun todos-lower-item-priority () |
4362 | "Lower priority of current item by moving it down by one item." | |
4363 | (interactive) | |
4364 | (todos-raise-item-priority t)) | |
ee7412e4 | 4365 | |
0e89c3fc | 4366 | ;; FIXME: incorporate todos-(raise|lower)-item-priority ? |
0e89c3fc SB |
4367 | (defun todos-set-item-priority (item cat &optional new) |
4368 | "Set todo ITEM's priority in category CAT, moving item as needed. | |
4369 | Interactively, the item and the category are the current ones, | |
4370 | and the priority is a number between 1 and the number of items in | |
4371 | the category. Non-interactively with argument NEW, the lowest | |
4372 | priority is one more than the number of items in CAT." | |
4373 | (interactive (list (todos-item-string) (todos-current-category))) | |
4374 | (unless (called-interactively-p t) | |
4375 | (todos-category-number cat) | |
4376 | (todos-category-select)) | |
4377 | (let* ((todo (todos-get-count 'todo cat)) | |
4378 | (maxnum (if new (1+ todo) todo)) | |
4379 | (buffer-read-only) | |
4380 | priority candidate prompt) | |
4381 | (unless (zerop todo) | |
4382 | (while (not priority) | |
4383 | (setq candidate | |
4384 | (string-to-number (read-from-minibuffer | |
4385 | (concat prompt | |
4386 | (format "Set item priority (1-%d): " | |
4387 | maxnum))))) | |
4388 | (setq prompt | |
4389 | (when (or (< candidate 1) (> candidate maxnum)) | |
4390 | (format "Priority must be an integer between 1 and %d.\n" | |
4391 | maxnum))) | |
4392 | (unless prompt (setq priority candidate))) | |
4393 | ;; Interactively, just relocate the item within its category. | |
4394 | (when (called-interactively-p) (todos-remove-item)) | |
4395 | (goto-char (point-min)) | |
4396 | (unless (= priority 1) (todos-forward-item (1- priority)))) | |
4397 | (todos-insert-with-overlays item))) | |
ee7412e4 | 4398 | |
2a9e69d6 SB |
4399 | (defun todos-set-item-top-priority () |
4400 | "Set this item's priority in the Top Priorities display. | |
4401 | Reprioritizing items that belong to the same category is not | |
4402 | allowed; this is reserved for Todos mode." | |
4403 | (interactive) | |
4404 | (when (string-match (regexp-quote todos-top-priorities-buffer) (buffer-name)) | |
4405 | (let* ((count 0) | |
4406 | (item (todos-item-string)) | |
4407 | (end (todos-item-end)) | |
4408 | (beg (todos-item-start)) | |
4409 | (regexp (concat todos-date-string-start todos-date-pattern | |
4410 | "\\(?: " diary-time-regexp "\\)?" | |
4411 | (regexp-quote todos-nondiary-end) | |
4412 | "?\\(?1: \\[\\(?:.+:\\)?.+\\]\\)")) | |
4413 | (cat (when (looking-at regexp) (match-string 1))) | |
4414 | buffer-read-only current priority candidate prompt new) | |
4415 | (save-excursion | |
4416 | (goto-char (point-min)) | |
4417 | (while (not (eobp)) | |
4418 | (setq count (1+ count)) | |
4419 | (when (string= item (todos-item-string)) | |
4420 | (setq current count)) | |
4421 | (todos-forward-item))) | |
4422 | (unless (zerop count) | |
4423 | (while (not priority) | |
4424 | (setq candidate | |
4425 | (string-to-number (read-from-minibuffer | |
4426 | (concat prompt | |
4427 | (format "Set item priority (1-%d): " | |
4428 | count))))) | |
4429 | (setq prompt | |
4430 | (when (or (< candidate 1) (> candidate count)) | |
4431 | (format "Priority must be an integer between 1 and %d.\n" | |
4432 | count))) | |
4433 | (unless prompt (setq priority candidate))) | |
4434 | (goto-char (point-min)) | |
4435 | (unless (= priority 1) (todos-forward-item (1- priority))) | |
4436 | (setq new (point-marker)) | |
4437 | (if (or (and (< priority current) | |
4438 | (todos-item-end) | |
4439 | (save-excursion (search-forward cat beg t))) | |
4440 | (and (> priority current) | |
4441 | (save-excursion (search-backward cat end t)))) | |
4442 | (progn | |
4443 | (set-marker new nil) | |
4444 | (goto-char beg) | |
4445 | (error (concat "Cannot reprioritize items in the same category " | |
4446 | "in this mode, only in Todos mode"))) | |
4447 | (goto-char beg) | |
4448 | (todos-remove-item) | |
4449 | (goto-char new) | |
4450 | (todos-insert-with-overlays item) | |
4451 | (set-marker new nil)))))) | |
4452 | ||
0e89c3fc SB |
4453 | (defun todos-move-item (&optional file) |
4454 | "Move at least one todo item to another category. | |
58c7641d | 4455 | |
0e89c3fc SB |
4456 | If there are marked items, move all of these; otherwise, move |
4457 | the item at point. | |
58c7641d | 4458 | |
0e89c3fc SB |
4459 | With non-nil argument FILE, first prompt for another Todos file and |
4460 | then a category in that file to move the item or items to. | |
58c7641d | 4461 | |
0e89c3fc SB |
4462 | If the chosen category is not one of the existing categories, |
4463 | then it is created and the item(s) become(s) the first | |
4464 | entry/entries in that category." | |
4465 | (interactive) | |
4466 | (unless (or (todos-done-item-p) | |
4467 | ;; Point is between todo and done items. | |
4468 | (looking-at "^$")) | |
4469 | (let* ((buffer-read-only) | |
4470 | (file1 todos-current-todos-file) | |
4471 | (cat1 (todos-current-category)) | |
4472 | (marked (assoc cat1 todos-categories-with-marks)) | |
4473 | (num todos-category-number) | |
4474 | (item (todos-item-string)) | |
4475 | (diary-item (todos-diary-item-p)) | |
4476 | (omark (save-excursion (todos-item-start) (point-marker))) | |
4477 | (file2 (if file | |
4478 | (todos-read-file-name "Choose a Todos file: " nil t) | |
4479 | file1)) | |
4480 | (count 0) | |
4481 | (count-diary 0) | |
4482 | cat2 nmark) | |
4483 | (set-buffer (find-file-noselect file2)) | |
4484 | (setq cat2 (let* ((pl (if (and marked (> (cdr marked) 1)) "s" "")) | |
4485 | (name (todos-read-category | |
4486 | (concat "Move item" pl " to category: "))) | |
4487 | (prompt (concat "Choose a different category than " | |
4488 | "the current one\n(type `" | |
4489 | (key-description | |
4490 | (car (where-is-internal | |
4491 | 'todos-set-item-priority))) | |
4492 | "' to reprioritize item " | |
4493 | "within the same category): "))) | |
4494 | (while (equal name cat1) | |
4495 | (setq name (todos-read-category prompt))) | |
4496 | name)) | |
6be04162 | 4497 | (set-buffer (find-buffer-visiting file1)) |
0e89c3fc SB |
4498 | (if marked |
4499 | (progn | |
4500 | (setq item nil) | |
4501 | (goto-char (point-min)) | |
4502 | (while (not (eobp)) | |
4503 | (when (todos-marked-item-p) | |
4504 | (setq item (concat item (todos-item-string) "\n")) | |
4505 | (setq count (1+ count)) | |
4506 | (when (todos-diary-item-p) | |
4507 | (setq count-diary (1+ count-diary)))) | |
4508 | (todos-forward-item)) | |
4509 | ;; Chop off last newline. | |
4510 | (setq item (substring item 0 -1))) | |
4511 | (setq count 1) | |
4512 | (when (todos-diary-item-p) (setq count-diary 1))) | |
4513 | (set-window-buffer (selected-window) | |
4514 | (set-buffer (find-file-noselect file2))) | |
4515 | (unless (assoc cat2 todos-categories) (todos-add-category cat2)) | |
4516 | (todos-set-item-priority item cat2 t) | |
4517 | (setq nmark (point-marker)) | |
3af3cd0b SB |
4518 | (todos-update-count 'todo count) |
4519 | (todos-update-count 'diary count-diary) | |
0e89c3fc | 4520 | (todos-update-categories-sexp) |
6be04162 | 4521 | (with-current-buffer (find-buffer-visiting file1) |
0e89c3fc SB |
4522 | (save-excursion |
4523 | (save-restriction | |
4524 | (widen) | |
4525 | (goto-char omark) | |
4526 | (if marked | |
4527 | (let (beg end) | |
4528 | (setq item nil) | |
4529 | (re-search-backward | |
4530 | (concat "^" (regexp-quote todos-category-beg)) nil t) | |
4531 | (forward-line) | |
4532 | (setq beg (point)) | |
4533 | (re-search-forward | |
4534 | (concat "^" (regexp-quote todos-category-done)) nil t) | |
4535 | (setq end (match-beginning 0)) | |
4536 | (goto-char beg) | |
4537 | (while (< (point) end) | |
4538 | (if (todos-marked-item-p) | |
4539 | (todos-remove-item) | |
4540 | (todos-forward-item)))) | |
4541 | (todos-remove-item)))) | |
3af3cd0b SB |
4542 | (todos-update-count 'todo (- count) cat1) |
4543 | (todos-update-count 'diary (- count-diary) cat1) | |
0e89c3fc SB |
4544 | (todos-update-categories-sexp)) |
4545 | (set-window-buffer (selected-window) | |
4546 | (set-buffer (find-file-noselect file2))) | |
4547 | (setq todos-category-number (todos-category-number cat2)) | |
4548 | (todos-category-select) | |
4549 | (goto-char nmark)))) | |
58c7641d | 4550 | |
0e89c3fc SB |
4551 | (defun todos-move-item-to-file () |
4552 | "Move the current todo item to a category in another Todos file." | |
58c7641d | 4553 | (interactive) |
0e89c3fc | 4554 | (todos-move-item t)) |
58c7641d | 4555 | |
0e89c3fc SB |
4556 | (defun todos-move-item-to-diary () |
4557 | "Move one or more items in current category to the diary file. | |
58c7641d | 4558 | |
0e89c3fc SB |
4559 | If there are marked items, move all of these; otherwise, move |
4560 | the item at point." | |
4561 | (interactive) | |
4562 | ;; FIXME | |
4563 | ) | |
58c7641d | 4564 | |
0e89c3fc SB |
4565 | ;; FIXME: make adding date customizable, and make this and time customization |
4566 | ;; overridable via double prefix arg ?? | |
4567 | (defun todos-item-done (&optional arg) | |
4568 | "Tag at least one item in this category as done and hide it. | |
4569 | ||
4570 | With prefix argument ARG prompt for a comment and append it to | |
4571 | the done item; this is only possible if there are no marked | |
4572 | items. If there are marked items, tag all of these with | |
4573 | `todos-done-string' plus the current date and, if | |
4574 | `todos-always-add-time-string' is non-nil, the current time; | |
4575 | otherwise, just tag the item at point. Items tagged as done are | |
4576 | relocated to the category's (by default hidden) done section." | |
4577 | (interactive "P") | |
4578 | (let* ((cat (todos-current-category)) | |
4579 | (marked (assoc cat todos-categories-with-marks))) | |
4580 | (unless (or (todos-done-item-p) | |
4581 | (and (looking-at "^$") (not marked))) | |
4582 | (let* ((date-string (calendar-date-string (calendar-current-date) t t)) | |
4583 | (time-string (if todos-always-add-time-string | |
4584 | (concat " " (substring (current-time-string) 11 16)) | |
4585 | "")) | |
4586 | (done-prefix (concat "[" todos-done-string date-string time-string | |
4587 | "] ")) | |
4588 | (comment (and arg (not marked) (read-string "Enter a comment: "))) | |
4589 | (item-count 0) | |
4590 | (diary-count 0) | |
4591 | item done-item | |
4592 | (buffer-read-only)) | |
4593 | (and marked (goto-char (point-min))) | |
4594 | (catch 'done | |
4595 | (while (not (eobp)) | |
4596 | (if (or (not marked) (and marked (todos-marked-item-p))) | |
4597 | (progn | |
4598 | (setq item (todos-item-string)) | |
4599 | (setq done-item (cond (marked | |
4600 | (concat done-item done-prefix item "\n")) | |
4601 | (comment | |
4602 | (concat done-prefix item " [" | |
4603 | todos-comment-string | |
4604 | ": " comment "]")) | |
4605 | (t | |
4606 | (concat done-prefix item)))) | |
4607 | (setq item-count (1+ item-count)) | |
4608 | (when (todos-diary-item-p) | |
4609 | (setq diary-count (1+ diary-count))) | |
4610 | (todos-remove-item) | |
4611 | (unless marked (throw 'done nil))) | |
4612 | (todos-forward-item)))) | |
4613 | (when marked | |
4614 | ;; Chop off last newline of done item string. | |
4615 | (setq done-item (substring done-item 0 -1)) | |
4616 | (remove-overlays (point-min) (point-max) 'before-string todos-item-mark) | |
4617 | (setq todos-categories-with-marks | |
4618 | (assq-delete-all cat todos-categories-with-marks))) | |
4619 | (save-excursion | |
4620 | (widen) | |
4621 | (re-search-forward | |
4622 | (concat "^" (regexp-quote todos-category-done)) nil t) | |
4623 | (forward-char) | |
4624 | (insert done-item "\n")) | |
3af3cd0b SB |
4625 | (todos-update-count 'todo (- item-count)) |
4626 | (todos-update-count 'done item-count) | |
4627 | (todos-update-count 'diary (- diary-count)) | |
0e89c3fc SB |
4628 | (todos-update-categories-sexp) |
4629 | (save-excursion (todos-category-select)))))) | |
4630 | ||
47011bed SB |
4631 | (defun todos-done-item-add-or-edit-comment () |
4632 | "Add a comment to this done item or edit an existing comment." | |
0e89c3fc SB |
4633 | (interactive) |
4634 | (when (todos-done-item-p) | |
47011bed SB |
4635 | (let ((item (todos-item-string)) |
4636 | (end (save-excursion (todos-item-end))) | |
4637 | comment buffer-read-only) | |
4638 | (save-excursion | |
4639 | (todos-item-start) | |
4640 | (if (re-search-forward (concat " \\[" | |
4641 | (regexp-quote todos-comment-string) | |
4642 | ": \\([^]]+\\)\\]") end t) | |
4643 | (progn | |
4644 | (setq comment (read-string "Edit comment: " | |
4645 | (cons (match-string 1) 1))) | |
4646 | (replace-match comment nil nil nil 1)) | |
4647 | (setq comment (read-string "Enter a comment: ")) | |
4648 | (todos-item-end) | |
4649 | (insert " [" todos-comment-string ": " comment "]")))))) | |
58c7641d | 4650 | |
0e89c3fc SB |
4651 | ;; FIXME: implement this or done item editing? |
4652 | (defun todos-uncomment-done-item () | |
4653 | "" | |
4654 | ) | |
58c7641d | 4655 | |
0e89c3fc SB |
4656 | ;; FIXME: delete comment from restored item or just leave it up to user? |
4657 | (defun todos-item-undo () | |
4658 | "Restore this done item to the todo section of this category." | |
4659 | (interactive) | |
4660 | (when (todos-done-item-p) | |
4661 | (let* ((buffer-read-only) | |
4662 | (done-item (todos-item-string)) | |
4663 | (opoint (point)) | |
4664 | (orig-mrk (progn (todos-item-start) (point-marker))) | |
4665 | ;; Find the end of the date string added upon making item done. | |
4666 | (start (search-forward "] ")) | |
4667 | (item (buffer-substring start (todos-item-end))) | |
4668 | undone) | |
4669 | (todos-remove-item) | |
4670 | ;; If user cancels before setting new priority, then restore everything. | |
4671 | (unwind-protect | |
4672 | (progn | |
4673 | (todos-set-item-priority item (todos-current-category) t) | |
4674 | (setq undone t) | |
3af3cd0b SB |
4675 | (todos-update-count 'todo 1) |
4676 | (todos-update-count 'done -1) | |
4677 | (and (todos-diary-item-p) (todos-update-count 'diary 1)) | |
0e89c3fc SB |
4678 | (todos-update-categories-sexp)) |
4679 | (unless undone | |
4680 | (widen) | |
4681 | (goto-char orig-mrk) | |
4682 | (todos-insert-with-overlays done-item) | |
4683 | (let ((todos-show-with-done t)) | |
4684 | (todos-category-select) | |
4685 | (goto-char opoint))) | |
4686 | (set-marker orig-mrk nil))))) | |
58c7641d | 4687 | |
2a9e69d6 | 4688 | (defun todos-archive-done-item (&optional all) |
0e89c3fc | 4689 | "Archive at least one done item in this category. |
d04d6b95 | 4690 | |
0e89c3fc SB |
4691 | If there are marked done items (and no marked todo items), |
4692 | archive all of these; otherwise, with non-nil argument ALL, | |
4693 | archive all done items in this category; otherwise, archive the | |
4694 | done item at point. | |
d04d6b95 | 4695 | |
0e89c3fc SB |
4696 | If the archive of this file does not exist, it is created. If |
4697 | this category does not exist in the archive, it is created." | |
4698 | (interactive) | |
2a9e69d6 | 4699 | (when (eq major-mode 'todos-mode) |
0e89c3fc SB |
4700 | (if (and all (zerop (todos-get-count 'done))) |
4701 | (message "No done items in this category") | |
4702 | (catch 'end | |
4703 | (let* ((cat (todos-current-category)) | |
4704 | (tbuf (current-buffer)) | |
4705 | (marked (assoc cat todos-categories-with-marks)) | |
4706 | (afile (concat (file-name-sans-extension | |
4707 | todos-current-todos-file) ".toda")) | |
4708 | (archive (if (file-exists-p afile) | |
4709 | (find-file-noselect afile t) | |
6be04162 | 4710 | (get-buffer-create afile))) |
0e89c3fc SB |
4711 | (item (and (todos-done-item-p) (concat (todos-item-string) "\n"))) |
4712 | (count 0) | |
4713 | marked-items beg end all-done | |
4714 | buffer-read-only) | |
4715 | (cond | |
4716 | (marked | |
4717 | (save-excursion | |
4718 | (goto-char (point-min)) | |
4719 | (while (not (eobp)) | |
6be04162 SB |
4720 | (when (todos-marked-item-p) |
4721 | (if (not (todos-done-item-p)) | |
4722 | (throw 'end (message "Only done items can be archived")) | |
4723 | (setq marked-items | |
4724 | (concat marked-items (todos-item-string) "\n")) | |
4725 | (setq count (1+ count)))) | |
4726 | (todos-forward-item)))) | |
0e89c3fc SB |
4727 | (all |
4728 | (if (y-or-n-p "Archive all done items in this category? ") | |
4729 | (save-excursion | |
4730 | (save-restriction | |
4731 | (goto-char (point-min)) | |
4732 | (widen) | |
4733 | (setq beg (progn | |
4734 | (re-search-forward todos-done-string-start nil t) | |
4735 | (match-beginning 0)) | |
4736 | end (if (re-search-forward | |
4737 | (concat "^" (regexp-quote todos-category-beg)) | |
4738 | nil t) | |
4739 | (match-beginning 0) | |
4740 | (point-max)) | |
4741 | all-done (buffer-substring beg end) | |
4742 | count (todos-get-count 'done)))) | |
4743 | (throw 'end nil)))) | |
4744 | (when (or marked all item) | |
4745 | (with-current-buffer archive | |
6be04162 | 4746 | (unless buffer-file-name (erase-buffer)) |
0e89c3fc SB |
4747 | (let ((current todos-global-current-todos-file) |
4748 | (buffer-read-only)) | |
4749 | (widen) | |
4750 | (goto-char (point-min)) | |
6be04162 SB |
4751 | (if (and (re-search-forward (concat "^" |
4752 | (regexp-quote | |
4753 | (concat todos-category-beg | |
4754 | cat))) | |
4755 | nil t) | |
4756 | (re-search-forward (regexp-quote todos-category-done) | |
4757 | nil t)) | |
4758 | (forward-char) ; Start of done items section. | |
0e89c3fc | 4759 | (todos-add-category cat) |
6be04162 | 4760 | (goto-char (point-max))) ; Start of done items section. |
0e89c3fc SB |
4761 | (insert (cond (marked marked-items) |
4762 | (all all-done) | |
4763 | (item))) | |
3af3cd0b | 4764 | (todos-update-count 'done (if (or marked all) count 1)) |
0e89c3fc | 4765 | (todos-update-categories-sexp) |
6be04162 SB |
4766 | ;; Save to file now (using write-region in order not to get |
4767 | ;; prompted for file to save to), to let auto-mode-alist take | |
4768 | ;; effect below. | |
4769 | (unless buffer-file-name | |
4770 | (write-region nil nil afile) | |
4771 | (kill-buffer)) | |
0e89c3fc SB |
4772 | (setq todos-current-todos-file current))) |
4773 | (with-current-buffer tbuf | |
4774 | (cond ((or marked item) | |
4775 | (and marked (goto-char (point-min))) | |
4776 | (catch 'done | |
4777 | (while (not (eobp)) | |
4778 | (if (or (and marked (todos-marked-item-p)) item) | |
4779 | (progn | |
4780 | (todos-remove-item) | |
3af3cd0b SB |
4781 | (todos-update-count 'done -1) |
4782 | (todos-update-count 'archived 1) | |
0e89c3fc SB |
4783 | ;; Don't leave point below last item. |
4784 | (and item (bolp) (eolp) (< (point-min) (point-max)) | |
4785 | (todos-backward-item)) | |
4786 | (when item | |
4787 | (throw 'done (setq item nil)))) | |
4788 | (todos-forward-item))))) | |
4789 | (all | |
4790 | (remove-overlays beg end) | |
4791 | (delete-region beg end) | |
3af3cd0b SB |
4792 | (todos-update-count 'done (- count)) |
4793 | (todos-update-count 'archived count))) | |
0e89c3fc SB |
4794 | (when marked |
4795 | (remove-overlays (point-min) (point-max) | |
4796 | 'before-string todos-item-mark) | |
4797 | (setq todos-categories-with-marks | |
4798 | (assq-delete-all cat todos-categories-with-marks)) | |
4799 | (goto-char opoint)) | |
4800 | (todos-update-categories-sexp) | |
4801 | (todos-prefix-overlays) | |
4802 | ;; FIXME: Heisenbug: item displays mark -- but not when edebugging | |
6be04162 SB |
4803 | ;; (remove-overlays (point-min) (point-max) |
4804 | ;; 'before-string todos-item-mark) | |
4805 | )) | |
4806 | (find-file afile) | |
4807 | (todos-category-number cat) | |
4808 | (todos-category-select) | |
4809 | ;; FIXME: what if window is already split? | |
4810 | (split-window-below) | |
4811 | (set-window-buffer (selected-window) tbuf)))))) | |
d04d6b95 | 4812 | |
0e89c3fc SB |
4813 | (defun todos-archive-category-done-items () |
4814 | "Move all done items in this category to its archive." | |
4815 | (interactive) | |
2a9e69d6 | 4816 | (todos-archive-done-item t)) |
d04d6b95 | 4817 | |
0e89c3fc SB |
4818 | (defun todos-unarchive-items (&optional all) |
4819 | "Unarchive at least one item in this archive category. | |
d04d6b95 | 4820 | |
0e89c3fc SB |
4821 | If there are marked items, unarchive all of these; otherwise, |
4822 | with non-nil argument ALL, unarchive all items in this category; | |
4823 | otherwise, unarchive the item at point. | |
d04d6b95 | 4824 | |
0e89c3fc SB |
4825 | Unarchived items are restored as done items to the corresponding |
4826 | category in the Todos file, inserted at the end of done section. | |
4827 | If all items in the archive category were restored, the category | |
4828 | is deleted from the archive. If this was the only category in the | |
4829 | archive, the archive file is deleted." | |
4830 | (interactive) | |
4831 | (when (member (buffer-file-name) (funcall todos-files-function t)) | |
4832 | (catch 'end | |
4833 | (let* ((buffer-read-only nil) | |
4834 | (tbuf (find-file-noselect | |
4835 | (concat (file-name-sans-extension todos-current-todos-file) | |
4836 | ".todo") t)) | |
4837 | (cat (todos-current-category)) | |
4838 | (marked (assoc cat todos-categories-with-marks)) | |
4839 | (item (concat (todos-item-string) "\n")) | |
4840 | (all-items (buffer-substring (point-min) (point-max))) | |
4841 | (all-count (todos-get-count 'done)) | |
4842 | marked-items marked-count) | |
4843 | (save-excursion | |
4844 | (goto-char (point-min)) | |
4845 | (while (not (eobp)) | |
4846 | (when (todos-marked-item-p) | |
4847 | (concat marked-items (todos-item-string) "\n") | |
4848 | (setq marked-count (1+ marked-count))) | |
4849 | (todos-forward-item))) | |
4850 | ;; Restore items to end of category's done section and update counts. | |
4851 | (with-current-buffer tbuf | |
4852 | (let (buffer-read-only) | |
4853 | (widen) | |
4854 | (goto-char (point-min)) | |
4855 | (re-search-forward (concat "^" (regexp-quote | |
4856 | (concat todos-category-beg cat))) | |
4857 | nil t) | |
4858 | (if (re-search-forward (concat "^" (regexp-quote todos-category-beg)) | |
4859 | nil t) | |
4860 | (goto-char (match-beginning 0)) | |
4861 | (goto-char (point-max))) | |
4862 | (cond (marked | |
4863 | (insert marked-items) | |
3af3cd0b SB |
4864 | (todos-update-count 'done marked-count) |
4865 | (todos-update-count 'archived (- marked-count))) | |
0e89c3fc SB |
4866 | (all |
4867 | (if (y-or-n-p (concat "Restore this category's items " | |
4868 | "to Todos file as done items " | |
4869 | "and delete this category? ")) | |
4870 | (progn (insert all-items) | |
3af3cd0b SB |
4871 | (todos-update-count 'done all-count) |
4872 | (todos-update-count 'archived (- all-count))) | |
0e89c3fc SB |
4873 | (throw 'end nil))) |
4874 | (t | |
4875 | (insert item) | |
3af3cd0b SB |
4876 | (todos-update-count 'done 1) |
4877 | (todos-update-count 'archived -1))) | |
0e89c3fc SB |
4878 | (todos-update-categories-sexp))) |
4879 | ;; Delete restored items from archive. | |
4880 | (cond ((or marked item) | |
4881 | (and marked (goto-char (point-min))) | |
4882 | (catch 'done | |
4883 | (while (not (eobp)) | |
4884 | (if (or (and marked (todos-marked-item-p)) item) | |
4885 | (progn | |
4886 | (todos-remove-item) | |
3af3cd0b | 4887 | (todos-update-count 'done -1) |
0e89c3fc SB |
4888 | ;; Don't leave point below last item. |
4889 | (and item (bolp) (eolp) (< (point-min) (point-max)) | |
4890 | (todos-backward-item)) | |
4891 | (when item | |
4892 | (throw 'done (setq item nil)))) | |
4893 | (todos-forward-item))))) | |
4894 | (all | |
4895 | (remove-overlays (point-min) (point-max)) | |
4896 | (delete-region (point-min) (point-max)) | |
3af3cd0b | 4897 | (todos-update-count 'done (- all-count)))) |
0e89c3fc SB |
4898 | ;; If that was the last category in the archive, delete the whole file. |
4899 | (if (= (length todos-categories) 1) | |
4900 | (progn | |
4901 | (delete-file todos-current-todos-file) | |
4902 | ;; Don't bother confirming killing the archive buffer. | |
4903 | (set-buffer-modified-p nil) | |
4904 | (kill-buffer)) | |
4905 | ;; Otherwise, if the archive category is now empty, delete it. | |
4906 | (when (eq (point-min) (point-max)) | |
4907 | (widen) | |
4908 | (let ((beg (re-search-backward | |
4909 | (concat "^" (regexp-quote todos-category-beg) cat) | |
4910 | nil t)) | |
4911 | (end (if (re-search-forward | |
4912 | (concat "^" (regexp-quote todos-category-beg)) | |
4913 | nil t 2) | |
4914 | (match-beginning 0) | |
4915 | (point-max)))) | |
4916 | (remove-overlays beg end) | |
4917 | (delete-region beg end) | |
4918 | (setq todos-categories (delete (assoc cat todos-categories) | |
4919 | todos-categories)) | |
7464f422 SB |
4920 | (setq todos-categories (delete (assoc cat todos-categories) |
4921 | todos-categories)) | |
0e89c3fc SB |
4922 | (todos-update-categories-sexp)))) |
4923 | ;; Visit category in Todos file and show restored done items. | |
4924 | (let ((tfile (buffer-file-name tbuf)) | |
4925 | (todos-show-with-done t)) | |
4926 | (set-window-buffer (selected-window) | |
4927 | (set-buffer (find-file-noselect tfile))) | |
4928 | (todos-category-number cat) | |
4929 | (todos-show) | |
4930 | (message "Items unarchived.")))))) | |
58c7641d | 4931 | |
0e89c3fc SB |
4932 | (defun todos-unarchive-category () |
4933 | "Unarchive all items in this category. See `todos-unarchive-items'." | |
4934 | (interactive) | |
4935 | (todos-unarchive-items t)) | |
3f031767 SB |
4936 | |
4937 | (provide 'todos) | |
4938 | ||
3f031767 | 4939 | ;;; todos.el ends here |
58c7641d | 4940 | |
520d912e | 4941 | ;; --------------------------------------------------------------------------- |
520d912e | 4942 | |
7464f422 SB |
4943 | ;; FIXME: remove when part of Emacs |
4944 | (add-to-list 'auto-mode-alist '("\\.todo\\'" . todos-mode)) | |
4945 | (add-to-list 'auto-mode-alist '("\\.toda\\'" . todos-archive-mode)) | |
4946 | ||
4947 | ;;; Addition to calendar.el | |
520d912e SB |
4948 | ;; FIXME: autoload when key-binding is defined in calendar.el |
4949 | (defun todos-insert-item-from-calendar () | |
4950 | "" | |
4951 | (interactive) | |
4952 | ;; FIXME: todos-current-todos-file is nil here, better to solicit Todos | |
4953 | ;; file? todos-global-current-todos-file is nil if no Todos file has been | |
4954 | ;; visited | |
4955 | (pop-to-buffer (file-name-nondirectory todos-global-current-todos-file)) | |
4956 | (todos-show) | |
4957 | ;; FIXME: this now calls todos-set-date-from-calendar | |
4958 | (todos-insert-item t 'calendar)) | |
4959 | ||
4960 | ;; FIXME: calendar is loaded before todos | |
4961 | ;; (add-hook 'calendar-load-hook | |
4962 | ;; (lambda () | |
4963 | (define-key calendar-mode-map "it" 'todos-insert-item-from-calendar);)) | |
4964 | ||
0e89c3fc | 4965 | ;; --------------------------------------------------------------------------- |
58c7641d SB |
4966 | ;;; necessitated adaptations to diary-lib.el |
4967 | ||
4968 | ;; (defun diary-goto-entry (button) | |
4969 | ;; "Jump to the diary entry for the BUTTON at point." | |
4970 | ;; (let* ((locator (button-get button 'locator)) | |
4971 | ;; (marker (car locator)) | |
4972 | ;; markbuf file opoint) | |
4973 | ;; ;; If marker pointing to diary location is valid, use that. | |
4974 | ;; (if (and marker (setq markbuf (marker-buffer marker))) | |
4975 | ;; (progn | |
4976 | ;; (pop-to-buffer markbuf) | |
4977 | ;; (goto-char (marker-position marker))) | |
4978 | ;; ;; Marker is invalid (eg buffer has been killed, as is the case with | |
4979 | ;; ;; included diary files). | |
4980 | ;; (or (and (setq file (cadr locator)) | |
4981 | ;; (file-exists-p file) | |
4982 | ;; (find-file-other-window file) | |
4983 | ;; (progn | |
4984 | ;; (when (eq major-mode (default-value 'major-mode)) (diary-mode)) | |
4985 | ;; (when (eq major-mode 'todos-mode) (widen)) | |
4986 | ;; (goto-char (point-min)) | |
4987 | ;; (when (re-search-forward (format "%s.*\\(%s\\)" | |
4988 | ;; (regexp-quote (nth 2 locator)) | |
4989 | ;; (regexp-quote (nth 3 locator))) | |
4990 | ;; nil t) | |
4991 | ;; (goto-char (match-beginning 1)) | |
4992 | ;; (when (eq major-mode 'todos-mode) | |
4993 | ;; (setq opoint (point)) | |
4994 | ;; (re-search-backward (concat "^" | |
4995 | ;; (regexp-quote todos-category-beg) | |
4996 | ;; "\\(.*\\)\n") | |
4997 | ;; nil t) | |
4998 | ;; (todos-category-number (match-string 1)) | |
4999 | ;; (todos-category-select) | |
5000 | ;; (goto-char opoint))))) | |
5001 | ;; (message "Unable to locate this diary entry"))))) |