Commit | Line | Data |
---|---|---|
a9b0e28e | 1 | ;;; todos.el --- facilities for making and maintaining todo lists |
3f031767 | 2 | |
e99a2125 | 3 | ;; Copyright (C) 2013 Free Software Foundation, Inc. |
3f031767 | 4 | |
e99a2125 | 5 | ;; Author: Stephen Berman <stephen.berman@gmx.net> |
3f031767 SB |
6 | ;; Keywords: calendar, todo |
7 | ||
0e89c3fc | 8 | ;; This file is [not yet] part of GNU Emacs. |
3f031767 SB |
9 | |
10 | ;; GNU Emacs is free software: you can redistribute it and/or modify | |
11 | ;; it under the terms of the GNU General Public License as published by | |
12 | ;; the Free Software Foundation, either version 3 of the License, or | |
13 | ;; (at your option) any later version. | |
14 | ||
15 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 | ;; GNU General Public License for more details. | |
19 | ||
20 | ;; You should have received a copy of the GNU General Public License | |
21 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | |
22 | ||
3f031767 SB |
23 | ;;; Commentary: |
24 | ||
e99a2125 SB |
25 | ;; This package provides facilities for making, displaying, navigating |
26 | ;; and editing todo lists, which are prioritized lists of todo items. | |
db5ea477 SB |
27 | ;; Todo lists are identified with named categories, so you can group |
28 | ;; together thematically related todo items. Each category is stored | |
29 | ;; in a file, which thus provides a further level of organization. | |
30 | ;; You can create as many todo files, and in each as many categories, | |
31 | ;; as you want. | |
32 | ||
33 | ;; With Todos you can navigate among the items of a category, and | |
34 | ;; between categories in the same and in different todo files. You | |
35 | ;; can edit todo items, reprioritize them within their category, move | |
36 | ;; them to another category, delete them, or mark items as done and | |
37 | ;; store them separately from the not yet done items in a category. | |
38 | ;; You can add new todo files and categories, rename categories, move | |
39 | ;; them to another file or delete them. You can also display summary | |
40 | ;; tables of the categories in a file and the types of items they | |
41 | ;; contain. And you can build cross-categorial lists of items that | |
42 | ;; satisfy various criteria. | |
e99a2125 SB |
43 | |
44 | ;; To get started, load this package and type `M-x todos-show'. This | |
db5ea477 SB |
45 | ;; will prompt you for the name of the first todo file, its first |
46 | ;; category and the category's first item, create these and display | |
47 | ;; them in Todos mode. Now you can insert further items into the list | |
48 | ;; (i.e., the category) and assign them priorities by typing `i i'. | |
49 | ||
50 | ;; You will probably find it convenient to give `todos-show' a global | |
51 | ;; key binding in your init file, since it is one of the entry points | |
52 | ;; to Todos mode; a good choice is `C-c t', since `todos-show' is | |
53 | ;; bound to `t' in Todos mode. | |
54 | ||
55 | ;; To see a list of all Todos mode commands and their key bindings, | |
56 | ;; including other entry points, type `C-h m' in Todos mode. Consult | |
57 | ;; the document strings of the commands for details of their use. The | |
58 | ;; `todos' customization group and its subgroups list the options you | |
59 | ;; can set to alter the behavior of many commands and various aspects | |
60 | ;; of the display. | |
e99a2125 SB |
61 | |
62 | ;; This package is a new version of Oliver Seidel's todo-mode.el, | |
63 | ;; which retains the same basic organization and handling of todo | |
64 | ;; lists and the basic UI, but extends these in many ways and | |
65 | ;; reimplements most of the internals. | |
66 | ||
3f031767 SB |
67 | ;;; Code: |
68 | ||
b28025ed | 69 | (require 'diary-lib) |
e4ae44d9 | 70 | ;; For cl-remove-duplicates (in todos-insertion-commands-args) and cl-oddp. |
a9b0e28e | 71 | (require 'cl-lib) |
3f031767 | 72 | |
a9b0e28e | 73 | ;; ============================================================================= |
27139cd5 | 74 | ;;; User interface |
a9b0e28e SB |
75 | ;; ============================================================================= |
76 | ;; ----------------------------------------------------------------------------- | |
27139cd5 | 77 | ;;; Options for file and category selection |
a9b0e28e | 78 | ;; ----------------------------------------------------------------------------- |
27139cd5 | 79 | |
caa229d5 | 80 | (defcustom todos-directory (locate-user-emacs-file "todos/") |
0e89c3fc SB |
81 | "Directory where user's Todos files are saved." |
82 | :type 'directory | |
83 | :group 'todos) | |
84 | ||
85 | (defun todos-files (&optional archives) | |
86 | "Default value of `todos-files-function'. | |
87 | This returns the case-insensitive alphabetically sorted list of | |
caa229d5 | 88 | file truenames in `todos-directory' with the extension |
0e89c3fc SB |
89 | \".todo\". With non-nil ARCHIVES return the list of archive file |
90 | truenames (those with the extension \".toda\")." | |
caa229d5 | 91 | (let ((files (if (file-exists-p todos-directory) |
0e89c3fc | 92 | (mapcar 'file-truename |
caa229d5 | 93 | (directory-files todos-directory t |
0e89c3fc SB |
94 | (if archives "\.toda$" "\.todo$") t))))) |
95 | (sort files (lambda (s1 s2) (let ((cis1 (upcase s1)) | |
96 | (cis2 (upcase s2))) | |
97 | (string< cis1 cis2)))))) | |
98 | ||
99 | (defcustom todos-files-function 'todos-files | |
100 | "Function returning the value of the variable `todos-files'. | |
101 | This function should take an optional argument that, if non-nil, | |
102 | makes it return the value of the variable `todos-archives'." | |
103 | :type 'function | |
104 | :group 'todos) | |
105 | ||
106 | (defun todos-short-file-name (file) | |
107 | "Return short form of Todos FILE. | |
108 | This lacks the extension and directory components." | |
37f48249 SB |
109 | (when (stringp file) |
110 | (file-name-sans-extension (file-name-nondirectory file)))) | |
0e89c3fc | 111 | |
27139cd5 SB |
112 | (defcustom todos-visit-files-commands (list 'find-file 'dired-find-file) |
113 | "List of file finding commands for `todos-display-as-todos-file'. | |
114 | Invoking these commands to visit a Todos or Todos Archive file | |
115 | calls `todos-show' or `todos-find-archive', so that the file is | |
116 | displayed correctly." | |
117 | :type '(repeat function) | |
118 | :group 'todos) | |
119 | ||
a2730169 SB |
120 | (defcustom todos-default-todos-file (todos-short-file-name |
121 | (car (funcall todos-files-function))) | |
0e89c3fc SB |
122 | "Todos file visited by first session invocation of `todos-show'." |
123 | :type `(radio ,@(mapcar (lambda (f) (list 'const f)) | |
124 | (mapcar 'todos-short-file-name | |
125 | (funcall todos-files-function)))) | |
126 | :group 'todos) | |
127 | ||
0e89c3fc SB |
128 | (defcustom todos-show-current-file t |
129 | "Non-nil to make `todos-show' visit the current Todos file. | |
130 | Otherwise, `todos-show' always visits `todos-default-todos-file'." | |
131 | :type 'boolean | |
132 | :initialize 'custom-initialize-default | |
3af3cd0b | 133 | :set 'todos-set-show-current-file |
0e89c3fc SB |
134 | :group 'todos) |
135 | ||
27139cd5 SB |
136 | (defcustom todos-show-first 'first |
137 | "What action to take on first use of `todos-show' on a file." | |
138 | :type '(choice (const :tag "Show first category" first) | |
139 | (const :tag "Show table of categories" table) | |
140 | (const :tag "Show top priorities" top) | |
141 | (const :tag "Show diary items" diary) | |
142 | (const :tag "Show regexp items" regexp)) | |
0e89c3fc SB |
143 | :group 'todos) |
144 | ||
145 | (defcustom todos-initial-file "Todo" | |
146 | "Default file name offered on adding first Todos file." | |
147 | :type 'string | |
148 | :group 'todos) | |
149 | ||
d04d6b95 SB |
150 | (defcustom todos-initial-category "Todo" |
151 | "Default category name offered on initializing a new Todos file." | |
152 | :type 'string | |
153 | :group 'todos) | |
154 | ||
27139cd5 SB |
155 | (defcustom todos-category-completions-files nil |
156 | "List of files for building `todos-read-category' completions." | |
157 | :type `(set ,@(mapcar (lambda (f) (list 'const f)) | |
158 | (mapcar 'todos-short-file-name | |
159 | (funcall todos-files-function)))) | |
d04d6b95 SB |
160 | :group 'todos) |
161 | ||
18aef8a3 SB |
162 | (defcustom todos-completion-ignore-case nil |
163 | "Non-nil means case is ignored by `todos-read-*' functions." | |
164 | :type 'boolean | |
165 | :group 'todos) | |
166 | ||
a9b0e28e | 167 | ;; ----------------------------------------------------------------------------- |
27139cd5 | 168 | ;;; Entering and exiting Todos mode |
a9b0e28e | 169 | ;; ----------------------------------------------------------------------------- |
1a9cb339 | 170 | |
27139cd5 SB |
171 | (defun todos-show (&optional solicit-file) |
172 | "Visit a Todos file and display one of its categories. | |
18aef8a3 | 173 | |
27139cd5 SB |
174 | When invoked in Todos mode, prompt for which todo file to visit. |
175 | When invoked outside of Todos mode with non-nil prefix argument | |
176 | SOLICIT-FILE prompt for which todo file to visit; otherwise visit | |
177 | `todos-default-todos-file'. Subsequent invocations from outside | |
178 | of Todos mode revisit this file or, with option | |
179 | `todos-show-current-file' non-nil (the default), whichever Todos | |
180 | file was last visited. | |
18aef8a3 | 181 | |
27139cd5 SB |
182 | Calling this command before any Todos file exists prompts for a |
183 | file name and an initial category (defaulting to | |
184 | `todos-initial-file' and `todos-initial-category'), creates both | |
c66f681c SB |
185 | of these, visits the file and displays the category, and if |
186 | option `todos-add-item-if-new-category' is non-nil (the default), | |
187 | prompts for the first item. | |
36341a66 | 188 | |
27139cd5 SB |
189 | The first invocation of this command on an existing Todos file |
190 | interacts with the option `todos-show-first': if its value is | |
191 | `first' (the default), show the first category in the file; if | |
192 | its value is `table', show the table of categories in the file; | |
193 | if its value is one of `top', `diary' or `regexp', show the | |
194 | corresponding saved top priorities, diary items, or regexp items | |
195 | file, if any. Subsequent invocations always show the file's | |
196 | current (i.e., last displayed) category. | |
18aef8a3 | 197 | |
27139cd5 SB |
198 | In Todos mode just the category's unfinished todo items are shown |
199 | by default. The done items are hidden, but typing | |
200 | `\\[todos-toggle-view-done-items]' displays them below the todo | |
201 | items. With non-nil user option `todos-show-with-done' both todo | |
202 | and done items are always shown on visiting a category. | |
2c173503 | 203 | |
27139cd5 SB |
204 | Invoking this command in Todos Archive mode visits the |
205 | corresponding Todos file, displaying the corresponding category." | |
206 | (interactive "P") | |
207 | (let* ((cat) | |
208 | (show-first todos-show-first) | |
209 | (file (cond ((or solicit-file | |
210 | (and (called-interactively-p 'any) | |
211 | (memq major-mode '(todos-mode | |
212 | todos-archive-mode | |
213 | todos-filtered-items-mode)))) | |
214 | (if (funcall todos-files-function) | |
215 | (todos-read-file-name "Choose a Todos file to visit: " | |
216 | nil t) | |
a9b0e28e | 217 | (user-error "There are no Todos files"))) |
27139cd5 SB |
218 | ((and (eq major-mode 'todos-archive-mode) |
219 | ;; Called noninteractively via todos-quit | |
220 | ;; to jump to corresponding category in | |
221 | ;; todo file. | |
222 | (not (called-interactively-p 'any))) | |
223 | (setq cat (todos-current-category)) | |
e99a2125 SB |
224 | (concat (file-name-sans-extension |
225 | todos-current-todos-file) ".todo")) | |
27139cd5 SB |
226 | (t |
227 | (or todos-current-todos-file | |
228 | (and todos-show-current-file | |
229 | todos-global-current-todos-file) | |
230 | (todos-absolute-file-name todos-default-todos-file) | |
c66f681c SB |
231 | (todos-add-file))))) |
232 | add-item first-file) | |
37f48249 SB |
233 | (unless todos-default-todos-file |
234 | ;; We just initialized the first todo file, so make it the default. | |
c66f681c SB |
235 | (setq todos-default-todos-file (todos-short-file-name file) |
236 | first-file t) | |
37f48249 | 237 | (todos-reevaluate-default-file-defcustom)) |
27139cd5 SB |
238 | (unless (member file todos-visited) |
239 | ;; Can't setq t-c-t-f here, otherwise wrong file shown when | |
240 | ;; todos-show is called from todos-show-categories-table. | |
241 | (let ((todos-current-todos-file file)) | |
242 | (cond ((eq todos-show-first 'table) | |
243 | (todos-show-categories-table)) | |
244 | ((memq todos-show-first '(top diary regexp)) | |
245 | (let* ((shortf (todos-short-file-name file)) | |
246 | (fi-file (todos-absolute-file-name | |
247 | shortf todos-show-first))) | |
248 | (when (eq todos-show-first 'regexp) | |
249 | (let ((rxfiles (directory-files todos-directory t | |
250 | ".*\\.todr$" t))) | |
251 | (when (and rxfiles (> (length rxfiles) 1)) | |
252 | (let ((rxf (mapcar 'todos-short-file-name rxfiles))) | |
253 | (setq fi-file (todos-absolute-file-name | |
254 | (completing-read | |
255 | "Choose a regexp items file: " | |
256 | rxf) 'regexp)))))) | |
257 | (if (file-exists-p fi-file) | |
258 | (set-window-buffer | |
259 | (selected-window) | |
260 | (set-buffer (find-file-noselect fi-file 'nowarn))) | |
261 | (message "There is no %s file for %s" | |
262 | (cond ((eq todos-show-first 'top) | |
263 | "top priorities") | |
264 | ((eq todos-show-first 'diary) | |
265 | "diary items") | |
266 | ((eq todos-show-first 'regexp) | |
267 | "regexp items")) | |
268 | shortf) | |
269 | (setq todos-show-first 'first))))))) | |
270 | (when (or (member file todos-visited) | |
271 | (eq todos-show-first 'first)) | |
272 | (set-window-buffer (selected-window) | |
273 | (set-buffer (find-file-noselect file 'nowarn))) | |
274 | ;; When quitting archive file, show corresponding category in | |
275 | ;; Todos file, if it exists. | |
276 | (when (assoc cat todos-categories) | |
277 | (setq todos-category-number (todos-category-number cat))) | |
278 | ;; If this is a new Todos file, add its first category. | |
279 | (when (zerop (buffer-size)) | |
c66f681c SB |
280 | (let (cat-added) |
281 | (unwind-protect | |
282 | (setq todos-category-number | |
283 | (todos-add-category todos-current-todos-file "") | |
284 | add-item todos-add-item-if-new-category | |
285 | cat-added t) | |
286 | (if cat-added | |
287 | ;; If the category was added, save the file now, so we | |
db5ea477 SB |
288 | ;; don't risk having an empty todo file, which would |
289 | ;; signal an error if we tried to visit it later, | |
290 | ;; since doing that looks for category boundaries. | |
c66f681c SB |
291 | (save-buffer 0) |
292 | ;; If user cancels before adding the category, clean up | |
293 | ;; and exit, so we have a fresh slate the next time. | |
294 | (delete-file file) | |
295 | (setq todos-files (delete file todos-files)) | |
296 | (when first-file | |
297 | (setq todos-default-todos-file nil | |
298 | todos-current-todos-file nil)) | |
299 | (kill-buffer) | |
300 | (keyboard-quit))))) | |
37f48249 SB |
301 | (save-excursion (todos-category-select)) |
302 | (when add-item (todos-basic-insert-item))) | |
27139cd5 SB |
303 | (setq todos-show-first show-first) |
304 | (add-to-list 'todos-visited file))) | |
2c173503 | 305 | |
27139cd5 SB |
306 | (defun todos-save () |
307 | "Save the current Todos file." | |
308 | (interactive) | |
309 | (cond ((eq major-mode 'todos-filtered-items-mode) | |
310 | (todos-check-filtered-items-file) | |
311 | (todos-save-filtered-items-buffer)) | |
312 | (t | |
313 | (save-buffer)))) | |
0e89c3fc | 314 | |
27139cd5 SB |
315 | (defun todos-quit () |
316 | "Exit the current Todos-related buffer. | |
317 | Depending on the specific mode, this either kills the buffer or | |
318 | buries it and restores state as needed." | |
319 | (interactive) | |
320 | (let ((buf (current-buffer))) | |
321 | (cond ((eq major-mode 'todos-categories-mode) | |
322 | ;; Postpone killing buffer till after calling todos-show, to | |
323 | ;; prevent killing todos-mode buffer. | |
324 | (setq todos-descending-counts nil) | |
325 | ;; Ensure todos-show calls todos-show-categories-table only on | |
326 | ;; first invocation per file. | |
327 | (when (eq todos-show-first 'table) | |
328 | (add-to-list 'todos-visited todos-current-todos-file)) | |
329 | (todos-show) | |
330 | (kill-buffer buf)) | |
331 | ((eq major-mode 'todos-filtered-items-mode) | |
332 | (kill-buffer) | |
333 | (unless (eq major-mode 'todos-mode) (todos-show))) | |
334 | ((eq major-mode 'todos-archive-mode) | |
db5ea477 SB |
335 | ;; Have to write a newly created archive to file to avoid |
336 | ;; subsequent errors. | |
337 | (todos-save) | |
27139cd5 SB |
338 | (todos-show) |
339 | (bury-buffer buf)) | |
340 | ((eq major-mode 'todos-mode) | |
341 | (todos-save) | |
342 | ;; If we just quit archive mode, just burying the buffer | |
343 | ;; in todos-mode would return to archive. | |
344 | (set-window-buffer (selected-window) | |
345 | (set-buffer (other-buffer))) | |
346 | (bury-buffer buf))))) | |
1fcf038b | 347 | |
a9b0e28e | 348 | ;; ----------------------------------------------------------------------------- |
27139cd5 | 349 | ;;; Navigation commands |
a9b0e28e | 350 | ;; ----------------------------------------------------------------------------- |
144faf47 | 351 | |
27139cd5 SB |
352 | (defun todos-forward-category (&optional back) |
353 | "Visit the numerically next category in this Todos file. | |
354 | If the current category is the highest numbered, visit the first | |
355 | category. With non-nil argument BACK, visit the numerically | |
356 | previous category (the highest numbered one, if the current | |
357 | category is the first)." | |
358 | (interactive) | |
359 | (setq todos-category-number | |
360 | (1+ (mod (- todos-category-number (if back 2 0)) | |
361 | (length todos-categories)))) | |
362 | (when todos-skip-archived-categories | |
363 | (while (and (zerop (todos-get-count 'todo)) | |
364 | (zerop (todos-get-count 'done)) | |
365 | (not (zerop (todos-get-count 'archived)))) | |
366 | (setq todos-category-number | |
367 | (apply (if back '1- '1+) (list todos-category-number))))) | |
368 | (todos-category-select) | |
369 | (goto-char (point-min))) | |
2c173503 | 370 | |
27139cd5 SB |
371 | (defun todos-backward-category () |
372 | "Visit the numerically previous category in this Todos file. | |
373 | If the current category is the highest numbered, visit the first | |
374 | category." | |
375 | (interactive) | |
376 | (todos-forward-category t)) | |
0e89c3fc | 377 | |
27139cd5 SB |
378 | (defun todos-jump-to-category (&optional file where) |
379 | "Prompt for a category in a Todos file and jump to it. | |
58c7641d | 380 | |
27139cd5 SB |
381 | With non-nil FILE (interactively a prefix argument), prompt for a |
382 | specific Todos file and choose (with TAB completion) a category | |
383 | in it to jump to; otherwise, choose and jump to any category in | |
384 | either the current Todos file or a file in | |
385 | `todos-category-completions-files'. | |
0e89c3fc | 386 | |
c66f681c SB |
387 | Also accept a non-existing category name and ask whether to add a |
388 | new category by that name; on confirmation, add it and jump to | |
389 | that category, and if option `todos-add-item-if-new-category' is | |
390 | non-nil (the default), then prompt for the first item. | |
2c173503 | 391 | |
27139cd5 SB |
392 | In noninteractive calls non-nil WHERE specifies either the goal |
393 | category or its file. If its value is `archive', the choice of | |
394 | categories is restricted to the current archive file or the | |
395 | archive you were prompted to choose; this is used by | |
396 | `todos-jump-to-archive-category'. If its value is the name of a | |
397 | category, jump directly to that category; this is used in Todos | |
398 | Categories mode." | |
399 | (interactive "P") | |
400 | ;; If invoked outside of Todos mode and there is not yet any Todos | |
401 | ;; file, initialize one. | |
402 | (if (null todos-files) | |
403 | (todos-show) | |
404 | (let* ((archive (eq where 'archive)) | |
405 | (cat (unless archive where)) | |
406 | (file0 (when cat ; We're in Todos Categories mode. | |
407 | ;; With non-nil `todos-skip-archived-categories' | |
408 | ;; jump to archive file of a category with only | |
409 | ;; archived items. | |
410 | (if (and todos-skip-archived-categories | |
411 | (zerop (todos-get-count 'todo cat)) | |
412 | (zerop (todos-get-count 'done cat)) | |
413 | (not (zerop (todos-get-count 'archived cat)))) | |
414 | (concat (file-name-sans-extension | |
415 | todos-current-todos-file) ".toda") | |
416 | ;; Otherwise, jump to current todos file. | |
417 | todos-current-todos-file))) | |
37f48249 SB |
418 | (len (length todos-categories)) |
419 | (cat+file (unless cat | |
420 | (todos-read-category "Jump to category: " | |
421 | (if archive 'archive) file))) | |
422 | (add-item (and todos-add-item-if-new-category | |
423 | (> (length todos-categories) len)))) | |
27139cd5 SB |
424 | (setq category (or cat (car cat+file))) |
425 | (unless cat (setq file0 (cdr cat+file))) | |
426 | (with-current-buffer (find-file-noselect file0 'nowarn) | |
427 | (setq todos-current-todos-file file0) | |
428 | ;; If called from Todos Categories mode, clean up before jumping. | |
429 | (if (string= (buffer-name) todos-categories-buffer) | |
430 | (kill-buffer)) | |
431 | (set-window-buffer (selected-window) | |
432 | (set-buffer (find-buffer-visiting file0))) | |
433 | (unless todos-global-current-todos-file | |
434 | (setq todos-global-current-todos-file todos-current-todos-file)) | |
435 | (todos-category-number category) | |
436 | (todos-category-select) | |
37f48249 SB |
437 | (goto-char (point-min)) |
438 | (when add-item (todos-basic-insert-item)))))) | |
0e89c3fc | 439 | |
27139cd5 SB |
440 | (defun todos-next-item (&optional count) |
441 | "Move point down to the beginning of the next item. | |
442 | With positive numerical prefix COUNT, move point COUNT items | |
443 | downward. | |
2c173503 | 444 | |
27139cd5 SB |
445 | If the category's done items are hidden, this command also moves |
446 | point to the empty line below the last todo item from any higher | |
447 | item in the category, i.e., when invoked with or without a prefix | |
448 | argument. If the category's done items are visible, this command | |
449 | called with a prefix argument only moves point to a lower item, | |
450 | e.g., with point on the last todo item and called with prefix 1, | |
451 | it moves point to the first done item; but if called with point | |
452 | on the last todo item without a prefix argument, it moves point | |
453 | the the empty line above the done items separator." | |
454 | (interactive "p") | |
455 | ;; It's not worth the trouble to allow prefix arg value < 1, since we have | |
456 | ;; the corresponding command. | |
457 | (cond ((and current-prefix-arg (< count 1)) | |
458 | (user-error "The prefix argument must be a positive number")) | |
459 | (current-prefix-arg | |
460 | (todos-forward-item count)) | |
461 | (t | |
462 | (todos-forward-item)))) | |
58c7641d | 463 | |
27139cd5 SB |
464 | (defun todos-previous-item (&optional count) |
465 | "Move point up to start of item with next higher priority. | |
466 | With positive numerical prefix COUNT, move point COUNT items | |
467 | upward. | |
2c173503 | 468 | |
27139cd5 SB |
469 | If the category's done items are visible, this command called |
470 | with a prefix argument only moves point to a higher item, e.g., | |
471 | with point on the first done item and called with prefix 1, it | |
472 | moves to the last todo item; but if called with point on the | |
473 | first done item without a prefix argument, it moves point the the | |
474 | empty line above the done items separator." | |
475 | (interactive "p") | |
476 | ;; Avoid moving to bob if on the first item but not at bob. | |
477 | (when (> (line-number-at-pos) 1) | |
478 | ;; It's not worth the trouble to allow prefix arg value < 1, since we have | |
479 | ;; the corresponding command. | |
a9b0e28e SB |
480 | (cond ((and current-prefix-arg (< count 1)) |
481 | (user-error "The prefix argument must be a positive number")) | |
482 | (current-prefix-arg | |
483 | (todos-backward-item count)) | |
484 | (t | |
485 | (todos-backward-item))))) | |
2c173503 | 486 | |
a9b0e28e | 487 | ;; ----------------------------------------------------------------------------- |
27139cd5 | 488 | ;;; File editing commands |
a9b0e28e | 489 | ;; ----------------------------------------------------------------------------- |
18aef8a3 | 490 | |
27139cd5 | 491 | (defun todos-add-file () |
a9b0e28e | 492 | "Name and initialize a new Todos file. |
c66f681c SB |
493 | Interactively, prompt for a category and display it, and if |
494 | option `todos-add-item-if-new-category' is non-nil (the default), | |
495 | prompt for the first item. | |
a9b0e28e SB |
496 | Noninteractively, return the name of the new file. |
497 | ||
498 | This command does not save the file to disk; to do that type | |
499 | \\[todos-save] or \\[todos-quit]." | |
27139cd5 SB |
500 | (interactive) |
501 | (let ((prompt (concat "Enter name of new Todos file " | |
502 | "(TAB or SPC to see current names): ")) | |
503 | file) | |
504 | (setq file (todos-read-file-name prompt)) | |
505 | (with-current-buffer (get-buffer-create file) | |
506 | (erase-buffer) | |
507 | (write-region (point-min) (point-max) file nil 'nomessage nil t) | |
508 | (kill-buffer file)) | |
37f48249 | 509 | (setq todos-files (funcall todos-files-function)) |
27139cd5 | 510 | (todos-reevaluate-filelist-defcustoms) |
c66f681c | 511 | (if (called-interactively-p 'any) |
27139cd5 SB |
512 | (progn |
513 | (set-window-buffer (selected-window) | |
514 | (set-buffer (find-file-noselect file))) | |
515 | (setq todos-current-todos-file file) | |
516 | (todos-show)) | |
517 | file))) | |
18aef8a3 | 518 | |
27139cd5 SB |
519 | (defvar todos-edit-buffer "*Todos Edit*" |
520 | "Name of current buffer in Todos Edit mode.") | |
18aef8a3 | 521 | |
e99a2125 | 522 | (defun todos-edit-file () |
a9b0e28e SB |
523 | "Put current buffer in `todos-edit-mode'. |
524 | This makes the entire file visible and the buffer writeable and | |
525 | you can use the self-insertion keys and standard Emacs editing | |
526 | commands to make changes. To return to Todos mode, type | |
527 | \\[todos-edit-quit]. This runs a file format check, signalling | |
528 | an error if the format has become invalid. However, this check | |
529 | cannot tell if the number of items changed, which could result in | |
530 | the file containing inconsistent information. For this reason | |
531 | this command should be used with caution." | |
27139cd5 SB |
532 | (interactive) |
533 | (widen) | |
534 | (todos-edit-mode) | |
535 | (remove-overlays) | |
536 | (message "%s" (substitute-command-keys | |
537 | (concat "Type \\[todos-edit-quit] to check file format " | |
538 | "validity and return to Todos mode.\n")))) | |
36341a66 | 539 | |
a9b0e28e | 540 | ;; ----------------------------------------------------------------------------- |
27139cd5 | 541 | ;;; Category editing commands |
a9b0e28e | 542 | ;; ----------------------------------------------------------------------------- |
d04d6b95 | 543 | |
27139cd5 SB |
544 | (defun todos-add-category (&optional file cat) |
545 | "Add a new category to a Todos file. | |
d04d6b95 | 546 | |
27139cd5 SB |
547 | Called interactively with prefix argument FILE, prompt for a file |
548 | and then for a new category to add to that file, otherwise prompt | |
c66f681c SB |
549 | just for a category to add to the current Todos file. After |
550 | adding the category, visit it in Todos mode and if option | |
551 | `todos-add-item-if-new-category' is non-nil (the default), prompt | |
552 | for the first item. | |
58c7641d | 553 | |
27139cd5 SB |
554 | Non-interactively, add category CAT to file FILE; if FILE is nil, |
555 | add CAT to the current Todos file. After adding the category, | |
556 | return the new category number." | |
557 | (interactive "P") | |
558 | (let (catfil file0) | |
559 | ;; If cat is passed from caller, don't prompt, unless it is "", | |
560 | ;; which means the file was just added and has no category yet. | |
561 | (if (and cat (> (length cat) 0)) | |
562 | (setq file0 (or (and (stringp file) file) | |
563 | todos-current-todos-file)) | |
564 | (setq catfil (todos-read-category "Enter a new category name: " | |
565 | 'add (when (called-interactively-p 'any) | |
566 | file)) | |
567 | cat (car catfil) | |
568 | file0 (if (called-interactively-p 'any) | |
569 | (cdr catfil) | |
570 | file))) | |
571 | (find-file file0) | |
572 | (let ((counts (make-vector 4 0)) ; [todo diary done archived] | |
573 | (num (1+ (length todos-categories))) | |
574 | (buffer-read-only nil)) | |
575 | (setq todos-current-todos-file file0) | |
576 | (setq todos-categories (append todos-categories | |
577 | (list (cons cat counts)))) | |
578 | (widen) | |
579 | (goto-char (point-max)) | |
580 | (save-excursion ; Save point for todos-category-select. | |
581 | (insert todos-category-beg cat "\n\n" todos-category-done "\n")) | |
582 | (todos-update-categories-sexp) | |
583 | ;; If invoked by user, display the newly added category, if | |
584 | ;; called programmatically return the category number to the | |
585 | ;; caller. | |
586 | (if (called-interactively-p 'any) | |
587 | (progn | |
588 | (setq todos-category-number num) | |
37f48249 SB |
589 | (todos-category-select) |
590 | (when todos-add-item-if-new-category | |
591 | (todos-basic-insert-item))) | |
27139cd5 | 592 | num)))) |
2c173503 | 593 | |
27139cd5 SB |
594 | (defun todos-rename-category () |
595 | "Rename current Todos category. | |
596 | If this file has an archive containing this category, rename the | |
597 | category there as well." | |
598 | (interactive) | |
599 | (let* ((cat (todos-current-category)) | |
e99a2125 SB |
600 | (new (read-from-minibuffer |
601 | (format "Rename category \"%s\" to: " cat)))) | |
27139cd5 SB |
602 | (setq new (todos-validate-name new 'category)) |
603 | (let* ((ofile todos-current-todos-file) | |
604 | (archive (concat (file-name-sans-extension ofile) ".toda")) | |
605 | (buffers (append (list ofile) | |
606 | (unless (zerop (todos-get-count 'archived cat)) | |
607 | (list archive))))) | |
608 | (dolist (buf buffers) | |
609 | (with-current-buffer (find-file-noselect buf) | |
0e89c3fc | 610 | (let (buffer-read-only) |
27139cd5 SB |
611 | (setq todos-categories (todos-set-categories)) |
612 | (save-excursion | |
613 | (save-restriction | |
614 | (setcar (assoc cat todos-categories) new) | |
615 | (widen) | |
616 | (goto-char (point-min)) | |
617 | (todos-update-categories-sexp) | |
618 | (re-search-forward (concat (regexp-quote todos-category-beg) | |
619 | "\\(" (regexp-quote cat) "\\)\n") | |
620 | nil t) | |
621 | (replace-match new t t nil 1))))))) | |
622 | (force-mode-line-update)) | |
623 | (save-excursion (todos-category-select))) | |
624 | ||
625 | (defun todos-delete-category (&optional arg) | |
626 | "Delete current Todos category provided it is empty. | |
627 | With ARG non-nil delete the category unconditionally, | |
628 | i.e. including all existing todo and done items." | |
629 | (interactive "P") | |
630 | (let* ((file todos-current-todos-file) | |
631 | (cat (todos-current-category)) | |
632 | (todo (todos-get-count 'todo cat)) | |
633 | (done (todos-get-count 'done cat)) | |
634 | (archived (todos-get-count 'archived cat))) | |
635 | (if (and (not arg) | |
636 | (or (> todo 0) (> done 0))) | |
637 | (message "%s" (substitute-command-keys | |
638 | (concat "To delete a non-empty category, " | |
639 | "type C-u \\[todos-delete-category]."))) | |
640 | (when (cond ((= (length todos-categories) 1) | |
e99a2125 SB |
641 | (todos-y-or-n-p |
642 | (concat "This is the only category in this file; " | |
643 | "deleting it will also delete the file.\n" | |
644 | "Do you want to proceed? "))) | |
27139cd5 | 645 | ((> archived 0) |
cc416fd3 | 646 | (todos-y-or-n-p (concat "This category has archived items; " |
27139cd5 SB |
647 | "the archived category will remain\n" |
648 | "after deleting the todo category. " | |
649 | "Do you still want to delete it\n" | |
650 | "(see `todos-skip-archived-categories' " | |
651 | "for another option)? "))) | |
652 | (t | |
cc416fd3 | 653 | (todos-y-or-n-p (concat "Permanently remove category \"" cat |
27139cd5 SB |
654 | "\"" (and arg " and all its entries") |
655 | "? ")))) | |
656 | (widen) | |
657 | (let ((buffer-read-only) | |
658 | (beg (re-search-backward | |
659 | (concat "^" (regexp-quote (concat todos-category-beg cat)) | |
660 | "\n") nil t)) | |
661 | (end (if (re-search-forward | |
662 | (concat "\n\\(" (regexp-quote todos-category-beg) | |
663 | ".*\n\\)") nil t) | |
664 | (match-beginning 1) | |
665 | (point-max)))) | |
666 | (remove-overlays beg end) | |
667 | (delete-region beg end) | |
668 | (if (= (length todos-categories) 1) | |
669 | ;; If deleted category was the only one, delete the file. | |
670 | (progn | |
671 | (todos-reevaluate-filelist-defcustoms) | |
672 | ;; Skip confirming killing the archive buffer if it has been | |
673 | ;; modified and not saved. | |
674 | (set-buffer-modified-p nil) | |
675 | (delete-file file) | |
676 | (kill-buffer) | |
677 | (message "Deleted Todos file %s." file)) | |
678 | (setq todos-categories (delete (assoc cat todos-categories) | |
679 | todos-categories)) | |
680 | (todos-update-categories-sexp) | |
681 | (setq todos-category-number | |
682 | (1+ (mod todos-category-number (length todos-categories)))) | |
683 | (todos-category-select) | |
0e89c3fc | 684 | (goto-char (point-min)) |
27139cd5 | 685 | (message "Deleted category %s." cat))))))) |
0e89c3fc | 686 | |
27139cd5 SB |
687 | (defun todos-move-category () |
688 | "Move current category to a different Todos file. | |
689 | If current category has archived items, also move those to the | |
690 | archive of the file moved to, creating it if it does not exist." | |
691 | (interactive) | |
692 | (when (or (> (length todos-categories) 1) | |
cc416fd3 | 693 | (todos-y-or-n-p (concat "This is the only category in this file; " |
e99a2125 SB |
694 | "moving it will also delete the file.\n" |
695 | "Do you want to proceed? "))) | |
27139cd5 SB |
696 | (let* ((ofile todos-current-todos-file) |
697 | (cat (todos-current-category)) | |
698 | (nfile (todos-read-file-name | |
699 | "Choose a Todos file to move this category to: " nil t)) | |
700 | (archive (concat (file-name-sans-extension ofile) ".toda")) | |
701 | (buffers (append (list ofile) | |
702 | (unless (zerop (todos-get-count 'archived cat)) | |
703 | (list archive)))) | |
704 | new) | |
705 | (while (equal (file-truename nfile) (file-truename ofile)) | |
706 | (setq nfile (todos-read-file-name | |
707 | "Choose a file distinct from this file: " nil t))) | |
708 | (dolist (buf buffers) | |
709 | (with-current-buffer (find-file-noselect buf) | |
710 | (widen) | |
711 | (goto-char (point-max)) | |
712 | (let* ((beg (re-search-backward | |
e99a2125 SB |
713 | (concat "^" |
714 | (regexp-quote (concat todos-category-beg cat)) | |
27139cd5 SB |
715 | "$") |
716 | nil t)) | |
717 | (end (if (re-search-forward | |
718 | (concat "^" (regexp-quote todos-category-beg)) | |
719 | nil t 2) | |
720 | (match-beginning 0) | |
721 | (point-max))) | |
722 | (content (buffer-substring-no-properties beg end)) | |
723 | (counts (cdr (assoc cat todos-categories))) | |
724 | buffer-read-only) | |
725 | ;; Move the category to the new file. Also update or create | |
726 | ;; archive file if necessary. | |
727 | (with-current-buffer | |
728 | (find-file-noselect | |
729 | ;; Regenerate todos-archives in case there | |
730 | ;; is a newly created archive. | |
731 | (if (member buf (funcall todos-files-function t)) | |
732 | (concat (file-name-sans-extension nfile) ".toda") | |
733 | nfile)) | |
734 | (let* ((nfile-short (todos-short-file-name nfile)) | |
735 | (prompt (concat | |
736 | (format "Todos file \"%s\" already has " | |
737 | nfile-short) | |
738 | (format "the category \"%s\";\n" cat) | |
739 | "enter a new category name: ")) | |
740 | buffer-read-only) | |
741 | (widen) | |
742 | (goto-char (point-max)) | |
743 | (insert content) | |
744 | ;; If the file moved to has a category with the same | |
745 | ;; name, rename the moved category. | |
746 | (when (assoc cat todos-categories) | |
747 | (unless (member (file-truename (buffer-file-name)) | |
748 | (funcall todos-files-function t)) | |
749 | (setq new (read-from-minibuffer prompt)) | |
750 | (setq new (todos-validate-name new 'category)))) | |
751 | ;; Replace old with new name in Todos and archive files. | |
752 | (when new | |
753 | (goto-char (point-max)) | |
754 | (re-search-backward | |
755 | (concat "^" (regexp-quote todos-category-beg) | |
756 | "\\(" (regexp-quote cat) "\\)$") nil t) | |
757 | (replace-match new nil nil nil 1))) | |
758 | (setq todos-categories | |
759 | (append todos-categories (list (cons new counts)))) | |
760 | (todos-update-categories-sexp) | |
761 | ;; If archive was just created, save it to avoid "File | |
762 | ;; <xyz> no longer exists!" message on invoking | |
763 | ;; `todos-view-archived-items'. | |
764 | (unless (file-exists-p (buffer-file-name)) | |
765 | (save-buffer)) | |
766 | (todos-category-number (or new cat)) | |
767 | (todos-category-select)) | |
768 | ;; Delete the category from the old file, and if that was the | |
769 | ;; last category, delete the file. Also handle archive file | |
770 | ;; if necessary. | |
771 | (remove-overlays beg end) | |
772 | (delete-region beg end) | |
773 | (goto-char (point-min)) | |
774 | ;; Put point after todos-categories sexp. | |
775 | (forward-line) | |
776 | (if (eobp) ; Aside from sexp, file is empty. | |
777 | (progn | |
778 | ;; Skip confirming killing the archive buffer. | |
779 | (set-buffer-modified-p nil) | |
780 | (delete-file todos-current-todos-file) | |
781 | (kill-buffer) | |
782 | (when (member todos-current-todos-file todos-files) | |
783 | (todos-reevaluate-filelist-defcustoms))) | |
784 | (setq todos-categories (delete (assoc cat todos-categories) | |
e99a2125 | 785 | todos-categories)) |
27139cd5 SB |
786 | (todos-update-categories-sexp) |
787 | (todos-category-select))))) | |
788 | (set-window-buffer (selected-window) | |
789 | (set-buffer (find-file-noselect nfile))) | |
790 | (todos-category-number (or new cat)) | |
791 | (todos-category-select)))) | |
0e89c3fc | 792 | |
27139cd5 SB |
793 | (defun todos-merge-category (&optional file) |
794 | "Merge current category into another existing category. | |
ee7412e4 | 795 | |
27139cd5 SB |
796 | With prefix argument FILE, prompt for a specific Todos file and |
797 | choose (with TAB completion) a category in it to merge into; | |
798 | otherwise, choose and merge into a category in either the | |
799 | current Todos file or a file in `todos-category-completions-files'. | |
d04d6b95 | 800 | |
27139cd5 SB |
801 | After merging, the current category's todo and done items are |
802 | appended to the chosen goal category's todo and done items, | |
803 | respectively. The goal category becomes the current category, | |
804 | and the previous current category is deleted. | |
3a898abe | 805 | |
27139cd5 SB |
806 | If both the first and goal categories also have archived items, |
807 | the former are merged to the latter. If only the first category | |
808 | has archived items, the archived category is renamed to the goal | |
809 | category." | |
810 | (interactive "P") | |
811 | (let* ((tfile todos-current-todos-file) | |
812 | (archive (concat (file-name-sans-extension (if file gfile tfile)) | |
813 | ".toda")) | |
814 | (cat (todos-current-category)) | |
6d12ff8b | 815 | (cat+file (todos-read-category "Merge into category: " 'todo file)) |
27139cd5 SB |
816 | (goal (car cat+file)) |
817 | (gfile (cdr cat+file)) | |
818 | archived-count here) | |
819 | ;; Merge in todo file. | |
820 | (with-current-buffer (get-buffer (find-file-noselect tfile)) | |
821 | (widen) | |
822 | (let* ((buffer-read-only nil) | |
823 | (cbeg (progn | |
824 | (re-search-backward | |
825 | (concat "^" (regexp-quote todos-category-beg)) nil t) | |
826 | (point-marker))) | |
827 | (tbeg (progn (forward-line) (point-marker))) | |
828 | (dbeg (progn | |
829 | (re-search-forward | |
830 | (concat "^" (regexp-quote todos-category-done)) nil t) | |
831 | (forward-line) (point-marker))) | |
832 | ;; Omit empty line between todo and done items. | |
833 | (tend (progn (forward-line -2) (point-marker))) | |
834 | (cend (progn | |
835 | (if (re-search-forward | |
836 | (concat "^" (regexp-quote todos-category-beg)) nil t) | |
837 | (progn | |
838 | (goto-char (match-beginning 0)) | |
839 | (point-marker)) | |
840 | (point-max-marker)))) | |
841 | (todo (buffer-substring-no-properties tbeg tend)) | |
842 | (done (buffer-substring-no-properties dbeg cend))) | |
843 | (goto-char (point-min)) | |
844 | ;; Merge any todo items. | |
845 | (unless (zerop (length todo)) | |
846 | (re-search-forward | |
847 | (concat "^" (regexp-quote (concat todos-category-beg goal)) "$") | |
848 | nil t) | |
849 | (re-search-forward | |
850 | (concat "^" (regexp-quote todos-category-done)) nil t) | |
851 | (forward-line -1) | |
852 | (setq here (point-marker)) | |
853 | (insert todo) | |
854 | (todos-update-count 'todo (todos-get-count 'todo cat) goal)) | |
855 | ;; Merge any done items. | |
856 | (unless (zerop (length done)) | |
857 | (goto-char (if (re-search-forward | |
858 | (concat "^" (regexp-quote todos-category-beg)) nil t) | |
859 | (match-beginning 0) | |
860 | (point-max))) | |
861 | (when (zerop (length todo)) (setq here (point-marker))) | |
862 | (insert done) | |
863 | (todos-update-count 'done (todos-get-count 'done cat) goal)) | |
864 | (remove-overlays cbeg cend) | |
865 | (delete-region cbeg cend) | |
866 | (setq todos-categories (delete (assoc cat todos-categories) | |
867 | todos-categories)) | |
868 | (todos-update-categories-sexp) | |
869 | (mapc (lambda (m) (set-marker m nil)) (list cbeg tbeg dbeg tend cend)))) | |
870 | (when (file-exists-p archive) | |
e99a2125 | 871 | ;; Merge in archive file. |
27139cd5 SB |
872 | (with-current-buffer (get-buffer (find-file-noselect archive)) |
873 | (widen) | |
874 | (goto-char (point-min)) | |
875 | (let ((buffer-read-only nil) | |
876 | (cbeg (save-excursion | |
877 | (when (re-search-forward | |
878 | (concat "^" (regexp-quote | |
879 | (concat todos-category-beg cat)) "$") | |
880 | nil t) | |
881 | (goto-char (match-beginning 0)) | |
882 | (point-marker)))) | |
883 | (gbeg (save-excursion | |
884 | (when (re-search-forward | |
885 | (concat "^" (regexp-quote | |
886 | (concat todos-category-beg goal)) "$") | |
887 | nil t) | |
888 | (goto-char (match-beginning 0)) | |
889 | (point-marker)))) | |
890 | cend carch) | |
891 | (when cbeg | |
892 | (setq archived-count (todos-get-count 'done cat)) | |
893 | (setq cend (save-excursion | |
894 | (if (re-search-forward | |
895 | (concat "^" (regexp-quote todos-category-beg)) | |
896 | nil t) | |
897 | (match-beginning 0) | |
898 | (point-max)))) | |
899 | (setq carch (save-excursion (goto-char cbeg) (forward-line) | |
900 | (buffer-substring-no-properties (point) cend))) | |
901 | ;; If both categories of the merge have archived items, merge the | |
902 | ;; source items to the goal items, else "merge" by renaming the | |
903 | ;; source category to goal. | |
904 | (if gbeg | |
905 | (progn | |
906 | (goto-char (if (re-search-forward | |
907 | (concat "^" (regexp-quote todos-category-beg)) | |
908 | nil t) | |
909 | (match-beginning 0) | |
910 | (point-max))) | |
911 | (insert carch) | |
912 | (remove-overlays cbeg cend) | |
913 | (delete-region cbeg cend)) | |
914 | (goto-char cbeg) | |
915 | (search-forward cat) | |
916 | (replace-match goal)) | |
917 | (setq todos-categories (todos-make-categories-list t)) | |
918 | (todos-update-categories-sexp))))) | |
919 | (with-current-buffer (get-file-buffer tfile) | |
920 | (when archived-count | |
921 | (unless (zerop archived-count) | |
922 | (todos-update-count 'archived archived-count goal) | |
923 | (todos-update-categories-sexp))) | |
924 | (todos-category-number goal) | |
925 | ;; If there are only merged done items, show them. | |
926 | (let ((todos-show-with-done (zerop (todos-get-count 'todo goal)))) | |
927 | (todos-category-select) | |
928 | ;; Put point on the first merged item. | |
929 | (goto-char here))) | |
930 | (set-marker here nil))) | |
db2c5d34 | 931 | |
a9b0e28e | 932 | ;; ----------------------------------------------------------------------------- |
27139cd5 | 933 | ;;; Item marking |
a9b0e28e | 934 | ;; ----------------------------------------------------------------------------- |
58c7641d | 935 | |
27139cd5 SB |
936 | (defcustom todos-item-mark "*" |
937 | "String used to mark items. | |
938 | To ensure item marking works, change the value of this option | |
939 | only when no items are marked." | |
940 | :type '(string :validate | |
941 | (lambda (widget) | |
942 | (when (string= (widget-value widget) todos-prefix) | |
943 | (widget-put | |
944 | widget :error | |
945 | "Invalid value: must be distinct from `todos-prefix'") | |
946 | widget))) | |
947 | :set (lambda (symbol value) | |
948 | (custom-set-default symbol (propertize value 'face 'todos-mark))) | |
53e63b4c | 949 | :group 'todos-edit) |
d04d6b95 | 950 | |
27139cd5 SB |
951 | (defun todos-toggle-mark-item (&optional n) |
952 | "Mark item with `todos-item-mark' if unmarked, otherwise unmark it. | |
953 | With a positive numerical prefix argument N, change the | |
954 | marking of the next N items." | |
955 | (interactive "p") | |
956 | (when (todos-item-string) | |
957 | (unless (> n 1) (setq n 1)) | |
958 | (dotimes (i n) | |
959 | (let* ((cat (todos-current-category)) | |
960 | (marks (assoc cat todos-categories-with-marks)) | |
961 | (ov (progn | |
962 | (unless (looking-at todos-item-start) | |
963 | (todos-item-start)) | |
964 | (todos-get-overlay 'prefix))) | |
965 | (pref (overlay-get ov 'before-string))) | |
966 | (if (todos-marked-item-p) | |
967 | (progn | |
968 | (overlay-put ov 'before-string (substring pref 1)) | |
969 | (if (= (cdr marks) 1) ; Deleted last mark in this category. | |
970 | (setq todos-categories-with-marks | |
971 | (assq-delete-all cat todos-categories-with-marks)) | |
972 | (setcdr marks (1- (cdr marks))))) | |
973 | (overlay-put ov 'before-string (concat todos-item-mark pref)) | |
974 | (if marks | |
975 | (setcdr marks (1+ (cdr marks))) | |
976 | (push (cons cat 1) todos-categories-with-marks)))) | |
977 | (todos-forward-item)))) | |
d04d6b95 | 978 | |
27139cd5 SB |
979 | (defun todos-mark-category () |
980 | "Mark all visiblw items in this category with `todos-item-mark'." | |
981 | (interactive) | |
982 | (let* ((cat (todos-current-category)) | |
983 | (marks (assoc cat todos-categories-with-marks))) | |
984 | (save-excursion | |
985 | (goto-char (point-min)) | |
986 | (while (not (eobp)) | |
987 | (let* ((ov (todos-get-overlay 'prefix)) | |
988 | (pref (overlay-get ov 'before-string))) | |
989 | (unless (todos-marked-item-p) | |
990 | (overlay-put ov 'before-string (concat todos-item-mark pref)) | |
991 | (if marks | |
992 | (setcdr marks (1+ (cdr marks))) | |
993 | (push (cons cat 1) todos-categories-with-marks)))) | |
994 | (todos-forward-item))))) | |
d04d6b95 | 995 | |
27139cd5 SB |
996 | (defun todos-unmark-category () |
997 | "Remove `todos-item-mark' from all visible items in this category." | |
998 | (interactive) | |
999 | (let* ((cat (todos-current-category)) | |
1000 | (marks (assoc cat todos-categories-with-marks))) | |
1001 | (save-excursion | |
1002 | (goto-char (point-min)) | |
1003 | (while (not (eobp)) | |
1004 | (let* ((ov (todos-get-overlay 'prefix)) | |
1005 | ;; No overlay on empty line between todo and done items. | |
1006 | (pref (when ov (overlay-get ov 'before-string)))) | |
1007 | (when (todos-marked-item-p) | |
1008 | (overlay-put ov 'before-string (substring pref 1))) | |
1009 | (todos-forward-item)))) | |
e99a2125 SB |
1010 | (setq todos-categories-with-marks |
1011 | (delq marks todos-categories-with-marks)))) | |
ee7412e4 | 1012 | |
a9b0e28e | 1013 | ;; ----------------------------------------------------------------------------- |
27139cd5 | 1014 | ;;; Item editing options |
a9b0e28e | 1015 | ;; ----------------------------------------------------------------------------- |
0e89c3fc | 1016 | |
c66f681c | 1017 | (defcustom todos-add-item-if-new-category t |
37f48249 SB |
1018 | "Non-nil to prompt for an item after adding a new category." |
1019 | :type 'boolean | |
1020 | :group 'todos-edit) | |
1021 | ||
27139cd5 SB |
1022 | (defcustom todos-include-in-diary nil |
1023 | "Non-nil to allow new Todo items to be included in the diary." | |
1024 | :type 'boolean | |
53e63b4c | 1025 | :group 'todos-edit) |
b28025ed | 1026 | |
27139cd5 SB |
1027 | (defcustom todos-diary-nonmarking nil |
1028 | "Non-nil to insert new Todo diary items as nonmarking by default. | |
1029 | This appends `diary-nonmarking-symbol' to the front of an item on | |
1030 | insertion provided it doesn't begin with `todos-nondiary-marker'." | |
1031 | :type 'boolean | |
53e63b4c | 1032 | :group 'todos-edit) |
b28025ed | 1033 | |
27139cd5 SB |
1034 | (defcustom todos-nondiary-marker '("[" "]") |
1035 | "List of strings surrounding item date to block diary inclusion. | |
1036 | The first string is inserted before the item date and must be a | |
1037 | non-empty string that does not match a diary date in order to | |
1038 | have its intended effect. The second string is inserted after | |
1039 | the diary date." | |
1040 | :type '(list string string) | |
53e63b4c | 1041 | :group 'todos-edit |
27139cd5 SB |
1042 | :initialize 'custom-initialize-default |
1043 | :set 'todos-reset-nondiary-marker) | |
e0f6342f | 1044 | |
27139cd5 SB |
1045 | (defcustom todos-always-add-time-string nil |
1046 | "Non-nil adds current time to a new item's date header by default. | |
1047 | When the Todos insertion commands have a non-nil \"maybe-notime\" | |
1048 | argument, this reverses the effect of | |
1049 | `todos-always-add-time-string': if t, these commands omit the | |
1050 | current time, if nil, they include it." | |
1051 | :type 'boolean | |
53e63b4c | 1052 | :group 'todos-edit) |
e0f6342f | 1053 | |
27139cd5 SB |
1054 | (defcustom todos-use-only-highlighted-region t |
1055 | "Non-nil to enable inserting only highlighted region as new item." | |
1056 | :type 'boolean | |
53e63b4c | 1057 | :group 'todos-edit) |
e0f6342f | 1058 | |
27139cd5 SB |
1059 | (defcustom todos-undo-item-omit-comment 'ask |
1060 | "Whether to omit done item comment on undoing the item. | |
1061 | Nil means never omit the comment, t means always omit it, `ask' | |
1062 | means prompt user and omit comment only on confirmation." | |
1063 | :type '(choice (const :tag "Never" nil) | |
1064 | (const :tag "Always" t) | |
1065 | (const :tag "Ask" ask)) | |
53e63b4c | 1066 | :group 'todos-edit) |
58c7641d | 1067 | |
a9b0e28e | 1068 | ;; ----------------------------------------------------------------------------- |
27139cd5 | 1069 | ;;; Item editing commands |
a9b0e28e | 1070 | ;; ----------------------------------------------------------------------------- |
db2c5d34 | 1071 | |
a9b0e28e | 1072 | (defun todos-basic-insert-item (&optional arg diary nonmarking date-type time |
27139cd5 | 1073 | region-or-here) |
a9b0e28e SB |
1074 | "Insert a new Todo item into a category. |
1075 | This is the function from which the generated Todos item | |
1076 | insertion commands derive. | |
1077 | ||
1078 | The generated commands have mnenomic key bindings based on the | |
1079 | arguments' values and their order in the command's argument list, | |
1080 | as follows: (1) for DIARY `d', (2) for NONMARKING `k', (3) for | |
1081 | DATE-TYPE either `c' for calendar or `d' for date or `n' for | |
1082 | weekday name, (4) for TIME `t', (5) for REGION-OR-HERE either `r' | |
1083 | for region or `h' for here. Sequences of these keys are appended | |
1084 | to the insertion prefix key `i'. Keys that allow a following | |
1085 | key (i.e., any but `r' or `h') must be doubled when used finally. | |
1086 | For example, the command bound to the key sequence `i y h' will | |
1087 | insert a new item with today's date, marked according to the | |
1088 | DIARY argument described below, and with priority according to | |
1089 | the HERE argument; `i y y' does the same except that the priority | |
1090 | is not given by HERE but by prompting. | |
1091 | ||
1092 | In command invocations, ARG is passed as a prefix argument as | |
1093 | follows. With no prefix argument, add the item to the current | |
e99a2125 SB |
1094 | category; with one prefix argument (`C-u'), prompt for a category |
1095 | from the current Todos file; with two prefix arguments (`C-u C-u'), | |
27139cd5 SB |
1096 | first prompt for a Todos file, then a category in that file. If |
1097 | a non-existing category is entered, ask whether to add it to the | |
1098 | Todos file; if answered affirmatively, add the category and | |
1099 | insert the item there. | |
78fe7289 | 1100 | |
a9b0e28e SB |
1101 | The remaining arguments are set or left nil by the generated item |
1102 | insertion commands; their meanings are described in the follows | |
1103 | paragraphs. | |
1104 | ||
27139cd5 SB |
1105 | When argument DIARY is non-nil, this overrides the intent of the |
1106 | user option `todos-include-in-diary' for this item: if | |
1107 | `todos-include-in-diary' is nil, include the item in the Fancy | |
1108 | Diary display, and if it is non-nil, exclude the item from the | |
1109 | Fancy Diary display. When DIARY is nil, `todos-include-in-diary' | |
1110 | has its intended effect. | |
78fe7289 | 1111 | |
27139cd5 SB |
1112 | When the item is included in the Fancy Diary display and the |
1113 | argument NONMARKING is non-nil, this overrides the intent of the | |
1114 | user option `todos-diary-nonmarking' for this item: if | |
1115 | `todos-diary-nonmarking' is nil, append `diary-nonmarking-symbol' | |
1116 | to the item, and if it is non-nil, omit `diary-nonmarking-symbol'. | |
78fe7289 | 1117 | |
27139cd5 SB |
1118 | The argument DATE-TYPE determines the content of the item's |
1119 | mandatory date header string and how it is added: | |
1120 | - If DATE-TYPE is the symbol `calendar', the Calendar pops up and | |
1121 | when the user puts the cursor on a date and hits RET, that | |
1122 | date, in the format set by `calendar-date-display-form', | |
1123 | becomes the date in the header. | |
1124 | - If DATE-TYPE is a string matching the regexp | |
1125 | `todos-date-pattern', that string becomes the date in the | |
1126 | header. This case is for the command | |
1127 | `todos-insert-item-from-calendar' which is called from the | |
1128 | Calendar. | |
1129 | - If DATE-TYPE is the symbol `date', the header contains the date | |
1130 | in the format set by `calendar-date-display-form', with year, | |
1131 | month and day individually prompted for (month with tab | |
1132 | completion). | |
1133 | - If DATE-TYPE is the symbol `dayname' the header contains a | |
1134 | weekday name instead of a date, prompted for with tab | |
1135 | completion. | |
1136 | - If DATE-TYPE has any other value (including nil or none) the | |
1137 | header contains the current date (in the format set by | |
1138 | `calendar-date-display-form'). | |
78fe7289 | 1139 | |
27139cd5 SB |
1140 | With non-nil argument TIME prompt for a time string, which must |
1141 | match `diary-time-regexp'. Typing `<return>' at the prompt | |
1142 | returns the current time, if the user option | |
1143 | `todos-always-add-time-string' is non-nil, otherwise the empty | |
1144 | string (i.e., no time string). If TIME is absent or nil, add or | |
1145 | omit the current time string according as | |
1146 | `todos-always-add-time-string' is non-nil or nil, respectively. | |
78fe7289 | 1147 | |
27139cd5 SB |
1148 | The argument REGION-OR-HERE determines the source and location of |
1149 | the new item: | |
a9b0e28e SB |
1150 | - If the REGION-OR-HERE is the symbol `here', prompt for the text of |
1151 | the new item and, if the command was invoked with point in the todo | |
1152 | items section of the current category, give the new item the | |
1153 | priority of the item at point, lowering the latter's priority and | |
1154 | the priority of the remaining items. If point is in the done items | |
1155 | section of the category, insert the new item as the first todo item | |
1156 | in the category. Likewise, if the command with `here' is invoked | |
1157 | outside of the current category, jump to the chosen category and | |
1158 | insert the new item as the first item in the category. | |
27139cd5 SB |
1159 | - If REGION-OR-HERE is the symbol `region', use the region of the |
1160 | current buffer as the text of the new item, depending on the | |
1161 | value of user option `todos-use-only-highlighted-region': if | |
1162 | this is non-nil, then use the region only when it is | |
1163 | highlighted; otherwise, use the region regardless of | |
1164 | highlighting. An error is signalled if there is no region in | |
1165 | the current buffer. Prompt for the item's priority in the | |
1166 | category (an integer between 1 and one more than the number of | |
1167 | items in the category), and insert the item accordingly. | |
1168 | - If REGION-OR-HERE has any other value (in particular, nil or | |
1169 | none), prompt for the text and the item's priority, and insert | |
a9b0e28e | 1170 | the item accordingly." |
27139cd5 SB |
1171 | ;; If invoked outside of Todos mode and there is not yet any Todos |
1172 | ;; file, initialize one. | |
1173 | (if (null todos-files) | |
1174 | (todos-show) | |
1175 | (let ((region (eq region-or-here 'region)) | |
1176 | (here (eq region-or-here 'here))) | |
1177 | (when region | |
1178 | (let (use-empty-active-region) | |
1179 | (unless (and todos-use-only-highlighted-region (use-region-p)) | |
a9b0e28e | 1180 | (user-error "There is no active region")))) |
27139cd5 SB |
1181 | (let* ((obuf (current-buffer)) |
1182 | (ocat (todos-current-category)) | |
1183 | (opoint (point)) | |
1184 | (todos-mm (eq major-mode 'todos-mode)) | |
1185 | (cat+file (cond ((equal arg '(4)) | |
1186 | (todos-read-category "Insert in category: ")) | |
1187 | ((equal arg '(16)) | |
1188 | (todos-read-category "Insert in category: " | |
1189 | nil 'file)) | |
1190 | (t | |
1191 | (cons (todos-current-category) | |
1192 | (or todos-current-todos-file | |
1193 | (and todos-show-current-file | |
1194 | todos-global-current-todos-file) | |
1195 | (todos-absolute-file-name | |
1196 | todos-default-todos-file)))))) | |
1197 | (cat (car cat+file)) | |
1198 | (file (cdr cat+file)) | |
1199 | (new-item (if region | |
1200 | (buffer-substring-no-properties | |
1201 | (region-beginning) (region-end)) | |
1202 | (read-from-minibuffer "Todo item: "))) | |
1203 | (date-string (cond | |
1204 | ((eq date-type 'date) | |
1205 | (todos-read-date)) | |
1206 | ((eq date-type 'dayname) | |
1207 | (todos-read-dayname)) | |
1208 | ((eq date-type 'calendar) | |
1209 | (setq todos-date-from-calendar t) | |
1210 | (or (todos-set-date-from-calendar) | |
1211 | ;; If user exits Calendar before choosing | |
1212 | ;; a date, cancel item insertion. | |
1213 | (keyboard-quit))) | |
1214 | ((and (stringp date-type) | |
1215 | (string-match todos-date-pattern date-type)) | |
1216 | (setq todos-date-from-calendar date-type) | |
1217 | (todos-set-date-from-calendar)) | |
1218 | (t | |
e99a2125 SB |
1219 | (calendar-date-string |
1220 | (calendar-current-date) t t)))) | |
27139cd5 SB |
1221 | (time-string (or (and time (todos-read-time)) |
1222 | (and todos-always-add-time-string | |
1223 | (substring (current-time-string) 11 16))))) | |
1224 | (setq todos-date-from-calendar nil) | |
1225 | (find-file-noselect file 'nowarn) | |
1226 | (set-window-buffer (selected-window) | |
1227 | (set-buffer (find-buffer-visiting file))) | |
1228 | ;; If this command was invoked outside of a Todos buffer, the | |
1229 | ;; call to todos-current-category above returned nil. If we | |
1230 | ;; just entered Todos mode now, then cat was set to the file's | |
1231 | ;; first category, but if todos-mode was already enabled, cat | |
1232 | ;; did not get set, so we have to set it explicitly. | |
1233 | (unless cat | |
1234 | (setq cat (todos-current-category))) | |
1235 | (setq todos-current-todos-file file) | |
1236 | (unless todos-global-current-todos-file | |
1237 | (setq todos-global-current-todos-file todos-current-todos-file)) | |
1238 | (let ((buffer-read-only nil) | |
1239 | (called-from-outside (not (and todos-mm (equal cat ocat)))) | |
1240 | done-only item-added) | |
1241 | (setq new-item | |
1242 | ;; Add date, time and diary marking as required. | |
1243 | (concat (if (not (and diary (not todos-include-in-diary))) | |
1244 | todos-nondiary-start | |
1245 | (when (and nonmarking (not todos-diary-nonmarking)) | |
1246 | diary-nonmarking-symbol)) | |
e99a2125 SB |
1247 | date-string (when (and time-string ; Can be empty. |
1248 | (not (zerop (length | |
1249 | time-string)))) | |
27139cd5 SB |
1250 | (concat " " time-string)) |
1251 | (when (not (and diary (not todos-include-in-diary))) | |
1252 | todos-nondiary-end) | |
1253 | " " new-item)) | |
1254 | ;; Indent newlines inserted by C-q C-j if nonspace char follows. | |
1255 | (setq new-item (replace-regexp-in-string "\\(\n\\)[^[:blank:]]" | |
1256 | "\n\t" new-item nil nil 1)) | |
1257 | (unwind-protect | |
1258 | (progn | |
1259 | ;; Make sure the correct category is selected. There | |
1260 | ;; are two cases: (i) we just visited the file, so no | |
1261 | ;; category is selected yet, or (ii) we invoked | |
1262 | ;; insertion "here" from outside the category we want | |
1263 | ;; to insert in (with priority insertion, category | |
1264 | ;; selection is done by todos-set-item-priority). | |
1265 | (when (or (= (- (point-max) (point-min)) (buffer-size)) | |
1266 | (and here called-from-outside)) | |
1267 | (todos-category-number cat) | |
1268 | (todos-category-select)) | |
1269 | ;; If only done items are displayed in category, | |
1270 | ;; toggle to todo items before inserting new item. | |
1271 | (when (save-excursion | |
1272 | (goto-char (point-min)) | |
1273 | (looking-at todos-done-string-start)) | |
1274 | (setq done-only t) | |
1275 | (todos-toggle-view-done-only)) | |
1276 | (if here | |
1277 | (progn | |
1278 | ;; If command was invoked with point in done | |
1279 | ;; items section or outside of the current | |
1280 | ;; category, can't insert "here", so to be | |
1281 | ;; useful give new item top priority. | |
1282 | (when (or (todos-done-item-section-p) | |
1283 | called-from-outside | |
1284 | done-only) | |
1285 | (goto-char (point-min))) | |
1286 | (todos-insert-with-overlays new-item)) | |
1287 | (todos-set-item-priority new-item cat t)) | |
1288 | (setq item-added t)) | |
1289 | ;; If user cancels before setting priority, restore | |
1290 | ;; display. | |
1291 | (unless item-added | |
1292 | (if ocat | |
1293 | (progn | |
1294 | (unless (equal cat ocat) | |
1295 | (todos-category-number ocat) | |
1296 | (todos-category-select)) | |
1297 | (and done-only (todos-toggle-view-done-only))) | |
1298 | (set-window-buffer (selected-window) (set-buffer obuf))) | |
1299 | (goto-char opoint)) | |
1300 | ;; If the todo items section is not visible when the | |
1301 | ;; insertion command is called (either because only done | |
1302 | ;; items were shown or because the category was not in the | |
1303 | ;; current buffer), then if the item is inserted at the | |
1304 | ;; end of the category, point is at eob and eob at | |
1305 | ;; window-start, so that higher priority todo items are | |
1306 | ;; out of view. So we recenter to make sure the todo | |
1307 | ;; items are displayed in the window. | |
1308 | (when item-added (recenter))) | |
1309 | (todos-update-count 'todo 1) | |
1310 | (if (or diary todos-include-in-diary) (todos-update-count 'diary 1)) | |
1311 | (todos-update-categories-sexp)))))) | |
78fe7289 | 1312 | |
27139cd5 SB |
1313 | (defvar todos-date-from-calendar nil |
1314 | "Helper variable for setting item date from the Emacs Calendar.") | |
3f031767 | 1315 | |
27139cd5 SB |
1316 | (defun todos-set-date-from-calendar () |
1317 | "Return string of date chosen from Calendar." | |
1318 | (cond ((and (stringp todos-date-from-calendar) | |
1319 | (string-match todos-date-pattern todos-date-from-calendar)) | |
1320 | todos-date-from-calendar) | |
1321 | (todos-date-from-calendar | |
1322 | (let (calendar-view-diary-initially-flag) | |
1323 | (calendar)) ; *Calendar* is now current buffer. | |
1324 | (define-key calendar-mode-map [remap newline] 'exit-recursive-edit) | |
1325 | ;; If user exits Calendar before choosing a date, clean up properly. | |
1326 | (define-key calendar-mode-map | |
1327 | [remap calendar-exit] (lambda () | |
1328 | (interactive) | |
1329 | (progn | |
1330 | (calendar-exit) | |
1331 | (exit-recursive-edit)))) | |
1332 | (message "Put cursor on a date and type <return> to set it.") | |
1333 | (recursive-edit) | |
1334 | (unwind-protect | |
1335 | (when (equal (buffer-name) calendar-buffer) | |
1336 | (setq todos-date-from-calendar | |
1337 | (calendar-date-string (calendar-cursor-to-date t) t t)) | |
1338 | (calendar-exit) | |
1339 | todos-date-from-calendar) | |
1340 | (define-key calendar-mode-map [remap newline] nil) | |
1341 | (define-key calendar-mode-map [remap calendar-exit] nil) | |
1342 | (unless (zerop (recursion-depth)) (exit-recursive-edit)) | |
1343 | (when (stringp todos-date-from-calendar) | |
1344 | todos-date-from-calendar))))) | |
0e89c3fc | 1345 | |
e4ae44d9 SB |
1346 | (defun todos-insert-item-from-calendar (&optional arg) |
1347 | "Prompt for and insert a new item with date selected from calendar. | |
e99a2125 | 1348 | Invoked without prefix argument ARG, insert the item into the |
e4ae44d9 SB |
1349 | current category, without one prefix argument, prompt for the |
1350 | category from the current todo file or from one listed in | |
1351 | `todos-category-completions-files'; with two prefix arguments, | |
1352 | prompt for a todo file and then for a category in it." | |
1353 | (interactive "P") | |
1354 | (setq todos-date-from-calendar | |
1355 | (calendar-date-string (calendar-cursor-to-date t) t t)) | |
1356 | (calendar-exit) | |
1357 | (todos-basic-insert-item arg nil nil todos-date-from-calendar)) | |
1358 | ||
1359 | (define-key calendar-mode-map "it" 'todos-insert-item-from-calendar) | |
1360 | ||
1361 | (defun todos-copy-item () | |
1362 | "Copy item at point and insert the copy as a new item." | |
1363 | (interactive) | |
1364 | (unless (or (todos-done-item-p) (looking-at "^$")) | |
1365 | (let ((copy (todos-item-string)) | |
1366 | (diary-item (todos-diary-item-p))) | |
1367 | (todos-set-item-priority copy (todos-current-category) t) | |
1368 | (todos-update-count 'todo 1) | |
1369 | (when diary-item (todos-update-count 'diary 1)) | |
1370 | (todos-update-categories-sexp)))) | |
1371 | ||
27139cd5 SB |
1372 | (defun todos-delete-item () |
1373 | "Delete at least one item in this category. | |
58c7641d | 1374 | |
27139cd5 SB |
1375 | If there are marked items, delete all of these; otherwise, delete |
1376 | the item at point." | |
1377 | (interactive) | |
1378 | (let (ov) | |
1379 | (unwind-protect | |
1380 | (let* ((cat (todos-current-category)) | |
1381 | (marked (assoc cat todos-categories-with-marks)) | |
1382 | (item (unless marked (todos-item-string))) | |
1383 | (answer (if marked | |
e99a2125 SB |
1384 | (todos-y-or-n-p |
1385 | "Permanently delete all marked items? ") | |
27139cd5 SB |
1386 | (when item |
1387 | (setq ov (make-overlay | |
1388 | (save-excursion (todos-item-start)) | |
1389 | (save-excursion (todos-item-end)))) | |
1390 | (overlay-put ov 'face 'todos-search) | |
e99a2125 | 1391 | (todos-y-or-n-p "Permanently delete this item? ")))) |
27139cd5 SB |
1392 | buffer-read-only) |
1393 | (when answer | |
1394 | (and marked (goto-char (point-min))) | |
1395 | (catch 'done | |
1396 | (while (not (eobp)) | |
1397 | (if (or (and marked (todos-marked-item-p)) item) | |
1398 | (progn | |
1399 | (if (todos-done-item-p) | |
1400 | (todos-update-count 'done -1) | |
1401 | (todos-update-count 'todo -1 cat) | |
e99a2125 SB |
1402 | (and (todos-diary-item-p) |
1403 | (todos-update-count 'diary -1))) | |
27139cd5 SB |
1404 | (if ov (delete-overlay ov)) |
1405 | (todos-remove-item) | |
1406 | ;; Don't leave point below last item. | |
1407 | (and item (bolp) (eolp) (< (point-min) (point-max)) | |
1408 | (todos-backward-item)) | |
e99a2125 | 1409 | (when item |
27139cd5 SB |
1410 | (throw 'done (setq item nil)))) |
1411 | (todos-forward-item)))) | |
1412 | (when marked | |
1413 | (setq todos-categories-with-marks | |
1414 | (assq-delete-all cat todos-categories-with-marks))) | |
1415 | (todos-update-categories-sexp) | |
1416 | (todos-prefix-overlays))) | |
1417 | (if ov (delete-overlay ov))))) | |
6be04162 | 1418 | |
27139cd5 SB |
1419 | (defun todos-edit-item (&optional arg) |
1420 | "Edit the Todo item at point. | |
6be04162 | 1421 | |
27139cd5 SB |
1422 | With non-nil prefix argument ARG, include the item's date/time |
1423 | header, making it also editable; otherwise, include only the item | |
1424 | content. | |
58c7641d | 1425 | |
27139cd5 SB |
1426 | If the item consists of only one logical line, edit it in the |
1427 | minibuffer; otherwise, edit it in Todos Edit mode." | |
1428 | (interactive "P") | |
1429 | (when (todos-item-string) | |
1430 | (let* ((opoint (point)) | |
1431 | (start (todos-item-start)) | |
1432 | (item-beg (progn | |
1433 | (re-search-forward | |
1434 | (concat todos-date-string-start todos-date-pattern | |
1435 | "\\( " diary-time-regexp "\\)?" | |
1436 | (regexp-quote todos-nondiary-end) "?") | |
1437 | (line-end-position) t) | |
1438 | (1+ (- (point) start)))) | |
1439 | (header (substring (todos-item-string) 0 item-beg)) | |
1440 | (item (if arg (todos-item-string) | |
1441 | (substring (todos-item-string) item-beg))) | |
1442 | (multiline (> (length (split-string item "\n")) 1)) | |
1443 | (buffer-read-only nil)) | |
1444 | (if multiline | |
1445 | (todos-edit-multiline-item) | |
1446 | (let ((new (concat (if arg "" header) | |
1447 | (read-string "Edit: " (if arg | |
1448 | (cons item item-beg) | |
1449 | (cons item 0)))))) | |
1450 | (when arg | |
1451 | (while (not (string-match (concat todos-date-string-start | |
1452 | todos-date-pattern) new)) | |
1453 | (setq new (read-from-minibuffer | |
1454 | "Item must start with a date: " new)))) | |
1455 | ;; Ensure lines following hard newlines are indented. | |
1456 | (setq new (replace-regexp-in-string "\\(\n\\)[^[:blank:]]" | |
1457 | "\n\t" new nil nil 1)) | |
1458 | ;; If user moved point during editing, make sure it moves back. | |
1459 | (goto-char opoint) | |
1460 | (todos-remove-item) | |
1461 | (todos-insert-with-overlays new) | |
1462 | (move-to-column item-beg)))))) | |
0e89c3fc | 1463 | |
27139cd5 SB |
1464 | (defun todos-edit-multiline-item () |
1465 | "Edit current Todo item in Todos Edit mode. | |
1466 | Use of newlines invokes `todos-indent' to insure compliance with | |
1467 | the format of Diary entries." | |
1468 | (interactive) | |
1469 | (when (todos-item-string) | |
1470 | (let ((buf todos-edit-buffer)) | |
1471 | (set-window-buffer (selected-window) | |
1472 | (set-buffer (make-indirect-buffer (buffer-name) buf))) | |
1473 | (narrow-to-region (todos-item-start) (todos-item-end)) | |
1474 | (todos-edit-mode) | |
1475 | (message "%s" (substitute-command-keys | |
1476 | (concat "Type \\[todos-edit-quit] " | |
1477 | "to return to Todos mode.\n")))))) | |
0e89c3fc | 1478 | |
27139cd5 SB |
1479 | (defun todos-edit-quit () |
1480 | "Return from Todos Edit mode to Todos mode. | |
1481 | If the item contains hard line breaks, make sure the following | |
1482 | lines are indented by `todos-indent-to-here' to conform to diary | |
1483 | format. | |
58c7641d | 1484 | |
27139cd5 SB |
1485 | If the whole file was in Todos Edit mode, check before returning |
1486 | whether the file is still a valid Todos file and if so, also | |
1487 | recalculate the Todos categories sexp, in case changes were made | |
1488 | in the number or names of categories." | |
1489 | (interactive) | |
1490 | (if (> (buffer-size) (- (point-max) (point-min))) | |
1491 | ;; We got here via `e m'. | |
1492 | (let ((item (buffer-string)) | |
9fa64073 SB |
1493 | (regex "\\(\n\\)[^[:blank:]]") |
1494 | (buf (buffer-base-buffer))) | |
27139cd5 SB |
1495 | (while (not (string-match (concat todos-date-string-start |
1496 | todos-date-pattern) item)) | |
1497 | (setq item (read-from-minibuffer | |
1498 | "Item must start with a date: " item))) | |
1499 | ;; Ensure lines following hard newlines are indented. | |
1500 | (when (string-match regex (buffer-string)) | |
1501 | (setq item (replace-regexp-in-string regex "\n\t" item nil nil 1)) | |
1502 | (delete-region (point-min) (point-max)) | |
1503 | (insert item)) | |
9fa64073 SB |
1504 | (kill-buffer) |
1505 | (unless (eq (current-buffer) buf) | |
1506 | (set-window-buffer (selected-window) (set-buffer buf)))) | |
27139cd5 SB |
1507 | ;; We got here via `F e'. |
1508 | (when (todos-check-format) | |
1509 | ;; FIXME: separate out sexp check? | |
1510 | ;; If manual editing makes e.g. item counts change, have to | |
1511 | ;; call this to update todos-categories, but it restores | |
1512 | ;; category order to list order. | |
1513 | ;; (todos-repair-categories-sexp) | |
1514 | ;; Compare (todos-make-categories-list t) with sexp and if | |
1515 | ;; different ask (todos-update-categories-sexp) ? | |
1516 | (todos-mode) | |
1517 | (let* ((cat-beg (concat "^" (regexp-quote todos-category-beg) | |
1518 | "\\(.*\\)$")) | |
1519 | (curline (buffer-substring-no-properties | |
1520 | (line-beginning-position) (line-end-position))) | |
1521 | (cat (cond ((string-match cat-beg curline) | |
1522 | (match-string-no-properties 1 curline)) | |
1523 | ((or (re-search-backward cat-beg nil t) | |
1524 | (re-search-forward cat-beg nil t)) | |
1525 | (match-string-no-properties 1))))) | |
1526 | (todos-category-number cat) | |
1527 | (todos-category-select) | |
1528 | (goto-char (point-min)))))) | |
58c7641d | 1529 | |
a9b0e28e | 1530 | (defun todos-basic-edit-item-header (what &optional inc) |
27139cd5 | 1531 | "Function underlying commands to edit item date/time header. |
18aef8a3 | 1532 | |
27139cd5 SB |
1533 | The argument WHAT (passed by invoking commands) specifies what |
1534 | part of the header to edit; possible values are these symbols: | |
1535 | `date', to edit the year, month, and day of the date string; | |
1536 | `time', to edit just the time string; `calendar', to select the | |
1537 | date from the Calendar; `today', to set the date to today's date; | |
1538 | `dayname', to set the date string to the name of a day or to | |
1539 | change the day name; and `year', `month' or `day', to edit only | |
1540 | these respective parts of the date string (`day' is the number of | |
1541 | the given day of the month, and `month' is either the name of the | |
1542 | given month or its number, depending on the value of | |
1543 | `calendar-date-display-form'). | |
58c7641d | 1544 | |
27139cd5 SB |
1545 | The optional argument INC is a positive or negative integer |
1546 | \(passed by invoking commands as a numerical prefix argument) | |
1547 | that in conjunction with the WHAT values `year', `month' or | |
1548 | `day', increments or decrements the specified date string | |
1549 | component by the specified number of suitable units, i.e., years, | |
1550 | months, or days, with automatic adjustment of the other date | |
1551 | string components as necessary. | |
6be04162 | 1552 | |
27139cd5 SB |
1553 | If there are marked items, apply the same edit to all of these; |
1554 | otherwise, edit just the item at point." | |
1555 | (let* ((cat (todos-current-category)) | |
1556 | (marked (assoc cat todos-categories-with-marks)) | |
1557 | (first t) | |
1558 | (todos-date-from-calendar t) | |
1559 | (buffer-read-only nil) | |
1560 | ndate ntime year monthname month day | |
1561 | dayname) ; Needed by calendar-date-display-form. | |
1562 | (save-excursion | |
1563 | (or (and marked (goto-char (point-min))) (todos-item-start)) | |
1564 | (catch 'end | |
1565 | (while (not (eobp)) | |
1566 | (and marked | |
1567 | (while (not (todos-marked-item-p)) | |
1568 | (todos-forward-item) | |
1569 | (and (eobp) (throw 'end nil)))) | |
1570 | (re-search-forward (concat todos-date-string-start "\\(?1:" | |
1571 | todos-date-pattern | |
1572 | "\\)\\(?2: " diary-time-regexp "\\)?" | |
1573 | (regexp-quote todos-nondiary-end) "?") | |
1574 | (line-end-position) t) | |
1575 | (let* ((odate (match-string-no-properties 1)) | |
1576 | (otime (match-string-no-properties 2)) | |
1577 | (omonthname (match-string-no-properties 6)) | |
1578 | (omonth (match-string-no-properties 7)) | |
1579 | (oday (match-string-no-properties 8)) | |
1580 | (oyear (match-string-no-properties 9)) | |
1581 | (tmn-array todos-month-name-array) | |
1582 | (mlist (append tmn-array nil)) | |
1583 | (tma-array todos-month-abbrev-array) | |
1584 | (mablist (append tma-array nil)) | |
1585 | (yy (and oyear (unless (string= oyear "*") | |
1586 | (string-to-number oyear)))) | |
1587 | (mm (or (and omonth (unless (string= omonth "*") | |
1588 | (string-to-number omonth))) | |
1589 | (1+ (- (length mlist) | |
1590 | (length (or (member omonthname mlist) | |
1591 | (member omonthname mablist))))))) | |
1592 | (dd (and oday (unless (string= oday "*") | |
1593 | (string-to-number oday))))) | |
1594 | ;; If there are marked items, use only the first to set | |
1595 | ;; header changes, and apply these to all marked items. | |
1596 | (when first | |
1597 | (cond | |
1598 | ((eq what 'date) | |
1599 | (setq ndate (todos-read-date))) | |
1600 | ((eq what 'calendar) | |
1601 | (setq ndate (save-match-data (todos-set-date-from-calendar)))) | |
1602 | ((eq what 'today) | |
1603 | (setq ndate (calendar-date-string (calendar-current-date) t t))) | |
1604 | ((eq what 'dayname) | |
1605 | (setq ndate (todos-read-dayname))) | |
1606 | ((eq what 'time) | |
1607 | (setq ntime (save-match-data (todos-read-time))) | |
1608 | (when (> (length ntime) 0) | |
1609 | (setq ntime (concat " " ntime)))) | |
1610 | ;; When date string consists only of a day name, | |
1611 | ;; passing other date components is a NOP. | |
1612 | ((and (memq what '(year month day)) | |
1613 | (not (or oyear omonth oday)))) | |
1614 | ((eq what 'year) | |
1615 | (setq day oday | |
1616 | monthname omonthname | |
1617 | month omonth | |
1618 | year (cond ((not current-prefix-arg) | |
1619 | (todos-read-date 'year)) | |
1620 | ((string= oyear "*") | |
a9b0e28e | 1621 | (user-error "Cannot increment *")) |
27139cd5 SB |
1622 | (t |
1623 | (number-to-string (+ yy inc)))))) | |
1624 | ((eq what 'month) | |
1625 | (setf day oday | |
1626 | year oyear | |
1627 | (if (memq 'month calendar-date-display-form) | |
1628 | month | |
1629 | monthname) | |
1630 | (cond ((not current-prefix-arg) | |
1631 | (todos-read-date 'month)) | |
1632 | ((or (string= omonth "*") (= mm 13)) | |
a9b0e28e | 1633 | (user-error "Cannot increment *")) |
27139cd5 | 1634 | (t |
e99a2125 | 1635 | (let ((mminc (+ mm inc))) |
27139cd5 SB |
1636 | ;; Increment or decrement month by INC |
1637 | ;; modulo 12. | |
1638 | (setq mm (% mminc 12)) | |
1639 | ;; If result is 0, make month December. | |
1640 | (setq mm (if (= mm 0) 12 (abs mm))) | |
1641 | ;; Adjust year if necessary. | |
1642 | (setq year (or (and (cond ((> mminc 12) | |
1643 | (+ yy (/ mminc 12))) | |
1644 | ((< mminc 1) | |
1645 | (- yy (/ mminc 12) 1)) | |
1646 | (t yy)) | |
1647 | (number-to-string yy)) | |
1648 | oyear))) | |
1649 | ;; Return the changed numerical month as | |
1650 | ;; a string or the corresponding month name. | |
1651 | (if omonth | |
1652 | (number-to-string mm) | |
1653 | (aref tma-array (1- mm)))))) | |
1654 | (let ((yy (string-to-number year)) ; 0 if year is "*". | |
1655 | ;; When mm is 13 (corresponding to "*" as value | |
1656 | ;; of month), this raises an args-out-of-range | |
1657 | ;; error in calendar-last-day-of-month, so use 1 | |
1658 | ;; (corresponding to January) to get 31 days. | |
1659 | (mm (if (= mm 13) 1 mm))) | |
1660 | (if (> (string-to-number day) | |
1661 | (calendar-last-day-of-month mm yy)) | |
a9b0e28e | 1662 | (user-error "%s %s does not have %s days" |
27139cd5 SB |
1663 | (aref tmn-array (1- mm)) |
1664 | (if (= mm 2) yy "") day)))) | |
1665 | ((eq what 'day) | |
1666 | (setq year oyear | |
1667 | month omonth | |
1668 | monthname omonthname | |
1669 | day (cond | |
1670 | ((not current-prefix-arg) | |
1671 | (todos-read-date 'day mm oyear)) | |
1672 | ((string= oday "*") | |
a9b0e28e | 1673 | (user-error "Cannot increment *")) |
27139cd5 SB |
1674 | ((or (string= omonth "*") (string= omonthname "*")) |
1675 | (setq dd (+ dd inc)) | |
1676 | (if (> dd 31) | |
a9b0e28e | 1677 | (user-error "A month cannot have more than 31 days") |
27139cd5 SB |
1678 | (number-to-string dd))) |
1679 | ;; Increment or decrement day by INC, | |
1680 | ;; adjusting month and year if necessary | |
1681 | ;; (if year is "*" assume current year to | |
1682 | ;; calculate adjustment). | |
1683 | (t | |
1684 | (let* ((yy (or yy (calendar-extract-year | |
1685 | (calendar-current-date)))) | |
1686 | (date (calendar-gregorian-from-absolute | |
1687 | (+ (calendar-absolute-from-gregorian | |
1688 | (list mm dd yy)) inc))) | |
1689 | (adjmm (nth 0 date))) | |
1690 | ;; Set year and month(name) to adjusted values. | |
1691 | (unless (string= year "*") | |
1692 | (setq year (number-to-string (nth 2 date)))) | |
1693 | (if month | |
1694 | (setq month (number-to-string adjmm)) | |
1695 | (setq monthname (aref tma-array (1- adjmm)))) | |
1696 | ;; Return changed numerical day as a string. | |
1697 | (number-to-string (nth 1 date))))))))) | |
1698 | ;; If new year, month or day date string components were | |
1699 | ;; calculated, rebuild the whole date string from them. | |
1700 | (when (memq what '(year month day)) | |
1701 | (if (or oyear omonth omonthname oday) | |
1702 | (setq ndate (mapconcat 'eval calendar-date-display-form "")) | |
1703 | (message "Cannot edit date component of empty date string"))) | |
1704 | (when ndate (replace-match ndate nil nil nil 1)) | |
1705 | ;; Add new time string to the header, if it was supplied. | |
1706 | (when ntime | |
1707 | (if otime | |
1708 | (replace-match ntime nil nil nil 2) | |
1709 | (goto-char (match-end 1)) | |
1710 | (insert ntime))) | |
1711 | (setq todos-date-from-calendar nil) | |
1712 | (setq first nil)) | |
1713 | ;; Apply the changes to the first marked item header to the | |
1714 | ;; remaining marked items. If there are no marked items, | |
1715 | ;; we're finished. | |
1716 | (if marked | |
1717 | (todos-forward-item) | |
1718 | (goto-char (point-max)))))))) | |
6be04162 | 1719 | |
27139cd5 SB |
1720 | (defun todos-edit-item-header () |
1721 | "Interactively edit at least the date of item's date/time header. | |
1722 | If user option `todos-always-add-time-string' is non-nil, also | |
1723 | edit item's time string." | |
1724 | (interactive) | |
a9b0e28e | 1725 | (todos-basic-edit-item-header 'date) |
27139cd5 SB |
1726 | (when todos-always-add-time-string |
1727 | (todos-edit-item-time))) | |
c523b0aa | 1728 | |
27139cd5 SB |
1729 | (defun todos-edit-item-time () |
1730 | "Interactively edit the time string of item's date/time header." | |
1731 | (interactive) | |
a9b0e28e | 1732 | (todos-basic-edit-item-header 'time)) |
6be04162 | 1733 | |
27139cd5 SB |
1734 | (defun todos-edit-item-date-from-calendar () |
1735 | "Interactively edit item's date using the Calendar." | |
1736 | (interactive) | |
a9b0e28e | 1737 | (todos-basic-edit-item-header 'calendar)) |
0e89c3fc | 1738 | |
27139cd5 SB |
1739 | (defun todos-edit-item-date-to-today () |
1740 | "Set item's date to today's date." | |
1741 | (interactive) | |
a9b0e28e | 1742 | (todos-basic-edit-item-header 'today)) |
0e89c3fc | 1743 | |
27139cd5 SB |
1744 | (defun todos-edit-item-date-day-name () |
1745 | "Replace item's date with the name of a day of the week." | |
1746 | (interactive) | |
a9b0e28e | 1747 | (todos-basic-edit-item-header 'dayname)) |
0e89c3fc | 1748 | |
27139cd5 SB |
1749 | (defun todos-edit-item-date-year (&optional inc) |
1750 | "Interactively edit the year of item's date string. | |
1751 | With prefix argument INC a positive or negative integer, | |
1752 | increment or decrement the year by INC." | |
1753 | (interactive "p") | |
a9b0e28e | 1754 | (todos-basic-edit-item-header 'year inc)) |
0e89c3fc | 1755 | |
27139cd5 SB |
1756 | (defun todos-edit-item-date-month (&optional inc) |
1757 | "Interactively edit the month of item's date string. | |
1758 | With prefix argument INC a positive or negative integer, | |
1759 | increment or decrement the month by INC." | |
1760 | (interactive "p") | |
a9b0e28e | 1761 | (todos-basic-edit-item-header 'month inc)) |
0e89c3fc | 1762 | |
27139cd5 SB |
1763 | (defun todos-edit-item-date-day (&optional inc) |
1764 | "Interactively edit the day of the month of item's date string. | |
1765 | With prefix argument INC a positive or negative integer, | |
1766 | increment or decrement the day by INC." | |
1767 | (interactive "p") | |
a9b0e28e | 1768 | (todos-basic-edit-item-header 'day inc)) |
a2730169 | 1769 | |
27139cd5 SB |
1770 | (defun todos-edit-item-diary-inclusion () |
1771 | "Change diary status of one or more todo items in this category. | |
1772 | That is, insert `todos-nondiary-marker' if the candidate items | |
1773 | lack this marking; otherwise, remove it. | |
58c7641d | 1774 | |
27139cd5 SB |
1775 | If there are marked todo items, change the diary status of all |
1776 | and only these, otherwise change the diary status of the item at | |
1777 | point." | |
1778 | (interactive) | |
1779 | (let ((buffer-read-only) | |
1780 | (marked (assoc (todos-current-category) | |
1781 | todos-categories-with-marks))) | |
1782 | (catch 'stop | |
1783 | (save-excursion | |
1784 | (when marked (goto-char (point-min))) | |
1785 | (while (not (eobp)) | |
1786 | (if (todos-done-item-p) | |
1787 | (throw 'stop (message "Done items cannot be edited")) | |
1788 | (unless (and marked (not (todos-marked-item-p))) | |
1789 | (let* ((beg (todos-item-start)) | |
1790 | (lim (save-excursion (todos-item-end))) | |
1791 | (end (save-excursion | |
1792 | (or (todos-time-string-matcher lim) | |
1793 | (todos-date-string-matcher lim))))) | |
1794 | (if (looking-at (regexp-quote todos-nondiary-start)) | |
1795 | (progn | |
1796 | (replace-match "") | |
1797 | (search-forward todos-nondiary-end (1+ end) t) | |
1798 | (replace-match "") | |
1799 | (todos-update-count 'diary 1)) | |
1800 | (when end | |
1801 | (insert todos-nondiary-start) | |
1802 | (goto-char (1+ end)) | |
1803 | (insert todos-nondiary-end) | |
1804 | (todos-update-count 'diary -1))))) | |
1805 | (unless marked (throw 'stop nil)) | |
1806 | (todos-forward-item))))) | |
1807 | (todos-update-categories-sexp))) | |
58c7641d | 1808 | |
27139cd5 SB |
1809 | (defun todos-edit-category-diary-inclusion (arg) |
1810 | "Make all items in this category diary items. | |
1811 | With prefix ARG, make all items in this category non-diary | |
1812 | items." | |
1813 | (interactive "P") | |
1814 | (save-excursion | |
1815 | (goto-char (point-min)) | |
1816 | (let ((todo-count (todos-get-count 'todo)) | |
1817 | (diary-count (todos-get-count 'diary)) | |
1818 | (buffer-read-only)) | |
1819 | (catch 'stop | |
1820 | (while (not (eobp)) | |
1821 | (if (todos-done-item-p) ; We've gone too far. | |
1822 | (throw 'stop nil) | |
1823 | (let* ((beg (todos-item-start)) | |
1824 | (lim (save-excursion (todos-item-end))) | |
1825 | (end (save-excursion | |
1826 | (or (todos-time-string-matcher lim) | |
1827 | (todos-date-string-matcher lim))))) | |
1828 | (if arg | |
1829 | (unless (looking-at (regexp-quote todos-nondiary-start)) | |
1830 | (insert todos-nondiary-start) | |
1831 | (goto-char (1+ end)) | |
1832 | (insert todos-nondiary-end)) | |
1833 | (when (looking-at (regexp-quote todos-nondiary-start)) | |
1834 | (replace-match "") | |
1835 | (search-forward todos-nondiary-end (1+ end) t) | |
1836 | (replace-match ""))))) | |
1837 | (todos-forward-item)) | |
1838 | (unless (if arg (zerop diary-count) (= diary-count todo-count)) | |
1839 | (todos-update-count 'diary (if arg | |
1840 | (- diary-count) | |
1841 | (- todo-count diary-count)))) | |
1842 | (todos-update-categories-sexp))))) | |
58c7641d | 1843 | |
27139cd5 SB |
1844 | (defun todos-edit-item-diary-nonmarking () |
1845 | "Change non-marking of one or more diary items in this category. | |
1846 | That is, insert `diary-nonmarking-symbol' if the candidate items | |
1847 | lack this marking; otherwise, remove it. | |
58c7641d | 1848 | |
27139cd5 SB |
1849 | If there are marked todo items, change the non-marking status of |
1850 | all and only these, otherwise change the non-marking status of | |
1851 | the item at point." | |
1852 | (interactive) | |
1853 | (let ((buffer-read-only) | |
1854 | (marked (assoc (todos-current-category) | |
1855 | todos-categories-with-marks))) | |
1856 | (catch 'stop | |
1857 | (save-excursion | |
1858 | (when marked (goto-char (point-min))) | |
1859 | (while (not (eobp)) | |
1860 | (if (todos-done-item-p) | |
1861 | (throw 'stop (message "Done items cannot be edited")) | |
1862 | (unless (and marked (not (todos-marked-item-p))) | |
1863 | (todos-item-start) | |
1864 | (unless (looking-at (regexp-quote todos-nondiary-start)) | |
1865 | (if (looking-at (regexp-quote diary-nonmarking-symbol)) | |
1866 | (replace-match "") | |
1867 | (insert diary-nonmarking-symbol)))) | |
1868 | (unless marked (throw 'stop nil)) | |
1869 | (todos-forward-item))))))) | |
2c173503 | 1870 | |
27139cd5 SB |
1871 | (defun todos-edit-category-diary-nonmarking (arg) |
1872 | "Add `diary-nonmarking-symbol' to all diary items in this category. | |
1873 | With prefix ARG, remove `diary-nonmarking-symbol' from all diary | |
1874 | items in this category." | |
1875 | (interactive "P") | |
1876 | (save-excursion | |
1877 | (goto-char (point-min)) | |
1878 | (let (buffer-read-only) | |
1879 | (catch 'stop | |
1880 | (while (not (eobp)) | |
1881 | (if (todos-done-item-p) ; We've gone too far. | |
1882 | (throw 'stop nil) | |
1883 | (unless (looking-at (regexp-quote todos-nondiary-start)) | |
1884 | (if arg | |
1885 | (when (looking-at (regexp-quote diary-nonmarking-symbol)) | |
1886 | (replace-match "")) | |
1887 | (unless (looking-at (regexp-quote diary-nonmarking-symbol)) | |
1888 | (insert diary-nonmarking-symbol)))) | |
1889 | (todos-forward-item))))))) | |
144faf47 | 1890 | |
27139cd5 SB |
1891 | (defun todos-set-item-priority (&optional item cat new arg) |
1892 | "Prompt for and set ITEM's priority in CATegory. | |
144faf47 | 1893 | |
27139cd5 SB |
1894 | Interactively, ITEM is the todo item at point, CAT is the current |
1895 | category, and the priority is a number between 1 and the number | |
1896 | of items in the category. Non-interactively, non-nil NEW means | |
1897 | ITEM is a new item and the lowest priority is one more than the | |
1898 | number of items in CAT. | |
d9be0d35 | 1899 | |
27139cd5 SB |
1900 | The new priority is set either interactively by prompt or by a |
1901 | numerical prefix argument, or noninteractively by argument ARG, | |
1902 | whose value can be either of the symbols `raise' or `lower', | |
1903 | meaning to raise or lower the item's priority by one." | |
a9b0e28e | 1904 | (interactive) |
27139cd5 SB |
1905 | (unless (and (called-interactively-p 'any) |
1906 | (or (todos-done-item-p) (looking-at "^$"))) | |
1907 | (let* ((item (or item (todos-item-string))) | |
1908 | (marked (todos-marked-item-p)) | |
1909 | (cat (or cat (cond ((eq major-mode 'todos-mode) | |
1910 | (todos-current-category)) | |
1911 | ((eq major-mode 'todos-filtered-items-mode) | |
1912 | (let* ((regexp1 | |
1913 | (concat todos-date-string-start | |
1914 | todos-date-pattern | |
1915 | "\\( " diary-time-regexp "\\)?" | |
1916 | (regexp-quote todos-nondiary-end) | |
1917 | "?\\(?1: \\[\\(.+:\\)?.+\\]\\)"))) | |
1918 | (save-excursion | |
1919 | (re-search-forward regexp1 nil t) | |
1920 | (match-string-no-properties 1))))))) | |
1921 | curnum | |
1922 | (todo (cond ((or (eq arg 'raise) (eq arg 'lower) | |
1923 | (eq major-mode 'todos-filtered-items-mode)) | |
1924 | (save-excursion | |
1925 | (let ((curstart (todos-item-start)) | |
1926 | (count 0)) | |
1927 | (goto-char (point-min)) | |
1928 | (while (looking-at todos-item-start) | |
1929 | (setq count (1+ count)) | |
1930 | (when (= (point) curstart) (setq curnum count)) | |
1931 | (todos-forward-item)) | |
1932 | count))) | |
1933 | ((eq major-mode 'todos-mode) | |
1934 | (todos-get-count 'todo cat)))) | |
1935 | (maxnum (if new (1+ todo) todo)) | |
1936 | (prompt (format "Set item priority (1-%d): " maxnum)) | |
1937 | (priority (cond ((and (not arg) (numberp current-prefix-arg)) | |
1938 | current-prefix-arg) | |
1939 | ((and (eq arg 'raise) (>= curnum 1)) | |
1940 | (1- curnum)) | |
1941 | ((and (eq arg 'lower) (<= curnum maxnum)) | |
1942 | (1+ curnum)))) | |
1943 | candidate | |
1944 | buffer-read-only) | |
1945 | (unless (and priority | |
1946 | (or (and (eq arg 'raise) (zerop priority)) | |
1947 | (and (eq arg 'lower) (> priority maxnum)))) | |
1948 | ;; When moving item to another category, show the category before | |
1949 | ;; prompting for its priority. | |
1950 | (unless (or arg (called-interactively-p 'any)) | |
1951 | (todos-category-number cat) | |
1952 | ;; If done items in category are visible, keep them visible. | |
1953 | (let ((done todos-show-with-done)) | |
1954 | (when (> (buffer-size) (- (point-max) (point-min))) | |
1955 | (save-excursion | |
308f5beb SB |
1956 | (goto-char (point-min)) |
1957 | (setq done (re-search-forward todos-done-string-start nil t)))) | |
1958 | (let ((todos-show-with-done done)) | |
27139cd5 SB |
1959 | (todos-category-select) |
1960 | ;; Keep top of category in view while setting priority. | |
1961 | (goto-char (point-min))))) | |
e99a2125 SB |
1962 | ;; Prompt for priority only when the category has at least one |
1963 | ;; todo item. | |
27139cd5 SB |
1964 | (when (> maxnum 1) |
1965 | (while (not priority) | |
1966 | (setq candidate (read-number prompt)) | |
1967 | (setq prompt (when (or (< candidate 1) (> candidate maxnum)) | |
1968 | (format "Priority must be an integer between 1 and %d.\n" | |
1969 | maxnum))) | |
1970 | (unless prompt (setq priority candidate)))) | |
1971 | ;; In Top Priorities buffer, an item's priority can be changed | |
1972 | ;; wrt items in another category, but not wrt items in the same | |
1973 | ;; category. | |
1974 | (when (eq major-mode 'todos-filtered-items-mode) | |
1975 | (let* ((regexp2 (concat todos-date-string-start todos-date-pattern | |
1976 | "\\( " diary-time-regexp "\\)?" | |
1977 | (regexp-quote todos-nondiary-end) | |
1978 | "?\\(?1:" (regexp-quote cat) "\\)")) | |
1979 | (end (cond ((< curnum priority) | |
1980 | (save-excursion (todos-item-end))) | |
1981 | ((> curnum priority) | |
1982 | (save-excursion (todos-item-start))))) | |
1983 | (match (save-excursion | |
1984 | (cond ((< curnum priority) | |
1985 | (todos-forward-item (1+ (- priority curnum))) | |
1986 | (when (re-search-backward regexp2 end t) | |
1987 | (match-string-no-properties 1))) | |
1988 | ((> curnum priority) | |
1989 | (todos-backward-item (- curnum priority)) | |
1990 | (when (re-search-forward regexp2 end t) | |
1991 | (match-string-no-properties 1))))))) | |
1992 | (when match | |
a9b0e28e | 1993 | (user-error (concat "Cannot reprioritize items from the same " |
27139cd5 SB |
1994 | "category in this mode, only in Todos mode"))))) |
1995 | ;; Interactively or with non-nil ARG, relocate the item within its | |
1996 | ;; category. | |
1997 | (when (or arg (called-interactively-p 'any)) | |
1998 | (todos-remove-item)) | |
1999 | (goto-char (point-min)) | |
2000 | (when priority | |
2001 | (unless (= priority 1) | |
2002 | (todos-forward-item (1- priority)) | |
2003 | ;; When called from todos-item-undone and the highest priority | |
2004 | ;; is chosen, this advances point to the first done item, so | |
2005 | ;; move it up to the empty line above the done items | |
2006 | ;; separator. | |
2007 | (when (looking-back (concat "^" | |
e99a2125 SB |
2008 | (regexp-quote todos-category-done) |
2009 | "\n")) | |
27139cd5 SB |
2010 | (todos-backward-item)))) |
2011 | (todos-insert-with-overlays item) | |
2012 | ;; If item was marked, restore the mark. | |
2013 | (and marked | |
2014 | (let* ((ov (todos-get-overlay 'prefix)) | |
2015 | (pref (overlay-get ov 'before-string))) | |
e99a2125 SB |
2016 | (overlay-put ov 'before-string |
2017 | (concat todos-item-mark pref)))))))) | |
3f031767 | 2018 | |
27139cd5 SB |
2019 | (defun todos-raise-item-priority () |
2020 | "Raise priority of current item by moving it up by one item." | |
2021 | (interactive) | |
2022 | (todos-set-item-priority nil nil nil 'raise)) | |
ee7412e4 | 2023 | |
27139cd5 SB |
2024 | (defun todos-lower-item-priority () |
2025 | "Lower priority of current item by moving it down by one item." | |
2026 | (interactive) | |
2027 | (todos-set-item-priority nil nil nil 'lower)) | |
d04d6b95 | 2028 | |
27139cd5 SB |
2029 | (defun todos-move-item (&optional file) |
2030 | "Move at least one todo or done item to another category. | |
2031 | If there are marked items, move all of these; otherwise, move | |
2032 | the item at point. | |
d04d6b95 | 2033 | |
27139cd5 SB |
2034 | With prefix argument FILE, prompt for a specific Todos file and |
2035 | choose (with TAB completion) a category in it to move the item or | |
2036 | items to; otherwise, choose and move to any category in either | |
2037 | the current Todos file or one of the files in | |
2038 | `todos-category-completions-files'. If the chosen category is | |
2039 | not an existing categories, then it is created and the item(s) | |
2040 | become(s) the first entry/entries in that category. | |
d04d6b95 | 2041 | |
27139cd5 SB |
2042 | With moved Todo items, prompt to set the priority in the category |
2043 | moved to (with multiple todos items, the one that had the highest | |
2044 | priority in the category moved from gets the new priority and the | |
2045 | rest of the moved todo items are inserted in sequence below it). | |
2046 | Moved done items are appended to the top of the done items | |
2047 | section in the category moved to." | |
2048 | (interactive "P") | |
2049 | (let* ((cat1 (todos-current-category)) | |
2050 | (marked (assoc cat1 todos-categories-with-marks))) | |
2051 | ;; Noop if point is not on an item and there are no marked items. | |
2052 | (unless (and (looking-at "^$") | |
2053 | (not marked)) | |
2054 | (let* ((buffer-read-only) | |
2055 | (file1 todos-current-todos-file) | |
2056 | (num todos-category-number) | |
2057 | (item (todos-item-string)) | |
2058 | (diary-item (todos-diary-item-p)) | |
2059 | (done-item (and (todos-done-item-p) (concat item "\n"))) | |
2060 | (omark (save-excursion (todos-item-start) (point-marker))) | |
2061 | (todo 0) | |
2062 | (diary 0) | |
2063 | (done 0) | |
2064 | ov cat2 file2 moved nmark todo-items done-items) | |
2065 | (unwind-protect | |
2066 | (progn | |
2067 | (unless marked | |
2068 | (setq ov (make-overlay (save-excursion (todos-item-start)) | |
2069 | (save-excursion (todos-item-end)))) | |
2070 | (overlay-put ov 'face 'todos-search)) | |
2071 | (let* ((pl (if (and marked (> (cdr marked) 1)) "s" "")) | |
2072 | (cat+file (todos-read-category (concat "Move item" pl | |
2073 | " to category: ") | |
2074 | nil file))) | |
2075 | (while (and (equal (car cat+file) cat1) | |
2076 | (equal (cdr cat+file) file1)) | |
2077 | (setq cat+file (todos-read-category | |
2078 | "Choose a different category: "))) | |
2079 | (setq cat2 (car cat+file) | |
2080 | file2 (cdr cat+file)))) | |
2081 | (if ov (delete-overlay ov))) | |
2082 | (set-buffer (find-buffer-visiting file1)) | |
2083 | (if marked | |
2084 | (progn | |
2085 | (goto-char (point-min)) | |
2086 | (while (not (eobp)) | |
2087 | (when (todos-marked-item-p) | |
2088 | (if (todos-done-item-p) | |
2089 | (setq done-items (concat done-items | |
2090 | (todos-item-string) "\n") | |
2091 | done (1+ done)) | |
2092 | (setq todo-items (concat todo-items | |
2093 | (todos-item-string) "\n") | |
2094 | todo (1+ todo)) | |
2095 | (when (todos-diary-item-p) | |
2096 | (setq diary (1+ diary))))) | |
2097 | (todos-forward-item)) | |
2098 | ;; Chop off last newline of multiple todo item string, | |
2099 | ;; since it will be reinserted when setting priority | |
2100 | ;; (but with done items priority is not set, so keep | |
2101 | ;; last newline). | |
2102 | (and todo-items | |
2103 | (setq todo-items (substring todo-items 0 -1)))) | |
2104 | (if (todos-done-item-p) | |
2105 | (setq done 1) | |
2106 | (setq todo 1) | |
2107 | (when (todos-diary-item-p) (setq diary 1)))) | |
2108 | (set-window-buffer (selected-window) | |
2109 | (set-buffer (find-file-noselect file2 'nowarn))) | |
2110 | (unwind-protect | |
2111 | (progn | |
2112 | (when (or todo-items (and item (not done-item))) | |
2113 | (todos-set-item-priority (or todo-items item) cat2 t)) | |
2114 | ;; Move done items en bloc to top of done items section. | |
2115 | (when (or done-items done-item) | |
2116 | (todos-category-number cat2) | |
2117 | (widen) | |
2118 | (goto-char (point-min)) | |
e99a2125 SB |
2119 | (re-search-forward |
2120 | (concat "^" (regexp-quote (concat todos-category-beg cat2)) | |
2121 | "$") nil t) | |
27139cd5 SB |
2122 | (re-search-forward |
2123 | (concat "^" (regexp-quote todos-category-done)) nil t) | |
2124 | (forward-line) | |
2125 | (insert (or done-items done-item))) | |
2126 | (setq moved t)) | |
2127 | (cond | |
2128 | ;; Move succeeded, so remove item from starting category, | |
2129 | ;; update item counts and display the category containing | |
2130 | ;; the moved item. | |
2131 | (moved | |
2132 | (setq nmark (point-marker)) | |
2133 | (when todo (todos-update-count 'todo todo)) | |
2134 | (when diary (todos-update-count 'diary diary)) | |
2135 | (when done (todos-update-count 'done done)) | |
2136 | (todos-update-categories-sexp) | |
2137 | (with-current-buffer (find-buffer-visiting file1) | |
2138 | (save-excursion | |
2139 | (save-restriction | |
2140 | (widen) | |
2141 | (goto-char omark) | |
2142 | (if marked | |
2143 | (let (beg end) | |
2144 | (setq item nil) | |
2145 | (re-search-backward | |
2146 | (concat "^" (regexp-quote todos-category-beg)) nil t) | |
2147 | (forward-line) | |
2148 | (setq beg (point)) | |
2149 | (setq end (if (re-search-forward | |
2150 | (concat "^" (regexp-quote | |
2151 | todos-category-beg)) nil t) | |
2152 | (match-beginning 0) | |
2153 | (point-max))) | |
2154 | (goto-char beg) | |
2155 | (while (< (point) end) | |
2156 | (if (todos-marked-item-p) | |
2157 | (todos-remove-item) | |
2158 | (todos-forward-item))) | |
2159 | (setq todos-categories-with-marks | |
2160 | (assq-delete-all cat1 todos-categories-with-marks))) | |
2161 | (if ov (delete-overlay ov)) | |
2162 | (todos-remove-item)))) | |
2163 | (when todo (todos-update-count 'todo (- todo) cat1)) | |
2164 | (when diary (todos-update-count 'diary (- diary) cat1)) | |
2165 | (when done (todos-update-count 'done (- done) cat1)) | |
2166 | (todos-update-categories-sexp)) | |
2167 | (set-window-buffer (selected-window) | |
2168 | (set-buffer (find-file-noselect file2 'nowarn))) | |
2169 | (setq todos-category-number (todos-category-number cat2)) | |
2170 | (let ((todos-show-with-done (or done-items done-item))) | |
2171 | (todos-category-select)) | |
2172 | (goto-char nmark) | |
2173 | ;; If item is moved to end of (just first?) category, make | |
2174 | ;; sure the items above it are displayed in the window. | |
2175 | (recenter)) | |
2176 | ;; User quit before setting priority of todo item(s), so | |
2177 | ;; return to starting category. | |
2178 | (t | |
2179 | (set-window-buffer (selected-window) | |
2180 | (set-buffer (find-file-noselect file1 'nowarn))) | |
2181 | (todos-category-number cat1) | |
2182 | (todos-category-select) | |
2183 | (goto-char omark)))))))) | |
36341a66 | 2184 | |
27139cd5 SB |
2185 | (defun todos-item-done (&optional arg) |
2186 | "Tag a todo item in this category as done and relocate it. | |
36341a66 | 2187 | |
27139cd5 SB |
2188 | With prefix argument ARG prompt for a comment and append it to |
2189 | the done item; this is only possible if there are no marked | |
2190 | items. If there are marked items, tag all of these with | |
2191 | `todos-done-string' plus the current date and, if | |
2192 | `todos-always-add-time-string' is non-nil, the current time; | |
2193 | otherwise, just tag the item at point. Items tagged as done are | |
2194 | relocated to the category's (by default hidden) done section. If | |
2195 | done items are visible on invoking this command, they remain | |
2196 | visible." | |
2197 | (interactive "P") | |
2198 | (let* ((cat (todos-current-category)) | |
2199 | (marked (assoc cat todos-categories-with-marks))) | |
2200 | (when marked | |
2201 | (save-excursion | |
2202 | (save-restriction | |
2203 | (goto-char (point-max)) | |
2204 | (todos-backward-item) | |
2205 | (unless (todos-done-item-p) | |
2206 | (widen) | |
2207 | (unless (re-search-forward | |
2208 | (concat "^" (regexp-quote todos-category-beg)) nil t) | |
2209 | (goto-char (point-max))) | |
2210 | (forward-line -1)) | |
2211 | (while (todos-done-item-p) | |
2212 | (when (todos-marked-item-p) | |
2213 | (user-error "This command does not apply to done items")) | |
2214 | (todos-backward-item))))) | |
2215 | (unless (and (not marked) | |
2216 | (or (todos-done-item-p) | |
2217 | ;; Point is between todo and done items. | |
2218 | (looking-at "^$"))) | |
2219 | (let* ((date-string (calendar-date-string (calendar-current-date) t t)) | |
2220 | (time-string (if todos-always-add-time-string | |
e99a2125 SB |
2221 | (concat " " (substring (current-time-string) |
2222 | 11 16)) | |
27139cd5 SB |
2223 | "")) |
2224 | (done-prefix (concat "[" todos-done-string date-string time-string | |
2225 | "] ")) | |
2226 | (comment (and arg (read-string "Enter a comment: "))) | |
2227 | (item-count 0) | |
2228 | (diary-count 0) | |
2229 | (show-done (save-excursion | |
2230 | (goto-char (point-min)) | |
2231 | (re-search-forward todos-done-string-start nil t))) | |
2232 | (buffer-read-only nil) | |
2233 | item done-item opoint) | |
2234 | ;; Don't add empty comment to done item. | |
2235 | (setq comment (unless (zerop (length comment)) | |
2236 | (concat " [" todos-comment-string ": " comment "]"))) | |
2237 | (and marked (goto-char (point-min))) | |
2238 | (catch 'done | |
2239 | ;; Stop looping when we hit the empty line below the last | |
2240 | ;; todo item (this is eobp if only done items are hidden). | |
2241 | (while (not (looking-at "^$")) | |
2242 | (if (or (not marked) (and marked (todos-marked-item-p))) | |
2243 | (progn | |
2244 | (setq item (todos-item-string)) | |
2245 | (setq done-item (concat done-item done-prefix item | |
2246 | comment (and marked "\n"))) | |
2247 | (setq item-count (1+ item-count)) | |
2248 | (when (todos-diary-item-p) | |
2249 | (setq diary-count (1+ diary-count))) | |
2250 | (todos-remove-item) | |
2251 | (unless marked (throw 'done nil))) | |
2252 | (todos-forward-item)))) | |
2253 | (when marked | |
2254 | ;; Chop off last newline of done item string. | |
2255 | (setq done-item (substring done-item 0 -1)) | |
2256 | (setq todos-categories-with-marks | |
2257 | (assq-delete-all cat todos-categories-with-marks))) | |
2258 | (save-excursion | |
2259 | (widen) | |
2260 | (re-search-forward | |
2261 | (concat "^" (regexp-quote todos-category-done)) nil t) | |
2262 | (forward-char) | |
2263 | (when show-done (setq opoint (point))) | |
2264 | (insert done-item "\n")) | |
2265 | (todos-update-count 'todo (- item-count)) | |
2266 | (todos-update-count 'done item-count) | |
2267 | (todos-update-count 'diary (- diary-count)) | |
2268 | (todos-update-categories-sexp) | |
2269 | (let ((todos-show-with-done show-done)) | |
2270 | (todos-category-select) | |
2271 | ;; When done items are shown, put cursor on first just done item. | |
2272 | (when opoint (goto-char opoint))))))) | |
abe748f5 | 2273 | |
27139cd5 SB |
2274 | (defun todos-done-item-add-edit-or-delete-comment (&optional arg) |
2275 | "Add a comment to this done item or edit an existing comment. | |
2276 | With prefix ARG delete an existing comment." | |
2277 | (interactive "P") | |
2278 | (when (todos-done-item-p) | |
2279 | (let ((item (todos-item-string)) | |
2280 | (opoint (point)) | |
2281 | (end (save-excursion (todos-item-end))) | |
2282 | comment buffer-read-only) | |
2283 | (save-excursion | |
2284 | (todos-item-start) | |
2285 | (if (re-search-forward (concat " \\[" | |
2286 | (regexp-quote todos-comment-string) | |
2287 | ": \\([^]]+\\)\\]") end t) | |
2288 | (if arg | |
cc416fd3 | 2289 | (when (todos-y-or-n-p "Delete comment? ") |
27139cd5 SB |
2290 | (delete-region (match-beginning 0) (match-end 0))) |
2291 | (setq comment (read-string "Edit comment: " | |
2292 | (cons (match-string 1) 1))) | |
2293 | (replace-match comment nil nil nil 1)) | |
2294 | (setq comment (read-string "Enter a comment: ")) | |
2295 | ;; If user moved point during editing, make sure it moves back. | |
2296 | (goto-char opoint) | |
2297 | (todos-item-end) | |
2298 | (insert " [" todos-comment-string ": " comment "]")))))) | |
58c7641d | 2299 | |
27139cd5 SB |
2300 | (defun todos-item-undone () |
2301 | "Restore at least one done item to this category's todo section. | |
2302 | Prompt for the new priority. If there are marked items, undo all | |
2303 | of these, giving the first undone item the new priority and the | |
2304 | rest following directly in sequence; otherwise, undo just the | |
2305 | item at point. | |
d04d6b95 | 2306 | |
27139cd5 SB |
2307 | If the done item has a comment, ask whether to omit the comment |
2308 | from the restored item. With multiple marked done items with | |
2309 | comments, only ask once, and if affirmed, omit subsequent | |
2310 | comments without asking." | |
2311 | (interactive) | |
2312 | (let* ((cat (todos-current-category)) | |
2313 | (marked (assoc cat todos-categories-with-marks)) | |
2314 | (pl (if (and marked (> (cdr marked) 1)) "s" ""))) | |
2315 | (when (or marked (todos-done-item-p)) | |
2316 | (let ((buffer-read-only) | |
2317 | (opoint (point)) | |
2318 | (omark (point-marker)) | |
2319 | (first 'first) | |
2320 | (item-count 0) | |
2321 | (diary-count 0) | |
2322 | start end item ov npoint undone) | |
2323 | (and marked (goto-char (point-min))) | |
2324 | (catch 'done | |
2325 | (while (not (eobp)) | |
2326 | (when (or (not marked) (and marked (todos-marked-item-p))) | |
2327 | (if (not (todos-done-item-p)) | |
a9b0e28e | 2328 | (user-error "Only done items can be undone") |
27139cd5 SB |
2329 | (todos-item-start) |
2330 | (unless marked | |
2331 | (setq ov (make-overlay (save-excursion (todos-item-start)) | |
2332 | (save-excursion (todos-item-end)))) | |
2333 | (overlay-put ov 'face 'todos-search)) | |
2334 | ;; Find the end of the date string added upon tagging item as | |
2335 | ;; done. | |
2336 | (setq start (search-forward "] ")) | |
2337 | (setq item-count (1+ item-count)) | |
2338 | (unless (looking-at (regexp-quote todos-nondiary-start)) | |
2339 | (setq diary-count (1+ diary-count))) | |
2340 | (setq end (save-excursion (todos-item-end))) | |
2341 | ;; Ask (once) whether to omit done item's comment. If | |
2342 | ;; affirmed, omit subsequent comments without asking. | |
2343 | (when (re-search-forward | |
2344 | (concat " \\[" (regexp-quote todos-comment-string) | |
2345 | ": [^]]+\\]") end t) | |
2346 | (unwind-protect | |
2347 | (if (eq first 'first) | |
2348 | (setq first | |
2349 | (if (eq todos-undo-item-omit-comment 'ask) | |
e99a2125 SB |
2350 | (when (todos-y-or-n-p |
2351 | (concat "Omit comment" pl | |
2352 | " from restored item" | |
2353 | pl "? ")) | |
27139cd5 SB |
2354 | 'omit) |
2355 | (when todos-undo-item-omit-comment 'omit))) | |
2356 | t) | |
2357 | (when (and (eq first 'first) ov) (delete-overlay ov))) | |
2358 | (when (eq first 'omit) | |
2359 | (setq end (match-beginning 0)))) | |
2360 | (setq item (concat item | |
2361 | (buffer-substring-no-properties start end) | |
2362 | (when marked "\n"))) | |
2363 | (unless marked (throw 'done nil)))) | |
2364 | (todos-forward-item))) | |
2365 | (unwind-protect | |
2366 | (progn | |
2367 | ;; Chop off last newline of multiple items string, since | |
2368 | ;; it will be reinserted on setting priority. | |
2369 | (and marked (setq item (substring item 0 -1))) | |
2370 | (todos-set-item-priority item cat t) | |
2371 | (setq npoint (point)) | |
2372 | (setq undone t)) | |
2373 | (when ov (delete-overlay ov)) | |
2374 | (if (not undone) | |
2375 | (goto-char opoint) | |
2376 | (if marked | |
2377 | (progn | |
2378 | (setq item nil) | |
2379 | (re-search-forward | |
2380 | (concat "^" (regexp-quote todos-category-done)) nil t) | |
2381 | (while (not (eobp)) | |
2382 | (if (todos-marked-item-p) | |
2383 | (todos-remove-item) | |
2384 | (todos-forward-item))) | |
2385 | (setq todos-categories-with-marks | |
2386 | (assq-delete-all cat todos-categories-with-marks))) | |
2387 | (goto-char omark) | |
2388 | (todos-remove-item)) | |
2389 | (todos-update-count 'todo item-count) | |
2390 | (todos-update-count 'done (- item-count)) | |
2391 | (when diary-count (todos-update-count 'diary diary-count)) | |
2392 | (todos-update-categories-sexp) | |
2393 | (let ((todos-show-with-done (> (todos-get-count 'done) 0))) | |
2394 | (todos-category-select)) | |
2395 | ;; Put cursor on undone item. | |
2396 | (goto-char npoint))) | |
2397 | (set-marker omark nil))))) | |
ee7412e4 | 2398 | |
a9b0e28e | 2399 | ;; ----------------------------------------------------------------------------- |
27139cd5 | 2400 | ;;; Done Item Archives |
a9b0e28e | 2401 | ;; ----------------------------------------------------------------------------- |
3f031767 | 2402 | |
27139cd5 SB |
2403 | (defcustom todos-skip-archived-categories nil |
2404 | "Non-nil to handle categories with only archived items specially. | |
2405 | ||
2406 | Sequential category navigation using \\[todos-forward-category] | |
2407 | or \\[todos-backward-category] skips categories that contain only | |
2408 | archived items. Other commands still recognize these categories. | |
2409 | In Todos Categories mode (\\[todos-show-categories-table]) these | |
2410 | categories shown in `todos-archived-only' face and pressing the | |
2411 | category button visits the category in the archive instead of the | |
2412 | todo file." | |
2413 | :type 'boolean | |
53e63b4c | 2414 | :group 'todos-display) |
ee7412e4 | 2415 | |
27139cd5 SB |
2416 | (defun todos-find-archive (&optional ask) |
2417 | "Visit the archive of the current Todos category, if it exists. | |
2418 | If the category has no archived items, prompt to visit the | |
2419 | archive anyway. If there is no archive for this file or with | |
2420 | non-nil argument ASK, prompt to visit another archive. | |
58c7641d | 2421 | |
27139cd5 SB |
2422 | The buffer showing the archive is in Todos Archive mode. The |
2423 | first visit in a session displays the first category in the | |
2424 | archive, subsequent visits return to the last category | |
2425 | displayed." | |
2426 | (interactive) | |
2427 | (let* ((cat (todos-current-category)) | |
2428 | (count (todos-get-count 'archived cat)) | |
2429 | (archive (concat (file-name-sans-extension todos-current-todos-file) | |
2430 | ".toda")) | |
2431 | place) | |
2432 | (setq place (cond (ask 'other-archive) | |
2433 | ((file-exists-p archive) 'this-archive) | |
e99a2125 SB |
2434 | (t (when (todos-y-or-n-p |
2435 | (concat "This file has no archive; " | |
2436 | "visit another archive? ")) | |
27139cd5 SB |
2437 | 'other-archive)))) |
2438 | (when (eq place 'other-archive) | |
2439 | (setq archive (todos-read-file-name "Choose a Todos archive: " t t))) | |
2440 | (when (and (eq place 'this-archive) (zerop count)) | |
cc416fd3 | 2441 | (setq place (when (todos-y-or-n-p |
27139cd5 SB |
2442 | (concat "This category has no archived items;" |
2443 | " visit archive anyway? ")) | |
2444 | 'other-cat))) | |
2445 | (when place | |
2446 | (set-window-buffer (selected-window) | |
2447 | (set-buffer (find-file-noselect archive))) | |
2448 | (if (member place '(other-archive other-cat)) | |
2449 | (setq todos-category-number 1) | |
2450 | (todos-category-number cat)) | |
2451 | (todos-category-select)))) | |
d04d6b95 | 2452 | |
27139cd5 SB |
2453 | (defun todos-choose-archive () |
2454 | "Choose an archive and visit it." | |
2455 | (interactive) | |
2456 | (todos-find-archive t)) | |
344187df | 2457 | |
27139cd5 SB |
2458 | (defun todos-archive-done-item (&optional all) |
2459 | "Archive at least one done item in this category. | |
2c173503 | 2460 | |
e99a2125 SB |
2461 | With prefix argument ALL, prompt whether to archive all done |
2462 | items in this category and on confirmation archive them. | |
2463 | Otherwise, if there are marked done items (and no marked todo | |
2464 | items), archive all of these; otherwise, archive the done item at | |
2465 | point. | |
3f031767 | 2466 | |
27139cd5 SB |
2467 | If the archive of this file does not exist, it is created. If |
2468 | this category does not exist in the archive, it is created." | |
2469 | (interactive "P") | |
2470 | (when (eq major-mode 'todos-mode) | |
2471 | (if (and all (zerop (todos-get-count 'done))) | |
2472 | (message "No done items in this category") | |
2473 | (catch 'end | |
2474 | (let* ((cat (todos-current-category)) | |
2475 | (tbuf (current-buffer)) | |
2476 | (marked (assoc cat todos-categories-with-marks)) | |
2477 | (afile (concat (file-name-sans-extension | |
2478 | todos-current-todos-file) ".toda")) | |
2479 | (archive (if (file-exists-p afile) | |
2480 | (find-file-noselect afile t) | |
2481 | (get-buffer-create afile))) | |
e99a2125 SB |
2482 | (item (and (todos-done-item-p) |
2483 | (concat (todos-item-string) "\n"))) | |
27139cd5 SB |
2484 | (count 0) |
2485 | (opoint (unless (todos-done-item-p) (point))) | |
2486 | marked-items beg end all-done | |
2487 | buffer-read-only) | |
2488 | (cond | |
2489 | (all | |
cc416fd3 | 2490 | (if (todos-y-or-n-p "Archive all done items in this category? ") |
27139cd5 SB |
2491 | (save-excursion |
2492 | (save-restriction | |
2493 | (goto-char (point-min)) | |
2494 | (widen) | |
2495 | (setq beg (progn | |
e99a2125 SB |
2496 | (re-search-forward todos-done-string-start |
2497 | nil t) | |
27139cd5 SB |
2498 | (match-beginning 0)) |
2499 | end (if (re-search-forward | |
e99a2125 SB |
2500 | (concat "^" |
2501 | (regexp-quote todos-category-beg)) | |
27139cd5 SB |
2502 | nil t) |
2503 | (match-beginning 0) | |
2504 | (point-max)) | |
2505 | all-done (buffer-substring-no-properties beg end) | |
2506 | count (todos-get-count 'done)) | |
2507 | ;; Restore starting point, unless it was on a done | |
2508 | ;; item, since they will all be deleted. | |
2509 | (when opoint (goto-char opoint)))) | |
2510 | (throw 'end nil))) | |
2511 | (marked | |
2512 | (save-excursion | |
2513 | (goto-char (point-min)) | |
2514 | (while (not (eobp)) | |
2515 | (when (todos-marked-item-p) | |
2516 | (if (not (todos-done-item-p)) | |
2517 | (throw 'end (message "Only done items can be archived")) | |
2518 | (setq marked-items | |
2519 | (concat marked-items (todos-item-string) "\n")) | |
2520 | (setq count (1+ count)))) | |
2521 | (todos-forward-item))))) | |
2522 | (if (not (or marked all item)) | |
2523 | (throw 'end (message "Only done items can be archived")) | |
2524 | (with-current-buffer archive | |
2525 | (unless buffer-file-name (erase-buffer)) | |
2526 | (let (buffer-read-only) | |
2527 | (widen) | |
2528 | (goto-char (point-min)) | |
2529 | (if (and (re-search-forward | |
2530 | (concat "^" (regexp-quote | |
2531 | (concat todos-category-beg cat)) "$") | |
2532 | nil t) | |
2533 | (re-search-forward (regexp-quote todos-category-done) | |
2534 | nil t)) | |
2535 | ;; Start of done items section in existing category. | |
2536 | (forward-char) | |
2537 | (todos-add-category nil cat) | |
2538 | ;; Start of done items section in new category. | |
2539 | (goto-char (point-max))) | |
2540 | (insert (cond (marked marked-items) | |
2541 | (all all-done) | |
2542 | (item))) | |
2543 | (todos-update-count 'done (if (or marked all) count 1) cat) | |
2544 | (todos-update-categories-sexp) | |
2545 | ;; If archive is new, save to file now (using write-region in | |
2546 | ;; order not to get prompted for file to save to), to let | |
2547 | ;; auto-mode-alist take effect below. | |
2548 | (unless buffer-file-name | |
2549 | (write-region nil nil afile) | |
2550 | (kill-buffer)))) | |
2551 | (with-current-buffer tbuf | |
2552 | (cond | |
2553 | (all | |
2554 | (save-excursion | |
2555 | (save-restriction | |
2556 | ;; Make sure done items are accessible. | |
2557 | (widen) | |
2558 | (remove-overlays beg end) | |
2559 | (delete-region beg end) | |
2560 | (todos-update-count 'done (- count)) | |
2561 | (todos-update-count 'archived count)))) | |
2562 | ((or marked | |
2563 | ;; If we're archiving all done items, can't | |
2564 | ;; first archive item point was on, since | |
2565 | ;; that will short-circuit the rest. | |
2566 | (and item (not all))) | |
2567 | (and marked (goto-char (point-min))) | |
2568 | (catch 'done | |
2569 | (while (not (eobp)) | |
2570 | (if (or (and marked (todos-marked-item-p)) item) | |
2571 | (progn | |
2572 | (todos-remove-item) | |
2573 | (todos-update-count 'done -1) | |
2574 | (todos-update-count 'archived 1) | |
2575 | ;; Don't leave point below last item. | |
2576 | (and item (bolp) (eolp) (< (point-min) (point-max)) | |
2577 | (todos-backward-item)) | |
2578 | (when item | |
2579 | (throw 'done (setq item nil)))) | |
2580 | (todos-forward-item)))))) | |
2581 | (when marked | |
2582 | (setq todos-categories-with-marks | |
2583 | (assq-delete-all cat todos-categories-with-marks))) | |
2584 | (todos-update-categories-sexp) | |
2585 | (todos-prefix-overlays))) | |
2586 | (find-file afile) | |
2587 | (todos-category-number cat) | |
2588 | (todos-category-select) | |
2589 | (split-window-below) | |
2590 | (set-window-buffer (selected-window) tbuf) | |
2591 | ;; Make todo file current to select category. | |
2592 | (find-file (buffer-file-name tbuf)) | |
2593 | ;; Make sure done item separator is hidden (if done items | |
2594 | ;; were initially visible). | |
2595 | (let (todos-show-with-done) (todos-category-select))))))) | |
2c173503 | 2596 | |
27139cd5 SB |
2597 | (defun todos-unarchive-items () |
2598 | "Unarchive at least one item in this archive category. | |
2599 | If there are marked items, unarchive all of these; otherwise, | |
2600 | unarchive the item at point. | |
2c173503 | 2601 | |
27139cd5 SB |
2602 | Unarchived items are restored as done items to the corresponding |
2603 | category in the Todos file, inserted at the top of done items | |
2604 | section. If all items in the archive category have been | |
2605 | restored, the category is deleted from the archive. If this was | |
2606 | the only category in the archive, the archive file is deleted." | |
2607 | (interactive) | |
2608 | (when (eq major-mode 'todos-archive-mode) | |
2609 | (let* ((cat (todos-current-category)) | |
2610 | (tbuf (find-file-noselect | |
2611 | (concat (file-name-sans-extension todos-current-todos-file) | |
2612 | ".todo") t)) | |
2613 | (marked (assoc cat todos-categories-with-marks)) | |
2614 | (item (concat (todos-item-string) "\n")) | |
2615 | (marked-count 0) | |
2616 | marked-items | |
2617 | buffer-read-only) | |
2618 | (when marked | |
2619 | (save-excursion | |
2620 | (goto-char (point-min)) | |
2621 | (while (not (eobp)) | |
2622 | (when (todos-marked-item-p) | |
2623 | (setq marked-items (concat marked-items (todos-item-string) "\n")) | |
2624 | (setq marked-count (1+ marked-count))) | |
2625 | (todos-forward-item)))) | |
2626 | ;; Restore items to top of category's done section and update counts. | |
2627 | (with-current-buffer tbuf | |
2628 | (let (buffer-read-only newcat) | |
2629 | (widen) | |
2630 | (goto-char (point-min)) | |
2631 | ;; Find the corresponding todo category, or if there isn't | |
2632 | ;; one, add it. | |
2633 | (unless (re-search-forward | |
2634 | (concat "^" (regexp-quote (concat todos-category-beg cat)) | |
2635 | "$") nil t) | |
2636 | (todos-add-category nil cat) | |
2637 | (setq newcat t)) | |
2638 | ;; Go to top of category's done section. | |
2639 | (re-search-forward | |
2640 | (concat "^" (regexp-quote todos-category-done)) nil t) | |
2641 | (forward-line) | |
27139cd5 SB |
2642 | (cond (marked |
2643 | (insert marked-items) | |
2644 | (todos-update-count 'done marked-count cat) | |
2645 | (unless newcat ; Newly added category has no archive. | |
2646 | (todos-update-count 'archived (- marked-count) cat))) | |
2647 | (t | |
2648 | (insert item) | |
2649 | (todos-update-count 'done 1 cat) | |
2650 | (unless newcat ; Newly added category has no archive. | |
2651 | (todos-update-count 'archived -1 cat)))) | |
2652 | (todos-update-categories-sexp))) | |
2653 | ;; Delete restored items from archive. | |
2654 | (when marked | |
2655 | (setq item nil) | |
2656 | (goto-char (point-min))) | |
2657 | (catch 'done | |
2658 | (while (not (eobp)) | |
2659 | (if (or (todos-marked-item-p) item) | |
2660 | (progn | |
2661 | (todos-remove-item) | |
2662 | (when item | |
2663 | (throw 'done (setq item nil)))) | |
2664 | (todos-forward-item)))) | |
2665 | (todos-update-count 'done (if marked (- marked-count) -1) cat) | |
2666 | ;; If that was the last category in the archive, delete the whole file. | |
2667 | (if (= (length todos-categories) 1) | |
2668 | (progn | |
2669 | (delete-file todos-current-todos-file) | |
2670 | ;; Kill the archive buffer silently. | |
2671 | (set-buffer-modified-p nil) | |
2672 | (kill-buffer)) | |
2673 | ;; Otherwise, if the archive category is now empty, delete it. | |
2674 | (when (eq (point-min) (point-max)) | |
2675 | (widen) | |
2676 | (let ((beg (re-search-backward | |
2677 | (concat "^" (regexp-quote todos-category-beg) cat "$") | |
2678 | nil t)) | |
2679 | (end (if (re-search-forward | |
2680 | (concat "^" (regexp-quote todos-category-beg)) | |
2681 | nil t 2) | |
2682 | (match-beginning 0) | |
2683 | (point-max)))) | |
2684 | (remove-overlays beg end) | |
2685 | (delete-region beg end) | |
2686 | (setq todos-categories (delete (assoc cat todos-categories) | |
2687 | todos-categories)) | |
2688 | (todos-update-categories-sexp)))) | |
2689 | ;; Visit category in Todos file and show restored done items. | |
2690 | (let ((tfile (buffer-file-name tbuf)) | |
2691 | (todos-show-with-done t)) | |
2692 | (set-window-buffer (selected-window) | |
2693 | (set-buffer (find-file-noselect tfile))) | |
2694 | (todos-category-number cat) | |
2695 | (todos-category-select) | |
2696 | (message "Items unarchived."))))) | |
abe748f5 | 2697 | |
27139cd5 SB |
2698 | (defun todos-jump-to-archive-category (&optional file) |
2699 | "Prompt for a category in a Todos archive and jump to it. | |
2700 | With prefix argument FILE, prompt for an archive and choose (with | |
2701 | TAB completion) a category in it to jump to; otherwise, choose | |
2702 | and jump to any category in the current archive." | |
2703 | (interactive "P") | |
2704 | (todos-jump-to-category file 'archive)) | |
ee7412e4 | 2705 | |
a9b0e28e | 2706 | ;; ----------------------------------------------------------------------------- |
27139cd5 | 2707 | ;;; Todos mode display options |
a9b0e28e | 2708 | ;; ----------------------------------------------------------------------------- |
d04d6b95 | 2709 | |
27139cd5 SB |
2710 | (defcustom todos-prefix "" |
2711 | "String prefixed to todo items for visual distinction." | |
2712 | :type '(string :validate | |
2713 | (lambda (widget) | |
2714 | (when (string= (widget-value widget) todos-item-mark) | |
2715 | (widget-put | |
2716 | widget :error | |
2717 | "Invalid value: must be distinct from `todos-item-mark'") | |
2718 | widget))) | |
2719 | :initialize 'custom-initialize-default | |
2720 | :set 'todos-reset-prefix | |
53e63b4c | 2721 | :group 'todos-display) |
a2730169 | 2722 | |
27139cd5 SB |
2723 | (defcustom todos-number-prefix t |
2724 | "Non-nil to prefix items with consecutively increasing integers. | |
2725 | These reflect the priorities of the items in each category." | |
2726 | :type 'boolean | |
2727 | :initialize 'custom-initialize-default | |
2728 | :set 'todos-reset-prefix | |
53e63b4c | 2729 | :group 'todos-display) |
a2730169 | 2730 | |
27139cd5 | 2731 | (defcustom todos-done-separator-string "=" |
e99a2125 | 2732 | "String determining the value of variable `todos-done-separator'. |
27139cd5 SB |
2733 | |
2734 | If the string consists of a single character, | |
2735 | `todos-done-separator' will be the string made by repeating this | |
2736 | character for the width of the window, and the length is | |
2737 | automatically recalculated when the window width changes. If the | |
2738 | string consists of more (or less) than one character, it will be | |
2739 | the value of `todos-done-separator'." | |
2740 | :type 'string | |
2741 | :initialize 'custom-initialize-default | |
2742 | :set 'todos-reset-done-separator-string | |
53e63b4c | 2743 | :group 'todos-display) |
3f031767 | 2744 | |
27139cd5 SB |
2745 | (defcustom todos-done-string "DONE " |
2746 | "Identifying string appended to the front of done todos items." | |
2747 | :type 'string | |
2748 | :initialize 'custom-initialize-default | |
2749 | :set 'todos-reset-done-string | |
53e63b4c | 2750 | :group 'todos-display) |
0e89c3fc | 2751 | |
27139cd5 SB |
2752 | (defcustom todos-comment-string "COMMENT" |
2753 | "String inserted before optional comment appended to done item." | |
2754 | :type 'string | |
2755 | :initialize 'custom-initialize-default | |
2756 | :set 'todos-reset-comment-string | |
53e63b4c | 2757 | :group 'todos-display) |
d16da867 | 2758 | |
27139cd5 SB |
2759 | (defcustom todos-show-with-done nil |
2760 | "Non-nil to display done items in all categories." | |
2761 | :type 'boolean | |
53e63b4c | 2762 | :group 'todos-display) |
d16da867 | 2763 | |
27139cd5 SB |
2764 | (defun todos-mode-line-control (cat) |
2765 | "Return a mode line control for todo or archive file buffers. | |
2766 | Argument CAT is the name of the current Todos category. | |
2767 | This function is the value of the user variable | |
2768 | `todos-mode-line-function'." | |
2769 | (let ((file (todos-short-file-name todos-current-todos-file))) | |
2770 | (format "%s category %d: %s" file todos-category-number cat))) | |
2c173503 | 2771 | |
27139cd5 SB |
2772 | (defcustom todos-mode-line-function 'todos-mode-line-control |
2773 | "Function that returns a mode line control for Todos buffers. | |
2774 | The function expects one argument holding the name of the current | |
2775 | Todos category. The resulting control becomes the local value of | |
2776 | `mode-line-buffer-identification' in each Todos buffer." | |
2777 | :type 'function | |
53e63b4c | 2778 | :group 'todos-display) |
58c7641d | 2779 | |
27139cd5 SB |
2780 | (defcustom todos-highlight-item nil |
2781 | "Non-nil means highlight items at point." | |
2782 | :type 'boolean | |
2783 | :initialize 'custom-initialize-default | |
2784 | :set 'todos-reset-highlight-item | |
53e63b4c | 2785 | :group 'todos-display) |
58c7641d | 2786 | |
27139cd5 SB |
2787 | (defcustom todos-wrap-lines t |
2788 | "Non-nil to activate Visual Line mode and use wrap prefix." | |
53e63b4c SB |
2789 | :type 'boolean |
2790 | :group 'todos-display) | |
2c173503 | 2791 | |
27139cd5 SB |
2792 | (defcustom todos-indent-to-here 3 |
2793 | "Number of spaces to indent continuation lines of items. | |
2794 | This must be a positive number to ensure such items are fully | |
2795 | shown in the Fancy Diary display." | |
2796 | :type '(integer :validate | |
2797 | (lambda (widget) | |
2798 | (unless (> (widget-value widget) 0) | |
2799 | (widget-put widget :error | |
2800 | "Invalid value: must be a positive integer") | |
2801 | widget))) | |
53e63b4c | 2802 | :group 'todos-display) |
58c7641d | 2803 | |
27139cd5 SB |
2804 | (defun todos-indent () |
2805 | "Indent from point to `todos-indent-to-here'." | |
2806 | (indent-to todos-indent-to-here todos-indent-to-here)) | |
58c7641d | 2807 | |
a9b0e28e | 2808 | ;; ----------------------------------------------------------------------------- |
27139cd5 | 2809 | ;;; Display Commands |
a9b0e28e | 2810 | ;; ----------------------------------------------------------------------------- |
27139cd5 SB |
2811 | |
2812 | (defun todos-toggle-prefix-numbers () | |
2813 | "Hide item numbering if shown, show if hidden." | |
2814 | (interactive) | |
2815 | (save-excursion | |
2816 | (save-restriction | |
2817 | (goto-char (point-min)) | |
2818 | (let* ((ov (todos-get-overlay 'prefix)) | |
2819 | (show-done (re-search-forward todos-done-string-start nil t)) | |
2820 | (todos-show-with-done show-done) | |
2821 | (todos-number-prefix (not (equal (overlay-get ov 'before-string) | |
2822 | "1 ")))) | |
2823 | (if (eq major-mode 'todos-filtered-items-mode) | |
2824 | (todos-prefix-overlays) | |
2825 | (todos-category-select)))))) | |
0e89c3fc | 2826 | |
27139cd5 SB |
2827 | (defun todos-toggle-view-done-items () |
2828 | "Show hidden or hide visible done items in current category." | |
2829 | (interactive) | |
2830 | (if (zerop (todos-get-count 'done (todos-current-category))) | |
2831 | (message "There are no done items in this category.") | |
2832 | (let ((opoint (point))) | |
2833 | (goto-char (point-min)) | |
2834 | (let* ((shown (re-search-forward todos-done-string-start nil t)) | |
2835 | (todos-show-with-done (not shown))) | |
2836 | (todos-category-select) | |
2837 | (goto-char opoint) | |
2838 | ;; If start of done items sections is below the bottom of the | |
2839 | ;; window, make it visible. | |
2840 | (unless shown | |
2841 | (setq shown (progn | |
2842 | (goto-char (point-min)) | |
2843 | (re-search-forward todos-done-string-start nil t))) | |
2844 | (if (not (pos-visible-in-window-p shown)) | |
2845 | (recenter) | |
2846 | (goto-char opoint))))))) | |
f1806c78 | 2847 | |
27139cd5 SB |
2848 | (defun todos-toggle-view-done-only () |
2849 | "Switch between displaying only done or only todo items." | |
2850 | (interactive) | |
2851 | (setq todos-show-done-only (not todos-show-done-only)) | |
2852 | (todos-category-select)) | |
f1806c78 | 2853 | |
27139cd5 SB |
2854 | (defun todos-toggle-item-highlighting () |
2855 | "Highlight or unhighlight the todo item the cursor is on." | |
2856 | (interactive) | |
2857 | (require 'hl-line) | |
2858 | (if hl-line-mode | |
2859 | (hl-line-mode -1) | |
2860 | (hl-line-mode 1))) | |
2861 | ||
2862 | (defun todos-toggle-item-header () | |
2863 | "Hide or show item date-time headers in the current file. | |
2864 | With done items, this hides only the done date-time string, not | |
2865 | the the original date-time string." | |
2866 | (interactive) | |
2867 | (save-excursion | |
2868 | (save-restriction | |
2869 | (goto-char (point-min)) | |
2870 | (if (todos-get-overlay 'header) | |
2871 | (remove-overlays 1 (1+ (buffer-size)) 'todos 'header) | |
2872 | (widen) | |
2873 | (goto-char (point-min)) | |
2874 | (while (not (eobp)) | |
2875 | (when (re-search-forward | |
2876 | (concat todos-item-start | |
2877 | "\\( " diary-time-regexp "\\)?" | |
2878 | (regexp-quote todos-nondiary-end) "? ") | |
2879 | nil t) | |
2880 | (setq ov (make-overlay (match-beginning 0) (match-end 0) nil t)) | |
2881 | (overlay-put ov 'todos 'header) | |
2882 | (overlay-put ov 'display "")) | |
2883 | (todos-forward-item)))))) | |
0e89c3fc | 2884 | |
a9b0e28e | 2885 | ;; ----------------------------------------------------------------------------- |
27139cd5 | 2886 | ;;; Faces |
a9b0e28e | 2887 | ;; ----------------------------------------------------------------------------- |
0e89c3fc | 2888 | |
27139cd5 SB |
2889 | (defface todos-prefix-string |
2890 | ;; '((t :inherit font-lock-constant-face)) | |
2891 | '((((class grayscale) (background light)) | |
2892 | (:foreground "LightGray" :weight bold :underline t)) | |
2893 | (((class grayscale) (background dark)) | |
2894 | (:foreground "Gray50" :weight bold :underline t)) | |
2895 | (((class color) (min-colors 88) (background light)) (:foreground "dark cyan")) | |
2896 | (((class color) (min-colors 88) (background dark)) (:foreground "Aquamarine")) | |
2897 | (((class color) (min-colors 16) (background light)) (:foreground "CadetBlue")) | |
2898 | (((class color) (min-colors 16) (background dark)) (:foreground "Aquamarine")) | |
2899 | (((class color) (min-colors 8)) (:foreground "magenta")) | |
2900 | (t (:weight bold :underline t))) | |
2901 | "Face for Todos prefix or numerical priority string." | |
2902 | :group 'todos-faces) | |
2c173503 | 2903 | |
27139cd5 SB |
2904 | (defface todos-top-priority |
2905 | ;; bold font-lock-comment-face | |
2906 | '((default :weight bold) | |
2907 | (((class grayscale) (background light)) :foreground "DimGray" :slant italic) | |
2908 | (((class grayscale) (background dark)) :foreground "LightGray" :slant italic) | |
2909 | (((class color) (min-colors 88) (background light)) :foreground "Firebrick") | |
2910 | (((class color) (min-colors 88) (background dark)) :foreground "chocolate1") | |
2911 | (((class color) (min-colors 16) (background light)) :foreground "red") | |
2912 | (((class color) (min-colors 16) (background dark)) :foreground "red1") | |
2913 | (((class color) (min-colors 8) (background light)) :foreground "red") | |
2914 | (((class color) (min-colors 8) (background dark)) :foreground "yellow") | |
2915 | (t :slant italic)) | |
2916 | "Face for top priority Todos item numerical priority string. | |
2917 | The item's priority number string has this face if the number is | |
2918 | less than or equal the category's top priority setting." | |
2919 | :group 'todos-faces) | |
6be04162 | 2920 | |
27139cd5 SB |
2921 | (defface todos-mark |
2922 | ;; '((t :inherit font-lock-warning-face)) | |
2923 | '((((class color) | |
2924 | (min-colors 88) | |
2925 | (background light)) | |
2926 | (:weight bold :foreground "Red1")) | |
2927 | (((class color) | |
2928 | (min-colors 88) | |
2929 | (background dark)) | |
2930 | (:weight bold :foreground "Pink")) | |
2931 | (((class color) | |
2932 | (min-colors 16) | |
2933 | (background light)) | |
2934 | (:weight bold :foreground "Red1")) | |
2935 | (((class color) | |
2936 | (min-colors 16) | |
2937 | (background dark)) | |
2938 | (:weight bold :foreground "Pink")) | |
2939 | (((class color) | |
2940 | (min-colors 8)) | |
2941 | (:foreground "red")) | |
2942 | (t | |
2943 | (:weight bold :inverse-video t))) | |
a9b0e28e | 2944 | "Face for marks on marked items." |
27139cd5 SB |
2945 | :group 'todos-faces) |
2946 | ||
2947 | (defface todos-button | |
2948 | ;; '((t :inherit widget-field)) | |
2949 | '((((type tty)) | |
2950 | (:foreground "black" :background "yellow3")) | |
2951 | (((class grayscale color) | |
2952 | (background light)) | |
2953 | (:background "gray85")) | |
2954 | (((class grayscale color) | |
2955 | (background dark)) | |
2956 | (:background "dim gray")) | |
2957 | (t | |
2958 | (:slant italic))) | |
a9b0e28e | 2959 | "Face for buttons in table of categories." |
27139cd5 SB |
2960 | :group 'todos-faces) |
2961 | ||
2962 | (defface todos-sorted-column | |
2963 | '((((type tty)) | |
2964 | (:inverse-video t)) | |
2965 | (((class color) | |
2966 | (background light)) | |
2967 | (:background "grey85")) | |
2968 | (((class color) | |
2969 | (background dark)) | |
2970 | (:background "grey85" :foreground "grey10")) | |
2971 | (t | |
2972 | (:background "gray"))) | |
a9b0e28e | 2973 | "Face for sorted column in table of categories." |
27139cd5 SB |
2974 | :group 'todos-faces) |
2975 | ||
2976 | (defface todos-archived-only | |
2977 | ;; '((t (:inherit (shadow)))) | |
2978 | '((((class color) | |
2979 | (background light)) | |
2980 | (:foreground "grey50")) | |
2981 | (((class color) | |
2982 | (background dark)) | |
2983 | (:foreground "grey70")) | |
2984 | (t | |
2985 | (:foreground "gray"))) | |
a9b0e28e | 2986 | "Face for archived-only category names in table of categories." |
27139cd5 SB |
2987 | :group 'todos-faces) |
2988 | ||
2989 | (defface todos-search | |
2990 | ;; '((t :inherit match)) | |
2991 | '((((class color) | |
2992 | (min-colors 88) | |
2993 | (background light)) | |
2994 | (:background "yellow1")) | |
2995 | (((class color) | |
2996 | (min-colors 88) | |
2997 | (background dark)) | |
2998 | (:background "RoyalBlue3")) | |
2999 | (((class color) | |
3000 | (min-colors 8) | |
3001 | (background light)) | |
3002 | (:foreground "black" :background "yellow")) | |
3003 | (((class color) | |
3004 | (min-colors 8) | |
3005 | (background dark)) | |
3006 | (:foreground "white" :background "blue")) | |
3007 | (((type tty) | |
3008 | (class mono)) | |
3009 | (:inverse-video t)) | |
3010 | (t | |
3011 | (:background "gray"))) | |
a9b0e28e | 3012 | "Face for matches found by `todos-search'." |
27139cd5 SB |
3013 | :group 'todos-faces) |
3014 | ||
3015 | (defface todos-diary-expired | |
3016 | ;; Doesn't contrast enough with todos-date (= diary) face. | |
3017 | ;; ;; '((t :inherit warning)) | |
3018 | ;; '((default :weight bold) | |
3019 | ;; (((class color) (min-colors 16)) :foreground "DarkOrange") | |
3020 | ;; (((class color)) :foreground "yellow")) | |
3021 | ;; bold font-lock-function-name-face | |
3022 | '((default :weight bold) | |
3023 | (((class color) (min-colors 88) (background light)) :foreground "Blue1") | |
3024 | (((class color) (min-colors 88) (background dark)) :foreground "LightSkyBlue") | |
3025 | (((class color) (min-colors 16) (background light)) :foreground "Blue") | |
3026 | (((class color) (min-colors 16) (background dark)) :foreground "LightSkyBlue") | |
3027 | (((class color) (min-colors 8)) :foreground "blue") | |
3028 | (t :inverse-video t)) | |
3029 | "Face for expired dates of diary items." | |
3030 | :group 'todos-faces) | |
a9b0e28e | 3031 | |
27139cd5 SB |
3032 | (defface todos-date |
3033 | '((t :inherit diary)) | |
3034 | "Face for the date string of a Todos item." | |
3035 | :group 'todos-faces) | |
a9b0e28e | 3036 | |
27139cd5 SB |
3037 | (defface todos-time |
3038 | '((t :inherit diary-time)) | |
3039 | "Face for the time string of a Todos item." | |
3040 | :group 'todos-faces) | |
a9b0e28e | 3041 | |
27139cd5 SB |
3042 | (defface todos-nondiary |
3043 | ;; '((t :inherit font-lock-type-face)) | |
3044 | '((((class grayscale) (background light)) :foreground "Gray90" :weight bold) | |
3045 | (((class grayscale) (background dark)) :foreground "DimGray" :weight bold) | |
3046 | (((class color) (min-colors 88) (background light)) :foreground "ForestGreen") | |
3047 | (((class color) (min-colors 88) (background dark)) :foreground "PaleGreen") | |
3048 | (((class color) (min-colors 16) (background light)) :foreground "ForestGreen") | |
3049 | (((class color) (min-colors 16) (background dark)) :foreground "PaleGreen") | |
3050 | (((class color) (min-colors 8)) :foreground "green") | |
3051 | (t :weight bold :underline t)) | |
3052 | "Face for non-diary markers around todo item date/time header." | |
3053 | :group 'todos-faces) | |
a9b0e28e | 3054 | |
27139cd5 SB |
3055 | (defface todos-category-string |
3056 | ;; '((t :inherit font-lock-type-face)) | |
3057 | '((((class grayscale) (background light)) :foreground "Gray90" :weight bold) | |
3058 | (((class grayscale) (background dark)) :foreground "DimGray" :weight bold) | |
3059 | (((class color) (min-colors 88) (background light)) :foreground "ForestGreen") | |
3060 | (((class color) (min-colors 88) (background dark)) :foreground "PaleGreen") | |
3061 | (((class color) (min-colors 16) (background light)) :foreground "ForestGreen") | |
3062 | (((class color) (min-colors 16) (background dark)) :foreground "PaleGreen") | |
3063 | (((class color) (min-colors 8)) :foreground "green") | |
3064 | (t :weight bold :underline t)) | |
a9b0e28e | 3065 | "Face for category-file header in Todos Filtered Items mode." |
27139cd5 | 3066 | :group 'todos-faces) |
a9b0e28e | 3067 | |
27139cd5 SB |
3068 | (defface todos-done |
3069 | ;; '((t :inherit font-lock-keyword-face)) | |
3070 | '((((class grayscale) (background light)) :foreground "LightGray" :weight bold) | |
3071 | (((class grayscale) (background dark)) :foreground "DimGray" :weight bold) | |
3072 | (((class color) (min-colors 88) (background light)) :foreground "Purple") | |
3073 | (((class color) (min-colors 88) (background dark)) :foreground "Cyan1") | |
3074 | (((class color) (min-colors 16) (background light)) :foreground "Purple") | |
3075 | (((class color) (min-colors 16) (background dark)) :foreground "Cyan") | |
3076 | (((class color) (min-colors 8)) :foreground "cyan" :weight bold) | |
3077 | (t :weight bold)) | |
3078 | "Face for done Todos item header string." | |
3079 | :group 'todos-faces) | |
a9b0e28e | 3080 | |
27139cd5 SB |
3081 | (defface todos-comment |
3082 | ;; '((t :inherit font-lock-comment-face)) | |
3083 | '((((class grayscale) (background light)) | |
3084 | :foreground "DimGray" :weight bold :slant italic) | |
3085 | (((class grayscale) (background dark)) | |
3086 | :foreground "LightGray" :weight bold :slant italic) | |
3087 | (((class color) (min-colors 88) (background light)) | |
3088 | :foreground "Firebrick") | |
3089 | (((class color) (min-colors 88) (background dark)) | |
3090 | :foreground "chocolate1") | |
3091 | (((class color) (min-colors 16) (background light)) | |
3092 | :foreground "red") | |
3093 | (((class color) (min-colors 16) (background dark)) | |
3094 | :foreground "red1") | |
3095 | (((class color) (min-colors 8) (background light)) | |
3096 | :foreground "red") | |
3097 | (((class color) (min-colors 8) (background dark)) | |
3098 | :foreground "yellow") | |
3099 | (t :weight bold :slant italic)) | |
3100 | "Face for comments appended to done Todos items." | |
3101 | :group 'todos-faces) | |
a9b0e28e | 3102 | |
27139cd5 SB |
3103 | (defface todos-done-sep |
3104 | ;; '((t :inherit font-lock-builtin-face)) | |
3105 | '((((class grayscale) (background light)) :foreground "LightGray" :weight bold) | |
3106 | (((class grayscale) (background dark)) :foreground "DimGray" :weight bold) | |
3107 | (((class color) (min-colors 88) (background light)) :foreground "dark slate blue") | |
3108 | (((class color) (min-colors 88) (background dark)) :foreground "LightSteelBlue") | |
3109 | (((class color) (min-colors 16) (background light)) :foreground "Orchid") | |
3110 | (((class color) (min-colors 16) (background dark)) :foreground "LightSteelBlue") | |
3111 | (((class color) (min-colors 8)) :foreground "blue" :weight bold) | |
3112 | (t :weight bold)) | |
3113 | "Face for separator string bewteen done and not done Todos items." | |
3114 | :group 'todos-faces) | |
a9b0e28e SB |
3115 | |
3116 | ;; ----------------------------------------------------------------------------- | |
27139cd5 | 3117 | ;;; Todos Categories mode options |
a9b0e28e | 3118 | ;; ----------------------------------------------------------------------------- |
f1806c78 | 3119 | |
27139cd5 SB |
3120 | (defcustom todos-categories-category-label "Category" |
3121 | "Category button label in Todos Categories mode." | |
3122 | :type 'string | |
3123 | :group 'todos-categories) | |
f1806c78 | 3124 | |
27139cd5 SB |
3125 | (defcustom todos-categories-todo-label "Todo" |
3126 | "Todo button label in Todos Categories mode." | |
3127 | :type 'string | |
3128 | :group 'todos-categories) | |
d04d6b95 | 3129 | |
27139cd5 SB |
3130 | (defcustom todos-categories-diary-label "Diary" |
3131 | "Diary button label in Todos Categories mode." | |
3132 | :type 'string | |
3133 | :group 'todos-categories) | |
20166aea | 3134 | |
27139cd5 SB |
3135 | (defcustom todos-categories-done-label "Done" |
3136 | "Done button label in Todos Categories mode." | |
3137 | :type 'string | |
3138 | :group 'todos-categories) | |
20166aea | 3139 | |
27139cd5 SB |
3140 | (defcustom todos-categories-archived-label "Archived" |
3141 | "Archived button label in Todos Categories mode." | |
3142 | :type 'string | |
3143 | :group 'todos-categories) | |
f1806c78 | 3144 | |
27139cd5 SB |
3145 | (defcustom todos-categories-totals-label "Totals" |
3146 | "String to label total item counts in Todos Categories mode." | |
3147 | :type 'string | |
3148 | :group 'todos-categories) | |
20166aea | 3149 | |
27139cd5 SB |
3150 | (defcustom todos-categories-number-separator " | " |
3151 | "String between number and category in Todos Categories mode. | |
3152 | This separates the number from the category name in the default | |
3153 | categories display according to priority." | |
3154 | :type 'string | |
3155 | :group 'todos-categories) | |
58c7641d | 3156 | |
27139cd5 SB |
3157 | (defcustom todos-categories-align 'center |
3158 | "Alignment of category names in Todos Categories mode." | |
3159 | :type '(radio (const left) (const center) (const right)) | |
3160 | :group 'todos-categories) | |
58c7641d | 3161 | |
a9b0e28e | 3162 | ;; ----------------------------------------------------------------------------- |
27139cd5 | 3163 | ;;; Entering and using Todos Categories mode |
a9b0e28e | 3164 | ;; ----------------------------------------------------------------------------- |
b58fa72f | 3165 | |
27139cd5 SB |
3166 | (defun todos-show-categories-table () |
3167 | "Display a table of the current file's categories and item counts. | |
58c7641d | 3168 | |
27139cd5 SB |
3169 | In the initial display the categories are numbered, indicating |
3170 | their current order for navigating by \\[todos-forward-category] | |
3171 | and \\[todos-backward-category]. You can persistantly change the | |
3172 | order of the category at point by typing | |
9e6b072c SB |
3173 | \\[todos-set-category-number], \\[todos-raise-category] or |
3174 | \\[todos-lower-category]. | |
58c7641d | 3175 | |
27139cd5 SB |
3176 | The labels above the category names and item counts are buttons, |
3177 | and clicking these changes the display: sorted by category name | |
3178 | or by the respective item counts (alternately descending or | |
3179 | ascending). In these displays the categories are not numbered | |
9e6b072c SB |
3180 | and \\[todos-set-category-number], \\[todos-raise-category] and |
3181 | \\[todos-lower-category] are disabled. (Programmatically, the | |
3182 | sorting is triggered by passing a non-nil SORTKEY argument.) | |
58c7641d | 3183 | |
27139cd5 SB |
3184 | In addition, the lines with the category names and item counts |
3185 | are buttonized, and pressing one of these button jumps to the | |
3186 | category in Todos mode (or Todos Archive mode, for categories | |
3187 | containing only archived items, provided user option | |
3188 | `todos-skip-archived-categories' is non-nil. These categories | |
3189 | are shown in `todos-archived-only' face." | |
3190 | (interactive) | |
a9b0e28e | 3191 | (todos-display-categories) |
27139cd5 SB |
3192 | (let (sortkey) |
3193 | (todos-update-categories-display sortkey))) | |
d04d6b95 | 3194 | |
9e6b072c | 3195 | (defun todos-sort-categories-alphabetically-or-numerically () |
a9b0e28e | 3196 | "Sort table of categories alphabetically or numerically." |
27139cd5 SB |
3197 | (interactive) |
3198 | (save-excursion | |
3199 | (goto-char (point-min)) | |
3200 | (forward-line 2) | |
3201 | (if (member 'alpha todos-descending-counts) | |
3202 | (progn | |
3203 | (todos-update-categories-display nil) | |
3204 | (setq todos-descending-counts | |
3205 | (delete 'alpha todos-descending-counts))) | |
3206 | (todos-update-categories-display 'alpha)))) | |
ee7412e4 | 3207 | |
27139cd5 | 3208 | (defun todos-sort-categories-by-todo () |
a9b0e28e | 3209 | "Sort table of categories by number of todo items." |
27139cd5 SB |
3210 | (interactive) |
3211 | (save-excursion | |
3212 | (goto-char (point-min)) | |
3213 | (forward-line 2) | |
3214 | (todos-update-categories-display 'todo))) | |
ee7412e4 | 3215 | |
27139cd5 | 3216 | (defun todos-sort-categories-by-diary () |
a9b0e28e | 3217 | "Sort table of categories by number of diary items." |
27139cd5 SB |
3218 | (interactive) |
3219 | (save-excursion | |
3220 | (goto-char (point-min)) | |
3221 | (forward-line 2) | |
3222 | (todos-update-categories-display 'diary))) | |
ee7412e4 | 3223 | |
27139cd5 | 3224 | (defun todos-sort-categories-by-done () |
a9b0e28e | 3225 | "Sort table of categories by number of non-archived done items." |
27139cd5 SB |
3226 | (interactive) |
3227 | (save-excursion | |
3228 | (goto-char (point-min)) | |
3229 | (forward-line 2) | |
3230 | (todos-update-categories-display 'done))) | |
459c6e93 | 3231 | |
27139cd5 | 3232 | (defun todos-sort-categories-by-archived () |
a9b0e28e | 3233 | "Sort table of categories by number of archived items." |
27139cd5 SB |
3234 | (interactive) |
3235 | (save-excursion | |
3236 | (goto-char (point-min)) | |
3237 | (forward-line 2) | |
3238 | (todos-update-categories-display 'archived))) | |
d04d6b95 | 3239 | |
e99a2125 SB |
3240 | (defun todos-next-button (n) |
3241 | "Move point to the Nth next button in the table of categories." | |
3242 | (interactive "p") | |
3243 | (forward-button n 'wrap 'display-message) | |
27139cd5 SB |
3244 | (and (bolp) (button-at (point)) |
3245 | ;; Align with beginning of category label. | |
3246 | (forward-char (+ 4 (length todos-categories-number-separator))))) | |
0e89c3fc | 3247 | |
e99a2125 SB |
3248 | (defun todos-previous-button (n) |
3249 | "Move point to the Nth previous button in the table of categories." | |
3250 | (interactive "p") | |
3251 | (backward-button n 'wrap 'display-message) | |
27139cd5 SB |
3252 | (and (bolp) (button-at (point)) |
3253 | ;; Align with beginning of category label. | |
3254 | (forward-char (+ 4 (length todos-categories-number-separator))))) | |
3255 | ||
9e6b072c SB |
3256 | (defun todos-set-category-number (&optional arg) |
3257 | "Change number of category at point in the table of categories. | |
ee7412e4 | 3258 | |
9e6b072c SB |
3259 | With ARG nil, prompt for the new number. Alternatively, the |
3260 | enter the new number with numerical prefix ARG. Otherwise, if | |
3261 | ARG is either of the symbols `raise' or `lower', raise or lower | |
3262 | the category line in the table by one, respectively, thereby | |
3263 | decreasing or increasing its number." | |
e99a2125 | 3264 | (interactive "P") |
27139cd5 SB |
3265 | (let ((curnum (save-excursion |
3266 | ;; Get the number representing the priority of the category | |
3267 | ;; on the current line. | |
3268 | (forward-line 0) (skip-chars-forward " ") (number-at-point)))) | |
3269 | (when curnum ; Do nothing if we're not on a category line. | |
3270 | (let* ((maxnum (length todos-categories)) | |
3271 | (prompt (format "Set category priority (1-%d): " maxnum)) | |
3272 | (col (current-column)) | |
3273 | (buffer-read-only nil) | |
3274 | (priority (cond ((and (eq arg 'raise) (> curnum 1)) | |
3275 | (1- curnum)) | |
3276 | ((and (eq arg 'lower) (< curnum maxnum)) | |
3277 | (1+ curnum)))) | |
3278 | candidate) | |
3279 | (while (not priority) | |
3280 | (setq candidate (or arg (read-number prompt))) | |
3281 | (setq arg nil) | |
3282 | (setq prompt | |
3283 | (cond ((or (< candidate 1) (> candidate maxnum)) | |
3284 | (format "Priority must be an integer between 1 and %d: " | |
3285 | maxnum)) | |
3286 | ((= candidate curnum) | |
3287 | "Choose a different priority than the current one: "))) | |
3288 | (unless prompt (setq priority candidate))) | |
3289 | (let* ((lower (< curnum priority)) ; Priority is being lowered. | |
3290 | (head (butlast todos-categories | |
3291 | (apply (if lower 'identity '1+) | |
3292 | (list (- maxnum priority))))) | |
3293 | (tail (nthcdr (apply (if lower 'identity '1-) (list priority)) | |
3294 | todos-categories)) | |
3295 | ;; Category's name and items counts list. | |
3296 | (catcons (nth (1- curnum) todos-categories)) | |
3297 | (todos-categories (nconc head (list catcons) tail)) | |
3298 | newcats) | |
3299 | (when lower (setq todos-categories (nreverse todos-categories))) | |
3300 | (setq todos-categories (delete-dups todos-categories)) | |
3301 | (when lower (setq todos-categories (nreverse todos-categories))) | |
3302 | (setq newcats todos-categories) | |
3303 | (kill-buffer) | |
3304 | (with-current-buffer (find-buffer-visiting todos-current-todos-file) | |
3305 | (setq todos-categories newcats) | |
3306 | (todos-update-categories-sexp)) | |
3307 | (todos-show-categories-table) | |
3308 | (forward-line (1+ priority)) | |
3309 | (forward-char col)))))) | |
ee7412e4 | 3310 | |
9e6b072c | 3311 | (defun todos-raise-category () |
27139cd5 SB |
3312 | "Raise priority of category at point in Todos Categories buffer." |
3313 | (interactive) | |
9e6b072c | 3314 | (todos-set-category-number 'raise)) |
7464f422 | 3315 | |
9e6b072c | 3316 | (defun todos-lower-category () |
27139cd5 SB |
3317 | "Lower priority of category at point in Todos Categories buffer." |
3318 | (interactive) | |
9e6b072c | 3319 | (todos-set-category-number 'lower)) |
7464f422 | 3320 | |
a9b0e28e | 3321 | ;; ----------------------------------------------------------------------------- |
27139cd5 | 3322 | ;;; Searching |
a9b0e28e | 3323 | ;; ----------------------------------------------------------------------------- |
0e89c3fc | 3324 | |
27139cd5 SB |
3325 | (defun todos-search () |
3326 | "Search for a regular expression in this Todos file. | |
3327 | The search runs through the whole file and encompasses all and | |
3328 | only todo and done items; it excludes category names. Multiple | |
3329 | matches are shown sequentially, highlighted in `todos-search' | |
3330 | face." | |
3331 | (interactive) | |
3332 | (let ((regex (read-from-minibuffer "Enter a search string (regexp): ")) | |
3333 | (opoint (point)) | |
3334 | matches match cat in-done ov mlen msg) | |
3335 | (widen) | |
3336 | (goto-char (point-min)) | |
3337 | (while (not (eobp)) | |
3338 | (setq match (re-search-forward regex nil t)) | |
3339 | (goto-char (line-beginning-position)) | |
3340 | (unless (or (equal (point) 1) | |
3341 | (looking-at (concat "^" (regexp-quote todos-category-beg)))) | |
3342 | (if match (push match matches))) | |
3343 | (forward-line)) | |
3344 | (setq matches (reverse matches)) | |
3345 | (if matches | |
3346 | (catch 'stop | |
3347 | (while matches | |
3348 | (setq match (pop matches)) | |
3349 | (goto-char match) | |
3350 | (todos-item-start) | |
3351 | (when (looking-at todos-done-string-start) | |
3352 | (setq in-done t)) | |
3353 | (re-search-backward (concat "^" (regexp-quote todos-category-beg) | |
3354 | "\\(.*\\)\n") nil t) | |
3355 | (setq cat (match-string-no-properties 1)) | |
3356 | (todos-category-number cat) | |
3357 | (todos-category-select) | |
3358 | (if in-done | |
3359 | (unless todos-show-with-done (todos-toggle-view-done-items))) | |
3360 | (goto-char match) | |
3361 | (setq ov (make-overlay (- (point) (length regex)) (point))) | |
3362 | (overlay-put ov 'face 'todos-search) | |
3363 | (when matches | |
3364 | (setq mlen (length matches)) | |
cc416fd3 | 3365 | (if (todos-y-or-n-p |
27139cd5 SB |
3366 | (if (> mlen 1) |
3367 | (format "There are %d more matches; go to next match? " | |
3368 | mlen) | |
3369 | "There is one more match; go to it? ")) | |
3370 | (widen) | |
3371 | (throw 'stop (setq msg (if (> mlen 1) | |
3372 | (format "There are %d more matches." | |
3373 | mlen) | |
3374 | "There is one more match.")))))) | |
3375 | (setq msg "There are no more matches.")) | |
3376 | (todos-category-select) | |
3377 | (goto-char opoint) | |
3378 | (message "No match for \"%s\"" regex)) | |
3379 | (when msg | |
cc416fd3 | 3380 | (if (todos-y-or-n-p (concat msg "\nUnhighlight matches? ")) |
27139cd5 SB |
3381 | (todos-clear-matches) |
3382 | (message "You can unhighlight the matches later by typing %s" | |
3383 | (key-description (car (where-is-internal | |
3384 | 'todos-clear-matches)))))))) | |
ee7412e4 | 3385 | |
27139cd5 SB |
3386 | (defun todos-clear-matches () |
3387 | "Remove highlighting on matches found by todos-search." | |
3388 | (interactive) | |
3389 | (remove-overlays 1 (1+ (buffer-size)) 'face 'todos-search)) | |
d04d6b95 | 3390 | |
a9b0e28e | 3391 | ;; ----------------------------------------------------------------------------- |
27139cd5 | 3392 | ;;; Item filtering options |
a9b0e28e SB |
3393 | ;; ----------------------------------------------------------------------------- |
3394 | ||
3395 | (defcustom todos-top-priorities-overrides nil | |
3396 | "List of rules specifying number of top priority items to show. | |
3397 | These rules override `todos-top-priorities' on invocations of | |
3398 | `\\[todos-filter-top-priorities]' and | |
3399 | `\\[todos-filter-top-priorities-multifile]'. Each rule is a list | |
3400 | of the form (FILE NUM ALIST), where FILE is a member of | |
3401 | `todos-files', NUM is a number specifying the default number of | |
3402 | top priority items for each category in that file, and ALIST, | |
3403 | when non-nil, consists of conses of a category name in FILE and a | |
3404 | number specifying the default number of top priority items in | |
3405 | that category, which overrides NUM. | |
ee7412e4 | 3406 | |
27139cd5 SB |
3407 | This variable should be set interactively by |
3408 | `\\[todos-set-top-priorities-in-file]' or | |
a9b0e28e | 3409 | `\\[todos-set-top-priorities-in-category]'." |
27139cd5 SB |
3410 | :type 'sexp |
3411 | :group 'todos-filtered) | |
d04d6b95 | 3412 | |
27139cd5 SB |
3413 | (defcustom todos-top-priorities 1 |
3414 | "Default number of top priorities shown by `todos-filter-top-priorities'." | |
3415 | :type 'integer | |
3416 | :group 'todos-filtered) | |
d04d6b95 | 3417 | |
27139cd5 SB |
3418 | (defcustom todos-filter-files nil |
3419 | "List of default files for multifile item filtering." | |
3420 | :type `(set ,@(mapcar (lambda (f) (list 'const f)) | |
3421 | (mapcar 'todos-short-file-name | |
3422 | (funcall todos-files-function)))) | |
3423 | :group 'todos-filtered) | |
3f031767 | 3424 | |
27139cd5 SB |
3425 | (defcustom todos-filter-done-items nil |
3426 | "Non-nil to include done items when processing regexp filters. | |
3427 | Done items from corresponding archive files are also included." | |
3428 | :type 'boolean | |
3429 | :group 'todos-filtered) | |
db2c5d34 | 3430 | |
a9b0e28e | 3431 | ;; ----------------------------------------------------------------------------- |
27139cd5 | 3432 | ;;; Item filtering commands |
a9b0e28e | 3433 | ;; ----------------------------------------------------------------------------- |
db2c5d34 | 3434 | |
27139cd5 SB |
3435 | (defun todos-set-top-priorities-in-file () |
3436 | "Set number of top priorities for this file. | |
3437 | See `todos-set-top-priorities' for more details." | |
3438 | (interactive) | |
3439 | (todos-set-top-priorities)) | |
ee7412e4 | 3440 | |
27139cd5 SB |
3441 | (defun todos-set-top-priorities-in-category () |
3442 | "Set number of top priorities for this category. | |
3443 | See `todos-set-top-priorities' for more details." | |
3444 | (interactive) | |
3445 | (todos-set-top-priorities t)) | |
ee7412e4 | 3446 | |
27139cd5 SB |
3447 | (defun todos-filter-top-priorities (&optional arg) |
3448 | "Display a list of top priority items from different categories. | |
3449 | The categories can be any of those in the current Todos file. | |
6be04162 | 3450 | |
27139cd5 SB |
3451 | With numerical prefix ARG show at most ARG top priority items |
3452 | from each category. With `C-u' as prefix argument show the | |
3453 | numbers of top priority items specified by category in | |
3454 | `todos-top-priorities-overrides', if this has an entry for the file(s); | |
3455 | otherwise show `todos-top-priorities' items per category in the | |
3456 | file(s). With no prefix argument, if a top priorities file for | |
3457 | the current Todos file has previously been saved (see | |
3458 | `todos-save-filtered-items-buffer'), visit this file; if there is | |
3459 | no such file, build the list as with prefix argument `C-u'. | |
0e89c3fc | 3460 | |
27139cd5 SB |
3461 | The prefix ARG regulates how many top priorities from |
3462 | each category to show, as described above." | |
3463 | (interactive "P") | |
3464 | (todos-filter-items 'top arg)) | |
d04d6b95 | 3465 | |
27139cd5 SB |
3466 | (defun todos-filter-top-priorities-multifile (&optional arg) |
3467 | "Display a list of top priority items from different categories. | |
3468 | The categories are a subset of the categories in the files listed | |
3469 | in `todos-filter-files', or if this nil, in the files chosen from | |
3470 | a file selection dialog that pops up in this case. | |
0e89c3fc | 3471 | |
27139cd5 SB |
3472 | With numerical prefix ARG show at most ARG top priority items |
3473 | from each category in each file. With `C-u' as prefix argument | |
3474 | show the numbers of top priority items specified in | |
3475 | `todos-top-priorities-overrides', if this is non-nil; otherwise show | |
3476 | `todos-top-priorities' items per category. With no prefix | |
3477 | argument, if a top priorities file for the chosen Todos files | |
3478 | exists (see `todos-save-filtered-items-buffer'), visit this file; | |
3479 | if there is no such file, do the same as with prefix argument | |
3480 | `C-u'." | |
3481 | (interactive "P") | |
3482 | (todos-filter-items 'top arg t)) | |
0e89c3fc | 3483 | |
27139cd5 SB |
3484 | (defun todos-filter-diary-items (&optional arg) |
3485 | "Display a list of todo diary items from different categories. | |
3486 | The categories can be any of those in the current Todos file. | |
0e89c3fc | 3487 | |
e99a2125 SB |
3488 | Called with no prefix ARG, if a diary items file for the current |
3489 | Todos file has previously been saved (see | |
27139cd5 SB |
3490 | `todos-save-filtered-items-buffer'), visit this file; if there is |
3491 | no such file, build the list of diary items. Called with a | |
3492 | prefix argument, build the list even if there is a saved file of | |
3493 | diary items." | |
3494 | (interactive "P") | |
3495 | (todos-filter-items 'diary arg)) | |
0e89c3fc | 3496 | |
27139cd5 SB |
3497 | (defun todos-filter-diary-items-multifile (&optional arg) |
3498 | "Display a list of todo diary items from different categories. | |
3499 | The categories are a subset of the categories in the files listed | |
3500 | in `todos-filter-files', or if this nil, in the files chosen from | |
3501 | a file selection dialog that pops up in this case. | |
0e89c3fc | 3502 | |
e99a2125 SB |
3503 | Called with no prefix ARG, if a diary items file for the chosen |
3504 | Todos files has previously been saved (see | |
27139cd5 SB |
3505 | `todos-save-filtered-items-buffer'), visit this file; if there is |
3506 | no such file, build the list of diary items. Called with a | |
3507 | prefix argument, build the list even if there is a saved file of | |
3508 | diary items." | |
3509 | (interactive "P") | |
3510 | (todos-filter-items 'diary arg t)) | |
6be04162 | 3511 | |
27139cd5 SB |
3512 | (defun todos-filter-regexp-items (&optional arg) |
3513 | "Prompt for a regular expression and display items that match it. | |
3514 | The matches can be from any categories in the current Todos file | |
3515 | and with non-nil option `todos-filter-done-items', can include | |
3516 | not only todo items but also done items, including those in | |
3517 | Archive files. | |
0e89c3fc | 3518 | |
e99a2125 SB |
3519 | Called with no prefix ARG, if a regexp items file for the current |
3520 | Todos file has previously been saved (see | |
27139cd5 SB |
3521 | `todos-save-filtered-items-buffer'), visit this file; if there is |
3522 | no such file, build the list of regexp items. Called with a | |
3523 | prefix argument, build the list even if there is a saved file of | |
3524 | regexp items." | |
3525 | (interactive "P") | |
3526 | (todos-filter-items 'regexp arg)) | |
0e89c3fc | 3527 | |
27139cd5 SB |
3528 | (defun todos-filter-regexp-items-multifile (&optional arg) |
3529 | "Prompt for a regular expression and display items that match it. | |
3530 | The matches can be from any categories in the files listed in | |
3531 | `todos-filter-files', or if this nil, in the files chosen from a | |
3532 | file selection dialog that pops up in this case. With non-nil | |
3533 | option `todos-filter-done-items', the matches can include not | |
3534 | only todo items but also done items, including those in Archive | |
3535 | files. | |
0e89c3fc | 3536 | |
e99a2125 SB |
3537 | Called with no prefix ARG, if a regexp items file for the current |
3538 | Todos file has previously been saved (see | |
27139cd5 SB |
3539 | `todos-save-filtered-items-buffer'), visit this file; if there is |
3540 | no such file, build the list of regexp items. Called with a | |
3541 | prefix argument, build the list even if there is a saved file of | |
3542 | regexp items." | |
3543 | (interactive "P") | |
3544 | (todos-filter-items 'regexp arg t)) | |
0e89c3fc | 3545 | |
27139cd5 SB |
3546 | (defun todos-find-filtered-items-file () |
3547 | "Choose a filtered items file and visit it." | |
3548 | (interactive) | |
3549 | (let ((files (directory-files todos-directory t "\.tod[rty]$" t)) | |
3550 | falist file) | |
3551 | (dolist (f files) | |
3552 | (let ((type (cond ((equal (file-name-extension f) "todr") "regexp") | |
3553 | ((equal (file-name-extension f) "todt") "top") | |
3554 | ((equal (file-name-extension f) "tody") "diary")))) | |
3555 | (push (cons (concat (todos-short-file-name f) " (" type ")") f) | |
3556 | falist))) | |
3557 | (setq file (completing-read "Choose a filtered items file: " | |
3558 | falist nil t nil nil (car falist))) | |
3559 | (setq file (cdr (assoc-string file falist))) | |
3560 | (find-file file))) | |
0e89c3fc | 3561 | |
27139cd5 SB |
3562 | (defun todos-go-to-source-item () |
3563 | "Display the file and category of the filtered item at point." | |
3564 | (interactive) | |
3565 | (let* ((str (todos-item-string)) | |
3566 | (buf (current-buffer)) | |
3567 | (res (todos-find-item str)) | |
3568 | (found (nth 0 res)) | |
3569 | (file (nth 1 res)) | |
3570 | (cat (nth 2 res))) | |
3571 | (if (not found) | |
3572 | (message "Category %s does not contain this item." cat) | |
3573 | (kill-buffer buf) | |
3574 | (set-window-buffer (selected-window) | |
3575 | (set-buffer (find-buffer-visiting file))) | |
3576 | (setq todos-current-todos-file file) | |
3577 | (setq todos-category-number (todos-category-number cat)) | |
3578 | (let ((todos-show-with-done (if (or todos-filter-done-items | |
3579 | (eq (cdr found) 'done)) | |
3580 | t | |
3581 | todos-show-with-done))) | |
3582 | (todos-category-select)) | |
3583 | (goto-char (car found))))) | |
0e89c3fc | 3584 | |
a9b0e28e | 3585 | ;; ----------------------------------------------------------------------------- |
27139cd5 | 3586 | ;;; Printing Todos Buffers |
a9b0e28e | 3587 | ;; ----------------------------------------------------------------------------- |
0e89c3fc | 3588 | |
27139cd5 | 3589 | (defcustom todos-print-buffer-function 'ps-print-buffer-with-faces |
e99a2125 | 3590 | "Function called by the command `todos-print-buffer'." |
27139cd5 SB |
3591 | :type 'symbol |
3592 | :group 'todos) | |
0e89c3fc | 3593 | |
27139cd5 SB |
3594 | (defvar todos-print-buffer "*Todos Print*" |
3595 | "Name of buffer containing printable Todos text.") | |
0e89c3fc | 3596 | |
27139cd5 SB |
3597 | (defun todos-print-buffer (&optional to-file) |
3598 | "Produce a printable version of the current Todos buffer. | |
3599 | This converts overlays and soft line wrapping and, depending on | |
3600 | the value of `todos-print-buffer-function', includes faces. With | |
3601 | non-nil argument TO-FILE write the printable version to a file; | |
3602 | otherwise, send it to the default printer." | |
3603 | (interactive) | |
3604 | (let ((buf todos-print-buffer) | |
3605 | (header (cond | |
3606 | ((eq major-mode 'todos-mode) | |
3607 | (concat "Todos File: " | |
3608 | (todos-short-file-name todos-current-todos-file) | |
3609 | "\nCategory: " (todos-current-category))) | |
3610 | ((eq major-mode 'todos-filtered-items-mode) | |
3611 | (buffer-name)))) | |
3612 | (prefix (propertize (concat todos-prefix " ") | |
3613 | 'face 'todos-prefix-string)) | |
3614 | (num 0) | |
3615 | (fill-prefix (make-string todos-indent-to-here 32)) | |
3616 | (content (buffer-string)) | |
3617 | file) | |
3618 | (with-current-buffer (get-buffer-create buf) | |
3619 | (insert content) | |
3620 | (goto-char (point-min)) | |
3621 | (while (not (eobp)) | |
3622 | (let ((beg (point)) | |
3623 | (end (save-excursion (todos-item-end)))) | |
3624 | (when todos-number-prefix | |
3625 | (setq num (1+ num)) | |
3626 | (setq prefix (propertize (concat (number-to-string num) " ") | |
3627 | 'face 'todos-prefix-string))) | |
3628 | (insert prefix) | |
3629 | (fill-region beg end)) | |
3630 | ;; Calling todos-forward-item infloops at todos-item-start due to | |
3631 | ;; non-overlay prefix, so search for item start instead. | |
3632 | (if (re-search-forward todos-item-start nil t) | |
3633 | (beginning-of-line) | |
3634 | (goto-char (point-max)))) | |
3635 | (if (re-search-backward (concat "^" (regexp-quote todos-category-done)) | |
3636 | nil t) | |
3637 | (replace-match todos-done-separator)) | |
3638 | (goto-char (point-min)) | |
3639 | (insert header) | |
3640 | (newline 2) | |
3641 | (if to-file | |
3642 | (let ((file (read-file-name "Print to file: "))) | |
3643 | (funcall todos-print-buffer-function file)) | |
3644 | (funcall todos-print-buffer-function))) | |
3645 | (kill-buffer buf))) | |
d04d6b95 | 3646 | |
27139cd5 SB |
3647 | (defun todos-print-buffer-to-file () |
3648 | "Save printable version of this Todos buffer to a file." | |
3649 | (interactive) | |
3650 | (todos-print-buffer t)) | |
58c7641d | 3651 | |
a9b0e28e | 3652 | ;; ----------------------------------------------------------------------------- |
27139cd5 | 3653 | ;;; Legacy Todo Mode Files |
a9b0e28e | 3654 | ;; ----------------------------------------------------------------------------- |
58c7641d | 3655 | |
27139cd5 SB |
3656 | (defcustom todos-todo-mode-date-time-regexp |
3657 | (concat "\\(?1:[0-9]\\{4\\}\\)-\\(?2:[0-9]\\{2\\}\\)-" | |
3658 | "\\(?3:[0-9]\\{2\\}\\) \\(?4:[0-9]\\{2\\}:[0-9]\\{2\\}\\)") | |
3659 | "Regexp matching legacy todo-mode.el item date-time strings. | |
3660 | In order for `todos-convert-legacy-files' to correctly convert this | |
3661 | string to the current Todos format, the regexp must contain four | |
3662 | explicitly numbered groups (see `(elisp) Regexp Backslash'), | |
3663 | where group 1 matches a string for the year, group 2 a string for | |
3664 | the month, group 3 a string for the day and group 4 a string for | |
3665 | the time. The default value converts date-time strings built | |
3666 | using the default value of `todo-time-string-format' from | |
3667 | todo-mode.el." | |
3668 | :type 'regexp | |
3669 | :group 'todos) | |
58c7641d | 3670 | |
27139cd5 SB |
3671 | (defun todos-convert-legacy-date-time () |
3672 | "Return converted date-time string. | |
3673 | Helper function for `todos-convert-legacy-files'." | |
3674 | (let* ((year (match-string 1)) | |
3675 | (month (match-string 2)) | |
3676 | (monthname (calendar-month-name (string-to-number month) t)) | |
3677 | (day (match-string 3)) | |
3678 | (time (match-string 4)) | |
3679 | dayname) | |
3680 | (replace-match "") | |
3681 | (insert (mapconcat 'eval calendar-date-display-form "") | |
3682 | (when time (concat " " time))))) | |
58c7641d | 3683 | |
27139cd5 SB |
3684 | (defun todos-convert-legacy-files () |
3685 | "Convert legacy Todo files to the current Todos format. | |
3686 | The files `todo-file-do' and `todo-file-done' are converted and | |
3687 | saved (the latter as a Todos Archive file) with a new name in | |
3688 | `todos-directory'. See also the documentation string of | |
3689 | `todos-todo-mode-date-time-regexp' for further details." | |
3690 | (interactive) | |
3691 | (if (fboundp 'todo-mode) | |
3692 | (require 'todo-mode) | |
a9b0e28e | 3693 | (user-error "Void function `todo-mode'")) |
27139cd5 SB |
3694 | ;; Convert `todo-file-do'. |
3695 | (if (file-exists-p todo-file-do) | |
3696 | (let ((default "todo-do-conv") | |
3697 | file archive-sexp) | |
3698 | (with-temp-buffer | |
3699 | (insert-file-contents todo-file-do) | |
3700 | (let ((end (search-forward ")" (line-end-position) t)) | |
3701 | (beg (search-backward "(" (line-beginning-position) t))) | |
3702 | (setq todo-categories | |
3703 | (read (buffer-substring-no-properties beg end)))) | |
3704 | (todo-mode) | |
3705 | (delete-region (line-beginning-position) (1+ (line-end-position))) | |
3706 | (while (not (eobp)) | |
3707 | (cond | |
3708 | ((looking-at (regexp-quote (concat todo-prefix todo-category-beg))) | |
3709 | (replace-match todos-category-beg)) | |
3710 | ((looking-at (regexp-quote todo-category-end)) | |
3711 | (replace-match "")) | |
3712 | ((looking-at (regexp-quote (concat todo-prefix " " | |
3713 | todo-category-sep))) | |
3714 | (replace-match todos-category-done)) | |
3715 | ((looking-at (concat (regexp-quote todo-prefix) " " | |
3716 | todos-todo-mode-date-time-regexp " " | |
3717 | (regexp-quote todo-initials) ":")) | |
3718 | (todos-convert-legacy-date-time))) | |
3719 | (forward-line)) | |
3720 | (setq file (concat todos-directory | |
3721 | (read-string | |
3722 | (format "Save file as (default \"%s\"): " default) | |
3723 | nil nil default) | |
3724 | ".todo")) | |
3725 | (write-region (point-min) (point-max) file nil 'nomessage nil t)) | |
3726 | (with-temp-buffer | |
3727 | (insert-file-contents file) | |
3728 | (let ((todos-categories (todos-make-categories-list t))) | |
3729 | (todos-update-categories-sexp)) | |
3730 | (write-region (point-min) (point-max) file nil 'nomessage)) | |
3731 | ;; Convert `todo-file-done'. | |
3732 | (when (file-exists-p todo-file-done) | |
3733 | (with-temp-buffer | |
3734 | (insert-file-contents todo-file-done) | |
3735 | (let ((beg (make-marker)) | |
3736 | (end (make-marker)) | |
3737 | cat cats comment item) | |
3738 | (while (not (eobp)) | |
3739 | (when (looking-at todos-todo-mode-date-time-regexp) | |
3740 | (set-marker beg (point)) | |
3741 | (todos-convert-legacy-date-time) | |
3742 | (set-marker end (point)) | |
3743 | (goto-char beg) | |
3744 | (insert "[" todos-done-string) | |
3745 | (goto-char end) | |
3746 | (insert "]") | |
3747 | (forward-char) | |
3748 | (when (looking-at todos-todo-mode-date-time-regexp) | |
3749 | (todos-convert-legacy-date-time)) | |
e99a2125 SB |
3750 | (when (looking-at (concat " " |
3751 | (regexp-quote todo-initials) ":")) | |
27139cd5 SB |
3752 | (replace-match ""))) |
3753 | (if (re-search-forward | |
3754 | (concat "^" todos-todo-mode-date-time-regexp) nil t) | |
3755 | (goto-char (match-beginning 0)) | |
3756 | (goto-char (point-max))) | |
3757 | (backward-char) | |
3758 | (when (looking-back "\\[\\([^][]+\\)\\]") | |
3759 | (setq cat (match-string 1)) | |
3760 | (goto-char (match-beginning 0)) | |
3761 | (replace-match "")) | |
3762 | ;; If the item ends with a non-comment parenthesis not | |
3763 | ;; followed by a period, we lose (but we inherit that problem | |
3764 | ;; from todo-mode.el). | |
3765 | (when (looking-back "(\\(.*\\)) ") | |
3766 | (setq comment (match-string 1)) | |
3767 | (replace-match "") | |
3768 | (insert "[" todos-comment-string ": " comment "]")) | |
3769 | (set-marker end (point)) | |
3770 | (if (member cat cats) | |
3771 | ;; If item is already in its category, leave it there. | |
3772 | (unless (save-excursion | |
3773 | (re-search-backward | |
3774 | (concat "^" (regexp-quote todos-category-beg) | |
3775 | "\\(.*\\)$") nil t) | |
3776 | (string= (match-string 1) cat)) | |
3777 | ;; Else move it to its category. | |
3778 | (setq item (buffer-substring-no-properties beg end)) | |
3779 | (delete-region beg (1+ end)) | |
3780 | (set-marker beg (point)) | |
3781 | (re-search-backward | |
e99a2125 SB |
3782 | (concat "^" |
3783 | (regexp-quote (concat todos-category-beg cat)) | |
27139cd5 SB |
3784 | "$") |
3785 | nil t) | |
3786 | (forward-line) | |
3787 | (if (re-search-forward | |
3788 | (concat "^" (regexp-quote todos-category-beg) | |
3789 | "\\(.*\\)$") nil t) | |
3790 | (progn (goto-char (match-beginning 0)) | |
3791 | (newline) | |
3792 | (forward-line -1)) | |
3793 | (goto-char (point-max))) | |
3794 | (insert item "\n") | |
3795 | (goto-char beg)) | |
3796 | (push cat cats) | |
3797 | (goto-char beg) | |
3798 | (insert todos-category-beg cat "\n\n" todos-category-done "\n")) | |
3799 | (forward-line)) | |
3800 | (set-marker beg nil) | |
3801 | (set-marker end nil)) | |
3802 | (setq file (concat (file-name-sans-extension file) ".toda")) | |
3803 | (write-region (point-min) (point-max) file nil 'nomessage nil t)) | |
3804 | (with-temp-buffer | |
3805 | (insert-file-contents file) | |
3806 | (let ((todos-categories (todos-make-categories-list t))) | |
3807 | (todos-update-categories-sexp)) | |
3808 | (write-region (point-min) (point-max) file nil 'nomessage) | |
3809 | (setq archive-sexp (read (buffer-substring-no-properties | |
3810 | (line-beginning-position) | |
3811 | (line-end-position))))) | |
3812 | (setq file (concat (file-name-sans-extension file) ".todo")) | |
3813 | ;; Update categories sexp of converted Todos file again, adding | |
3814 | ;; counts of archived items. | |
3815 | (with-temp-buffer | |
3816 | (insert-file-contents file) | |
3817 | (let ((sexp (read (buffer-substring-no-properties | |
3818 | (line-beginning-position) | |
3819 | (line-end-position))))) | |
3820 | (dolist (cat sexp) | |
3821 | (let ((archive-cat (assoc (car cat) archive-sexp))) | |
3822 | (if archive-cat | |
3823 | (aset (cdr cat) 3 (aref (cdr archive-cat) 2))))) | |
3824 | (delete-region (line-beginning-position) (line-end-position)) | |
3825 | (prin1 sexp (current-buffer))) | |
3826 | (write-region (point-min) (point-max) file nil 'nomessage))) | |
3827 | (todos-reevaluate-filelist-defcustoms) | |
3828 | (message "Format conversion done.")) | |
a9b0e28e | 3829 | (user-error "No legacy Todo file exists"))) |
58c7641d | 3830 | |
a9b0e28e SB |
3831 | ;; ============================================================================= |
3832 | ;;; Todos utilities and internals | |
3833 | ;; ============================================================================= | |
58c7641d | 3834 | |
cc416fd3 SB |
3835 | (defcustom todos-y-with-space nil |
3836 | "Non-nil means allow SPC to affirm a \"y or n\" question." | |
3837 | :type 'boolean | |
3838 | :group 'todos) | |
3839 | ||
3840 | (defun todos-y-or-n-p (prompt) | |
e99a2125 | 3841 | "Ask \"y or n\" question PROMPT and return t if answer is \"y\". |
cc416fd3 SB |
3842 | Also return t if answer is \"Y\", but unlike `y-or-n-p', allow |
3843 | SPC to affirm the question only if option `todos-y-with-space' is | |
3844 | non-nil." | |
3845 | (unless todos-y-with-space | |
3846 | (define-key query-replace-map " " 'ignore)) | |
3847 | (prog1 | |
3848 | (y-or-n-p prompt) | |
3849 | (define-key query-replace-map " " 'act))) | |
3850 | ||
a9b0e28e SB |
3851 | ;; ----------------------------------------------------------------------------- |
3852 | ;;; File-level global variables and support functions | |
3853 | ;; ----------------------------------------------------------------------------- | |
58c7641d | 3854 | |
27139cd5 SB |
3855 | (defvar todos-files (funcall todos-files-function) |
3856 | "List of truenames of user's Todos files.") | |
0e89c3fc | 3857 | |
27139cd5 SB |
3858 | (defvar todos-archives (funcall todos-files-function t) |
3859 | "List of truenames of user's Todos archives.") | |
0e89c3fc | 3860 | |
27139cd5 SB |
3861 | (defvar todos-visited nil |
3862 | "List of Todos files visited in this session by `todos-show'. | |
3863 | Used to determine initial display according to the value of | |
3864 | `todos-show-first'.") | |
0e89c3fc | 3865 | |
27139cd5 SB |
3866 | (defvar todos-file-buffers nil |
3867 | "List of file names of live Todos mode buffers.") | |
c898b975 | 3868 | |
27139cd5 SB |
3869 | (defvar todos-global-current-todos-file nil |
3870 | "Variable holding name of current Todos file. | |
3871 | Used by functions called from outside of Todos mode to visit the | |
3872 | current Todos file rather than the default Todos file (i.e. when | |
3873 | users option `todos-show-current-file' is non-nil).") | |
c523b0aa | 3874 | |
27139cd5 SB |
3875 | (defun todos-absolute-file-name (name &optional type) |
3876 | "Return the absolute file name of short Todos file NAME. | |
3877 | With TYPE `archive' or `top' return the absolute file name of the | |
3878 | short Todos Archive or Top Priorities file name, respectively." | |
3879 | ;; NOP if there is no Todos file yet (i.e. don't concatenate nil). | |
3880 | (when name | |
3881 | (file-truename | |
3882 | (concat todos-directory name | |
3883 | (cond ((eq type 'archive) ".toda") | |
3884 | ((eq type 'top) ".todt") | |
3885 | ((eq type 'diary) ".tody") | |
3886 | ((eq type 'regexp) ".todr") | |
3887 | (t ".todo")))))) | |
3888 | ||
3889 | (defun todos-check-format () | |
3890 | "Signal an error if the current Todos file is ill-formatted. | |
3891 | Otherwise return t. Display a message if the file is well-formed | |
3892 | but the categories sexp differs from the current value of | |
3893 | `todos-categories'." | |
3894 | (save-excursion | |
3895 | (save-restriction | |
3896 | (widen) | |
3897 | (goto-char (point-min)) | |
3898 | (let* ((cats (prin1-to-string todos-categories)) | |
3899 | (ssexp (buffer-substring-no-properties (line-beginning-position) | |
3900 | (line-end-position))) | |
3901 | (sexp (read ssexp))) | |
3902 | ;; Check the first line for `todos-categories' sexp. | |
3903 | (dolist (c sexp) | |
3904 | (let ((v (cdr c))) | |
3905 | (unless (and (stringp (car c)) | |
3906 | (vectorp v) | |
3907 | (= 4 (length v))) | |
a9b0e28e | 3908 | (user-error "Invalid or missing todos-categories sexp")))) |
27139cd5 SB |
3909 | (forward-line) |
3910 | ;; Check well-formedness of categories. | |
e99a2125 SB |
3911 | (let ((legit (concat |
3912 | "\\(^" (regexp-quote todos-category-beg) "\\)" | |
3913 | "\\|\\(" todos-date-string-start todos-date-pattern "\\)" | |
3914 | "\\|\\(^[ \t]+[^ \t]*\\)" | |
3915 | "\\|^$" | |
3916 | "\\|\\(^" (regexp-quote todos-category-done) "\\)" | |
3917 | "\\|\\(" todos-done-string-start "\\)"))) | |
27139cd5 SB |
3918 | (while (not (eobp)) |
3919 | (unless (looking-at legit) | |
a9b0e28e | 3920 | (user-error "Illegitimate Todos file format at line %d" |
27139cd5 SB |
3921 | (line-number-at-pos (point)))) |
3922 | (forward-line))) | |
3923 | ;; Warn user if categories sexp has changed. | |
3924 | (unless (string= ssexp cats) | |
3925 | (message (concat "The sexp at the beginning of the file differs " | |
3926 | "from the value of `todos-categories.\n" | |
3927 | "If the sexp is wrong, you can fix it with " | |
3928 | "M-x todos-repair-categories-sexp,\n" | |
3929 | "but note this reverts any changes you have " | |
3930 | "made in the order of the categories.")))))) | |
3931 | t) | |
c523b0aa | 3932 | |
27139cd5 SB |
3933 | (defun todos-reevaluate-filelist-defcustoms () |
3934 | "Reevaluate defcustoms that provide choice list of Todos files." | |
3935 | (custom-set-default 'todos-default-todos-file | |
3936 | (symbol-value 'todos-default-todos-file)) | |
3937 | (todos-reevaluate-default-file-defcustom) | |
3938 | (custom-set-default 'todos-filter-files (symbol-value 'todos-filter-files)) | |
3939 | (todos-reevaluate-filter-files-defcustom) | |
3940 | (custom-set-default 'todos-category-completions-files | |
3941 | (symbol-value 'todos-category-completions-files)) | |
3942 | (todos-reevaluate-category-completions-files-defcustom)) | |
0e89c3fc | 3943 | |
27139cd5 SB |
3944 | (defun todos-reevaluate-default-file-defcustom () |
3945 | "Reevaluate defcustom of `todos-default-todos-file'. | |
3946 | Called after adding or deleting a Todos file." | |
3947 | (eval (defcustom todos-default-todos-file (car (funcall todos-files-function)) | |
3948 | "Todos file visited by first session invocation of `todos-show'." | |
3949 | :type `(radio ,@(mapcar (lambda (f) (list 'const f)) | |
3950 | (mapcar 'todos-short-file-name | |
3951 | (funcall todos-files-function)))) | |
3952 | :group 'todos))) | |
2a9e69d6 | 3953 | |
27139cd5 SB |
3954 | (defun todos-reevaluate-category-completions-files-defcustom () |
3955 | "Reevaluate defcustom of `todos-category-completions-files'. | |
3956 | Called after adding or deleting a Todos file." | |
3957 | (eval (defcustom todos-category-completions-files nil | |
3958 | "List of files for building `todos-read-category' completions." | |
3959 | :type `(set ,@(mapcar (lambda (f) (list 'const f)) | |
3960 | (mapcar 'todos-short-file-name | |
3961 | (funcall todos-files-function)))) | |
3962 | :group 'todos))) | |
d04d6b95 | 3963 | |
27139cd5 SB |
3964 | (defun todos-reevaluate-filter-files-defcustom () |
3965 | "Reevaluate defcustom of `todos-filter-files'. | |
3966 | Called after adding or deleting a Todos file." | |
3967 | (eval (defcustom todos-filter-files nil | |
3968 | "List of files for multifile item filtering." | |
3969 | :type `(set ,@(mapcar (lambda (f) (list 'const f)) | |
3970 | (mapcar 'todos-short-file-name | |
3971 | (funcall todos-files-function)))) | |
3972 | :group 'todos))) | |
0e89c3fc | 3973 | |
a9b0e28e SB |
3974 | ;; ----------------------------------------------------------------------------- |
3975 | ;;; Category-level global variables and support functions | |
3976 | ;; ----------------------------------------------------------------------------- | |
0e89c3fc | 3977 | |
27139cd5 SB |
3978 | (defun todos-category-number (cat) |
3979 | "Return the number of category CAT in this Todos file. | |
3980 | The buffer-local variable `todos-category-number' holds this | |
3981 | number as its value." | |
3982 | (let ((categories (mapcar 'car todos-categories))) | |
3983 | (setq todos-category-number | |
3984 | ;; Increment by one, so that the highest priority category in Todos | |
3985 | ;; Categories mode is numbered one rather than zero. | |
3986 | (1+ (- (length categories) | |
3987 | (length (member cat categories))))))) | |
0e89c3fc | 3988 | |
27139cd5 SB |
3989 | (defun todos-current-category () |
3990 | "Return the name of the current category." | |
3991 | (car (nth (1- todos-category-number) todos-categories))) | |
2c173503 | 3992 | |
27139cd5 SB |
3993 | (defun todos-category-select () |
3994 | "Display the current category correctly." | |
3995 | (let ((name (todos-current-category)) | |
3996 | cat-begin cat-end done-start done-sep-start done-end) | |
3997 | (widen) | |
a820dfe8 | 3998 | (goto-char (point-min)) |
27139cd5 SB |
3999 | (re-search-forward |
4000 | (concat "^" (regexp-quote (concat todos-category-beg name)) "$") nil t) | |
4001 | (setq cat-begin (1+ (line-end-position))) | |
4002 | (setq cat-end (if (re-search-forward | |
4003 | (concat "^" (regexp-quote todos-category-beg)) nil t) | |
4004 | (match-beginning 0) | |
4005 | (point-max))) | |
4006 | (setq mode-line-buffer-identification | |
4007 | (funcall todos-mode-line-function name)) | |
4008 | (narrow-to-region cat-begin cat-end) | |
4009 | (todos-prefix-overlays) | |
a820dfe8 | 4010 | (goto-char (point-min)) |
27139cd5 SB |
4011 | (if (re-search-forward (concat "\n\\(" (regexp-quote todos-category-done) |
4012 | "\\)") nil t) | |
4013 | (progn | |
4014 | (setq done-start (match-beginning 0)) | |
4015 | (setq done-sep-start (match-beginning 1)) | |
4016 | (setq done-end (match-end 0))) | |
4017 | (error "Category %s is missing todos-category-done string" name)) | |
4018 | (if todos-show-done-only | |
4019 | (narrow-to-region (1+ done-end) (point-max)) | |
4020 | (when (and todos-show-with-done | |
4021 | (re-search-forward todos-done-string-start nil t)) | |
4022 | ;; Now we want to see the done items, so reset displayed end to end of | |
4023 | ;; done items. | |
4024 | (setq done-start cat-end) | |
4025 | ;; Make display overlay for done items separator string, unless there | |
4026 | ;; already is one. | |
4027 | (let* ((done-sep todos-done-separator) | |
4028 | (ov (progn (goto-char done-sep-start) | |
4029 | (todos-get-overlay 'separator)))) | |
4030 | (unless ov | |
4031 | (setq ov (make-overlay done-sep-start done-end)) | |
4032 | (overlay-put ov 'todos 'separator) | |
4033 | (overlay-put ov 'display done-sep)))) | |
4034 | (narrow-to-region (point-min) done-start) | |
4035 | ;; Loading this from todos-mode, or adding it to the mode hook, causes | |
4036 | ;; Emacs to hang in todos-item-start, at (looking-at todos-item-start). | |
4037 | (when todos-highlight-item | |
4038 | (require 'hl-line) | |
4039 | (hl-line-mode 1))))) | |
58c7641d | 4040 | |
27139cd5 SB |
4041 | (defconst todos-category-beg "--==-- " |
4042 | "String marking beginning of category (inserted with its name).") | |
58c7641d | 4043 | |
27139cd5 SB |
4044 | (defconst todos-category-done "==--== DONE " |
4045 | "String marking beginning of category's done items.") | |
0e89c3fc | 4046 | |
27139cd5 SB |
4047 | (defun todos-done-separator () |
4048 | "Return string used as value of variable `todos-done-separator'." | |
4049 | (let ((sep todos-done-separator-string)) | |
4050 | (propertize (if (= 1 (length sep)) | |
4051 | ;; Until bug#2749 is fixed, if separator's length | |
db5ea477 SB |
4052 | ;; is window-width and todos-wrap-lines is |
4053 | ;; non-nil, an indented empty line appears between | |
4054 | ;; the separator and the first done item. | |
4055 | ;; (make-string (window-width) (string-to-char sep)) | |
4056 | (make-string (1- (window-width)) (string-to-char sep)) | |
27139cd5 SB |
4057 | todos-done-separator-string) |
4058 | 'face 'todos-done-sep))) | |
0e89c3fc | 4059 | |
27139cd5 SB |
4060 | (defvar todos-done-separator (todos-done-separator) |
4061 | "String used to visually separate done from not done items. | |
4062 | Displayed as an overlay instead of `todos-category-done' when | |
4063 | done items are shown. Its value is determined by user option | |
4064 | `todos-done-separator-string'.") | |
3af3cd0b | 4065 | |
27139cd5 SB |
4066 | (defun todos-reset-done-separator (sep) |
4067 | "Replace existing overlays of done items separator string SEP." | |
4068 | (save-excursion | |
4069 | (save-restriction | |
4070 | (widen) | |
4071 | (goto-char (point-min)) | |
4072 | (while (re-search-forward | |
4073 | (concat "\n\\(" (regexp-quote todos-category-done) "\\)") nil t) | |
4074 | (let* ((beg (match-beginning 1)) | |
4075 | (end (match-end 0)) | |
4076 | (ov (progn (goto-char beg) | |
4077 | (todos-get-overlay 'separator))) | |
4078 | (old-sep (when ov (overlay-get ov 'display))) | |
4079 | new-ov) | |
4080 | (when old-sep | |
4081 | (unless (string= old-sep sep) | |
4082 | (setq new-ov (make-overlay beg end)) | |
4083 | (overlay-put new-ov 'todos 'separator) | |
4084 | (overlay-put new-ov 'display todos-done-separator) | |
4085 | (delete-overlay ov)))))))) | |
58c7641d | 4086 | |
27139cd5 SB |
4087 | (defun todos-get-count (type &optional category) |
4088 | "Return count of TYPE items in CATEGORY. | |
4089 | If CATEGORY is nil, default to the current category." | |
4090 | (let* ((cat (or category (todos-current-category))) | |
4091 | (counts (cdr (assoc cat todos-categories))) | |
4092 | (idx (cond ((eq type 'todo) 0) | |
4093 | ((eq type 'diary) 1) | |
4094 | ((eq type 'done) 2) | |
4095 | ((eq type 'archived) 3)))) | |
4096 | (aref counts idx))) | |
f4228ddc | 4097 | |
27139cd5 SB |
4098 | (defun todos-update-count (type increment &optional category) |
4099 | "Change count of TYPE items in CATEGORY by integer INCREMENT. | |
4100 | With nil or omitted CATEGORY, default to the current category." | |
4101 | (let* ((cat (or category (todos-current-category))) | |
4102 | (counts (cdr (assoc cat todos-categories))) | |
4103 | (idx (cond ((eq type 'todo) 0) | |
4104 | ((eq type 'diary) 1) | |
4105 | ((eq type 'done) 2) | |
4106 | ((eq type 'archived) 3)))) | |
4107 | (aset counts idx (+ increment (aref counts idx))))) | |
58c7641d | 4108 | |
27139cd5 SB |
4109 | (defun todos-set-categories () |
4110 | "Set `todos-categories' from the sexp at the top of the file." | |
4111 | ;; New archive files created by `todos-move-category' are empty, which would | |
4112 | ;; make the sexp test fail and raise an error, so in this case we skip it. | |
4113 | (unless (zerop (buffer-size)) | |
4114 | (save-excursion | |
4115 | (save-restriction | |
4116 | (widen) | |
4117 | (goto-char (point-min)) | |
4118 | (setq todos-categories | |
4119 | (if (looking-at "\(\(\"") | |
4120 | (read (buffer-substring-no-properties | |
4121 | (line-beginning-position) | |
4122 | (line-end-position))) | |
4123 | (error "Invalid or missing todos-categories sexp"))))))) | |
d04d6b95 | 4124 | |
27139cd5 SB |
4125 | (defun todos-update-categories-sexp () |
4126 | "Update the `todos-categories' sexp at the top of the file." | |
4127 | (let (buffer-read-only) | |
4128 | (save-excursion | |
4129 | (save-restriction | |
4130 | (widen) | |
4131 | (goto-char (point-min)) | |
4132 | (if (looking-at (concat "^" (regexp-quote todos-category-beg))) | |
4133 | (progn (newline) (goto-char (point-min)) ; Make space for sexp. | |
4134 | (setq todos-categories (todos-make-categories-list t))) | |
4135 | (delete-region (line-beginning-position) (line-end-position))) | |
4136 | (prin1 todos-categories (current-buffer)))))) | |
d04d6b95 | 4137 | |
27139cd5 SB |
4138 | (defun todos-make-categories-list (&optional force) |
4139 | "Return an alist of Todos categories and their item counts. | |
4140 | With non-nil argument FORCE parse the entire file to build the | |
4141 | list; otherwise, get the value by reading the sexp at the top of | |
4142 | the file." | |
4143 | (setq todos-categories nil) | |
4144 | (save-excursion | |
4145 | (save-restriction | |
4146 | (widen) | |
0e89c3fc | 4147 | (goto-char (point-min)) |
27139cd5 SB |
4148 | (let (counts cat archive) |
4149 | ;; If the file is a todo file and has archived items, identify the | |
4150 | ;; archive, in order to count its items. But skip this with | |
4151 | ;; `todos-convert-legacy-files', since that converts filed items to | |
4152 | ;; archived items. | |
4153 | (when buffer-file-name ; During conversion there is no file yet. | |
4154 | ;; If the file is an archive, it doesn't have an archive. | |
4155 | (unless (member (file-truename buffer-file-name) | |
4156 | (funcall todos-files-function t)) | |
4157 | (setq archive (concat (file-name-sans-extension | |
4158 | todos-current-todos-file) ".toda")))) | |
4159 | (while (not (eobp)) | |
4160 | (cond ((looking-at (concat (regexp-quote todos-category-beg) | |
4161 | "\\(.*\\)\n")) | |
4162 | (setq cat (match-string-no-properties 1)) | |
4163 | ;; Counts for each category: [todo diary done archive] | |
4164 | (setq counts (make-vector 4 0)) | |
4165 | (setq todos-categories | |
4166 | (append todos-categories (list (cons cat counts)))) | |
4167 | ;; Add archived item count to the todo file item counts. | |
4168 | ;; Make sure to include newly created archives, e.g. due to | |
4169 | ;; todos-move-category. | |
4170 | (when (member archive (funcall todos-files-function t)) | |
4171 | (let ((archive-count 0)) | |
4172 | (with-current-buffer (find-file-noselect archive) | |
4173 | (widen) | |
4174 | (goto-char (point-min)) | |
4175 | (when (re-search-forward | |
4176 | (concat "^" (regexp-quote todos-category-beg) | |
4177 | cat "$") | |
4178 | (point-max) t) | |
4179 | (forward-line) | |
4180 | (while (not (or (looking-at | |
4181 | (concat | |
4182 | (regexp-quote todos-category-beg) | |
4183 | "\\(.*\\)\n")) | |
4184 | (eobp))) | |
4185 | (when (looking-at todos-done-string-start) | |
4186 | (setq archive-count (1+ archive-count))) | |
4187 | (forward-line)))) | |
4188 | (todos-update-count 'archived archive-count cat)))) | |
4189 | ((looking-at todos-done-string-start) | |
4190 | (todos-update-count 'done 1 cat)) | |
4191 | ((looking-at (concat "^\\(" | |
4192 | (regexp-quote diary-nonmarking-symbol) | |
4193 | "\\)?" todos-date-pattern)) | |
4194 | (todos-update-count 'diary 1 cat) | |
4195 | (todos-update-count 'todo 1 cat)) | |
4196 | ((looking-at (concat todos-date-string-start todos-date-pattern)) | |
4197 | (todos-update-count 'todo 1 cat)) | |
4198 | ;; If first line is todos-categories list, use it and end loop | |
4199 | ;; -- unless FORCEd to scan whole file. | |
4200 | ((bobp) | |
4201 | (unless force | |
4202 | (setq todos-categories (read (buffer-substring-no-properties | |
4203 | (line-beginning-position) | |
4204 | (line-end-position)))) | |
4205 | (goto-char (1- (point-max)))))) | |
4206 | (forward-line))))) | |
4207 | todos-categories) | |
2c173503 | 4208 | |
27139cd5 SB |
4209 | (defun todos-repair-categories-sexp () |
4210 | "Repair corrupt Todos categories sexp. | |
4211 | This should only be needed as a consequence of careless manual | |
4212 | editing or a bug in todos.el. | |
d04d6b95 | 4213 | |
27139cd5 SB |
4214 | *Warning*: Calling this command restores the category order to |
4215 | the list element order in the Todos categories sexp, so any order | |
4216 | changes made in Todos Categories mode will have to be made again." | |
0e89c3fc | 4217 | (interactive) |
27139cd5 SB |
4218 | (let ((todos-categories (todos-make-categories-list t))) |
4219 | (todos-update-categories-sexp))) | |
2c173503 | 4220 | |
a9b0e28e SB |
4221 | ;; ----------------------------------------------------------------------------- |
4222 | ;;; Item-level global variables and support functions | |
4223 | ;; ----------------------------------------------------------------------------- | |
0e89c3fc | 4224 | |
27139cd5 SB |
4225 | (defconst todos-month-name-array |
4226 | (vconcat calendar-month-name-array (vector "*")) | |
4227 | "Array of month names, in order. | |
4228 | The final element is \"*\", indicating an unspecified month.") | |
4229 | ||
4230 | (defconst todos-month-abbrev-array | |
4231 | (vconcat calendar-month-abbrev-array (vector "*")) | |
4232 | "Array of abbreviated month names, in order. | |
4233 | The final element is \"*\", indicating an unspecified month.") | |
4234 | ||
4235 | (defconst todos-date-pattern | |
4236 | (let ((dayname (diary-name-pattern calendar-day-name-array nil t))) | |
4237 | (concat "\\(?5:" dayname "\\|" | |
4238 | (let ((dayname) | |
4239 | (monthname (format "\\(?6:%s\\)" (diary-name-pattern | |
4240 | todos-month-name-array | |
4241 | todos-month-abbrev-array))) | |
4242 | (month "\\(?7:[0-9]+\\|\\*\\)") | |
4243 | (day "\\(?8:[0-9]+\\|\\*\\)") | |
4244 | (year "-?\\(?9:[0-9]+\\|\\*\\)")) | |
4245 | (mapconcat 'eval calendar-date-display-form "")) | |
4246 | "\\)")) | |
4247 | "Regular expression matching a Todos date header.") | |
58c7641d | 4248 | |
27139cd5 SB |
4249 | (defconst todos-nondiary-start (nth 0 todos-nondiary-marker) |
4250 | "String inserted before item date to block diary inclusion.") | |
58c7641d | 4251 | |
27139cd5 SB |
4252 | (defconst todos-nondiary-end (nth 1 todos-nondiary-marker) |
4253 | "String inserted after item date matching `todos-nondiary-start'.") | |
a2730169 | 4254 | |
27139cd5 SB |
4255 | ;; By itself this matches anything, because of the `?'; however, it's only |
4256 | ;; used in the context of `todos-date-pattern' (but Emacs Lisp lacks | |
4257 | ;; lookahead). | |
4258 | (defconst todos-date-string-start | |
4259 | (concat "^\\(" (regexp-quote todos-nondiary-start) "\\|" | |
4260 | (regexp-quote diary-nonmarking-symbol) "\\)?") | |
4261 | "Regular expression matching part of item header before the date.") | |
0e89c3fc | 4262 | |
27139cd5 SB |
4263 | (defconst todos-done-string-start |
4264 | (concat "^\\[" (regexp-quote todos-done-string)) | |
4265 | "Regular expression matching start of done item.") | |
04c9cdf7 | 4266 | |
27139cd5 SB |
4267 | (defconst todos-item-start (concat "\\(" todos-date-string-start "\\|" |
4268 | todos-done-string-start "\\)" | |
4269 | todos-date-pattern) | |
4270 | "String identifying start of a Todos item.") | |
58c7641d | 4271 | |
27139cd5 SB |
4272 | (defun todos-item-start () |
4273 | "Move to start of current Todos item and return its position." | |
4274 | (unless (or | |
4275 | ;; Buffer is empty (invocation possible e.g. via todos-forward-item | |
4276 | ;; from todos-filter-items when processing category with no todo | |
4277 | ;; items). | |
4278 | (eq (point-min) (point-max)) | |
4279 | ;; Point is on the empty line below category's last todo item... | |
4280 | (and (looking-at "^$") | |
4281 | (or (eobp) ; ...and done items are hidden... | |
4282 | (save-excursion ; ...or done items are visible. | |
4283 | (forward-line) | |
4284 | (looking-at (concat "^" | |
4285 | (regexp-quote todos-category-done)))))) | |
4286 | ;; Buffer is widened. | |
4287 | (looking-at (regexp-quote todos-category-beg))) | |
4288 | (goto-char (line-beginning-position)) | |
4289 | (while (not (looking-at todos-item-start)) | |
4290 | (forward-line -1)) | |
4291 | (point))) | |
04c9cdf7 | 4292 | |
27139cd5 SB |
4293 | (defun todos-item-end () |
4294 | "Move to end of current Todos item and return its position." | |
4295 | ;; Items cannot end with a blank line. | |
4296 | (unless (looking-at "^$") | |
4297 | (let* ((done (todos-done-item-p)) | |
4298 | (to-lim nil) | |
4299 | ;; For todo items, end is before the done items section, for done | |
4300 | ;; items, end is before the next category. If these limits are | |
4301 | ;; missing or inaccessible, end it before the end of the buffer. | |
4302 | (lim (if (save-excursion | |
4303 | (re-search-forward | |
4304 | (concat "^" (regexp-quote (if done | |
4305 | todos-category-beg | |
4306 | todos-category-done))) | |
4307 | nil t)) | |
4308 | (progn (setq to-lim t) (match-beginning 0)) | |
4309 | (point-max)))) | |
4310 | (when (bolp) (forward-char)) ; Find start of next item. | |
4311 | (goto-char (if (re-search-forward todos-item-start lim t) | |
4312 | (match-beginning 0) | |
4313 | (if to-lim lim (point-max)))) | |
4314 | ;; For last todo item, skip back over the empty line before the done | |
4315 | ;; items section, else just back to the end of the previous line. | |
4316 | (backward-char (when (and to-lim (not done) (eq (point) lim)) 2)) | |
4317 | (point)))) | |
4318 | ||
4319 | (defun todos-item-string () | |
4320 | "Return bare text of current item as a string." | |
4321 | (let ((opoint (point)) | |
4322 | (start (todos-item-start)) | |
4323 | (end (todos-item-end))) | |
4324 | (goto-char opoint) | |
4325 | (and start end (buffer-substring-no-properties start end)))) | |
0e89c3fc | 4326 | |
0e89c3fc | 4327 | (defun todos-forward-item (&optional count) |
caa229d5 SB |
4328 | "Move point COUNT items down (by default, move down by one item)." |
4329 | (let* ((not-done (not (or (todos-done-item-p) (looking-at "^$")))) | |
4330 | (start (line-end-position))) | |
4331 | (goto-char start) | |
4332 | (if (re-search-forward todos-item-start nil t (or count 1)) | |
4333 | (goto-char (match-beginning 0)) | |
4334 | (goto-char (point-max))) | |
a9b0e28e SB |
4335 | ;; If points advances by one from a todo to a done item, go back |
4336 | ;; to the space above todos-done-separator, since that is a | |
4337 | ;; legitimate place to insert an item. But skip this space if | |
4338 | ;; count > 1, since that should only stop on an item. | |
caa229d5 SB |
4339 | (when (and not-done (todos-done-item-p) (not count)) |
4340 | ;; (if (or (not count) (= count 1)) | |
4341 | (re-search-backward "^$" start t))));) | |
a9b0e28e SB |
4342 | ;; The preceding sexp is insufficient when buffer is not narrowed, |
4343 | ;; since there could be no done items in this category, so the | |
4344 | ;; search puts us on first todo item of next category. Does this | |
4345 | ;; ever happen? If so: | |
caa229d5 SB |
4346 | ;; (let ((opoint) (point)) |
4347 | ;; (forward-line -1) | |
4348 | ;; (when (or (not count) (= count 1)) | |
4349 | ;; (cond ((looking-at (concat "^" (regexp-quote todos-category-beg))) | |
4350 | ;; (forward-line -2)) | |
4351 | ;; ((looking-at (concat "^" (regexp-quote todos-category-done))) | |
4352 | ;; (forward-line -1)) | |
4353 | ;; (t | |
4354 | ;; (goto-char opoint))))))) | |
4355 | ||
0e89c3fc SB |
4356 | (defun todos-backward-item (&optional count) |
4357 | "Move point up to start of item with next higher priority. | |
616ffa8b | 4358 | With positive numerical prefix COUNT, move point COUNT items |
344187df SB |
4359 | upward. |
4360 | ||
4361 | If the category's done items are visible, this command called | |
4362 | with a prefix argument only moves point to a higher item, e.g., | |
4363 | with point on the first done item and called with prefix 1, it | |
4364 | moves to the last todo item; but if called with point on the | |
4365 | first done item without a prefix argument, it moves point the the | |
4366 | empty line above the done items separator." | |
caa229d5 SB |
4367 | (let* ((done (todos-done-item-p))) |
4368 | (todos-item-start) | |
4369 | (unless (bobp) | |
4370 | (re-search-backward todos-item-start nil t (or count 1))) | |
4371 | ;; Unless this is a regexp filtered items buffer (which can contain | |
4372 | ;; intermixed todo and done items), if points advances by one from a | |
4373 | ;; done to a todo item, go back to the space above | |
4374 | ;; todos-done-separator, since that is a legitimate place to insert an | |
4375 | ;; item. But skip this space if count > 1, since that should only | |
4376 | ;; stop on an item. | |
4377 | (when (and done (not (todos-done-item-p)) (not count) | |
4378 | ;(or (not count) (= count 1)) | |
4379 | (not (equal (buffer-name) todos-regexp-items-buffer))) | |
4380 | (re-search-forward (concat "^" (regexp-quote todos-category-done)) | |
4381 | nil t) | |
4382 | (forward-line -1)))) | |
4383 | ||
27139cd5 SB |
4384 | (defun todos-remove-item () |
4385 | "Internal function called in editing, deleting or moving items." | |
4386 | (let* ((end (progn (todos-item-end) (1+ (point)))) | |
4387 | (beg (todos-item-start)) | |
4388 | (ov (todos-get-overlay 'prefix))) | |
4389 | (when ov (delete-overlay ov)) | |
4390 | (delete-region beg end))) | |
4391 | ||
4392 | (defun todos-diary-item-p () | |
4393 | "Return non-nil if item at point has diary entry format." | |
4394 | (save-excursion | |
4395 | (when (todos-item-string) ; Exclude empty lines. | |
4396 | (todos-item-start) | |
4397 | (not (looking-at (regexp-quote todos-nondiary-start)))))) | |
4398 | ||
db5ea477 SB |
4399 | (defun todos-diary-goto-entry () |
4400 | "Jump to todo item included in Fancy Diary display. | |
4401 | Helper function for `diary-goto-entry'." | |
4402 | (when (eq major-mode 'todos-mode) | |
4403 | (setq opoint (point)) | |
4404 | (re-search-backward (concat "^" (regexp-quote todos-category-beg) | |
4405 | "\\(.*\\)\n") nil t) | |
4406 | (todos-category-number (match-string 1)) | |
4407 | (todos-category-select) | |
4408 | (goto-char opoint))) | |
4409 | ||
27139cd5 SB |
4410 | (defun todos-done-item-p () |
4411 | "Return non-nil if item at point is a done item." | |
4412 | (save-excursion | |
4413 | (todos-item-start) | |
4414 | (looking-at todos-done-string-start))) | |
4415 | ||
4416 | (defun todos-done-item-section-p () | |
4417 | "Return non-nil if point is in category's done items section." | |
4418 | (save-excursion | |
4419 | (or (re-search-backward (concat "^" (regexp-quote todos-category-done)) | |
4420 | nil t) | |
4421 | (progn (goto-char (point-min)) | |
4422 | (looking-at todos-done-string-start))))) | |
4423 | ||
4424 | (defun todos-get-overlay (val) | |
4425 | "Return the overlay at point whose `todos' property has value VAL." | |
4426 | ;; Use overlays-in to find prefix overlays and check over two | |
4427 | ;; positions to find done separator overlay. | |
4428 | (let ((ovs (overlays-in (point) (1+ (point)))) | |
4429 | ov) | |
4430 | (catch 'done | |
4431 | (while ovs | |
4432 | (setq ov (pop ovs)) | |
4433 | (when (eq (overlay-get ov 'todos) val) | |
4434 | (throw 'done ov)))))) | |
4435 | ||
4436 | (defun todos-marked-item-p () | |
4437 | "Non-nil if this item begins with `todos-item-mark'. | |
e99a2125 | 4438 | In that case, return the item's prefix overlay." |
27139cd5 SB |
4439 | (let* ((ov (todos-get-overlay 'prefix)) |
4440 | ;; If an item insertion command is called on a Todos file | |
4441 | ;; before it is visited, it has no prefix overlays yet, so | |
4442 | ;; check for this. | |
4443 | (pref (when ov (overlay-get ov 'before-string))) | |
4444 | (marked (when pref | |
4445 | (string-match (concat "^" (regexp-quote todos-item-mark)) | |
4446 | pref)))) | |
4447 | (when marked ov))) | |
4448 | ||
4449 | (defun todos-insert-with-overlays (item) | |
4450 | "Insert ITEM at point and update prefix/priority number overlays." | |
4451 | (todos-item-start) | |
4452 | ;; Insertion pushes item down but not its prefix overlay. When the | |
4453 | ;; overlay includes a mark, this would now mark the inserted ITEM, | |
4454 | ;; so move it to the pushed down item. | |
4455 | (let ((ov (todos-get-overlay 'prefix)) | |
4456 | (marked (todos-marked-item-p))) | |
4457 | (insert item "\n") | |
4458 | (when marked (move-overlay ov (point) (point)))) | |
4459 | (todos-backward-item) | |
4460 | (todos-prefix-overlays)) | |
caa229d5 | 4461 | |
27139cd5 SB |
4462 | (defun todos-prefix-overlays () |
4463 | "Update the prefix overlays of the current category's items. | |
4464 | The overlay's value is the string `todos-prefix' or with non-nil | |
4465 | `todos-number-prefix' an integer in the sequence from 1 to | |
4466 | the number of todo or done items in the category indicating the | |
4467 | item's priority. Todo and done items are numbered independently | |
4468 | of each other." | |
4469 | (let ((num 0) | |
4470 | (cat-tp (or (cdr (assoc-string | |
4471 | (todos-current-category) | |
4472 | (nth 2 (assoc-string todos-current-todos-file | |
4473 | todos-top-priorities-overrides)))) | |
4474 | todos-top-priorities)) | |
4475 | done prefix) | |
4476 | (save-excursion | |
4477 | (goto-char (point-min)) | |
4478 | (while (not (eobp)) | |
4479 | (when (or (todos-date-string-matcher (line-end-position)) | |
4480 | (todos-done-string-matcher (line-end-position))) | |
4481 | (goto-char (match-beginning 0)) | |
4482 | (setq num (1+ num)) | |
4483 | ;; Reset number to 1 for first done item. | |
4484 | (when (and (eq major-mode 'todos-mode) | |
4485 | (looking-at todos-done-string-start) | |
4486 | (looking-back (concat "^" | |
4487 | (regexp-quote todos-category-done) | |
4488 | "\n"))) | |
4489 | (setq num 1 | |
4490 | done t)) | |
4491 | (setq prefix (concat (propertize | |
4492 | (if todos-number-prefix | |
4493 | (number-to-string num) | |
4494 | todos-prefix) | |
4495 | 'face | |
4496 | ;; Prefix of top priority items has a | |
4497 | ;; distinct face in Todos mode. | |
4498 | (if (and (eq major-mode 'todos-mode) | |
4499 | (not done) | |
4500 | (<= num cat-tp)) | |
4501 | 'todos-top-priority | |
4502 | 'todos-prefix-string)) | |
4503 | " ")) | |
4504 | (let ((ov (todos-get-overlay 'prefix)) | |
4505 | (marked (todos-marked-item-p))) | |
4506 | ;; Prefix overlay must be at a single position so its | |
4507 | ;; bounds aren't changed when (re)moving an item. | |
4508 | (unless ov (setq ov (make-overlay (point) (point)))) | |
4509 | (overlay-put ov 'todos 'prefix) | |
4510 | (overlay-put ov 'before-string (if marked | |
4511 | (concat todos-item-mark prefix) | |
4512 | prefix)))) | |
4513 | (forward-line))))) | |
b28872ce | 4514 | |
a9b0e28e | 4515 | ;; ----------------------------------------------------------------------------- |
e99a2125 | 4516 | ;;; Generation of item insertion commands and key bindings |
a9b0e28e | 4517 | ;; ----------------------------------------------------------------------------- |
18aef8a3 | 4518 | |
db5ea477 SB |
4519 | ;; These two powerset definitions are adaptations of code published at |
4520 | ;; http://rosettacode.org, whose content is licensed under GFDL 1.2. | |
4521 | ;; The recursive definition is a slight reformulation of | |
4522 | ;; http://rosettacode.org/wiki/Power_set#Common_Lisp. The iterative | |
4523 | ;; definition is my Elisp implementation of | |
4524 | ;; http://rosettacode.org/wiki/Power_set#C. Can either of these be | |
4525 | ;; included in Emacs, or is there no need to concerned about copyright | |
4526 | ;; here? | |
4527 | ||
4528 | ;; (defun todos-powerset (list) | |
4529 | ;; "Return the powerset of LIST." | |
4530 | ;; (cond ((null list) | |
4531 | ;; (list nil)) | |
4532 | ;; (t | |
4533 | ;; (let ((recur (todos-powerset-recursive (cdr list))) | |
4534 | ;; pset) | |
4535 | ;; (dolist (elt recur pset) | |
4536 | ;; (push (cons (car list) elt) pset)) | |
4537 | ;; (append pset recur))))) | |
4538 | ||
4539 | (defun todos-powerset (list) | |
4540 | "Return the powerset of LIST." | |
a9b0e28e | 4541 | (let ((card (expt 2 (length list))) |
27139cd5 | 4542 | pset elt) |
a9b0e28e SB |
4543 | (dotimes (n card) |
4544 | (let ((i n) | |
4545 | (l list)) | |
4546 | (while (not (zerop i)) | |
4547 | (let ((arg (pop l))) | |
4548 | (when (cl-oddp i) | |
27139cd5 | 4549 | (setq elt (append elt (list arg)))) |
a9b0e28e | 4550 | (setq i (/ i 2)))) |
27139cd5 SB |
4551 | (setq pset (append pset (list elt))) |
4552 | (setq elt nil))) | |
4553 | pset)) | |
b28872ce | 4554 | |
27139cd5 | 4555 | (defun todos-gen-arglists (arglist) |
a9b0e28e SB |
4556 | "Return list of lists of non-nil atoms produced from ARGLIST. |
4557 | The elements of ARGLIST may be atoms or lists." | |
27139cd5 SB |
4558 | (let (arglists) |
4559 | (while arglist | |
4560 | (let ((arg (pop arglist))) | |
4561 | (cond ((symbolp arg) | |
4562 | (setq arglists (if arglists | |
4563 | (mapcar (lambda (l) (push arg l)) arglists) | |
4564 | (list (push arg arglists))))) | |
4565 | ((listp arg) | |
4566 | (setq arglists | |
4567 | (mapcar (lambda (a) | |
4568 | (if (= 1 (length arglists)) | |
4569 | (apply (lambda (l) (push a l)) arglists) | |
4570 | (mapcar (lambda (l) (push a l)) arglists))) | |
4571 | arg)))))) | |
4572 | (setq arglists (mapcar 'reverse (apply 'append (mapc 'car arglists)))))) | |
b28872ce | 4573 | |
27139cd5 SB |
4574 | (defvar todos-insertion-commands-args-genlist |
4575 | '(diary nonmarking (calendar date dayname) time (here region)) | |
a9b0e28e | 4576 | "Generator list for argument lists of item insertion commands.") |
b28872ce | 4577 | |
27139cd5 SB |
4578 | (defvar todos-insertion-commands-args |
4579 | (let ((argslist (todos-gen-arglists todos-insertion-commands-args-genlist)) | |
4580 | res new) | |
a9b0e28e | 4581 | (setq res (cl-remove-duplicates |
27139cd5 SB |
4582 | (apply 'append (mapcar 'todos-powerset argslist)) :test 'equal)) |
4583 | (dolist (l res) | |
4584 | (unless (= 5 (length l)) | |
4585 | (let ((v (make-vector 5 nil)) elt) | |
4586 | (while l | |
4587 | (setq elt (pop l)) | |
4588 | (cond ((eq elt 'diary) | |
4589 | (aset v 0 elt)) | |
4590 | ((eq elt 'nonmarking) | |
4591 | (aset v 1 elt)) | |
4592 | ((or (eq elt 'calendar) | |
4593 | (eq elt 'date) | |
4594 | (eq elt 'dayname)) | |
4595 | (aset v 2 elt)) | |
4596 | ((eq elt 'time) | |
4597 | (aset v 3 elt)) | |
4598 | ((or (eq elt 'here) | |
4599 | (eq elt 'region)) | |
4600 | (aset v 4 elt)))) | |
4601 | (setq l (append v nil)))) | |
4602 | (setq new (append new (list l)))) | |
4603 | new) | |
4604 | "List of all argument lists for Todos item insertion commands.") | |
b28872ce | 4605 | |
27139cd5 SB |
4606 | (defun todos-insertion-command-name (arglist) |
4607 | "Generate Todos item insertion command name from ARGLIST." | |
4608 | (replace-regexp-in-string | |
4609 | "-\\_>" "" | |
4610 | (replace-regexp-in-string | |
4611 | "-+" "-" | |
4612 | ;; (concat "todos-item-insert-" | |
4613 | (concat "todos-insert-item-" | |
4614 | (mapconcat (lambda (e) (if e (symbol-name e))) arglist "-"))))) | |
b28872ce | 4615 | |
27139cd5 SB |
4616 | (defvar todos-insertion-commands-names |
4617 | (mapcar (lambda (l) | |
4618 | (todos-insertion-command-name l)) | |
4619 | todos-insertion-commands-args) | |
4620 | "List of names of Todos item insertion commands.") | |
b28872ce | 4621 | |
27139cd5 | 4622 | (defmacro todos-define-insertion-command (&rest args) |
a9b0e28e | 4623 | "Generate item insertion command definitions from ARGS." |
27139cd5 SB |
4624 | (let ((name (intern (todos-insertion-command-name args))) |
4625 | (arg0 (nth 0 args)) | |
4626 | (arg1 (nth 1 args)) | |
4627 | (arg2 (nth 2 args)) | |
4628 | (arg3 (nth 3 args)) | |
4629 | (arg4 (nth 4 args))) | |
4630 | `(defun ,name (&optional arg &rest args) | |
a9b0e28e SB |
4631 | "Todos item insertion command generated from ARGS. |
4632 | For descriptions of the individual arguments, their values, and | |
4633 | their relation to key bindings, see `todos-basic-insert-item'." | |
27139cd5 | 4634 | (interactive (list current-prefix-arg)) |
a9b0e28e | 4635 | (todos-basic-insert-item arg ',arg0 ',arg1 ',arg2 ',arg3 ',arg4)))) |
b28872ce | 4636 | |
27139cd5 SB |
4637 | (defvar todos-insertion-commands |
4638 | (mapcar (lambda (c) | |
4639 | (eval `(todos-define-insertion-command ,@c))) | |
4640 | todos-insertion-commands-args) | |
4641 | "List of Todos item insertion commands.") | |
b28872ce | 4642 | |
27139cd5 SB |
4643 | (defvar todos-insertion-commands-arg-key-list |
4644 | '(("diary" "y" "yy") | |
4645 | ("nonmarking" "k" "kk") | |
4646 | ("calendar" "c" "cc") | |
4647 | ("date" "d" "dd") | |
4648 | ("dayname" "n" "nn") | |
4649 | ("time" "t" "tt") | |
4650 | ("here" "h" "h") | |
4651 | ("region" "r" "r")) | |
a9b0e28e | 4652 | "List of mappings of insertion command arguments to key sequences.") |
b28872ce | 4653 | |
27139cd5 | 4654 | (defun todos-insertion-key-bindings (map) |
e99a2125 | 4655 | "Generate key binding definitions for item insertion keymap MAP." |
27139cd5 SB |
4656 | (dolist (c todos-insertion-commands) |
4657 | (let* ((key "") | |
4658 | (cname (symbol-name c))) | |
4659 | (mapc (lambda (l) | |
4660 | (let ((arg (nth 0 l)) | |
4661 | (key1 (nth 1 l)) | |
4662 | (key2 (nth 2 l))) | |
4663 | (if (string-match (concat (regexp-quote arg) "\\_>") cname) | |
4664 | (setq key (concat key key2))) | |
4665 | (if (string-match (concat (regexp-quote arg) ".+") cname) | |
4666 | (setq key (concat key key1))))) | |
4667 | todos-insertion-commands-arg-key-list) | |
27139cd5 SB |
4668 | (if (string-match (concat (regexp-quote "todos-insert-item") "\\_>") cname) |
4669 | (setq key (concat key "i"))) | |
4670 | (define-key map key c)))) | |
b28872ce | 4671 | |
a9b0e28e | 4672 | ;; ----------------------------------------------------------------------------- |
27139cd5 | 4673 | ;;; Todos minibuffer completion |
a9b0e28e | 4674 | ;; ----------------------------------------------------------------------------- |
b28872ce | 4675 | |
27139cd5 SB |
4676 | (defun todos-category-completions (&optional archive) |
4677 | "Return a list of completions for `todos-read-category'. | |
4678 | Each element of the list is a cons of a category name and the | |
4679 | file or list of files (as short file names) it is in. The files | |
4680 | are either the current (or if there is none, the default) todo | |
4681 | file plus the files listed in `todos-category-completions-files', | |
4682 | or, with non-nil ARCHIVE, the current archive file." | |
4683 | (let* ((curfile (or todos-current-todos-file | |
4684 | (and todos-show-current-file | |
4685 | todos-global-current-todos-file) | |
4686 | (todos-absolute-file-name todos-default-todos-file))) | |
4687 | (files (or (unless archive | |
4688 | (mapcar 'todos-absolute-file-name | |
4689 | todos-category-completions-files)) | |
4690 | (list curfile))) | |
4691 | listall listf) | |
4692 | ;; If file was just added, it has no category completions. | |
4693 | (unless (zerop (buffer-size (find-buffer-visiting curfile))) | |
4694 | (unless (member curfile todos-archives) | |
4695 | (add-to-list 'files curfile)) | |
4696 | (dolist (f files listall) | |
4697 | (with-current-buffer (find-file-noselect f 'nowarn) | |
4698 | ;; Ensure category is properly displayed in case user | |
4699 | ;; switches to file via a non-Todos command. And if done | |
4700 | ;; items in category are visible, keep them visible. | |
4701 | (let ((done todos-show-with-done)) | |
4702 | (when (> (buffer-size) (- (point-max) (point-min))) | |
4703 | (save-excursion | |
4704 | (goto-char (point-min)) | |
4705 | (setq done (re-search-forward todos-done-string-start nil t)))) | |
4706 | (let ((todos-show-with-done done)) | |
4707 | (save-excursion (todos-category-select)))) | |
4708 | (save-excursion | |
4709 | (save-restriction | |
4710 | (widen) | |
4711 | (goto-char (point-min)) | |
4712 | (setq listf (read (buffer-substring-no-properties | |
4713 | (line-beginning-position) | |
4714 | (line-end-position))))))) | |
4715 | (mapc (lambda (elt) (let* ((cat (car elt)) | |
4716 | (la-elt (assoc cat listall))) | |
4717 | (if la-elt | |
4718 | (setcdr la-elt (append (list (cdr la-elt)) | |
4719 | (list f))) | |
4720 | (push (cons cat f) listall)))) | |
4721 | listf))))) | |
b28872ce | 4722 | |
27139cd5 SB |
4723 | (defun todos-read-file-name (prompt &optional archive mustmatch) |
4724 | "Choose and return the name of a Todos file, prompting with PROMPT. | |
20166aea | 4725 | |
27139cd5 SB |
4726 | Show completions with TAB or SPC; the names are shown in short |
4727 | form but the absolute truename is returned. With non-nil ARCHIVE | |
4728 | return the absolute truename of a Todos archive file. With non-nil | |
4729 | MUSTMATCH the name of an existing file must be chosen; | |
4730 | otherwise, a new file name is allowed." | |
4731 | (let* ((completion-ignore-case todos-completion-ignore-case) | |
4732 | (files (mapcar 'todos-short-file-name | |
4733 | (if archive todos-archives todos-files))) | |
4734 | (file (completing-read prompt files nil mustmatch nil nil | |
4735 | (if files | |
4736 | ;; If user hit RET without | |
4737 | ;; choosing a file, default to | |
4738 | ;; current or default file. | |
4739 | (todos-short-file-name | |
4740 | (or todos-current-todos-file | |
4741 | (and todos-show-current-file | |
4742 | todos-global-current-todos-file) | |
4743 | (todos-absolute-file-name | |
4744 | todos-default-todos-file))) | |
4745 | ;; Trigger prompt for initial file. | |
4746 | "")))) | |
4747 | (unless (file-exists-p todos-directory) | |
4748 | (make-directory todos-directory)) | |
4749 | (unless mustmatch | |
4750 | (setq file (todos-validate-name file 'file))) | |
4751 | (setq file (file-truename (concat todos-directory file | |
4752 | (if archive ".toda" ".todo")))))) | |
20166aea | 4753 | |
27139cd5 SB |
4754 | (defun todos-read-category (prompt &optional match-type file) |
4755 | "Choose and return a category name, prompting with PROMPT. | |
4756 | Show completions for existing categories with TAB or SPC. | |
b28872ce | 4757 | |
27139cd5 SB |
4758 | The argument MATCH-TYPE specifies the matching requirements on |
4759 | the category name: with the value `todo' or `archive' the name | |
4760 | must complete to that of an existing todo or archive category, | |
4761 | respectively; with the value `add' the name must not be that of | |
4762 | an existing category; with all other values both existing and new | |
4763 | valid category names are accepted. | |
20166aea | 4764 | |
27139cd5 SB |
4765 | With non-nil argument FILE prompt for a file and complete only |
4766 | against categories in that file; otherwise complete against all | |
4767 | categories from `todos-category-completions-files'." | |
4768 | ;; Allow SPC to insert spaces, for adding new category names. | |
4769 | (let ((map minibuffer-local-completion-map)) | |
4770 | (define-key map " " nil) | |
4771 | (let* ((add (eq match-type 'add)) | |
4772 | (archive (eq match-type 'archive)) | |
4773 | (file0 (when (and file (> (length todos-files) 1)) | |
4774 | (todos-read-file-name (concat "Choose a" (if archive | |
4775 | "n archive" | |
4776 | " todo") | |
4777 | " file: ") archive t))) | |
4778 | (completions (unless file0 (todos-category-completions archive))) | |
4779 | (categories (cond (file0 | |
4780 | (with-current-buffer | |
4781 | (find-file-noselect file0 'nowarn) | |
4782 | (let ((todos-current-todos-file file0)) | |
4783 | todos-categories))) | |
4784 | ((and add (not file)) | |
4785 | (with-current-buffer | |
4786 | (find-file-noselect todos-current-todos-file) | |
4787 | todos-categories)) | |
4788 | (t | |
4789 | completions))) | |
4790 | (completion-ignore-case todos-completion-ignore-case) | |
4791 | (cat (completing-read prompt categories nil | |
6d12ff8b | 4792 | (eq match-type 'todo) nil nil |
27139cd5 SB |
4793 | ;; Unless we're adding a category via |
4794 | ;; todos-add-category, set default | |
4795 | ;; for existing categories to the | |
4796 | ;; current category of the chosen | |
4797 | ;; file or else of the current file. | |
4798 | (if (and categories (not add)) | |
4799 | (with-current-buffer | |
4800 | (find-file-noselect | |
4801 | (or file0 | |
4802 | todos-current-todos-file | |
4803 | (todos-absolute-file-name | |
4804 | todos-default-todos-file))) | |
4805 | (todos-current-category)) | |
4806 | ;; Trigger prompt for initial category. | |
4807 | ""))) | |
4808 | (catfil (cdr (assoc cat completions))) | |
4809 | (str "Category \"%s\" from which file (TAB for choices)? ")) | |
4810 | ;; If we do category completion and the chosen category name | |
4811 | ;; occurs in more than one file, prompt to choose one file. | |
4812 | (unless (or file0 add (not catfil)) | |
4813 | (setq file0 (file-truename | |
4814 | (if (atom catfil) | |
4815 | catfil | |
4816 | (todos-absolute-file-name | |
4817 | (let ((files (mapcar 'todos-short-file-name catfil))) | |
4818 | (completing-read (format str cat) files))))))) | |
4819 | ;; Default to the current file. | |
4820 | (unless file0 (setq file0 todos-current-todos-file)) | |
4821 | ;; First validate only a name passed interactively from | |
4822 | ;; todos-add-category, which must be of a nonexisting category. | |
4823 | (unless (and (assoc cat categories) (not add)) | |
4824 | ;; Validate only against completion categories. | |
4825 | (let ((todos-categories categories)) | |
4826 | (setq cat (todos-validate-name cat 'category))) | |
4827 | ;; When user enters a nonexisting category name by jumping or | |
4828 | ;; moving, confirm that it should be added, then validate. | |
4829 | (unless add | |
cc416fd3 | 4830 | (if (todos-y-or-n-p (format "Add new category \"%s\" to file \"%s\"? " |
27139cd5 SB |
4831 | cat (todos-short-file-name file0))) |
4832 | (progn | |
4833 | (when (assoc cat categories) | |
4834 | (let ((todos-categories categories)) | |
4835 | (setq cat (todos-validate-name cat 'category)))) | |
4836 | ;; Restore point and narrowing after adding new | |
4837 | ;; category, to avoid moving to beginning of file when | |
4838 | ;; moving marked items to a new category | |
4839 | ;; (todos-move-item). | |
4840 | (save-excursion | |
4841 | (save-restriction | |
4842 | (todos-add-category file0 cat)))) | |
4843 | ;; If we decide not to add a category, exit without returning. | |
4844 | (keyboard-quit)))) | |
4845 | (cons cat file0)))) | |
20166aea | 4846 | |
27139cd5 SB |
4847 | (defun todos-validate-name (name type) |
4848 | "Prompt for new NAME for TYPE until it is valid, then return it. | |
4849 | TYPE can be either of the symbols `file' or `category'." | |
4850 | (let ((categories todos-categories) | |
4851 | (files (mapcar 'todos-short-file-name todos-files)) | |
4852 | prompt) | |
4853 | (while | |
e99a2125 SB |
4854 | (and |
4855 | (cond ((string= "" name) | |
4856 | (setq prompt | |
4857 | (cond ((eq type 'file) | |
4858 | (if files | |
4859 | "Enter a non-empty file name: " | |
4860 | ;; Empty string passed by todos-show to | |
4861 | ;; prompt for initial Todos file. | |
4862 | (concat "Initial file name [" | |
4863 | todos-initial-file "]: "))) | |
4864 | ((eq type 'category) | |
4865 | (if categories | |
4866 | "Enter a non-empty category name: " | |
4867 | ;; Empty string passed by todos-show to | |
4868 | ;; prompt for initial category of a new | |
4869 | ;; Todos file. | |
4870 | (concat "Initial category name [" | |
4871 | todos-initial-category "]: ")))))) | |
4872 | ((string-match "\\`\\s-+\\'" name) | |
4873 | (setq prompt | |
4874 | "Enter a name that does not contain only white space: ")) | |
4875 | ((and (eq type 'file) (member name files)) | |
4876 | (setq prompt "Enter a non-existing file name: ")) | |
4877 | ((and (eq type 'category) (assoc name categories)) | |
4878 | (setq prompt "Enter a non-existing category name: "))) | |
4879 | (setq name (if (or (and (eq type 'file) files) | |
4880 | (and (eq type 'category) categories)) | |
4881 | (completing-read prompt (cond ((eq type 'file) | |
4882 | files) | |
4883 | ((eq type 'category) | |
4884 | categories))) | |
4885 | ;; Offer default initial name. | |
4886 | (completing-read prompt (if (eq type 'file) | |
4887 | files | |
4888 | categories) | |
4889 | nil nil (if (eq type 'file) | |
4890 | todos-initial-file | |
4891 | todos-initial-category)))))) | |
27139cd5 | 4892 | name)) |
f1806c78 | 4893 | |
27139cd5 SB |
4894 | ;; Adapted from calendar-read-date and calendar-date-string. |
4895 | (defun todos-read-date (&optional arg mo yr) | |
4896 | "Prompt for Gregorian date and return it in the current format. | |
f1806c78 | 4897 | |
27139cd5 SB |
4898 | With non-nil ARG, prompt for and return only the date component |
4899 | specified by ARG, which can be one of these symbols: | |
4900 | `month' (prompt for name, return name or number according to | |
4901 | value of `calendar-date-display-form'), `day' of month, or | |
4902 | `year'. The value of each of these components can be `*', | |
4903 | indicating an unspecified month, day, or year. | |
20166aea | 4904 | |
27139cd5 SB |
4905 | When ARG is `day', non-nil arguments MO and YR determine the |
4906 | number of the last the day of the month." | |
4907 | (let (year monthname month day | |
4908 | dayname) ; Needed by calendar-date-display-form. | |
4909 | (when (or (not arg) (eq arg 'year)) | |
4910 | (while (if (natnump year) (< year 1) (not (eq year '*))) | |
4911 | (setq year (read-from-minibuffer | |
4912 | "Year (>0 or RET for this year or * for any year): " | |
4913 | nil nil t nil (number-to-string | |
4914 | (calendar-extract-year | |
4915 | (calendar-current-date))))))) | |
4916 | (when (or (not arg) (eq arg 'month)) | |
4917 | (let* ((marray todos-month-name-array) | |
4918 | (mlist (append marray nil)) | |
4919 | (mabarray todos-month-abbrev-array) | |
4920 | (mablist (append mabarray nil)) | |
4921 | (completion-ignore-case todos-completion-ignore-case)) | |
4922 | (setq monthname (completing-read | |
4923 | "Month name (RET for current month, * for any month): " | |
4924 | ;; (mapcar 'list (append marray nil)) | |
4925 | mlist nil t nil nil | |
4926 | (calendar-month-name (calendar-extract-month | |
4927 | (calendar-current-date)) t)) | |
4928 | ;; month (cdr (assoc-string | |
4929 | ;; monthname (calendar-make-alist marray nil nil | |
4930 | ;; abbrevs)))))) | |
4931 | month (1+ (- (length mlist) | |
4932 | (length (or (member monthname mlist) | |
4933 | (member monthname mablist)))))) | |
4934 | (setq monthname (aref mabarray (1- month))))) | |
4935 | (when (or (not arg) (eq arg 'day)) | |
4936 | (let ((last (let ((mm (or month mo)) | |
4937 | (yy (or year yr))) | |
4938 | ;; If month is unspecified, use a month with 31 | |
4939 | ;; days for checking day of month input. Does | |
4940 | ;; Calendar do anything special when * is | |
4941 | ;; currently a shorter month? | |
4942 | (if (= mm 13) (setq mm 1)) | |
4943 | ;; If year is unspecified, use a leap year to | |
4944 | ;; allow Feb. 29. | |
4945 | (if (eq year '*) (setq yy 2012)) | |
4946 | (calendar-last-day-of-month mm yy)))) | |
4947 | (while (if (natnump day) (or (< day 1) (> day last)) (not (eq day '*))) | |
4948 | (setq day (read-from-minibuffer | |
4949 | (format "Day (1-%d or RET for today or * for any day): " | |
4950 | last) | |
4951 | nil nil t nil (number-to-string | |
4952 | (calendar-extract-day | |
4953 | (calendar-current-date)))))))) | |
4954 | ;; Stringify read values (monthname is already a string). | |
4955 | (and year (setq year (if (eq year '*) | |
4956 | (symbol-name '*) | |
4957 | (number-to-string year)))) | |
4958 | (and day (setq day (if (eq day '*) | |
4959 | (symbol-name '*) | |
4960 | (number-to-string day)))) | |
4961 | (and month (setq month (if (eq month '*) | |
4962 | (symbol-name '*) | |
4963 | (number-to-string month)))) | |
4964 | (if arg | |
4965 | (cond ((eq arg 'year) year) | |
4966 | ((eq arg 'day) day) | |
4967 | ((eq arg 'month) | |
4968 | (if (memq 'month calendar-date-display-form) | |
4969 | month | |
4970 | monthname))) | |
4971 | (mapconcat 'eval calendar-date-display-form "")))) | |
f1806c78 | 4972 | |
27139cd5 SB |
4973 | (defun todos-read-dayname () |
4974 | "Choose name of a day of the week with completion and return it." | |
4975 | (let ((completion-ignore-case todos-completion-ignore-case)) | |
4976 | (completing-read "Enter a day name: " | |
4977 | (append calendar-day-name-array nil) | |
4978 | nil t))) | |
4979 | ||
4980 | (defun todos-read-time () | |
4981 | "Prompt for and return a valid clock time as a string. | |
f1806c78 | 4982 | |
27139cd5 SB |
4983 | Valid time strings are those matching `diary-time-regexp'. |
4984 | Typing `<return>' at the prompt returns the current time, if the | |
4985 | user option `todos-always-add-time-string' is non-nil, otherwise | |
4986 | the empty string (i.e., no time string)." | |
4987 | (let (valid answer) | |
4988 | (while (not valid) | |
4989 | (setq answer (read-string "Enter a clock time: " nil nil | |
4990 | (when todos-always-add-time-string | |
4991 | (substring (current-time-string) 11 16)))) | |
4992 | (when (or (string= "" answer) | |
4993 | (string-match diary-time-regexp answer)) | |
4994 | (setq valid t))) | |
4995 | answer)) | |
20166aea | 4996 | |
a9b0e28e SB |
4997 | ;; ----------------------------------------------------------------------------- |
4998 | ;;; Todos Categories mode tabulation and sorting | |
4999 | ;; ----------------------------------------------------------------------------- | |
f1806c78 | 5000 | |
27139cd5 SB |
5001 | (defvar todos-categories-buffer "*Todos Categories*" |
5002 | "Name of buffer in Todos Categories mode.") | |
58c7641d | 5003 | |
27139cd5 SB |
5004 | (defun todos-longest-category-name-length (categories) |
5005 | "Return the length of the longest name in list CATEGORIES." | |
5006 | (let ((longest 0)) | |
5007 | (dolist (c categories longest) | |
5008 | (setq longest (max longest (length c)))))) | |
58c7641d | 5009 | |
27139cd5 SB |
5010 | (defun todos-adjusted-category-label-length () |
5011 | "Return adjusted length of category label button. | |
5012 | The adjustment ensures proper tabular alignment in Todos | |
5013 | Categories mode." | |
5014 | (let* ((categories (mapcar 'car todos-categories)) | |
5015 | (longest (todos-longest-category-name-length categories)) | |
5016 | (catlablen (length todos-categories-category-label)) | |
5017 | (lc-diff (- longest catlablen))) | |
a9b0e28e | 5018 | (if (and (natnump lc-diff) (cl-oddp lc-diff)) |
27139cd5 SB |
5019 | (1+ longest) |
5020 | (max longest catlablen)))) | |
0e89c3fc | 5021 | |
27139cd5 SB |
5022 | (defun todos-padded-string (str) |
5023 | "Return category name or label string STR padded with spaces. | |
5024 | The placement of the padding is determined by the value of user | |
5025 | option `todos-categories-align'." | |
5026 | (let* ((len (todos-adjusted-category-label-length)) | |
5027 | (strlen (length str)) | |
5028 | (strlen-odd (eq (logand strlen 1) 1)) | |
5029 | (padding (max 0 (/ (- len strlen) 2))) | |
5030 | (padding-left (cond ((eq todos-categories-align 'left) 0) | |
5031 | ((eq todos-categories-align 'center) padding) | |
5032 | ((eq todos-categories-align 'right) | |
5033 | (if strlen-odd (1+ (* padding 2)) (* padding 2))))) | |
5034 | (padding-right (cond ((eq todos-categories-align 'left) | |
5035 | (if strlen-odd (1+ (* padding 2)) (* padding 2))) | |
5036 | ((eq todos-categories-align 'center) | |
5037 | (if strlen-odd (1+ padding) padding)) | |
5038 | ((eq todos-categories-align 'right) 0)))) | |
5039 | (concat (make-string padding-left 32) str (make-string padding-right 32)))) | |
b28872ce | 5040 | |
27139cd5 SB |
5041 | (defvar todos-descending-counts nil |
5042 | "List of keys for category counts sorted in descending order.") | |
a2730169 | 5043 | |
27139cd5 SB |
5044 | (defun todos-sort (list &optional key) |
5045 | "Return a copy of LIST, possibly sorted according to KEY." | |
5046 | (let* ((l (copy-sequence list)) | |
5047 | (fn (if (eq key 'alpha) | |
5048 | (lambda (x) (upcase x)) ; Alphabetize case insensitively. | |
5049 | (lambda (x) (todos-get-count key x)))) | |
5050 | ;; Keep track of whether the last sort by key was descending or | |
5051 | ;; ascending. | |
5052 | (descending (member key todos-descending-counts)) | |
5053 | (cmp (if (eq key 'alpha) | |
5054 | 'string< | |
5055 | (if descending '< '>))) | |
5056 | (pred (lambda (s1 s2) (let ((t1 (funcall fn (car s1))) | |
5057 | (t2 (funcall fn (car s2)))) | |
5058 | (funcall cmp t1 t2))))) | |
5059 | (when key | |
5060 | (setq l (sort l pred)) | |
5061 | ;; Switch between descending and ascending sort order. | |
5062 | (if descending | |
5063 | (setq todos-descending-counts | |
5064 | (delete key todos-descending-counts)) | |
5065 | (push key todos-descending-counts))) | |
5066 | l)) | |
a2730169 | 5067 | |
27139cd5 SB |
5068 | (defun todos-display-sorted (type) |
5069 | "Keep point on the TYPE count sorting button just clicked." | |
5070 | (let ((opoint (point))) | |
5071 | (todos-update-categories-display type) | |
5072 | (goto-char opoint))) | |
0e89c3fc | 5073 | |
27139cd5 SB |
5074 | (defun todos-label-to-key (label) |
5075 | "Return symbol for sort key associated with LABEL." | |
5076 | (let (key) | |
5077 | (cond ((string= label todos-categories-category-label) | |
5078 | (setq key 'alpha)) | |
5079 | ((string= label todos-categories-todo-label) | |
5080 | (setq key 'todo)) | |
5081 | ((string= label todos-categories-diary-label) | |
5082 | (setq key 'diary)) | |
5083 | ((string= label todos-categories-done-label) | |
5084 | (setq key 'done)) | |
5085 | ((string= label todos-categories-archived-label) | |
5086 | (setq key 'archived))) | |
5087 | key)) | |
5088 | ||
5089 | (defun todos-insert-sort-button (label) | |
5090 | "Insert button for displaying categories sorted by item counts. | |
5091 | LABEL determines which type of count is sorted." | |
5092 | (setq str (if (string= label todos-categories-category-label) | |
5093 | (todos-padded-string label) | |
5094 | label)) | |
5095 | (setq beg (point)) | |
5096 | (setq end (+ beg (length str))) | |
5097 | (insert-button str 'face nil | |
5098 | 'action | |
5099 | `(lambda (button) | |
5100 | (let ((key (todos-label-to-key ,label))) | |
5101 | (if (and (member key todos-descending-counts) | |
5102 | (eq key 'alpha)) | |
5103 | (progn | |
5104 | ;; If display is alphabetical, switch back to | |
5105 | ;; category priority order. | |
5106 | (todos-display-sorted nil) | |
5107 | (setq todos-descending-counts | |
5108 | (delete key todos-descending-counts))) | |
5109 | (todos-display-sorted key))))) | |
5110 | (setq ovl (make-overlay beg end)) | |
5111 | (overlay-put ovl 'face 'todos-button)) | |
0e89c3fc | 5112 | |
27139cd5 SB |
5113 | (defun todos-total-item-counts () |
5114 | "Return a list of total item counts for the current file." | |
5115 | (mapcar (lambda (i) (apply '+ (mapcar (lambda (l) (aref l i)) | |
5116 | (mapcar 'cdr todos-categories)))) | |
5117 | (list 0 1 2 3))) | |
3f031767 | 5118 | |
27139cd5 SB |
5119 | (defvar todos-categories-category-number 0 |
5120 | "Variable for numbering categories in Todos Categories mode.") | |
5121 | ||
5122 | (defun todos-insert-category-line (cat &optional nonum) | |
5123 | "Insert button with category CAT's name and item counts. | |
5124 | With non-nil argument NONUM show only these; otherwise, insert a | |
5125 | number in front of the button indicating the category's priority. | |
5126 | The number and the category name are separated by the string | |
5127 | which is the value of the user option | |
5128 | `todos-categories-number-separator'." | |
5129 | (let ((archive (member todos-current-todos-file todos-archives)) | |
5130 | (num todos-categories-category-number) | |
5131 | (str (todos-padded-string cat)) | |
5132 | (opoint (point))) | |
5133 | (setq num (1+ num) todos-categories-category-number num) | |
5134 | (insert-button | |
5135 | (concat (if nonum | |
5136 | (make-string (+ 4 (length todos-categories-number-separator)) | |
5137 | 32) | |
5138 | (format " %3d%s" num todos-categories-number-separator)) | |
5139 | str | |
5140 | (mapconcat (lambda (elt) | |
5141 | (concat | |
5142 | (make-string (1+ (/ (length (car elt)) 2)) 32) ; label | |
5143 | (format "%3d" (todos-get-count (cdr elt) cat)) ; count | |
a9b0e28e SB |
5144 | ;; Add an extra space if label length is odd. |
5145 | (when (cl-oddp (length (car elt))) " "))) | |
27139cd5 SB |
5146 | (if archive |
5147 | (list (cons todos-categories-done-label 'done)) | |
5148 | (list (cons todos-categories-todo-label 'todo) | |
5149 | (cons todos-categories-diary-label 'diary) | |
5150 | (cons todos-categories-done-label 'done) | |
5151 | (cons todos-categories-archived-label | |
5152 | 'archived))) | |
5153 | "") | |
e99a2125 | 5154 | " ") ; Make highlighting on last column look better. |
27139cd5 SB |
5155 | 'face (if (and todos-skip-archived-categories |
5156 | (zerop (todos-get-count 'todo cat)) | |
5157 | (zerop (todos-get-count 'done cat)) | |
5158 | (not (zerop (todos-get-count 'archived cat)))) | |
5159 | 'todos-archived-only | |
5160 | nil) | |
5161 | 'action `(lambda (button) (let ((buf (current-buffer))) | |
5162 | (todos-jump-to-category nil ,cat) | |
5163 | (kill-buffer buf)))) | |
5164 | ;; Highlight the sorted count column. | |
5165 | (let* ((beg (+ opoint 7 (length str))) | |
5166 | end ovl) | |
5167 | (cond ((eq nonum 'todo) | |
5168 | (setq beg (+ beg 1 (/ (length todos-categories-todo-label) 2)))) | |
5169 | ((eq nonum 'diary) | |
5170 | (setq beg (+ beg 1 (length todos-categories-todo-label) | |
5171 | 2 (/ (length todos-categories-diary-label) 2)))) | |
5172 | ((eq nonum 'done) | |
5173 | (setq beg (+ beg 1 (length todos-categories-todo-label) | |
5174 | 2 (length todos-categories-diary-label) | |
5175 | 2 (/ (length todos-categories-done-label) 2)))) | |
5176 | ((eq nonum 'archived) | |
5177 | (setq beg (+ beg 1 (length todos-categories-todo-label) | |
5178 | 2 (length todos-categories-diary-label) | |
5179 | 2 (length todos-categories-done-label) | |
5180 | 2 (/ (length todos-categories-archived-label) 2))))) | |
5181 | (unless (= beg (+ opoint 7 (length str))) ; Don't highlight categories. | |
5182 | (setq end (+ beg 4)) | |
5183 | (setq ovl (make-overlay beg end)) | |
5184 | (overlay-put ovl 'face 'todos-sorted-column))) | |
5185 | (newline))) | |
5186 | ||
a9b0e28e | 5187 | (defun todos-display-categories () |
27139cd5 SB |
5188 | "Prepare buffer for displaying table of categories and item counts." |
5189 | (unless (eq major-mode 'todos-categories-mode) | |
5190 | (setq todos-global-current-todos-file | |
5191 | (or todos-current-todos-file | |
5192 | (todos-absolute-file-name todos-default-todos-file))) | |
5193 | (set-window-buffer (selected-window) | |
5194 | (set-buffer (get-buffer-create todos-categories-buffer))) | |
5195 | (kill-all-local-variables) | |
5196 | (todos-categories-mode) | |
5197 | (let ((archive (member todos-current-todos-file todos-archives)) | |
e99a2125 | 5198 | buffer-read-only) |
27139cd5 SB |
5199 | (erase-buffer) |
5200 | (insert (format (concat "Category counts for Todos " | |
5201 | (if archive "archive" "file") | |
5202 | " \"%s\".") | |
5203 | (todos-short-file-name todos-current-todos-file))) | |
5204 | (newline 2) | |
5205 | ;; Make space for the column of category numbers. | |
5206 | (insert (make-string (+ 4 (length todos-categories-number-separator)) 32)) | |
5207 | ;; Add the category and item count buttons (if this is the list of | |
5208 | ;; categories in an archive, show only done item counts). | |
5209 | (todos-insert-sort-button todos-categories-category-label) | |
5210 | (if archive | |
5211 | (progn | |
5212 | (insert (make-string 3 32)) | |
5213 | (todos-insert-sort-button todos-categories-done-label)) | |
5214 | (insert (make-string 3 32)) | |
5215 | (todos-insert-sort-button todos-categories-todo-label) | |
5216 | (insert (make-string 2 32)) | |
5217 | (todos-insert-sort-button todos-categories-diary-label) | |
5218 | (insert (make-string 2 32)) | |
5219 | (todos-insert-sort-button todos-categories-done-label) | |
5220 | (insert (make-string 2 32)) | |
5221 | (todos-insert-sort-button todos-categories-archived-label)) | |
5222 | (newline 2)))) | |
2c173503 | 5223 | |
27139cd5 | 5224 | (defun todos-update-categories-display (sortkey) |
a9b0e28e | 5225 | "Populate table of categories and sort by SORTKEY." |
27139cd5 SB |
5226 | (let* ((cats0 todos-categories) |
5227 | (cats (todos-sort cats0 sortkey)) | |
5228 | (archive (member todos-current-todos-file todos-archives)) | |
5229 | (todos-categories-category-number 0) | |
5230 | ;; Find start of Category button if we just entered Todos Categories | |
5231 | ;; mode. | |
5232 | (pt (if (eq (point) (point-max)) | |
5233 | (save-excursion | |
5234 | (forward-line -2) | |
5235 | (goto-char (next-single-char-property-change | |
5236 | (point) 'face nil (line-end-position)))))) | |
5237 | (buffer-read-only)) | |
5238 | (forward-line 2) | |
5239 | (delete-region (point) (point-max)) | |
5240 | ;; Fill in the table with buttonized lines, each showing a category and | |
5241 | ;; its item counts. | |
5242 | (mapc (lambda (cat) (todos-insert-category-line cat sortkey)) | |
5243 | (mapcar 'car cats)) | |
5244 | (newline) | |
5245 | ;; Add a line showing item count totals. | |
5246 | (insert (make-string (+ 4 (length todos-categories-number-separator)) 32) | |
5247 | (todos-padded-string todos-categories-totals-label) | |
5248 | (mapconcat | |
5249 | (lambda (elt) | |
5250 | (concat | |
5251 | (make-string (1+ (/ (length (car elt)) 2)) 32) | |
5252 | (format "%3d" (nth (cdr elt) (todos-total-item-counts))) | |
a9b0e28e SB |
5253 | ;; Add an extra space if label length is odd. |
5254 | (when (cl-oddp (length (car elt))) " "))) | |
27139cd5 SB |
5255 | (if archive |
5256 | (list (cons todos-categories-done-label 2)) | |
5257 | (list (cons todos-categories-todo-label 0) | |
5258 | (cons todos-categories-diary-label 1) | |
5259 | (cons todos-categories-done-label 2) | |
5260 | (cons todos-categories-archived-label 3))) | |
5261 | "")) | |
5262 | ;; Put cursor on Category button initially. | |
5263 | (if pt (goto-char pt)) | |
5264 | (setq buffer-read-only t))) | |
18aef8a3 | 5265 | |
a9b0e28e SB |
5266 | ;; ----------------------------------------------------------------------------- |
5267 | ;;; Item filtering selection and display | |
5268 | ;; ----------------------------------------------------------------------------- | |
a2730169 | 5269 | |
27139cd5 SB |
5270 | (defvar todos-multiple-filter-files nil |
5271 | "List of files selected from `todos-multiple-filter-files' widget.") | |
18aef8a3 | 5272 | |
27139cd5 SB |
5273 | (defvar todos-multiple-filter-files-widget nil |
5274 | "Variable holding widget created by `todos-multiple-filter-files'.") | |
5275 | ||
5276 | (defun todos-multiple-filter-files () | |
5277 | "Pop to a buffer with a widget for choosing multiple filter files." | |
5278 | (require 'widget) | |
5279 | (eval-when-compile | |
5280 | (require 'wid-edit)) | |
5281 | (with-current-buffer (get-buffer-create "*Todos Filter Files*") | |
5282 | (pop-to-buffer (current-buffer)) | |
5283 | (erase-buffer) | |
5284 | (kill-all-local-variables) | |
5285 | (widget-insert "Select files for generating the top priorities list.\n\n") | |
5286 | (setq todos-multiple-filter-files-widget | |
5287 | (widget-create | |
5288 | `(set ,@(mapcar (lambda (x) (list 'const x)) | |
5289 | (mapcar 'todos-short-file-name | |
5290 | (funcall todos-files-function)))))) | |
5291 | (widget-insert "\n") | |
5292 | (widget-create 'push-button | |
5293 | :notify (lambda (widget &rest ignore) | |
5294 | (setq todos-multiple-filter-files 'quit) | |
5295 | (quit-window t) | |
5296 | (exit-recursive-edit)) | |
5297 | "Cancel") | |
5298 | (widget-insert " ") | |
5299 | (widget-create 'push-button | |
5300 | :notify (lambda (&rest ignore) | |
5301 | (setq todos-multiple-filter-files | |
5302 | (mapcar (lambda (f) | |
5303 | (file-truename | |
5304 | (concat todos-directory | |
5305 | f ".todo"))) | |
5306 | (widget-value | |
5307 | todos-multiple-filter-files-widget))) | |
5308 | (quit-window t) | |
5309 | (exit-recursive-edit)) | |
5310 | "Apply") | |
5311 | (use-local-map widget-keymap) | |
5312 | (widget-setup)) | |
5313 | (message "Click \"Apply\" after selecting files.") | |
5314 | (recursive-edit)) | |
5315 | ||
5316 | (defun todos-filter-items (filter &optional new multifile) | |
a9b0e28e | 5317 | "Display a cross-categorial list of items filtered by FILTER. |
27139cd5 SB |
5318 | The values of FILTER can be `top' for top priority items, a cons |
5319 | of `top' and a number passed by the caller, `diary' for diary | |
5320 | items, or `regexp' for items matching a regular expresion entered | |
5321 | by the user. The items can be from any categories in the current | |
5322 | todo file or, with non-nil MULTIFILE, from several files. If NEW | |
5323 | is nil, visit an appropriate file containing the list of filtered | |
5324 | items; if there is no such file, or with non-nil NEW, build the | |
5325 | list and display it. | |
5326 | ||
a9b0e28e SB |
5327 | See the document strings of the commands |
5328 | `todos-filter-top-priorities', `todos-filter-diary-items', | |
5329 | `todos-filter-regexp-items', and those of the corresponding | |
5330 | multifile commands for further details." | |
27139cd5 SB |
5331 | (let* ((top (eq filter 'top)) |
5332 | (diary (eq filter 'diary)) | |
5333 | (regexp (eq filter 'regexp)) | |
5334 | (buf (cond (top todos-top-priorities-buffer) | |
5335 | (diary todos-diary-items-buffer) | |
5336 | (regexp todos-regexp-items-buffer))) | |
5337 | (flist (if multifile | |
5338 | (or todos-filter-files | |
5339 | (progn (todos-multiple-filter-files) | |
5340 | todos-multiple-filter-files)) | |
5341 | (list todos-current-todos-file))) | |
5342 | (multi (> (length flist) 1)) | |
5343 | (fname (if (equal flist 'quit) | |
5344 | ;; Pressed `cancel' in t-m-f-f file selection dialog. | |
5345 | (keyboard-quit) | |
5346 | (concat todos-directory | |
5347 | (mapconcat 'todos-short-file-name flist "-") | |
5348 | (cond (top ".todt") | |
5349 | (diary ".tody") | |
5350 | (regexp ".todr"))))) | |
5351 | (rxfiles (when regexp | |
5352 | (directory-files todos-directory t ".*\\.todr$" t))) | |
5353 | (file-exists (or (file-exists-p fname) rxfiles))) | |
5354 | (cond ((and top new (natnump new)) | |
5355 | (todos-filter-items-1 (cons 'top new) flist)) | |
5356 | ((and (not new) file-exists) | |
5357 | (when (and rxfiles (> (length rxfiles) 1)) | |
5358 | (let ((rxf (mapcar 'todos-short-file-name rxfiles))) | |
5359 | (setq fname (todos-absolute-file-name | |
5360 | (completing-read "Choose a regexp items file: " | |
5361 | rxf) 'regexp)))) | |
5362 | (find-file fname) | |
5363 | (todos-prefix-overlays) | |
5364 | (todos-check-filtered-items-file)) | |
5365 | (t | |
5366 | (todos-filter-items-1 filter flist))) | |
5367 | (setq fname (replace-regexp-in-string "-" ", " | |
5368 | (todos-short-file-name fname))) | |
5369 | (rename-buffer (format (concat "%s for file" (if multi "s" "") | |
5370 | " \"%s\"") buf fname)))) | |
5371 | ||
5372 | (defun todos-filter-items-1 (filter file-list) | |
a9b0e28e SB |
5373 | "Build a list of items by applying FILTER to FILE-LIST. |
5374 | Internal subroutine called by `todos-filter-items', which passes | |
5375 | the values of FILTER and FILE-LIST." | |
27139cd5 SB |
5376 | (let ((num (if (consp filter) (cdr filter) todos-top-priorities)) |
5377 | (buf (get-buffer-create todos-filtered-items-buffer)) | |
5378 | (multifile (> (length file-list) 1)) | |
5379 | regexp fname bufstr cat beg end done) | |
5380 | (if (null file-list) | |
a9b0e28e | 5381 | (user-error "No files have been chosen for filtering") |
27139cd5 SB |
5382 | (with-current-buffer buf |
5383 | (erase-buffer) | |
5384 | (kill-all-local-variables) | |
5385 | (todos-filtered-items-mode)) | |
5386 | (when (eq filter 'regexp) | |
5387 | (setq regexp (read-string "Enter a regular expression: "))) | |
5388 | (save-current-buffer | |
5389 | (dolist (f file-list) | |
5390 | ;; Before inserting file contents into temp buffer, save a modified | |
5391 | ;; buffer visiting it. | |
5392 | (let ((bf (find-buffer-visiting f))) | |
5393 | (when (buffer-modified-p bf) | |
5394 | (with-current-buffer bf (save-buffer)))) | |
5395 | (setq fname (todos-short-file-name f)) | |
5396 | (with-temp-buffer | |
5397 | (when (and todos-filter-done-items (eq filter 'regexp)) | |
e99a2125 SB |
5398 | ;; If there is a corresponding archive file for the |
5399 | ;; Todos file, insert it first and add identifiers for | |
5400 | ;; todos-go-to-source-item. | |
27139cd5 SB |
5401 | (let ((arch (concat (file-name-sans-extension f) ".toda"))) |
5402 | (when (file-exists-p arch) | |
5403 | (insert-file-contents arch) | |
5404 | ;; Delete Todos archive file categories sexp. | |
5405 | (delete-region (line-beginning-position) | |
5406 | (1+ (line-end-position))) | |
5407 | (save-excursion | |
5408 | (while (not (eobp)) | |
18aef8a3 | 5409 | (when (re-search-forward |
27139cd5 SB |
5410 | (concat (if todos-filter-done-items |
5411 | (concat "\\(?:" todos-done-string-start | |
5412 | "\\|" todos-date-string-start | |
5413 | "\\)") | |
5414 | todos-date-string-start) | |
5415 | todos-date-pattern "\\(?: " | |
5416 | diary-time-regexp "\\)?" | |
5417 | (if todos-filter-done-items | |
5418 | "\\]" | |
5419 | (regexp-quote todos-nondiary-end)) "?") | |
18aef8a3 | 5420 | nil t) |
27139cd5 SB |
5421 | (insert "(archive) ")) |
5422 | (forward-line)))))) | |
5423 | (insert-file-contents f) | |
5424 | ;; Delete Todos file categories sexp. | |
5425 | (delete-region (line-beginning-position) (1+ (line-end-position))) | |
5426 | (let (fnum) | |
5427 | ;; Unless the number of top priorities to show was | |
5428 | ;; passed by the caller, the file-wide value from | |
5429 | ;; `todos-top-priorities-overrides', if non-nil, overrides | |
5430 | ;; `todos-top-priorities'. | |
5431 | (unless (consp filter) | |
5432 | (setq fnum (or (nth 1 (assoc f todos-top-priorities-overrides)) | |
5433 | todos-top-priorities))) | |
5434 | (while (re-search-forward | |
e99a2125 SB |
5435 | (concat "^" (regexp-quote todos-category-beg) |
5436 | "\\(.+\\)\n") nil t) | |
27139cd5 SB |
5437 | (setq cat (match-string 1)) |
5438 | (let (cnum) | |
5439 | ;; Unless the number of top priorities to show was | |
5440 | ;; passed by the caller, the category-wide value | |
5441 | ;; from `todos-top-priorities-overrides', if non-nil, | |
5442 | ;; overrides a non-nil file-wide value from | |
5443 | ;; `todos-top-priorities-overrides' as well as | |
5444 | ;; `todos-top-priorities'. | |
5445 | (unless (consp filter) | |
5446 | (let ((cats (nth 2 (assoc f todos-top-priorities-overrides)))) | |
5447 | (setq cnum (or (cdr (assoc cat cats)) fnum)))) | |
5448 | (delete-region (match-beginning 0) (match-end 0)) | |
5449 | (setq beg (point)) ; First item in the current category. | |
5450 | (setq end (if (re-search-forward | |
5451 | (concat "^" (regexp-quote todos-category-beg)) | |
5452 | nil t) | |
5453 | (match-beginning 0) | |
5454 | (point-max))) | |
5455 | (goto-char beg) | |
5456 | (setq done | |
5457 | (if (re-search-forward | |
5458 | (concat "\n" (regexp-quote todos-category-done)) | |
5459 | end t) | |
5460 | (match-beginning 0) | |
5461 | end)) | |
5462 | (unless (and todos-filter-done-items (eq filter 'regexp)) | |
5463 | ;; Leave done items. | |
5464 | (delete-region done end) | |
5465 | (setq end done)) | |
5466 | (narrow-to-region beg end) ; Process only current category. | |
5467 | (goto-char (point-min)) | |
5468 | ;; Apply the filter. | |
5469 | (cond ((eq filter 'diary) | |
5470 | (while (not (eobp)) | |
5471 | (if (looking-at (regexp-quote todos-nondiary-start)) | |
5472 | (todos-remove-item) | |
5473 | (todos-forward-item)))) | |
5474 | ((eq filter 'regexp) | |
5475 | (while (not (eobp)) | |
5476 | (if (looking-at todos-item-start) | |
5477 | (if (string-match regexp (todos-item-string)) | |
5478 | (todos-forward-item) | |
5479 | (todos-remove-item)) | |
5480 | ;; Kill lines that aren't part of a todo or done | |
5481 | ;; item (empty or todos-category-done). | |
5482 | (delete-region (line-beginning-position) | |
5483 | (1+ (line-end-position)))) | |
5484 | ;; If last todo item in file matches regexp and | |
5485 | ;; there are no following done items, | |
5486 | ;; todos-category-done string is left dangling, | |
5487 | ;; because todos-forward-item jumps over it. | |
5488 | (if (and (eobp) | |
5489 | (looking-back | |
5490 | (concat (regexp-quote todos-done-string) | |
5491 | "\n"))) | |
5492 | (delete-region (point) (progn | |
5493 | (forward-line -2) | |
5494 | (point)))))) | |
5495 | (t ; Filter top priority items. | |
5496 | (setq num (or cnum fnum num)) | |
5497 | (unless (zerop num) | |
5498 | (todos-forward-item num)))) | |
5499 | (setq beg (point)) | |
5500 | ;; Delete non-top-priority items. | |
5501 | (unless (member filter '(diary regexp)) | |
5502 | (delete-region beg end)) | |
5503 | (goto-char (point-min)) | |
5504 | ;; Add file (if using multiple files) and category tags to | |
5505 | ;; item. | |
5506 | (while (not (eobp)) | |
5507 | (when (re-search-forward | |
5508 | (concat (if todos-filter-done-items | |
5509 | (concat "\\(?:" todos-done-string-start | |
5510 | "\\|" todos-date-string-start | |
5511 | "\\)") | |
5512 | todos-date-string-start) | |
5513 | todos-date-pattern "\\(?: " diary-time-regexp | |
5514 | "\\)?" (if todos-filter-done-items | |
5515 | "\\]" | |
5516 | (regexp-quote todos-nondiary-end)) | |
5517 | "?") | |
5518 | nil t) | |
5519 | (insert " [") | |
5520 | (when (looking-at "(archive) ") (goto-char (match-end 0))) | |
5521 | (insert (if multifile (concat fname ":") "") cat "]")) | |
5522 | (forward-line)) | |
5523 | (widen))) | |
5524 | (setq bufstr (buffer-string)) | |
5525 | (with-current-buffer buf | |
5526 | (let (buffer-read-only) | |
5527 | (insert bufstr))))))) | |
5528 | (set-window-buffer (selected-window) (set-buffer buf)) | |
5529 | (todos-prefix-overlays) | |
5530 | (goto-char (point-min))))) | |
2c173503 | 5531 | |
27139cd5 SB |
5532 | (defun todos-set-top-priorities (&optional arg) |
5533 | "Set number of top priorities shown by `todos-filter-top-priorities'. | |
5534 | With non-nil ARG, set the number only for the current Todos | |
5535 | category; otherwise, set the number for all categories in the | |
5536 | current Todos file. | |
616ffa8b | 5537 | |
27139cd5 SB |
5538 | Calling this function via either of the commands |
5539 | `todos-set-top-priorities-in-file' or | |
5540 | `todos-set-top-priorities-in-category' is the recommended way to | |
5541 | set the user customizable option `todos-top-priorities-overrides'." | |
5542 | (let* ((cat (todos-current-category)) | |
5543 | (file todos-current-todos-file) | |
5544 | (rules todos-top-priorities-overrides) | |
5545 | (frule (assoc-string file rules)) | |
5546 | (crule (assoc-string cat (nth 2 frule))) | |
5547 | (crules (nth 2 frule)) | |
5548 | (cur (or (if arg (cdr crule) (nth 1 frule)) | |
5549 | todos-top-priorities)) | |
5550 | (prompt (if arg (concat "Number of top priorities in this category" | |
5551 | " (currently %d): ") | |
5552 | (concat "Default number of top priorities per category" | |
5553 | " in this file (currently %d): "))) | |
5554 | (new -1) | |
5555 | nrule) | |
5556 | (while (< new 0) | |
5557 | (let ((cur0 cur)) | |
5558 | (setq new (read-number (format prompt cur0)) | |
5559 | prompt "Enter a non-negative number: " | |
5560 | cur0 nil))) | |
5561 | (setq nrule (if arg | |
5562 | (append (delete crule crules) (list (cons cat new))) | |
5563 | (append (list file new) (list crules)))) | |
5564 | (setq rules (cons (if arg | |
5565 | (list file cur nrule) | |
5566 | nrule) | |
5567 | (delete frule rules))) | |
5568 | (customize-save-variable 'todos-top-priorities-overrides rules) | |
5569 | (todos-prefix-overlays))) | |
b28872ce | 5570 | |
27139cd5 SB |
5571 | (defconst todos-filtered-items-buffer "Todos filtered items" |
5572 | "Initial name of buffer in Todos Filter Items mode.") | |
b28872ce | 5573 | |
27139cd5 SB |
5574 | (defconst todos-top-priorities-buffer "Todos top priorities" |
5575 | "Buffer type string for `todos-filter-items'.") | |
b28872ce | 5576 | |
27139cd5 SB |
5577 | (defconst todos-diary-items-buffer "Todos diary items" |
5578 | "Buffer type string for `todos-filter-items'.") | |
b28872ce | 5579 | |
27139cd5 SB |
5580 | (defconst todos-regexp-items-buffer "Todos regexp items" |
5581 | "Buffer type string for `todos-filter-items'.") | |
f730d273 | 5582 | |
27139cd5 SB |
5583 | (defun todos-find-item (str) |
5584 | "Search for filtered item STR in its saved Todos file. | |
5585 | Return the list (FOUND FILE CAT), where CAT and FILE are the | |
5586 | item's category and file, and FOUND is a cons cell if the search | |
5587 | succeeds, whose car is the start of the item in FILE and whose | |
5588 | cdr is `done', if the item is now a done item, `changed', if its | |
5589 | text was truncated or augmented or, for a top priority item, if | |
5590 | its priority has changed, and `same' otherwise." | |
5591 | (string-match (concat (if todos-filter-done-items | |
5592 | (concat "\\(?:" todos-done-string-start "\\|" | |
5593 | todos-date-string-start "\\)") | |
5594 | todos-date-string-start) | |
5595 | todos-date-pattern "\\(?: " diary-time-regexp "\\)?" | |
5596 | (if todos-filter-done-items | |
5597 | "\\]" | |
5598 | (regexp-quote todos-nondiary-end)) "?" | |
5599 | "\\(?4: \\[\\(?3:(archive) \\)?\\(?2:.*:\\)?" | |
5600 | "\\(?1:.*\\)\\]\\).*$") str) | |
5601 | (let ((cat (match-string 1 str)) | |
5602 | (file (match-string 2 str)) | |
5603 | (archive (string= (match-string 3 str) "(archive) ")) | |
5604 | (filcat (match-string 4 str)) | |
5605 | (tpriority 1) | |
5606 | (tpbuf (save-match-data (string-match "top" (buffer-name)))) | |
5607 | found) | |
5608 | (setq str (replace-match "" nil nil str 4)) | |
5609 | (when tpbuf | |
5610 | ;; Calculate priority of STR wrt its category. | |
5611 | (save-excursion | |
5612 | (while (search-backward filcat nil t) | |
5613 | (setq tpriority (1+ tpriority))))) | |
5614 | (setq file (if file | |
5615 | (concat todos-directory (substring file 0 -1) | |
5616 | (if archive ".toda" ".todo")) | |
5617 | (if archive | |
5618 | (concat (file-name-sans-extension | |
5619 | todos-global-current-todos-file) ".toda") | |
5620 | todos-global-current-todos-file))) | |
5621 | (find-file-noselect file) | |
5622 | (with-current-buffer (find-buffer-visiting file) | |
5623 | (save-restriction | |
5624 | (widen) | |
5625 | (goto-char (point-min)) | |
5626 | (let ((beg (re-search-forward | |
5627 | (concat "^" (regexp-quote (concat todos-category-beg cat)) | |
5628 | "$") | |
5629 | nil t)) | |
5630 | (done (save-excursion | |
5631 | (re-search-forward | |
5632 | (concat "^" (regexp-quote todos-category-done)) nil t))) | |
5633 | (end (save-excursion | |
5634 | (or (re-search-forward | |
5635 | (concat "^" (regexp-quote todos-category-beg)) | |
5636 | nil t) | |
5637 | (point-max))))) | |
5638 | (setq found (when (search-forward str end t) | |
5639 | (goto-char (match-beginning 0)))) | |
5640 | (when found | |
5641 | (setq found | |
5642 | (cons found (if (> (point) done) | |
5643 | 'done | |
5644 | (let ((cpriority 1)) | |
5645 | (when tpbuf | |
5646 | (save-excursion | |
5647 | ;; Not top item in category. | |
5648 | (while (> (point) (1+ beg)) | |
5649 | (let ((opoint (point))) | |
5650 | (todos-backward-item) | |
5651 | ;; Can't move backward beyond | |
5652 | ;; first item in file. | |
5653 | (unless (= (point) opoint) | |
5654 | (setq cpriority (1+ cpriority))))))) | |
5655 | (if (and (= tpriority cpriority) | |
5656 | ;; Proper substring is not the same. | |
5657 | (string= (todos-item-string) | |
5658 | str)) | |
5659 | 'same | |
5660 | 'changed))))))))) | |
5661 | (list found file cat))) | |
d04d6b95 | 5662 | |
27139cd5 SB |
5663 | (defun todos-check-filtered-items-file () |
5664 | "Check if filtered items file is up to date and a show suitable message." | |
5665 | ;; (catch 'old | |
5666 | (let ((count 0)) | |
5667 | (while (not (eobp)) | |
5668 | (let* ((item (todos-item-string)) | |
5669 | (found (car (todos-find-item item)))) | |
5670 | (unless (eq (cdr found) 'same) | |
5671 | (save-excursion | |
5672 | (overlay-put (make-overlay (todos-item-start) (todos-item-end)) | |
5673 | 'face 'todos-search)) | |
5674 | (setq count (1+ count)))) | |
5675 | ;; (throw 'old (message "The marked item is not up to date."))) | |
5676 | (todos-forward-item)) | |
5677 | (if (zerop count) | |
5678 | (message "Filtered items file is up to date.") | |
5679 | (message (concat "The highlighted item" (if (= count 1) " is " "s are ") | |
5680 | "not up to date." | |
5681 | ;; "\nType <return> on item for details." | |
5682 | ))))) | |
58c7641d | 5683 | |
27139cd5 SB |
5684 | (defun todos-filter-items-filename () |
5685 | "Return absolute file name for saving this Filtered Items buffer." | |
5686 | (let ((bufname (buffer-name))) | |
5687 | (string-match "\"\\([^\"]+\\)\"" bufname) | |
5688 | (let* ((filename-str (substring bufname (match-beginning 1) (match-end 1))) | |
5689 | (filename-base (replace-regexp-in-string ", " "-" filename-str)) | |
5690 | (top-priorities (string-match "top priorities" bufname)) | |
5691 | (diary-items (string-match "diary items" bufname)) | |
5692 | (regexp-items (string-match "regexp items" bufname))) | |
5693 | (when regexp-items | |
5694 | (let ((prompt (concat "Enter a short identifying string" | |
5695 | " to make this file name unique: "))) | |
5696 | (setq filename-base (concat filename-base "-" (read-string prompt))))) | |
5697 | (concat todos-directory filename-base | |
5698 | (cond (top-priorities ".todt") | |
5699 | (diary-items ".tody") | |
5700 | (regexp-items ".todr")))))) | |
d04d6b95 | 5701 | |
27139cd5 SB |
5702 | (defun todos-save-filtered-items-buffer () |
5703 | "Save current Filtered Items buffer to a file. | |
5704 | If the file already exists, overwrite it only on confirmation." | |
5705 | (let ((filename (or (buffer-file-name) (todos-filter-items-filename)))) | |
5706 | (write-file filename t))) | |
58c7641d | 5707 | |
a9b0e28e | 5708 | ;; ----------------------------------------------------------------------------- |
27139cd5 | 5709 | ;;; Customization groups and set functions |
a9b0e28e | 5710 | ;; ----------------------------------------------------------------------------- |
58c7641d | 5711 | |
27139cd5 SB |
5712 | (defgroup todos nil |
5713 | "Create and maintain categorized lists of todo items." | |
5714 | :link '(emacs-commentary-link "todos") | |
53e63b4c | 5715 | :version "24.4" |
27139cd5 SB |
5716 | :group 'calendar) |
5717 | ||
53e63b4c SB |
5718 | (defgroup todos-edit nil |
5719 | "User options for adding and editing todo items." | |
5720 | :version "24.4" | |
27139cd5 SB |
5721 | :group 'todos) |
5722 | ||
5723 | (defgroup todos-categories nil | |
5724 | "User options for Todos Categories mode." | |
53e63b4c | 5725 | :version "24.4" |
27139cd5 | 5726 | :group 'todos) |
58c7641d | 5727 | |
27139cd5 SB |
5728 | (defgroup todos-filtered nil |
5729 | "User options for Todos Filter Items mode." | |
53e63b4c | 5730 | :version "24.4" |
27139cd5 SB |
5731 | :group 'todos) |
5732 | ||
53e63b4c | 5733 | (defgroup todos-display nil |
27139cd5 | 5734 | "User display options for Todos mode." |
53e63b4c | 5735 | :version "24.4" |
27139cd5 SB |
5736 | :group 'todos) |
5737 | ||
5738 | (defgroup todos-faces nil | |
5739 | "Faces for the Todos modes." | |
53e63b4c | 5740 | :version "24.4" |
27139cd5 SB |
5741 | :group 'todos) |
5742 | ||
5743 | (defun todos-set-show-current-file (symbol value) | |
5744 | "The :set function for user option `todos-show-current-file'." | |
5745 | (custom-set-default symbol value) | |
5746 | (if value | |
5747 | (add-hook 'pre-command-hook 'todos-show-current-file nil t) | |
5748 | (remove-hook 'pre-command-hook 'todos-show-current-file t))) | |
5749 | ||
5750 | (defun todos-reset-prefix (symbol value) | |
5751 | "The :set function for `todos-prefix' and `todos-number-prefix'." | |
5752 | (let ((oldvalue (symbol-value symbol)) | |
5753 | (files todos-file-buffers)) | |
5754 | (custom-set-default symbol value) | |
5755 | (when (not (equal value oldvalue)) | |
5756 | (dolist (f files) | |
5757 | (with-current-buffer (find-file-noselect f) | |
5758 | ;; Activate the new setting in the current category. | |
5759 | (save-excursion (todos-category-select))))))) | |
5760 | ||
5761 | (defun todos-reset-nondiary-marker (symbol value) | |
5762 | "The :set function for user option `todos-nondiary-marker'." | |
5763 | (let ((oldvalue (symbol-value symbol)) | |
5764 | (files (append todos-files todos-archives))) | |
5765 | (custom-set-default symbol value) | |
5766 | ;; Need to reset these to get font-locking right. | |
5767 | (setq todos-nondiary-start (nth 0 todos-nondiary-marker) | |
5768 | todos-nondiary-end (nth 1 todos-nondiary-marker) | |
5769 | todos-date-string-start | |
5770 | ;; See comment in defvar of `todos-date-string-start'. | |
5771 | (concat "^\\(" (regexp-quote todos-nondiary-start) "\\|" | |
5772 | (regexp-quote diary-nonmarking-symbol) "\\)?")) | |
5773 | (when (not (equal value oldvalue)) | |
5774 | (dolist (f files) | |
5775 | (with-current-buffer (find-file-noselect f) | |
5776 | (let (buffer-read-only) | |
5777 | (widen) | |
5778 | (goto-char (point-min)) | |
5779 | (while (not (eobp)) | |
5780 | (if (re-search-forward | |
5781 | (concat "^\\(" todos-done-string-start "[^][]+] \\)?" | |
5782 | "\\(?1:" (regexp-quote (car oldvalue)) | |
5783 | "\\)" todos-date-pattern "\\( " | |
5784 | diary-time-regexp "\\)?\\(?2:" | |
5785 | (regexp-quote (cadr oldvalue)) "\\)") | |
5786 | nil t) | |
aa91082d | 5787 | (progn |
27139cd5 SB |
5788 | (replace-match (nth 0 value) t t nil 1) |
5789 | (replace-match (nth 1 value) t t nil 2)) | |
5790 | (forward-line))) | |
5791 | (todos-category-select))))))) | |
d04d6b95 | 5792 | |
27139cd5 SB |
5793 | (defun todos-reset-done-separator-string (symbol value) |
5794 | "The :set function for `todos-done-separator-string'." | |
5795 | (let ((oldvalue (symbol-value symbol)) | |
5796 | (files todos-file-buffers) | |
5797 | (sep todos-done-separator)) | |
5798 | (custom-set-default symbol value) | |
5799 | (when (not (equal value oldvalue)) | |
5800 | (dolist (f files) | |
5801 | (with-current-buffer (find-file-noselect f) | |
5802 | (let (buffer-read-only) | |
5803 | (setq todos-done-separator (todos-done-separator)) | |
5804 | (when (= 1 (length value)) | |
5805 | (todos-reset-done-separator sep))) | |
5806 | (todos-category-select)))))) | |
5807 | ||
5808 | (defun todos-reset-done-string (symbol value) | |
5809 | "The :set function for user option `todos-done-string'." | |
5810 | (let ((oldvalue (symbol-value symbol)) | |
5811 | (files (append todos-files todos-archives))) | |
5812 | (custom-set-default symbol value) | |
5813 | ;; Need to reset this to get font-locking right. | |
5814 | (setq todos-done-string-start | |
5815 | (concat "^\\[" (regexp-quote todos-done-string))) | |
5816 | (when (not (equal value oldvalue)) | |
5817 | (dolist (f files) | |
5818 | (with-current-buffer (find-file-noselect f) | |
5819 | (let (buffer-read-only) | |
5820 | (widen) | |
5821 | (goto-char (point-min)) | |
5822 | (while (not (eobp)) | |
5823 | (if (re-search-forward | |
5824 | (concat "^" (regexp-quote todos-nondiary-start) | |
5825 | "\\(" (regexp-quote oldvalue) "\\)") | |
5826 | nil t) | |
5827 | (replace-match value t t nil 1) | |
5828 | (forward-line))) | |
5829 | (todos-category-select))))))) | |
fd6c6328 | 5830 | |
27139cd5 SB |
5831 | (defun todos-reset-comment-string (symbol value) |
5832 | "The :set function for user option `todos-comment-string'." | |
5833 | (let ((oldvalue (symbol-value symbol)) | |
5834 | (files (append todos-files todos-archives))) | |
5835 | (custom-set-default symbol value) | |
5836 | (when (not (equal value oldvalue)) | |
5837 | (dolist (f files) | |
5838 | (with-current-buffer (find-file-noselect f) | |
5839 | (let (buffer-read-only) | |
5840 | (save-excursion | |
5841 | (widen) | |
5842 | (goto-char (point-min)) | |
5843 | (while (not (eobp)) | |
5844 | (if (re-search-forward | |
5845 | (concat | |
5846 | "\\[\\(" (regexp-quote oldvalue) "\\): [^]]*\\]") | |
5847 | nil t) | |
5848 | (replace-match value t t nil 1) | |
5849 | (forward-line))) | |
5850 | (todos-category-select)))))))) | |
2c173503 | 5851 | |
27139cd5 SB |
5852 | (defun todos-reset-highlight-item (symbol value) |
5853 | "The :set function for `todos-toggle-item-highlighting'." | |
5854 | (let ((oldvalue (symbol-value symbol)) | |
5855 | (files (append todos-files todos-archives))) | |
5856 | (custom-set-default symbol value) | |
5857 | (when (not (equal value oldvalue)) | |
5858 | (dolist (f files) | |
5859 | (let ((buf (find-buffer-visiting f))) | |
5860 | (when buf | |
5861 | (with-current-buffer buf | |
5862 | (require 'hl-line) | |
5863 | (if value | |
5864 | (hl-line-mode 1) | |
5865 | (hl-line-mode -1))))))))) | |
d04d6b95 | 5866 | |
a9b0e28e | 5867 | ;; ----------------------------------------------------------------------------- |
27139cd5 | 5868 | ;;; Font locking |
a9b0e28e | 5869 | ;; ----------------------------------------------------------------------------- |
3f031767 | 5870 | |
27139cd5 SB |
5871 | (defun todos-date-string-matcher (lim) |
5872 | "Search for Todos date string within LIM for font-locking." | |
5873 | (re-search-forward | |
5874 | (concat todos-date-string-start "\\(?1:" todos-date-pattern "\\)") lim t)) | |
d16da867 | 5875 | |
27139cd5 SB |
5876 | (defun todos-time-string-matcher (lim) |
5877 | "Search for Todos time string within LIM for font-locking." | |
5878 | (re-search-forward (concat todos-date-string-start todos-date-pattern | |
5879 | " \\(?1:" diary-time-regexp "\\)") lim t)) | |
5880 | ||
5881 | (defun todos-nondiary-marker-matcher (lim) | |
5882 | "Search for Todos nondiary markers within LIM for font-locking." | |
5883 | (re-search-forward (concat "^\\(?1:" (regexp-quote todos-nondiary-start) "\\)" | |
5884 | todos-date-pattern "\\(?: " diary-time-regexp | |
5885 | "\\)?\\(?2:" (regexp-quote todos-nondiary-end) "\\)") | |
5886 | lim t)) | |
d16da867 | 5887 | |
27139cd5 SB |
5888 | (defun todos-diary-nonmarking-matcher (lim) |
5889 | "Search for diary nonmarking symbol within LIM for font-locking." | |
5890 | (re-search-forward (concat "^\\(?1:" (regexp-quote diary-nonmarking-symbol) | |
5891 | "\\)" todos-date-pattern) lim t)) | |
d16da867 | 5892 | |
27139cd5 SB |
5893 | (defun todos-diary-expired-matcher (lim) |
5894 | "Search for expired diary item date within LIM for font-locking." | |
5895 | (when (re-search-forward (concat "^\\(?:" | |
5896 | (regexp-quote diary-nonmarking-symbol) | |
5897 | "\\)?\\(?1:" todos-date-pattern "\\) \\(?2:" | |
5898 | diary-time-regexp "\\)?") lim t) | |
5899 | (let* ((date (match-string-no-properties 1)) | |
5900 | (time (match-string-no-properties 2)) | |
5901 | ;; Function days-between requires a non-empty time string. | |
5902 | (date-time (concat date " " (or time "00:00")))) | |
5903 | (or (and (not (string-match ".+day\\|\\*" date)) | |
5904 | (< (days-between date-time (current-time-string)) 0)) | |
5905 | (todos-diary-expired-matcher lim))))) | |
58c7641d | 5906 | |
27139cd5 SB |
5907 | (defun todos-done-string-matcher (lim) |
5908 | "Search for Todos done header within LIM for font-locking." | |
5909 | (re-search-forward (concat todos-done-string-start | |
5910 | "[^][]+]") | |
5911 | lim t)) | |
d16da867 | 5912 | |
27139cd5 SB |
5913 | (defun todos-comment-string-matcher (lim) |
5914 | "Search for Todos done comment within LIM for font-locking." | |
5915 | (re-search-forward (concat "\\[\\(?1:" todos-comment-string "\\):") | |
5916 | lim t)) | |
58c7641d | 5917 | |
27139cd5 SB |
5918 | (defun todos-category-string-matcher-1 (lim) |
5919 | "Search for Todos category name within LIM for font-locking. | |
5920 | This is for fontifying category and file names appearing in Todos | |
5921 | Filtered Items mode following done items." | |
5922 | (if (eq major-mode 'todos-filtered-items-mode) | |
5923 | (re-search-forward (concat todos-done-string-start todos-date-pattern | |
5924 | "\\(?: " diary-time-regexp | |
5925 | ;; Use non-greedy operator to prevent | |
5926 | ;; capturing possible following non-diary | |
5927 | ;; date string. | |
5928 | "\\)?] \\(?1:\\[.+?\\]\\)") | |
5929 | lim t))) | |
d16da867 | 5930 | |
27139cd5 SB |
5931 | (defun todos-category-string-matcher-2 (lim) |
5932 | "Search for Todos category name within LIM for font-locking. | |
5933 | This is for fontifying category and file names appearing in Todos | |
5934 | Filtered Items mode following todo (not done) items." | |
5935 | (if (eq major-mode 'todos-filtered-items-mode) | |
5936 | (re-search-forward (concat todos-date-string-start todos-date-pattern | |
5937 | "\\(?: " diary-time-regexp "\\)?\\(?:" | |
5938 | (regexp-quote todos-nondiary-end) | |
5939 | "\\)? \\(?1:\\[.+\\]\\)") | |
5940 | lim t))) | |
d16da867 | 5941 | |
a9b0e28e SB |
5942 | (defvar todos-diary-expired-face 'todos-diary-expired) |
5943 | (defvar todos-date-face 'todos-date) | |
5944 | (defvar todos-time-face 'todos-time) | |
5945 | (defvar todos-nondiary-face 'todos-nondiary) | |
5946 | (defvar todos-category-string-face 'todos-category-string) | |
5947 | (defvar todos-done-face 'todos-done) | |
5948 | (defvar todos-comment-face 'todos-comment) | |
5949 | (defvar todos-done-sep-face 'todos-done-sep) | |
5950 | ||
27139cd5 SB |
5951 | (defvar todos-font-lock-keywords |
5952 | (list | |
5953 | '(todos-nondiary-marker-matcher 1 todos-nondiary-face t) | |
5954 | '(todos-nondiary-marker-matcher 2 todos-nondiary-face t) | |
5955 | ;; diary-lib.el uses font-lock-constant-face for diary-nonmarking-symbol. | |
5956 | '(todos-diary-nonmarking-matcher 1 font-lock-constant-face t) | |
5957 | '(todos-date-string-matcher 1 todos-date-face t) | |
5958 | '(todos-time-string-matcher 1 todos-time-face t) | |
5959 | '(todos-done-string-matcher 0 todos-done-face t) | |
5960 | '(todos-comment-string-matcher 1 todos-comment-face t) | |
5961 | '(todos-category-string-matcher-1 1 todos-category-string-face t t) | |
5962 | '(todos-category-string-matcher-2 1 todos-category-string-face t t) | |
5963 | '(todos-diary-expired-matcher 1 todos-diary-expired-face t) | |
5964 | '(todos-diary-expired-matcher 2 todos-diary-expired-face t t) | |
5965 | ) | |
5966 | "Font-locking for Todos modes.") | |
d16da867 | 5967 | |
a9b0e28e | 5968 | ;; ----------------------------------------------------------------------------- |
27139cd5 | 5969 | ;;; Key maps and menus |
a9b0e28e | 5970 | ;; ----------------------------------------------------------------------------- |
d16da867 | 5971 | |
27139cd5 SB |
5972 | (defvar todos-insertion-map |
5973 | (let ((map (make-keymap))) | |
5974 | (todos-insertion-key-bindings map) | |
5975 | (define-key map "p" 'todos-copy-item) | |
5976 | map) | |
5977 | "Keymap for Todos mode item insertion commands.") | |
58c7641d | 5978 | |
a9b0e28e | 5979 | (defvar todos-key-bindings-t |
27139cd5 | 5980 | `( |
a9b0e28e SB |
5981 | ("Af" todos-find-archive) |
5982 | ("Ac" todos-choose-archive) | |
5983 | ("Ad" todos-archive-done-item) | |
5984 | ("Cv" todos-toggle-view-done-items) | |
5985 | ("v" todos-toggle-view-done-items) | |
5986 | ("Ca" todos-add-category) | |
5987 | ("Cr" todos-rename-category) | |
5988 | ("Cg" todos-merge-category) | |
5989 | ("Cm" todos-move-category) | |
5990 | ("Ck" todos-delete-category) | |
5991 | ("Cts" todos-set-top-priorities-in-category) | |
5992 | ("Cey" todos-edit-category-diary-inclusion) | |
5993 | ("Cek" todos-edit-category-diary-nonmarking) | |
5994 | ("Fa" todos-add-file) | |
5995 | ("Ff" todos-find-filtered-items-file) | |
5996 | ("FV" todos-toggle-view-done-only) | |
5997 | ("V" todos-toggle-view-done-only) | |
5998 | ("Ftt" todos-filter-top-priorities) | |
5999 | ("Ftm" todos-filter-top-priorities-multifile) | |
6000 | ("Fts" todos-set-top-priorities-in-file) | |
6001 | ("Fyy" todos-filter-diary-items) | |
6002 | ("Fym" todos-filter-diary-items-multifile) | |
6003 | ("Frr" todos-filter-regexp-items) | |
6004 | ("Frm" todos-filter-regexp-items-multifile) | |
6005 | ("ee" todos-edit-item) | |
6006 | ("em" todos-edit-multiline-item) | |
6007 | ("edt" todos-edit-item-header) | |
6008 | ("edc" todos-edit-item-date-from-calendar) | |
6009 | ("eda" todos-edit-item-date-to-today) | |
6010 | ("edn" todos-edit-item-date-day-name) | |
6011 | ("edy" todos-edit-item-date-year) | |
6012 | ("edm" todos-edit-item-date-month) | |
6013 | ("edd" todos-edit-item-date-day) | |
6014 | ("et" todos-edit-item-time) | |
6015 | ("eyy" todos-edit-item-diary-inclusion) | |
6016 | ("eyk" todos-edit-item-diary-nonmarking) | |
6017 | ("ec" todos-done-item-add-edit-or-delete-comment) | |
6018 | ("d" todos-item-done) | |
6019 | ("i" ,todos-insertion-map) | |
6020 | ("k" todos-delete-item) | |
6021 | ("m" todos-move-item) | |
6022 | ("u" todos-item-undone) | |
6023 | ([remap newline] newline-and-indent) | |
27139cd5 | 6024 | ) |
a9b0e28e SB |
6025 | "List of key bindings for Todos mode only.") |
6026 | ||
6027 | (defvar todos-key-bindings-t+a+f | |
6028 | `( | |
6029 | ("C*" todos-mark-category) | |
6030 | ("Cu" todos-unmark-category) | |
6031 | ("Fh" todos-toggle-item-header) | |
6032 | ("h" todos-toggle-item-header) | |
6033 | ("Fe" todos-edit-file) | |
6034 | ("FH" todos-toggle-item-highlighting) | |
6035 | ("H" todos-toggle-item-highlighting) | |
6036 | ("FN" todos-toggle-prefix-numbers) | |
6037 | ("N" todos-toggle-prefix-numbers) | |
6038 | ("PB" todos-print-buffer) | |
6039 | ("PF" todos-print-buffer-to-file) | |
6040 | ("b" todos-backward-category) | |
6041 | ("d" todos-item-done) | |
6042 | ("f" todos-forward-category) | |
6043 | ("j" todos-jump-to-category) | |
6044 | ("n" todos-next-item) | |
6045 | ("p" todos-previous-item) | |
6046 | ("q" todos-quit) | |
6047 | ("s" todos-save) | |
6048 | ("t" todos-show) | |
6049 | ) | |
6050 | "List of key bindings for Todos, Archive, and Filtered Items modes.") | |
6051 | ||
6052 | (defvar todos-key-bindings-t+a | |
6053 | `( | |
6054 | ("Fc" todos-show-categories-table) | |
6055 | ("S" todos-search) | |
6056 | ("X" todos-clear-matches) | |
6057 | ("*" todos-toggle-mark-item) | |
6058 | ) | |
6059 | "List of key bindings for Todos and Todos Archive modes.") | |
6060 | ||
6061 | (defvar todos-key-bindings-t+f | |
6062 | `( | |
6063 | ("l" todos-lower-item-priority) | |
6064 | ("r" todos-raise-item-priority) | |
6065 | ("#" todos-set-item-priority) | |
6066 | ) | |
6067 | "List of key bindings for Todos and Todos Filtered Items modes.") | |
d04d6b95 | 6068 | |
27139cd5 SB |
6069 | (defvar todos-mode-map |
6070 | (let ((map (make-keymap))) | |
6071 | ;; Don't suppress digit keys, so they can supply prefix arguments. | |
6072 | (suppress-keymap map) | |
a9b0e28e SB |
6073 | (dolist (kb todos-key-bindings-t) |
6074 | (define-key map (nth 0 kb) (nth 1 kb))) | |
6075 | (dolist (kb todos-key-bindings-t+a+f) | |
6076 | (define-key map (nth 0 kb) (nth 1 kb))) | |
6077 | (dolist (kb todos-key-bindings-t+a) | |
6078 | (define-key map (nth 0 kb) (nth 1 kb))) | |
6079 | (dolist (kb todos-key-bindings-t+f) | |
6080 | (define-key map (nth 0 kb) (nth 1 kb))) | |
27139cd5 SB |
6081 | map) |
6082 | "Todos mode keymap.") | |
58c7641d | 6083 | |
27139cd5 SB |
6084 | (defvar todos-archive-mode-map |
6085 | (let ((map (make-sparse-keymap))) | |
a9b0e28e SB |
6086 | (suppress-keymap map) |
6087 | (dolist (kb todos-key-bindings-t+a+f) | |
6088 | (define-key map (nth 0 kb) (nth 1 kb))) | |
6089 | (dolist (kb todos-key-bindings-t+a) | |
6090 | (define-key map (nth 0 kb) (nth 1 kb))) | |
27139cd5 | 6091 | (define-key map "a" 'todos-jump-to-archive-category) |
27139cd5 | 6092 | (define-key map "u" 'todos-unarchive-items) |
27139cd5 SB |
6093 | map) |
6094 | "Todos Archive mode keymap.") | |
d04d6b95 | 6095 | |
27139cd5 SB |
6096 | (defvar todos-edit-mode-map |
6097 | (let ((map (make-sparse-keymap))) | |
6098 | (define-key map "\C-x\C-q" 'todos-edit-quit) | |
6099 | (define-key map [remap newline] 'newline-and-indent) | |
6100 | map) | |
6101 | "Todos Edit mode keymap.") | |
58c7641d | 6102 | |
27139cd5 SB |
6103 | (defvar todos-categories-mode-map |
6104 | (let ((map (make-sparse-keymap))) | |
a9b0e28e | 6105 | (suppress-keymap map) |
9e6b072c | 6106 | (define-key map "c" 'todos-sort-categories-alphabetically-or-numerically) |
27139cd5 SB |
6107 | (define-key map "t" 'todos-sort-categories-by-todo) |
6108 | (define-key map "y" 'todos-sort-categories-by-diary) | |
6109 | (define-key map "d" 'todos-sort-categories-by-done) | |
6110 | (define-key map "a" 'todos-sort-categories-by-archived) | |
9e6b072c SB |
6111 | (define-key map "#" 'todos-set-category-number) |
6112 | (define-key map "l" 'todos-lower-category) | |
6113 | (define-key map "r" 'todos-raise-category) | |
27139cd5 SB |
6114 | (define-key map "n" 'todos-next-button) |
6115 | (define-key map "p" 'todos-previous-button) | |
6116 | (define-key map [tab] 'todos-next-button) | |
6117 | (define-key map [backtab] 'todos-previous-button) | |
6118 | (define-key map "q" 'todos-quit) | |
27139cd5 SB |
6119 | map) |
6120 | "Todos Categories mode keymap.") | |
58c7641d | 6121 | |
27139cd5 | 6122 | (defvar todos-filtered-items-mode-map |
a9b0e28e SB |
6123 | (let ((map (make-sparse-keymap))) |
6124 | (suppress-keymap map) | |
6125 | (dolist (kb todos-key-bindings-t+a+f) | |
6126 | (define-key map (nth 0 kb) (nth 1 kb))) | |
6127 | (dolist (kb todos-key-bindings-t+f) | |
6128 | (define-key map (nth 0 kb) (nth 1 kb))) | |
23cbdcbc SB |
6129 | (define-key map "g" 'todos-go-to-source-item) |
6130 | (define-key map [remap newline] 'todos-go-to-source-item) | |
27139cd5 | 6131 | map) |
a9b0e28e SB |
6132 | "Todos Filtered Items mode keymap.") |
6133 | ||
6134 | ;; (easy-menu-define | |
6135 | ;; todos-menu todos-mode-map "Todos Menu" | |
6136 | ;; '("Todos" | |
6137 | ;; ("Navigation" | |
6138 | ;; ["Next Item" todos-forward-item t] | |
6139 | ;; ["Previous Item" todos-backward-item t] | |
6140 | ;; "---" | |
6141 | ;; ["Next Category" todos-forward-category t] | |
6142 | ;; ["Previous Category" todos-backward-category t] | |
6143 | ;; ["Jump to Category" todos-jump-to-category t] | |
6144 | ;; "---" | |
6145 | ;; ["Search Todos File" todos-search t] | |
6146 | ;; ["Clear Highlighting on Search Matches" todos-category-done t]) | |
6147 | ;; ("Display" | |
6148 | ;; ["List Current Categories" todos-show-categories-table t] | |
6149 | ;; ;; ["List Categories Alphabetically" todos-display-categories-alphabetically t] | |
6150 | ;; ["Turn Item Highlighting on/off" todos-toggle-item-highlighting t] | |
6151 | ;; ["Turn Item Numbering on/off" todos-toggle-prefix-numbers t] | |
6152 | ;; ["Turn Item Time Stamp on/off" todos-toggle-item-header t] | |
6153 | ;; ["View/Hide Done Items" todos-toggle-view-done-items t] | |
6154 | ;; "---" | |
6155 | ;; ["View Diary Items" todos-filter-diary-items t] | |
6156 | ;; ["View Top Priority Items" todos-filter-top-priorities t] | |
6157 | ;; ["View Multifile Top Priority Items" todos-filter-top-priorities-multifile t] | |
6158 | ;; "---" | |
6159 | ;; ["Print Category" todos-print-buffer t]) | |
6160 | ;; ("Editing" | |
6161 | ;; ["Insert New Item" todos-insert-item t] | |
6162 | ;; ["Insert Item Here" todos-insert-item-here t] | |
6163 | ;; ("More Insertion Commands") | |
6164 | ;; ["Edit Item" todos-edit-item t] | |
6165 | ;; ["Edit Multiline Item" todos-edit-multiline-item t] | |
6166 | ;; ["Edit Item Header" todos-edit-item-header t] | |
6167 | ;; ["Edit Item Date" todos-edit-item-date t] | |
6168 | ;; ["Edit Item Time" todos-edit-item-time t] | |
6169 | ;; "---" | |
6170 | ;; ["Lower Item Priority" todos-lower-item-priority t] | |
6171 | ;; ["Raise Item Priority" todos-raise-item-priority t] | |
6172 | ;; ["Set Item Priority" todos-set-item-priority t] | |
6173 | ;; ["Move (Recategorize) Item" todos-move-item t] | |
6174 | ;; ["Delete Item" todos-delete-item t] | |
6175 | ;; ["Undo Done Item" todos-item-undone t] | |
6176 | ;; ["Mark/Unmark Item for Diary" todos-toggle-item-diary-inclusion t] | |
6177 | ;; ["Mark/Unmark Items for Diary" todos-edit-item-diary-inclusion t] | |
6178 | ;; ["Mark & Hide Done Item" todos-item-done t] | |
6179 | ;; ["Archive Done Items" todos-archive-category-done-items t] | |
6180 | ;; "---" | |
6181 | ;; ["Add New Todos File" todos-add-file t] | |
6182 | ;; ["Add New Category" todos-add-category t] | |
6183 | ;; ["Delete Current Category" todos-delete-category t] | |
6184 | ;; ["Rename Current Category" todos-rename-category t] | |
6185 | ;; "---" | |
6186 | ;; ["Save Todos File" todos-save t] | |
6187 | ;; ) | |
6188 | ;; "---" | |
6189 | ;; ["Quit" todos-quit t] | |
6190 | ;; )) | |
6191 | ||
6192 | ;; ----------------------------------------------------------------------------- | |
27139cd5 | 6193 | ;;; Mode local variables and hook functions |
a9b0e28e | 6194 | ;; ----------------------------------------------------------------------------- |
616ffa8b | 6195 | |
27139cd5 SB |
6196 | (defvar todos-current-todos-file nil |
6197 | "Variable holding the name of the currently active Todos file.") | |
6198 | ||
6199 | (defun todos-show-current-file () | |
6200 | "Visit current instead of default Todos file with `todos-show'. | |
6201 | This function is added to `pre-command-hook' when user option | |
6202 | `todos-show-current-file' is set to non-nil." | |
6203 | (setq todos-global-current-todos-file todos-current-todos-file)) | |
3f031767 | 6204 | |
27139cd5 SB |
6205 | (defun todos-display-as-todos-file () |
6206 | "Show Todos files correctly when visited from outside of Todos mode." | |
6207 | (and (member this-command todos-visit-files-commands) | |
6208 | (= (- (point-max) (point-min)) (buffer-size)) | |
6209 | (member major-mode '(todos-mode todos-archive-mode)) | |
6210 | (todos-category-select))) | |
ee7412e4 | 6211 | |
27139cd5 SB |
6212 | (defun todos-add-to-buffer-list () |
6213 | "Add name of just visited Todos file to `todos-file-buffers'. | |
6214 | This function is added to `find-file-hook' in Todos mode." | |
6215 | (let ((filename (file-truename (buffer-file-name)))) | |
6216 | (when (member filename todos-files) | |
6217 | (add-to-list 'todos-file-buffers filename)))) | |
2a9e69d6 | 6218 | |
27139cd5 SB |
6219 | (defun todos-update-buffer-list () |
6220 | "Make current Todos mode buffer file car of `todos-file-buffers'. | |
6221 | This function is added to `post-command-hook' in Todos mode." | |
6222 | (let ((filename (file-truename (buffer-file-name)))) | |
6223 | (unless (eq (car todos-file-buffers) filename) | |
6224 | (setq todos-file-buffers | |
6225 | (cons filename (delete filename todos-file-buffers)))))) | |
58c7641d | 6226 | |
27139cd5 SB |
6227 | (defun todos-reset-global-current-todos-file () |
6228 | "Update the value of `todos-global-current-todos-file'. | |
6229 | This becomes the latest existing Todos file or, if there is none, | |
6230 | the value of `todos-default-todos-file'. | |
6231 | This function is added to `kill-buffer-hook' in Todos mode." | |
6232 | (let ((filename (file-truename (buffer-file-name)))) | |
6233 | (setq todos-file-buffers (delete filename todos-file-buffers)) | |
6234 | (setq todos-global-current-todos-file | |
6235 | (or (car todos-file-buffers) | |
6236 | (todos-absolute-file-name todos-default-todos-file))))) | |
c4bf3e3d | 6237 | |
27139cd5 SB |
6238 | (defvar todos-categories nil |
6239 | "Alist of categories in the current Todos file. | |
6240 | The elements are cons cells whose car is a category name and | |
6241 | whose cdr is a vector of the category's item counts. These are, | |
6242 | in order, the numbers of todo items, of todo items included in | |
6243 | the Diary, of done items and of archived items.") | |
6244 | ||
6245 | (defvar todos-categories-with-marks nil | |
6246 | "Alist of categories and number of marked items they contain.") | |
6247 | ||
6248 | (defvar todos-category-number 1 | |
6249 | "Variable holding the number of the current Todos category. | |
6250 | Todos categories are numbered starting from 1.") | |
6251 | ||
6252 | (defvar todos-show-done-only nil | |
6253 | "If non-nil display only done items in current category. | |
6254 | Set by the command `todos-toggle-view-done-only' and used by | |
6255 | `todos-category-select'.") | |
6256 | ||
6257 | (defun todos-reset-and-enable-done-separator () | |
6258 | "Show resized done items separator overlay after window change. | |
6259 | Added to `window-configuration-change-hook' in `todos-mode'." | |
6260 | (when (= 1 (length todos-done-separator-string)) | |
6261 | (let ((sep todos-done-separator)) | |
6262 | (setq todos-done-separator (todos-done-separator)) | |
6263 | (save-match-data (todos-reset-done-separator sep))))) | |
6264 | ||
a9b0e28e | 6265 | ;; ----------------------------------------------------------------------------- |
27139cd5 | 6266 | ;;; Mode definitions |
a9b0e28e | 6267 | ;; ----------------------------------------------------------------------------- |
27139cd5 SB |
6268 | |
6269 | (defun todos-modes-set-1 () | |
db5ea477 | 6270 | "Make some settings that apply to multiple Todos modes." |
a9b0e28e SB |
6271 | (setq-local font-lock-defaults '(todos-font-lock-keywords t)) |
6272 | (setq-local tab-width todos-indent-to-here) | |
6273 | (setq-local indent-line-function 'todos-indent) | |
27139cd5 SB |
6274 | (when todos-wrap-lines |
6275 | (visual-line-mode) | |
6276 | (setq wrap-prefix (make-string todos-indent-to-here 32)))) | |
6277 | ||
6278 | (defun todos-modes-set-2 () | |
db5ea477 | 6279 | "Make some settings that apply to multiple Todos modes." |
27139cd5 SB |
6280 | (add-to-invisibility-spec 'todos) |
6281 | (setq buffer-read-only t) | |
a9b0e28e SB |
6282 | (setq-local hl-line-range-function (lambda() (save-excursion |
6283 | (when (todos-item-end) | |
6284 | (cons (todos-item-start) | |
6285 | (todos-item-end))))))) | |
27139cd5 SB |
6286 | |
6287 | (defun todos-modes-set-3 () | |
db5ea477 | 6288 | "Make some settings that apply to multiple Todos modes." |
a9b0e28e SB |
6289 | (setq-local todos-categories (todos-set-categories)) |
6290 | (setq-local todos-category-number 1) | |
27139cd5 SB |
6291 | (add-hook 'find-file-hook 'todos-display-as-todos-file nil t)) |
6292 | ||
6293 | (put 'todos-mode 'mode-class 'special) | |
6294 | ||
6295 | (define-derived-mode todos-mode special-mode "Todos" | |
6296 | "Major mode for displaying, navigating and editing Todo lists. | |
6297 | ||
6298 | \\{todos-mode-map}" | |
23cbdcbc | 6299 | ;; (easy-menu-add todos-menu) |
27139cd5 SB |
6300 | (todos-modes-set-1) |
6301 | (todos-modes-set-2) | |
6302 | (todos-modes-set-3) | |
6303 | ;; Initialize todos-current-todos-file. | |
6304 | (when (member (file-truename (buffer-file-name)) | |
6305 | (funcall todos-files-function)) | |
a9b0e28e SB |
6306 | (setq-local todos-current-todos-file (file-truename (buffer-file-name)))) |
6307 | (setq-local todos-show-done-only nil) | |
6308 | (setq-local todos-categories-with-marks nil) | |
27139cd5 SB |
6309 | (add-hook 'find-file-hook 'todos-add-to-buffer-list nil t) |
6310 | (add-hook 'post-command-hook 'todos-update-buffer-list nil t) | |
6311 | (when todos-show-current-file | |
6312 | (add-hook 'pre-command-hook 'todos-show-current-file nil t)) | |
6313 | (add-hook 'window-configuration-change-hook | |
6314 | 'todos-reset-and-enable-done-separator nil t) | |
6315 | (add-hook 'kill-buffer-hook 'todos-reset-global-current-todos-file nil t)) | |
58c7641d | 6316 | |
27139cd5 | 6317 | (put 'todos-archive-mode 'mode-class 'special) |
0e89c3fc | 6318 | |
27139cd5 SB |
6319 | ;; If todos-mode is parent, all todos-mode key bindings appear to be |
6320 | ;; available in todos-archive-mode (e.g. shown by C-h m). | |
6321 | (define-derived-mode todos-archive-mode special-mode "Todos-Arch" | |
6322 | "Major mode for archived Todos categories. | |
0e89c3fc | 6323 | |
27139cd5 SB |
6324 | \\{todos-archive-mode-map}" |
6325 | (todos-modes-set-1) | |
6326 | (todos-modes-set-2) | |
6327 | (todos-modes-set-3) | |
a9b0e28e SB |
6328 | (setq-local todos-current-todos-file (file-truename (buffer-file-name))) |
6329 | (setq-local todos-show-done-only t)) | |
58c7641d | 6330 | |
27139cd5 | 6331 | (defun todos-mode-external-set () |
db5ea477 | 6332 | "Set `todos-categories' externally to `todos-current-todos-file'." |
a9b0e28e | 6333 | (setq-local todos-current-todos-file todos-global-current-todos-file) |
27139cd5 SB |
6334 | (let ((cats (with-current-buffer |
6335 | ;; Can't use find-buffer-visiting when | |
6336 | ;; `todos-show-categories-table' is called on first | |
6337 | ;; invocation of `todos-show', since there is then | |
6338 | ;; no buffer visiting the current file. | |
6339 | (find-file-noselect todos-current-todos-file 'nowarn) | |
6340 | (or todos-categories | |
6341 | ;; In Todos Edit mode todos-categories is now nil | |
6342 | ;; since it uses same buffer as Todos mode but | |
6343 | ;; doesn't have the latter's local variables. | |
6344 | (save-excursion | |
6345 | (goto-char (point-min)) | |
6346 | (read (buffer-substring-no-properties | |
6347 | (line-beginning-position) | |
6348 | (line-end-position)))))))) | |
a9b0e28e | 6349 | (setq-local todos-categories cats))) |
308f5beb | 6350 | |
27139cd5 SB |
6351 | (define-derived-mode todos-edit-mode text-mode "Todos-Ed" |
6352 | "Major mode for editing multiline Todo items. | |
6353 | ||
6354 | \\{todos-edit-mode-map}" | |
6355 | (todos-modes-set-1) | |
6356 | (todos-mode-external-set) | |
6357 | (setq buffer-read-only nil)) | |
58c7641d | 6358 | |
27139cd5 | 6359 | (put 'todos-categories-mode 'mode-class 'special) |
d04d6b95 | 6360 | |
27139cd5 SB |
6361 | (define-derived-mode todos-categories-mode special-mode "Todos-Cats" |
6362 | "Major mode for displaying and editing Todos categories. | |
d04d6b95 | 6363 | |
27139cd5 SB |
6364 | \\{todos-categories-mode-map}" |
6365 | (todos-mode-external-set)) | |
d04d6b95 | 6366 | |
27139cd5 | 6367 | (put 'todos-filtered-items-mode 'mode-class 'special) |
d04d6b95 | 6368 | |
27139cd5 SB |
6369 | (define-derived-mode todos-filtered-items-mode special-mode "Todos-Fltr" |
6370 | "Mode for displaying and reprioritizing top priority Todos. | |
3f031767 | 6371 | |
27139cd5 SB |
6372 | \\{todos-filtered-items-mode-map}" |
6373 | (todos-modes-set-1) | |
6374 | (todos-modes-set-2)) | |
3f031767 | 6375 | |
7464f422 SB |
6376 | (add-to-list 'auto-mode-alist '("\\.todo\\'" . todos-mode)) |
6377 | (add-to-list 'auto-mode-alist '("\\.toda\\'" . todos-archive-mode)) | |
f1806c78 | 6378 | (add-to-list 'auto-mode-alist '("\\.tod[tyr]\\'" . todos-filtered-items-mode)) |
7464f422 | 6379 | |
e4ae44d9 SB |
6380 | ;; ----------------------------------------------------------------------------- |
6381 | (provide 'todos) | |
520d912e | 6382 | |
e4ae44d9 | 6383 | ;;; todos.el ends here |