Commit | Line | Data |
---|---|---|
ddce2e3e | 1 | ;;; todo-mode.el --- facilities for making and maintaining todo lists |
3f031767 | 2 | |
857b9748 | 3 | ;; Copyright (C) 1997, 1999, 2001-2013 Free Software Foundation, Inc. |
3f031767 | 4 | |
857b9748 SB |
5 | ;; Author: Oliver Seidel <privat@os10000.net> |
6 | ;; Stephen Berman <stephen.berman@gmx.net> | |
7 | ;; Maintainer: Stephen Berman <stephen.berman@gmx.net> | |
3f031767 SB |
8 | ;; Keywords: calendar, todo |
9 | ||
857b9748 | 10 | ;; This file is part of GNU Emacs. |
3f031767 SB |
11 | |
12 | ;; GNU Emacs is free software: you can redistribute it and/or modify | |
13 | ;; it under the terms of the GNU General Public License as published by | |
14 | ;; the Free Software Foundation, either version 3 of the License, or | |
15 | ;; (at your option) any later version. | |
16 | ||
17 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 | ;; GNU General Public License for more details. | |
21 | ||
22 | ;; You should have received a copy of the GNU General Public License | |
23 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | |
24 | ||
3f031767 SB |
25 | ;;; Commentary: |
26 | ||
85ea34e2 SB |
27 | ;; This package provides facilities for making, displaying, navigating |
28 | ;; and editing todo lists, which are prioritized lists of todo items. | |
29 | ;; Todo lists are identified with named categories, so you can group | |
30 | ;; together and separately prioritize thematically related todo items. | |
31 | ;; Each category is stored in a file, which thus provides a further | |
32 | ;; level of organization. You can create as many todo files, and in | |
33 | ;; each as many categories, as you want. | |
34 | ||
ddce2e3e | 35 | ;; With Todo mode you can navigate among the items of a category, and |
85ea34e2 SB |
36 | ;; between categories in the same and in different todo files. You |
37 | ;; can edit todo items, reprioritize them within their category, move | |
38 | ;; them to another category, delete them, or mark items as done and | |
39 | ;; store them separately from the not yet done items in a category. | |
d610f6dd SB |
40 | ;; You can add new todo files, edit and delete them. You can add new |
41 | ;; categories, rename and delete them, move categories to another file | |
42 | ;; and merge the items of two categories. You can also reorder the | |
43 | ;; sequence of categories in a todo file for the purpose of | |
44 | ;; navigation. You can display summary tables of the categories in a | |
45 | ;; file and the types of items they contain. And you can compile | |
46 | ;; lists of existing items from multiple categories in one or more | |
47 | ;; todo files, which are filtered by various criteria. | |
85ea34e2 | 48 | |
ddce2e3e | 49 | ;; To get started, load this package and type `M-x todo-show'. This |
85ea34e2 SB |
50 | ;; will prompt you for the name of the first todo file, its first |
51 | ;; category and the category's first item, create these and display | |
ddce2e3e | 52 | ;; them in Todo mode. Now you can insert further items into the list |
85ea34e2 SB |
53 | ;; (i.e., the category) and assign them priorities by typing `i i'. |
54 | ||
ddce2e3e | 55 | ;; You will probably find it convenient to give `todo-show' a global |
85ea34e2 | 56 | ;; key binding in your init file, since it is one of the entry points |
ddce2e3e SB |
57 | ;; to Todo mode; a good choice is `C-c t', since `todo-show' is |
58 | ;; bound to `t' in Todo mode. | |
85ea34e2 | 59 | |
ddce2e3e SB |
60 | ;; To see a list of all Todo mode commands and their key bindings, |
61 | ;; including other entry points, type `C-h m' in Todo mode. Consult | |
ebc83885 SB |
62 | ;; the documentation strings of the commands for details of their use. |
63 | ;; The `todo' customization group and its subgroups list the options | |
64 | ;; you can set to alter the behavior of many commands and various | |
65 | ;; aspects of the display. | |
85ea34e2 SB |
66 | |
67 | ;; This package is a new version of Oliver Seidel's todo-mode.el. | |
68 | ;; While it retains the same basic organization and handling of todo | |
857b9748 | 69 | ;; lists and the basic UI, it significantly extends these and adds |
03e6d469 SB |
70 | ;; many features. This required also making changes to the internals, |
71 | ;; including the file format. If you have a todo file in old format, | |
72 | ;; then the first time you invoke `todo-show' (i.e., before you have | |
73 | ;; created any todo file in the current format), it will ask you | |
74 | ;; whether to convert that file and show it. If you choose not to | |
75 | ;; convert the old-style file at this time, you can do so later by | |
76 | ;; calling the command `todo-convert-legacy-files'. | |
e99a2125 | 77 | |
3f031767 SB |
78 | ;;; Code: |
79 | ||
b28025ed | 80 | (require 'diary-lib) |
ddce2e3e | 81 | ;; For cl-remove-duplicates (in todo-insertion-commands-args) and |
85ea34e2 | 82 | ;; cl-oddp. |
a9b0e28e | 83 | (require 'cl-lib) |
3f031767 | 84 | |
a9b0e28e | 85 | ;; ----------------------------------------------------------------------------- |
4fe738d3 | 86 | ;;; Setting up todo files, categories, and items |
a9b0e28e | 87 | ;; ----------------------------------------------------------------------------- |
27139cd5 | 88 | |
ddce2e3e | 89 | (defcustom todo-directory (locate-user-emacs-file "todo/") |
4fe738d3 | 90 | "Directory where user's todo files are saved." |
0e89c3fc | 91 | :type 'directory |
ddce2e3e | 92 | :group 'todo) |
0e89c3fc | 93 | |
ddce2e3e SB |
94 | (defun todo-files (&optional archives) |
95 | "Default value of `todo-files-function'. | |
0e89c3fc | 96 | This returns the case-insensitive alphabetically sorted list of |
ddce2e3e | 97 | file truenames in `todo-directory' with the extension |
0e89c3fc SB |
98 | \".todo\". With non-nil ARCHIVES return the list of archive file |
99 | truenames (those with the extension \".toda\")." | |
ddce2e3e | 100 | (let ((files (if (file-exists-p todo-directory) |
0e89c3fc | 101 | (mapcar 'file-truename |
ddce2e3e | 102 | (directory-files todo-directory t |
0e89c3fc SB |
103 | (if archives "\.toda$" "\.todo$") t))))) |
104 | (sort files (lambda (s1 s2) (let ((cis1 (upcase s1)) | |
105 | (cis2 (upcase s2))) | |
106 | (string< cis1 cis2)))))) | |
107 | ||
ddce2e3e SB |
108 | (defcustom todo-files-function 'todo-files |
109 | "Function returning the value of the variable `todo-files'. | |
0e89c3fc | 110 | This function should take an optional argument that, if non-nil, |
ddce2e3e | 111 | makes it return the value of the variable `todo-archives'." |
0e89c3fc | 112 | :type 'function |
ddce2e3e | 113 | :group 'todo) |
0e89c3fc | 114 | |
ddce2e3e | 115 | (defvar todo-files (funcall todo-files-function) |
4fe738d3 | 116 | "List of truenames of user's todo files.") |
0e89c3fc | 117 | |
ddce2e3e | 118 | (defvar todo-archives (funcall todo-files-function t) |
4fe738d3 | 119 | "List of truenames of user's todo archives.") |
27139cd5 | 120 | |
ddce2e3e | 121 | (defvar todo-visited nil |
4fe738d3 | 122 | "List of todo files visited in this session by `todo-show'. |
8b27b080 | 123 | Used to determine initial display according to the value of |
ddce2e3e | 124 | `todo-show-first'.") |
0e89c3fc | 125 | |
ddce2e3e SB |
126 | (defvar todo-file-buffers nil |
127 | "List of file names of live Todo mode buffers.") | |
0e89c3fc | 128 | |
ddce2e3e | 129 | (defvar todo-global-current-todo-file nil |
4fe738d3 | 130 | "Variable holding name of current todo file. |
ddce2e3e | 131 | Used by functions called from outside of Todo mode to visit the |
4fe738d3 | 132 | current todo file rather than the default todo file (i.e. when |
ddce2e3e | 133 | users option `todo-show-current-file' is non-nil).") |
0e89c3fc | 134 | |
ddce2e3e | 135 | (defvar todo-current-todo-file nil |
4fe738d3 | 136 | "Variable holding the name of the currently active todo file.") |
8b27b080 | 137 | |
ddce2e3e | 138 | (defvar todo-categories nil |
4fe738d3 | 139 | "Alist of categories in the current todo file. |
8b27b080 SB |
140 | The elements are cons cells whose car is a category name and |
141 | whose cdr is a vector of the category's item counts. These are, | |
142 | in order, the numbers of todo items, of todo items included in | |
143 | the Diary, of done items and of archived items.") | |
144 | ||
ddce2e3e | 145 | (defvar todo-category-number 1 |
4fe738d3 | 146 | "Variable holding the number of the current todo category. |
ddce2e3e | 147 | Todo categories are numbered starting from 1.") |
8b27b080 | 148 | |
ddce2e3e | 149 | (defvar todo-categories-with-marks nil |
8b27b080 SB |
150 | "Alist of categories and number of marked items they contain.") |
151 | ||
ddce2e3e | 152 | (defconst todo-category-beg "--==-- " |
8b27b080 SB |
153 | "String marking beginning of category (inserted with its name).") |
154 | ||
ddce2e3e | 155 | (defconst todo-category-done "==--== DONE " |
8b27b080 SB |
156 | "String marking beginning of category's done items.") |
157 | ||
ddce2e3e SB |
158 | (defcustom todo-done-separator-string "=" |
159 | "String determining the value of variable `todo-done-separator'. | |
8b27b080 | 160 | If the string consists of a single character, |
ddce2e3e | 161 | `todo-done-separator' will be the string made by repeating this |
8b27b080 SB |
162 | character for the width of the window, and the length is |
163 | automatically recalculated when the window width changes. If the | |
164 | string consists of more (or less) than one character, it will be | |
ddce2e3e | 165 | the value of `todo-done-separator'." |
0e89c3fc | 166 | :type 'string |
8b27b080 | 167 | :initialize 'custom-initialize-default |
ddce2e3e SB |
168 | :set 'todo-reset-done-separator-string |
169 | :group 'todo-display) | |
0e89c3fc | 170 | |
ddce2e3e SB |
171 | (defun todo-done-separator () |
172 | "Return string used as value of variable `todo-done-separator'." | |
173 | (let ((sep todo-done-separator-string)) | |
8b27b080 | 174 | (propertize (if (= 1 (length sep)) |
d610f6dd | 175 | (make-string (window-width) (string-to-char sep)) |
ddce2e3e SB |
176 | todo-done-separator-string) |
177 | 'face 'todo-done-sep))) | |
8b27b080 | 178 | |
ddce2e3e | 179 | (defvar todo-done-separator (todo-done-separator) |
8b27b080 | 180 | "String used to visually separate done from not done items. |
ddce2e3e | 181 | Displayed as an overlay instead of `todo-category-done' when |
8b27b080 | 182 | done items are shown. Its value is determined by user option |
ddce2e3e | 183 | `todo-done-separator-string'.") |
8b27b080 | 184 | |
ddce2e3e | 185 | (defvar todo-show-done-only nil |
8b27b080 | 186 | "If non-nil display only done items in current category. |
ddce2e3e SB |
187 | Set by the command `todo-toggle-view-done-only' and used by |
188 | `todo-category-select'.") | |
8b27b080 | 189 | |
ddce2e3e | 190 | (defcustom todo-nondiary-marker '("[" "]") |
8b27b080 SB |
191 | "List of strings surrounding item date to block diary inclusion. |
192 | The first string is inserted before the item date and must be a | |
193 | non-empty string that does not match a diary date in order to | |
194 | have its intended effect. The second string is inserted after | |
195 | the diary date." | |
196 | :type '(list string string) | |
ddce2e3e | 197 | :group 'todo-edit |
8b27b080 | 198 | :initialize 'custom-initialize-default |
ddce2e3e | 199 | :set 'todo-reset-nondiary-marker) |
8b27b080 | 200 | |
ddce2e3e | 201 | (defconst todo-nondiary-start (nth 0 todo-nondiary-marker) |
8b27b080 SB |
202 | "String inserted before item date to block diary inclusion.") |
203 | ||
ddce2e3e SB |
204 | (defconst todo-nondiary-end (nth 1 todo-nondiary-marker) |
205 | "String inserted after item date matching `todo-nondiary-start'.") | |
8b27b080 | 206 | |
ddce2e3e | 207 | (defconst todo-month-name-array |
8b27b080 SB |
208 | (vconcat calendar-month-name-array (vector "*")) |
209 | "Array of month names, in order. | |
210 | The final element is \"*\", indicating an unspecified month.") | |
211 | ||
ddce2e3e | 212 | (defconst todo-month-abbrev-array |
8b27b080 SB |
213 | (vconcat calendar-month-abbrev-array (vector "*")) |
214 | "Array of abbreviated month names, in order. | |
215 | The final element is \"*\", indicating an unspecified month.") | |
216 | ||
ddce2e3e | 217 | (defconst todo-date-pattern |
8b27b080 | 218 | (let ((dayname (diary-name-pattern calendar-day-name-array nil t))) |
d7a49dae | 219 | (concat "\\(?4:\\(?5:" dayname "\\)\\|" |
8b27b080 SB |
220 | (let ((dayname) |
221 | (monthname (format "\\(?6:%s\\)" (diary-name-pattern | |
ddce2e3e SB |
222 | todo-month-name-array |
223 | todo-month-abbrev-array))) | |
8b27b080 SB |
224 | (month "\\(?7:[0-9]+\\|\\*\\)") |
225 | (day "\\(?8:[0-9]+\\|\\*\\)") | |
226 | (year "-?\\(?9:[0-9]+\\|\\*\\)")) | |
227 | (mapconcat 'eval calendar-date-display-form "")) | |
228 | "\\)")) | |
4fe738d3 | 229 | "Regular expression matching a todo item date header.") |
8b27b080 SB |
230 | |
231 | ;; By itself this matches anything, because of the `?'; however, it's only | |
ddce2e3e | 232 | ;; used in the context of `todo-date-pattern' (but Emacs Lisp lacks |
8b27b080 | 233 | ;; lookahead). |
ddce2e3e SB |
234 | (defconst todo-date-string-start |
235 | (concat "^\\(" (regexp-quote todo-nondiary-start) "\\|" | |
8b27b080 SB |
236 | (regexp-quote diary-nonmarking-symbol) "\\)?") |
237 | "Regular expression matching part of item header before the date.") | |
238 | ||
ddce2e3e SB |
239 | (defcustom todo-done-string "DONE " |
240 | "Identifying string appended to the front of done todo items." | |
d04d6b95 | 241 | :type 'string |
8b27b080 | 242 | :initialize 'custom-initialize-default |
ddce2e3e SB |
243 | :set 'todo-reset-done-string |
244 | :group 'todo-edit) | |
d04d6b95 | 245 | |
ddce2e3e SB |
246 | (defconst todo-done-string-start |
247 | (concat "^\\[" (regexp-quote todo-done-string)) | |
8b27b080 | 248 | "Regular expression matching start of done item.") |
d04d6b95 | 249 | |
ddce2e3e SB |
250 | (defconst todo-item-start (concat "\\(" todo-date-string-start "\\|" |
251 | todo-done-string-start "\\)" | |
252 | todo-date-pattern) | |
4fe738d3 | 253 | "String identifying start of a todo item.") |
18aef8a3 | 254 | |
a9b0e28e | 255 | ;; ----------------------------------------------------------------------------- |
ddce2e3e | 256 | ;;; Todo mode display options |
a9b0e28e | 257 | ;; ----------------------------------------------------------------------------- |
1a9cb339 | 258 | |
ddce2e3e | 259 | (defcustom todo-prefix "" |
8b27b080 SB |
260 | "String prefixed to todo items for visual distinction." |
261 | :type '(string :validate | |
262 | (lambda (widget) | |
ddce2e3e | 263 | (when (string= (widget-value widget) todo-item-mark) |
8b27b080 SB |
264 | (widget-put |
265 | widget :error | |
ddce2e3e | 266 | "Invalid value: must be distinct from `todo-item-mark'") |
8b27b080 SB |
267 | widget))) |
268 | :initialize 'custom-initialize-default | |
ddce2e3e SB |
269 | :set 'todo-reset-prefix |
270 | :group 'todo-display) | |
18aef8a3 | 271 | |
ddce2e3e | 272 | (defcustom todo-number-prefix t |
8b27b080 SB |
273 | "Non-nil to prefix items with consecutively increasing integers. |
274 | These reflect the priorities of the items in each category." | |
275 | :type 'boolean | |
276 | :initialize 'custom-initialize-default | |
ddce2e3e SB |
277 | :set 'todo-reset-prefix |
278 | :group 'todo-display) | |
18aef8a3 | 279 | |
ddce2e3e | 280 | (defun todo-mode-line-control (cat) |
8b27b080 | 281 | "Return a mode line control for todo or archive file buffers. |
4fe738d3 | 282 | Argument CAT is the name of the current todo category. |
8b27b080 | 283 | This function is the value of the user variable |
ddce2e3e SB |
284 | `todo-mode-line-function'." |
285 | (let ((file (todo-short-file-name todo-current-todo-file))) | |
286 | (format "%s category %d: %s" file todo-category-number cat))) | |
36341a66 | 287 | |
ddce2e3e | 288 | (defcustom todo-mode-line-function 'todo-mode-line-control |
4fe738d3 | 289 | "Function that returns a mode line control for Todo mode buffers. |
8b27b080 | 290 | The function expects one argument holding the name of the current |
4fe738d3 SB |
291 | todo category. The resulting control becomes the local value of |
292 | `mode-line-buffer-identification' in each Todo mode buffer." | |
8b27b080 | 293 | :type 'function |
ddce2e3e | 294 | :group 'todo-display) |
18aef8a3 | 295 | |
ddce2e3e | 296 | (defcustom todo-highlight-item nil |
8b27b080 SB |
297 | "Non-nil means highlight items at point." |
298 | :type 'boolean | |
299 | :initialize 'custom-initialize-default | |
ddce2e3e SB |
300 | :set 'todo-reset-highlight-item |
301 | :group 'todo-display) | |
2c173503 | 302 | |
ddce2e3e | 303 | (defcustom todo-wrap-lines t |
8b27b080 SB |
304 | "Non-nil to activate Visual Line mode and use wrap prefix." |
305 | :type 'boolean | |
ddce2e3e | 306 | :group 'todo-display) |
2c173503 | 307 | |
ddce2e3e | 308 | (defcustom todo-indent-to-here 3 |
8b27b080 SB |
309 | "Number of spaces to indent continuation lines of items. |
310 | This must be a positive number to ensure such items are fully | |
311 | shown in the Fancy Diary display." | |
312 | :type '(integer :validate | |
313 | (lambda (widget) | |
314 | (unless (> (widget-value widget) 0) | |
315 | (widget-put widget :error | |
316 | "Invalid value: must be a positive integer") | |
317 | widget))) | |
ddce2e3e | 318 | :group 'todo-display) |
0e89c3fc | 319 | |
ddce2e3e SB |
320 | (defun todo-indent () |
321 | "Indent from point to `todo-indent-to-here'." | |
322 | (indent-to todo-indent-to-here todo-indent-to-here)) | |
8b27b080 | 323 | |
ddce2e3e | 324 | (defcustom todo-show-with-done nil |
8b27b080 SB |
325 | "Non-nil to display done items in all categories." |
326 | :type 'boolean | |
ddce2e3e | 327 | :group 'todo-display) |
1fcf038b | 328 | |
a9b0e28e | 329 | ;; ----------------------------------------------------------------------------- |
8b27b080 | 330 | ;;; Faces |
a9b0e28e | 331 | ;; ----------------------------------------------------------------------------- |
144faf47 | 332 | |
f3a66082 SB |
333 | (defface todo-key-prompt |
334 | '((t (:weight bold))) | |
335 | "Face for making keys in item insertion prompt stand out." | |
336 | :group 'todo-faces) | |
337 | ||
ddce2e3e | 338 | (defface todo-mark |
8b27b080 SB |
339 | ;; '((t :inherit font-lock-warning-face)) |
340 | '((((class color) | |
341 | (min-colors 88) | |
342 | (background light)) | |
343 | (:weight bold :foreground "Red1")) | |
344 | (((class color) | |
345 | (min-colors 88) | |
346 | (background dark)) | |
347 | (:weight bold :foreground "Pink")) | |
348 | (((class color) | |
349 | (min-colors 16) | |
350 | (background light)) | |
351 | (:weight bold :foreground "Red1")) | |
352 | (((class color) | |
353 | (min-colors 16) | |
354 | (background dark)) | |
355 | (:weight bold :foreground "Pink")) | |
356 | (((class color) | |
357 | (min-colors 8)) | |
358 | (:foreground "red")) | |
359 | (t | |
360 | (:weight bold :inverse-video t))) | |
361 | "Face for marks on marked items." | |
ddce2e3e | 362 | :group 'todo-faces) |
58c7641d | 363 | |
ddce2e3e | 364 | (defface todo-prefix-string |
8b27b080 SB |
365 | ;; '((t :inherit font-lock-constant-face)) |
366 | '((((class grayscale) (background light)) | |
367 | (:foreground "LightGray" :weight bold :underline t)) | |
368 | (((class grayscale) (background dark)) | |
369 | (:foreground "Gray50" :weight bold :underline t)) | |
370 | (((class color) (min-colors 88) (background light)) (:foreground "dark cyan")) | |
371 | (((class color) (min-colors 88) (background dark)) (:foreground "Aquamarine")) | |
372 | (((class color) (min-colors 16) (background light)) (:foreground "CadetBlue")) | |
373 | (((class color) (min-colors 16) (background dark)) (:foreground "Aquamarine")) | |
374 | (((class color) (min-colors 8)) (:foreground "magenta")) | |
375 | (t (:weight bold :underline t))) | |
4fe738d3 | 376 | "Face for todo item prefix or numerical priority string." |
ddce2e3e | 377 | :group 'todo-faces) |
0e89c3fc | 378 | |
ddce2e3e | 379 | (defface todo-top-priority |
8b27b080 SB |
380 | ;; bold font-lock-comment-face |
381 | '((default :weight bold) | |
382 | (((class grayscale) (background light)) :foreground "DimGray" :slant italic) | |
383 | (((class grayscale) (background dark)) :foreground "LightGray" :slant italic) | |
384 | (((class color) (min-colors 88) (background light)) :foreground "Firebrick") | |
385 | (((class color) (min-colors 88) (background dark)) :foreground "chocolate1") | |
386 | (((class color) (min-colors 16) (background light)) :foreground "red") | |
387 | (((class color) (min-colors 16) (background dark)) :foreground "red1") | |
388 | (((class color) (min-colors 8) (background light)) :foreground "red") | |
389 | (((class color) (min-colors 8) (background dark)) :foreground "yellow") | |
390 | (t :slant italic)) | |
4fe738d3 | 391 | "Face for top priority todo item numerical priority string. |
8b27b080 SB |
392 | The item's priority number string has this face if the number is |
393 | less than or equal the category's top priority setting." | |
ddce2e3e | 394 | :group 'todo-faces) |
2c173503 | 395 | |
ddce2e3e | 396 | (defface todo-nondiary |
8b27b080 SB |
397 | ;; '((t :inherit font-lock-type-face)) |
398 | '((((class grayscale) (background light)) :foreground "Gray90" :weight bold) | |
399 | (((class grayscale) (background dark)) :foreground "DimGray" :weight bold) | |
400 | (((class color) (min-colors 88) (background light)) :foreground "ForestGreen") | |
401 | (((class color) (min-colors 88) (background dark)) :foreground "PaleGreen") | |
402 | (((class color) (min-colors 16) (background light)) :foreground "ForestGreen") | |
403 | (((class color) (min-colors 16) (background dark)) :foreground "PaleGreen") | |
404 | (((class color) (min-colors 8)) :foreground "green") | |
405 | (t :weight bold :underline t)) | |
406 | "Face for non-diary markers around todo item date/time header." | |
ddce2e3e | 407 | :group 'todo-faces) |
2c173503 | 408 | |
ddce2e3e | 409 | (defface todo-date |
8b27b080 | 410 | '((t :inherit diary)) |
4fe738d3 | 411 | "Face for the date string of a todo item." |
ddce2e3e | 412 | :group 'todo-faces) |
2c173503 | 413 | |
ddce2e3e | 414 | (defface todo-time |
8b27b080 | 415 | '((t :inherit diary-time)) |
4fe738d3 | 416 | "Face for the time string of a todo item." |
ddce2e3e | 417 | :group 'todo-faces) |
18aef8a3 | 418 | |
ddce2e3e SB |
419 | (defface todo-diary-expired |
420 | ;; Doesn't contrast enough with todo-date (= diary) face. | |
8b27b080 SB |
421 | ;; ;; '((t :inherit warning)) |
422 | ;; '((default :weight bold) | |
423 | ;; (((class color) (min-colors 16)) :foreground "DarkOrange") | |
424 | ;; (((class color)) :foreground "yellow")) | |
425 | ;; bold font-lock-function-name-face | |
426 | '((default :weight bold) | |
427 | (((class color) (min-colors 88) (background light)) :foreground "Blue1") | |
428 | (((class color) (min-colors 88) (background dark)) :foreground "LightSkyBlue") | |
429 | (((class color) (min-colors 16) (background light)) :foreground "Blue") | |
430 | (((class color) (min-colors 16) (background dark)) :foreground "LightSkyBlue") | |
431 | (((class color) (min-colors 8)) :foreground "blue") | |
432 | (t :inverse-video t)) | |
433 | "Face for expired dates of diary items." | |
ddce2e3e | 434 | :group 'todo-faces) |
a9b0e28e | 435 | |
ddce2e3e | 436 | (defface todo-done-sep |
8b27b080 SB |
437 | ;; '((t :inherit font-lock-builtin-face)) |
438 | '((((class grayscale) (background light)) :foreground "LightGray" :weight bold) | |
439 | (((class grayscale) (background dark)) :foreground "DimGray" :weight bold) | |
440 | (((class color) (min-colors 88) (background light)) :foreground "dark slate blue") | |
441 | (((class color) (min-colors 88) (background dark)) :foreground "LightSteelBlue") | |
442 | (((class color) (min-colors 16) (background light)) :foreground "Orchid") | |
443 | (((class color) (min-colors 16) (background dark)) :foreground "LightSteelBlue") | |
444 | (((class color) (min-colors 8)) :foreground "blue" :weight bold) | |
445 | (t :weight bold)) | |
adc5dbce | 446 | "Face for separator string between done and not done todo items." |
ddce2e3e | 447 | :group 'todo-faces) |
18aef8a3 | 448 | |
ddce2e3e | 449 | (defface todo-done |
8b27b080 SB |
450 | ;; '((t :inherit font-lock-keyword-face)) |
451 | '((((class grayscale) (background light)) :foreground "LightGray" :weight bold) | |
452 | (((class grayscale) (background dark)) :foreground "DimGray" :weight bold) | |
453 | (((class color) (min-colors 88) (background light)) :foreground "Purple") | |
454 | (((class color) (min-colors 88) (background dark)) :foreground "Cyan1") | |
455 | (((class color) (min-colors 16) (background light)) :foreground "Purple") | |
456 | (((class color) (min-colors 16) (background dark)) :foreground "Cyan") | |
457 | (((class color) (min-colors 8)) :foreground "cyan" :weight bold) | |
458 | (t :weight bold)) | |
4fe738d3 | 459 | "Face for done todo item header string." |
ddce2e3e | 460 | :group 'todo-faces) |
18aef8a3 | 461 | |
ddce2e3e | 462 | (defface todo-comment |
8b27b080 SB |
463 | ;; '((t :inherit font-lock-comment-face)) |
464 | '((((class grayscale) (background light)) | |
465 | :foreground "DimGray" :weight bold :slant italic) | |
466 | (((class grayscale) (background dark)) | |
467 | :foreground "LightGray" :weight bold :slant italic) | |
468 | (((class color) (min-colors 88) (background light)) | |
469 | :foreground "Firebrick") | |
470 | (((class color) (min-colors 88) (background dark)) | |
471 | :foreground "chocolate1") | |
472 | (((class color) (min-colors 16) (background light)) | |
473 | :foreground "red") | |
474 | (((class color) (min-colors 16) (background dark)) | |
475 | :foreground "red1") | |
476 | (((class color) (min-colors 8) (background light)) | |
477 | :foreground "red") | |
478 | (((class color) (min-colors 8) (background dark)) | |
479 | :foreground "yellow") | |
480 | (t :weight bold :slant italic)) | |
4fe738d3 | 481 | "Face for comments appended to done todo items." |
ddce2e3e | 482 | :group 'todo-faces) |
36341a66 | 483 | |
ddce2e3e | 484 | (defface todo-search |
8b27b080 SB |
485 | ;; '((t :inherit match)) |
486 | '((((class color) | |
487 | (min-colors 88) | |
488 | (background light)) | |
489 | (:background "yellow1")) | |
490 | (((class color) | |
491 | (min-colors 88) | |
492 | (background dark)) | |
493 | (:background "RoyalBlue3")) | |
494 | (((class color) | |
495 | (min-colors 8) | |
496 | (background light)) | |
497 | (:foreground "black" :background "yellow")) | |
498 | (((class color) | |
499 | (min-colors 8) | |
500 | (background dark)) | |
501 | (:foreground "white" :background "blue")) | |
502 | (((type tty) | |
503 | (class mono)) | |
504 | (:inverse-video t)) | |
505 | (t | |
506 | (:background "gray"))) | |
ddce2e3e SB |
507 | "Face for matches found by `todo-search'." |
508 | :group 'todo-faces) | |
d04d6b95 | 509 | |
ddce2e3e | 510 | (defface todo-button |
8b27b080 SB |
511 | ;; '((t :inherit widget-field)) |
512 | '((((type tty)) | |
513 | (:foreground "black" :background "yellow3")) | |
514 | (((class grayscale color) | |
515 | (background light)) | |
516 | (:background "gray85")) | |
517 | (((class grayscale color) | |
518 | (background dark)) | |
519 | (:background "dim gray")) | |
520 | (t | |
521 | (:slant italic))) | |
522 | "Face for buttons in table of categories." | |
ddce2e3e | 523 | :group 'todo-faces) |
d04d6b95 | 524 | |
ddce2e3e | 525 | (defface todo-sorted-column |
8b27b080 SB |
526 | '((((type tty)) |
527 | (:inverse-video t)) | |
528 | (((class color) | |
529 | (background light)) | |
530 | (:background "grey85")) | |
531 | (((class color) | |
532 | (background dark)) | |
533 | (:background "grey85" :foreground "grey10")) | |
534 | (t | |
535 | (:background "gray"))) | |
536 | "Face for sorted column in table of categories." | |
ddce2e3e | 537 | :group 'todo-faces) |
58c7641d | 538 | |
ddce2e3e | 539 | (defface todo-archived-only |
8b27b080 SB |
540 | ;; '((t (:inherit (shadow)))) |
541 | '((((class color) | |
542 | (background light)) | |
543 | (:foreground "grey50")) | |
544 | (((class color) | |
545 | (background dark)) | |
546 | (:foreground "grey70")) | |
547 | (t | |
548 | (:foreground "gray"))) | |
549 | "Face for archived-only category names in table of categories." | |
ddce2e3e | 550 | :group 'todo-faces) |
2c173503 | 551 | |
ddce2e3e | 552 | (defface todo-category-string |
8b27b080 SB |
553 | ;; '((t :inherit font-lock-type-face)) |
554 | '((((class grayscale) (background light)) :foreground "Gray90" :weight bold) | |
555 | (((class grayscale) (background dark)) :foreground "DimGray" :weight bold) | |
556 | (((class color) (min-colors 88) (background light)) :foreground "ForestGreen") | |
557 | (((class color) (min-colors 88) (background dark)) :foreground "PaleGreen") | |
558 | (((class color) (min-colors 16) (background light)) :foreground "ForestGreen") | |
559 | (((class color) (min-colors 16) (background dark)) :foreground "PaleGreen") | |
560 | (((class color) (min-colors 8)) :foreground "green") | |
561 | (t :weight bold :underline t)) | |
ddce2e3e SB |
562 | "Face for category-file header in Todo Filtered Items mode." |
563 | :group 'todo-faces) | |
27139cd5 | 564 | |
8b27b080 | 565 | ;; ----------------------------------------------------------------------------- |
03e6d469 | 566 | ;;; Entering and exiting |
8b27b080 | 567 | ;; ----------------------------------------------------------------------------- |
0e89c3fc | 568 | |
ddce2e3e SB |
569 | (defcustom todo-visit-files-commands (list 'find-file 'dired-find-file) |
570 | "List of file finding commands for `todo-display-as-todo-file'. | |
4fe738d3 | 571 | Invoking these commands to visit a todo file or todo archive file |
ddce2e3e | 572 | calls `todo-show' or `todo-find-archive', so that the file is |
8b27b080 SB |
573 | displayed correctly." |
574 | :type '(repeat function) | |
ddce2e3e | 575 | :group 'todo) |
ee7412e4 | 576 | |
ddce2e3e | 577 | (defun todo-short-file-name (file) |
4fe738d3 | 578 | "Return the short form of todo file FILE's name. |
8b27b080 SB |
579 | This lacks the extension and directory components." |
580 | (when (stringp file) | |
581 | (file-name-sans-extension (file-name-nondirectory file)))) | |
d04d6b95 | 582 | |
ddce2e3e | 583 | (defcustom todo-default-todo-file (todo-short-file-name |
d610f6dd | 584 | (car (funcall todo-files-function))) |
ddce2e3e | 585 | "Todo file visited by first session invocation of `todo-show'." |
d610f6dd SB |
586 | :type (when todo-files |
587 | `(radio ,@(mapcar (lambda (f) (list 'const f)) | |
588 | (mapcar 'todo-short-file-name | |
589 | (funcall todo-files-function))))) | |
ddce2e3e | 590 | :group 'todo) |
3a898abe | 591 | |
ddce2e3e | 592 | (defcustom todo-show-current-file t |
4fe738d3 | 593 | "Non-nil to make `todo-show' visit the current todo file. |
ddce2e3e | 594 | Otherwise, `todo-show' always visits `todo-default-todo-file'." |
8b27b080 SB |
595 | :type 'boolean |
596 | :initialize 'custom-initialize-default | |
ddce2e3e SB |
597 | :set 'todo-set-show-current-file |
598 | :group 'todo) | |
db2c5d34 | 599 | |
ddce2e3e SB |
600 | (defcustom todo-show-first 'first |
601 | "What action to take on first use of `todo-show' on a file." | |
8b27b080 SB |
602 | :type '(choice (const :tag "Show first category" first) |
603 | (const :tag "Show table of categories" table) | |
604 | (const :tag "Show top priorities" top) | |
605 | (const :tag "Show diary items" diary) | |
606 | (const :tag "Show regexp items" regexp)) | |
ddce2e3e | 607 | :group 'todo) |
58c7641d | 608 | |
ddce2e3e | 609 | (defcustom todo-add-item-if-new-category t |
8b27b080 SB |
610 | "Non-nil to prompt for an item after adding a new category." |
611 | :type 'boolean | |
ddce2e3e | 612 | :group 'todo-edit) |
d04d6b95 | 613 | |
ddce2e3e | 614 | (defcustom todo-initial-file "Todo" |
4fe738d3 | 615 | "Default file name offered on adding first todo file." |
8b27b080 | 616 | :type 'string |
ddce2e3e | 617 | :group 'todo) |
d04d6b95 | 618 | |
ddce2e3e | 619 | (defcustom todo-initial-category "Todo" |
4fe738d3 | 620 | "Default category name offered on initializing a new todo file." |
8b27b080 | 621 | :type 'string |
ddce2e3e | 622 | :group 'todo) |
ee7412e4 | 623 | |
ddce2e3e SB |
624 | (defcustom todo-category-completions-files nil |
625 | "List of files for building `todo-read-category' completions." | |
8b27b080 | 626 | :type `(set ,@(mapcar (lambda (f) (list 'const f)) |
ddce2e3e SB |
627 | (mapcar 'todo-short-file-name |
628 | (funcall todo-files-function)))) | |
629 | :group 'todo) | |
0e89c3fc | 630 | |
ddce2e3e SB |
631 | (defcustom todo-completion-ignore-case nil |
632 | "Non-nil means case is ignored by `todo-read-*' functions." | |
37f48249 | 633 | :type 'boolean |
ddce2e3e | 634 | :group 'todo) |
37f48249 | 635 | |
03e6d469 | 636 | ;;;###autoload |
d610f6dd | 637 | (defun todo-show (&optional solicit-file interactive) |
03e6d469 | 638 | "Visit a todo file and display one of its categories. |
b28025ed | 639 | |
ddce2e3e SB |
640 | When invoked in Todo mode, prompt for which todo file to visit. |
641 | When invoked outside of Todo mode with non-nil prefix argument | |
8b27b080 | 642 | SOLICIT-FILE prompt for which todo file to visit; otherwise visit |
ddce2e3e SB |
643 | `todo-default-todo-file'. Subsequent invocations from outside |
644 | of Todo mode revisit this file or, with option | |
03e6d469 | 645 | `todo-show-current-file' non-nil (the default), whichever todo |
8b27b080 | 646 | file was last visited. |
b28025ed | 647 | |
03e6d469 SB |
648 | If you call this command before you have created any todo file in |
649 | the current format, and you have an todo file in old format, it | |
650 | will ask you whether to convert that file and show it. | |
4fe738d3 | 651 | Otherwise, calling this command before any todo file exists |
03e6d469 SB |
652 | prompts for a file name and an initial category (defaulting to |
653 | `todo-initial-file' and `todo-initial-category'), creates both of | |
654 | these, visits the file and displays the category, and if option | |
655 | `todo-add-item-if-new-category' is non-nil (the default), prompts | |
656 | for the first item. | |
e0f6342f | 657 | |
4fe738d3 | 658 | The first invocation of this command on an existing todo file |
ddce2e3e | 659 | interacts with the option `todo-show-first': if its value is |
8b27b080 SB |
660 | `first' (the default), show the first category in the file; if |
661 | its value is `table', show the table of categories in the file; | |
662 | if its value is one of `top', `diary' or `regexp', show the | |
663 | corresponding saved top priorities, diary items, or regexp items | |
664 | file, if any. Subsequent invocations always show the file's | |
665 | current (i.e., last displayed) category. | |
e0f6342f | 666 | |
ddce2e3e | 667 | In Todo mode just the category's unfinished todo items are shown |
8b27b080 | 668 | by default. The done items are hidden, but typing |
ddce2e3e SB |
669 | `\\[todo-toggle-view-done-items]' displays them below the todo |
670 | items. With non-nil user option `todo-show-with-done' both todo | |
8b27b080 | 671 | and done items are always shown on visiting a category. |
e0f6342f | 672 | |
ddce2e3e | 673 | Invoking this command in Todo Archive mode visits the |
4fe738d3 | 674 | corresponding todo file, displaying the corresponding category." |
d610f6dd SB |
675 | (interactive "P\np") |
676 | (when todo-default-todo-file | |
677 | (todo-check-file (todo-absolute-file-name todo-default-todo-file))) | |
03e6d469 | 678 | (catch 'shown |
d610f6dd SB |
679 | ;; Before initializing the first todo first, check if there is a |
680 | ;; legacy todo file and if so, offer to convert to the current | |
681 | ;; format and make it the first new todo file. | |
ddce2e3e | 682 | (unless todo-default-todo-file |
03e6d469 | 683 | (let ((legacy-todo-file (if (boundp 'todo-file-do) |
d610f6dd SB |
684 | todo-file-do |
685 | (locate-user-emacs-file "todo-do" ".todo-do")))) | |
686 | (when (and (file-exists-p legacy-todo-file) | |
687 | (y-or-n-p (concat "Do you want to convert a copy of your " | |
688 | "old todo file to the new format? "))) | |
689 | (when (todo-convert-legacy-files) | |
690 | (throw 'shown nil))))) | |
691 | (catch 'end | |
692 | (let* ((cat) | |
693 | (show-first todo-show-first) | |
694 | (file (cond ((or solicit-file | |
695 | (and interactive | |
696 | (memq major-mode '(todo-mode | |
697 | todo-archive-mode | |
698 | todo-filtered-items-mode)))) | |
699 | (if (funcall todo-files-function) | |
700 | (todo-read-file-name "Choose a todo file to visit: " | |
701 | nil t) | |
702 | (user-error "There are no todo files"))) | |
703 | ((and (eq major-mode 'todo-archive-mode) | |
704 | ;; Called noninteractively via todo-quit | |
705 | ;; to jump to corresponding category in | |
706 | ;; todo file. | |
707 | (not interactive)) | |
708 | (setq cat (todo-current-category)) | |
709 | (concat (file-name-sans-extension | |
710 | todo-current-todo-file) ".todo")) | |
711 | (t | |
712 | (or todo-current-todo-file | |
713 | (and todo-show-current-file | |
714 | todo-global-current-todo-file) | |
715 | (todo-absolute-file-name todo-default-todo-file) | |
716 | (todo-add-file))))) | |
717 | add-item first-file) | |
718 | (unless todo-default-todo-file | |
719 | ;; We just initialized the first todo file, so make it the default. | |
720 | (setq todo-default-todo-file (todo-short-file-name file) | |
721 | first-file t) | |
722 | (todo-reevaluate-default-file-defcustom)) | |
723 | (unless (member file todo-visited) | |
724 | ;; Can't setq t-c-t-f here, otherwise wrong file shown when | |
725 | ;; todo-show is called from todo-show-categories-table. | |
726 | (let ((todo-current-todo-file file)) | |
727 | (cond ((eq todo-show-first 'table) | |
728 | (todo-show-categories-table)) | |
729 | ((memq todo-show-first '(top diary regexp)) | |
730 | (let* ((shortf (todo-short-file-name file)) | |
731 | (fi-file (todo-absolute-file-name | |
732 | shortf todo-show-first))) | |
733 | (when (eq todo-show-first 'regexp) | |
734 | (let ((rxfiles (directory-files todo-directory t | |
735 | ".*\\.todr$" t))) | |
736 | (when (and rxfiles (> (length rxfiles) 1)) | |
737 | (let ((rxf (mapcar 'todo-short-file-name rxfiles))) | |
738 | (setq fi-file (todo-absolute-file-name | |
739 | (completing-read | |
740 | "Choose a regexp items file: " | |
741 | rxf) 'regexp)))))) | |
742 | (if (file-exists-p fi-file) | |
743 | (set-window-buffer | |
744 | (selected-window) | |
745 | (set-buffer (find-file-noselect fi-file 'nowarn))) | |
746 | (message "There is no %s file for %s" | |
747 | (cond ((eq todo-show-first 'top) | |
748 | "top priorities") | |
749 | ((eq todo-show-first 'diary) | |
750 | "diary items") | |
751 | ((eq todo-show-first 'regexp) | |
752 | "regexp items")) | |
753 | shortf) | |
754 | (setq todo-show-first 'first))))))) | |
755 | (when (or (member file todo-visited) | |
756 | (eq todo-show-first 'first)) | |
757 | (unless (todo-check-file file) (throw 'end nil)) | |
758 | (set-window-buffer (selected-window) | |
759 | (set-buffer (find-file-noselect file 'nowarn))) | |
760 | ;; When quitting an archive file, show the corresponding | |
761 | ;; category in the corresponding todo file, if it exists. | |
762 | (when (assoc cat todo-categories) | |
763 | (setq todo-category-number (todo-category-number cat))) | |
764 | ;; If this is a new todo file, add its first category. | |
765 | (when (zerop (buffer-size)) | |
766 | (let (cat-added) | |
767 | (unwind-protect | |
768 | (setq todo-category-number | |
769 | (todo-add-category todo-current-todo-file "") | |
770 | add-item todo-add-item-if-new-category | |
771 | cat-added t) | |
772 | (if cat-added | |
773 | ;; If the category was added, save the file now, so we | |
774 | ;; don't risk having an empty todo file, which would | |
775 | ;; signal an error if we tried to visit it later, | |
776 | ;; since doing that looks for category boundaries. | |
777 | (save-buffer 0) | |
778 | ;; If user cancels before adding the category, clean up | |
779 | ;; and exit, so we have a fresh slate the next time. | |
780 | (delete-file file) | |
781 | ;; (setq todo-files (funcall todo-files-function)) | |
782 | (setq todo-files (delete file todo-files)) | |
783 | (when first-file | |
784 | (setq todo-default-todo-file nil | |
785 | todo-current-todo-file nil) | |
786 | (todo-reevaluate-default-file-defcustom)) | |
787 | (kill-buffer) | |
788 | (keyboard-quit))))) | |
789 | (save-excursion (todo-category-select)) | |
790 | (when add-item (todo-basic-insert-item))) | |
791 | (setq todo-show-first show-first) | |
792 | (add-to-list 'todo-visited file))))) | |
8b27b080 | 793 | |
ddce2e3e | 794 | (defun todo-save () |
4fe738d3 | 795 | "Save the current todo file." |
8b27b080 | 796 | (interactive) |
ddce2e3e SB |
797 | (cond ((eq major-mode 'todo-filtered-items-mode) |
798 | (todo-check-filtered-items-file) | |
799 | (todo-save-filtered-items-buffer)) | |
8b27b080 SB |
800 | (t |
801 | (save-buffer)))) | |
802 | ||
ddce2e3e | 803 | (defvar todo-descending-counts) |
8b27b080 | 804 | |
ddce2e3e SB |
805 | (defun todo-quit () |
806 | "Exit the current Todo-related buffer. | |
8b27b080 SB |
807 | Depending on the specific mode, this either kills the buffer or |
808 | buries it and restores state as needed." | |
809 | (interactive) | |
810 | (let ((buf (current-buffer))) | |
ddce2e3e SB |
811 | (cond ((eq major-mode 'todo-categories-mode) |
812 | ;; Postpone killing buffer till after calling todo-show, to | |
813 | ;; prevent killing todo-mode buffer. | |
814 | (setq todo-descending-counts nil) | |
815 | ;; Ensure todo-show calls todo-show-categories-table only on | |
8b27b080 | 816 | ;; first invocation per file. |
ddce2e3e SB |
817 | (when (eq todo-show-first 'table) |
818 | (add-to-list 'todo-visited todo-current-todo-file)) | |
819 | (todo-show) | |
8b27b080 | 820 | (kill-buffer buf)) |
ddce2e3e | 821 | ((eq major-mode 'todo-filtered-items-mode) |
8b27b080 | 822 | (kill-buffer) |
ddce2e3e SB |
823 | (unless (eq major-mode 'todo-mode) (todo-show))) |
824 | ((eq major-mode 'todo-archive-mode) | |
8b27b080 SB |
825 | ;; Have to write a newly created archive to file to avoid |
826 | ;; subsequent errors. | |
ddce2e3e | 827 | (todo-save) |
d610f6dd SB |
828 | (let ((todo-file (concat todo-directory |
829 | (todo-short-file-name todo-current-todo-file) | |
830 | ".todo"))) | |
831 | (if (todo-check-file todo-file) | |
832 | (todo-show) | |
833 | (message "There is no todo file for this archive"))) | |
834 | ;; When todo-check-file runs in todo-show, it kills the | |
835 | ;; buffer if the archive file was deleted externally. | |
836 | (when (buffer-live-p buf) (bury-buffer buf))) | |
ddce2e3e SB |
837 | ((eq major-mode 'todo-mode) |
838 | (todo-save) | |
8b27b080 | 839 | ;; If we just quit archive mode, just burying the buffer |
ddce2e3e | 840 | ;; in todo-mode would return to archive. |
8b27b080 SB |
841 | (set-window-buffer (selected-window) |
842 | (set-buffer (other-buffer))) | |
843 | (bury-buffer buf))))) | |
58c7641d | 844 | |
a9b0e28e | 845 | ;; ----------------------------------------------------------------------------- |
8b27b080 | 846 | ;;; Navigation between and within categories |
a9b0e28e | 847 | ;; ----------------------------------------------------------------------------- |
db2c5d34 | 848 | |
ddce2e3e | 849 | (defcustom todo-skip-archived-categories nil |
8b27b080 | 850 | "Non-nil to handle categories with only archived items specially. |
a9b0e28e | 851 | |
ddce2e3e SB |
852 | Sequential category navigation using \\[todo-forward-category] |
853 | or \\[todo-backward-category] skips categories that contain only | |
8b27b080 | 854 | archived items. Other commands still recognize these categories. |
ddce2e3e SB |
855 | In Todo Categories mode (\\[todo-show-categories-table]) these |
856 | categories shown in `todo-archived-only' face and pressing the | |
8b27b080 SB |
857 | category button visits the category in the archive instead of the |
858 | todo file." | |
859 | :type 'boolean | |
ddce2e3e | 860 | :group 'todo-display) |
78fe7289 | 861 | |
ddce2e3e | 862 | (defun todo-forward-category (&optional back) |
4fe738d3 | 863 | "Visit the numerically next category in this todo file. |
8b27b080 SB |
864 | If the current category is the highest numbered, visit the first |
865 | category. With non-nil argument BACK, visit the numerically | |
866 | previous category (the highest numbered one, if the current | |
867 | category is the first)." | |
868 | (interactive) | |
ddce2e3e SB |
869 | (setq todo-category-number |
870 | (1+ (mod (- todo-category-number (if back 2 0)) | |
871 | (length todo-categories)))) | |
872 | (when todo-skip-archived-categories | |
873 | (while (and (zerop (todo-get-count 'todo)) | |
874 | (zerop (todo-get-count 'done)) | |
875 | (not (zerop (todo-get-count 'archived)))) | |
876 | (setq todo-category-number | |
877 | (apply (if back '1- '1+) (list todo-category-number))))) | |
878 | (todo-category-select) | |
8b27b080 | 879 | (goto-char (point-min))) |
a9b0e28e | 880 | |
ddce2e3e | 881 | (defun todo-backward-category () |
4fe738d3 | 882 | "Visit the numerically previous category in this todo file. |
8b27b080 SB |
883 | If the current category is the highest numbered, visit the first |
884 | category." | |
885 | (interactive) | |
ddce2e3e | 886 | (todo-forward-category t)) |
78fe7289 | 887 | |
ddce2e3e | 888 | (defvar todo-categories-buffer) |
78fe7289 | 889 | |
ddce2e3e | 890 | (defun todo-jump-to-category (&optional file where) |
4fe738d3 | 891 | "Prompt for a category in a todo file and jump to it. |
78fe7289 | 892 | |
8b27b080 | 893 | With non-nil FILE (interactively a prefix argument), prompt for a |
4fe738d3 | 894 | specific todo file and choose (with TAB completion) a category |
8b27b080 | 895 | in it to jump to; otherwise, choose and jump to any category in |
4fe738d3 | 896 | either the current todo file or a file in |
ddce2e3e | 897 | `todo-category-completions-files'. |
78fe7289 | 898 | |
8b27b080 SB |
899 | Also accept a non-existing category name and ask whether to add a |
900 | new category by that name; on confirmation, add it and jump to | |
ddce2e3e | 901 | that category, and if option `todo-add-item-if-new-category' is |
8b27b080 SB |
902 | non-nil (the default), then prompt for the first item. |
903 | ||
904 | In noninteractive calls non-nil WHERE specifies either the goal | |
905 | category or its file. If its value is `archive', the choice of | |
906 | categories is restricted to the current archive file or the | |
907 | archive you were prompted to choose; this is used by | |
ddce2e3e SB |
908 | `todo-jump-to-archive-category'. If its value is the name of a |
909 | category, jump directly to that category; this is used in Todo | |
8b27b080 SB |
910 | Categories mode." |
911 | (interactive "P") | |
ddce2e3e | 912 | ;; If invoked outside of Todo mode and there is not yet any Todo |
27139cd5 | 913 | ;; file, initialize one. |
d610f6dd | 914 | (if (null (funcall todo-files-function)) |
ddce2e3e | 915 | (todo-show) |
8b27b080 SB |
916 | (let* ((archive (eq where 'archive)) |
917 | (cat (unless archive where)) | |
ddce2e3e SB |
918 | (file0 (when cat ; We're in Todo Categories mode. |
919 | ;; With non-nil `todo-skip-archived-categories' | |
8b27b080 SB |
920 | ;; jump to archive file of a category with only |
921 | ;; archived items. | |
ddce2e3e SB |
922 | (if (and todo-skip-archived-categories |
923 | (zerop (todo-get-count 'todo cat)) | |
924 | (zerop (todo-get-count 'done cat)) | |
925 | (not (zerop (todo-get-count 'archived cat)))) | |
8b27b080 | 926 | (concat (file-name-sans-extension |
ddce2e3e SB |
927 | todo-current-todo-file) ".toda") |
928 | ;; Otherwise, jump to current todo file. | |
929 | todo-current-todo-file))) | |
930 | (len (length todo-categories)) | |
8b27b080 | 931 | (cat+file (unless cat |
ddce2e3e | 932 | (todo-read-category "Jump to category: " |
8b27b080 | 933 | (if archive 'archive) file))) |
ddce2e3e SB |
934 | (add-item (and todo-add-item-if-new-category |
935 | (> (length todo-categories) len))) | |
8b27b080 SB |
936 | (category (or cat (car cat+file)))) |
937 | (unless cat (setq file0 (cdr cat+file))) | |
938 | (with-current-buffer (find-file-noselect file0 'nowarn) | |
ddce2e3e SB |
939 | (setq todo-current-todo-file file0) |
940 | ;; If called from Todo Categories mode, clean up before jumping. | |
941 | (if (string= (buffer-name) todo-categories-buffer) | |
8b27b080 | 942 | (kill-buffer)) |
27139cd5 | 943 | (set-window-buffer (selected-window) |
8b27b080 | 944 | (set-buffer (find-buffer-visiting file0))) |
ddce2e3e SB |
945 | (unless todo-global-current-todo-file |
946 | (setq todo-global-current-todo-file todo-current-todo-file)) | |
947 | (todo-category-number category) | |
948 | (todo-category-select) | |
8b27b080 | 949 | (goto-char (point-min)) |
ddce2e3e | 950 | (when add-item (todo-basic-insert-item)))))) |
78fe7289 | 951 | |
ddce2e3e | 952 | (defun todo-next-item (&optional count) |
8b27b080 SB |
953 | "Move point down to the beginning of the next item. |
954 | With positive numerical prefix COUNT, move point COUNT items | |
955 | downward. | |
3f031767 | 956 | |
8b27b080 SB |
957 | If the category's done items are hidden, this command also moves |
958 | point to the empty line below the last todo item from any higher | |
959 | item in the category, i.e., when invoked with or without a prefix | |
960 | argument. If the category's done items are visible, this command | |
961 | called with a prefix argument only moves point to a lower item, | |
962 | e.g., with point on the last todo item and called with prefix 1, | |
963 | it moves point to the first done item; but if called with point | |
964 | on the last todo item without a prefix argument, it moves point | |
965 | the the empty line above the done items separator." | |
966 | (interactive "p") | |
4fe738d3 SB |
967 | ;; It's not worth the trouble to allow prefix arg value < 1, since |
968 | ;; we have the corresponding command. | |
8b27b080 SB |
969 | (cond ((and current-prefix-arg (< count 1)) |
970 | (user-error "The prefix argument must be a positive number")) | |
971 | (current-prefix-arg | |
ddce2e3e | 972 | (todo-forward-item count)) |
8b27b080 | 973 | (t |
ddce2e3e | 974 | (todo-forward-item)))) |
0e89c3fc | 975 | |
ddce2e3e | 976 | (defun todo-previous-item (&optional count) |
8b27b080 SB |
977 | "Move point up to start of item with next higher priority. |
978 | With positive numerical prefix COUNT, move point COUNT items | |
979 | upward. | |
e4ae44d9 | 980 | |
8b27b080 SB |
981 | If the category's done items are visible, this command called |
982 | with a prefix argument only moves point to a higher item, e.g., | |
983 | with point on the first done item and called with prefix 1, it | |
984 | moves to the last todo item; but if called with point on the | |
985 | first done item without a prefix argument, it moves point the the | |
986 | empty line above the done items separator." | |
987 | (interactive "p") | |
988 | ;; Avoid moving to bob if on the first item but not at bob. | |
989 | (when (> (line-number-at-pos) 1) | |
4fe738d3 SB |
990 | ;; It's not worth the trouble to allow prefix arg value < 1, since |
991 | ;; we have the corresponding command. | |
8b27b080 SB |
992 | (cond ((and current-prefix-arg (< count 1)) |
993 | (user-error "The prefix argument must be a positive number")) | |
994 | (current-prefix-arg | |
ddce2e3e | 995 | (todo-backward-item count)) |
8b27b080 | 996 | (t |
ddce2e3e | 997 | (todo-backward-item))))) |
e4ae44d9 | 998 | |
8b27b080 SB |
999 | ;; ----------------------------------------------------------------------------- |
1000 | ;;; Display toggle commands | |
1001 | ;; ----------------------------------------------------------------------------- | |
e4ae44d9 | 1002 | |
ddce2e3e | 1003 | (defun todo-toggle-prefix-numbers () |
8b27b080 SB |
1004 | "Hide item numbering if shown, show if hidden." |
1005 | (interactive) | |
1006 | (save-excursion | |
1007 | (save-restriction | |
1008 | (goto-char (point-min)) | |
ddce2e3e SB |
1009 | (let* ((ov (todo-get-overlay 'prefix)) |
1010 | (show-done (re-search-forward todo-done-string-start nil t)) | |
1011 | (todo-show-with-done show-done) | |
1012 | (todo-number-prefix (not (equal (overlay-get ov 'before-string) | |
8b27b080 | 1013 | "1 ")))) |
ddce2e3e SB |
1014 | (if (eq major-mode 'todo-filtered-items-mode) |
1015 | (todo-prefix-overlays) | |
1016 | (todo-category-select)))))) | |
58c7641d | 1017 | |
ddce2e3e | 1018 | (defun todo-toggle-view-done-items () |
8b27b080 | 1019 | "Show hidden or hide visible done items in current category." |
27139cd5 | 1020 | (interactive) |
ddce2e3e | 1021 | (if (zerop (todo-get-count 'done (todo-current-category))) |
8b27b080 SB |
1022 | (message "There are no done items in this category.") |
1023 | (let ((opoint (point))) | |
1024 | (goto-char (point-min)) | |
ddce2e3e SB |
1025 | (let* ((shown (re-search-forward todo-done-string-start nil t)) |
1026 | (todo-show-with-done (not shown))) | |
1027 | (todo-category-select) | |
8b27b080 SB |
1028 | (goto-char opoint) |
1029 | ;; If start of done items sections is below the bottom of the | |
1030 | ;; window, make it visible. | |
1031 | (unless shown | |
1032 | (setq shown (progn | |
1033 | (goto-char (point-min)) | |
ddce2e3e | 1034 | (re-search-forward todo-done-string-start nil t))) |
8b27b080 SB |
1035 | (if (not (pos-visible-in-window-p shown)) |
1036 | (recenter) | |
1037 | (goto-char opoint))))))) | |
6be04162 | 1038 | |
ddce2e3e | 1039 | (defun todo-toggle-view-done-only () |
8b27b080 SB |
1040 | "Switch between displaying only done or only todo items." |
1041 | (interactive) | |
ddce2e3e SB |
1042 | (setq todo-show-done-only (not todo-show-done-only)) |
1043 | (todo-category-select)) | |
6be04162 | 1044 | |
ddce2e3e | 1045 | (defun todo-toggle-item-highlighting () |
8b27b080 SB |
1046 | "Highlight or unhighlight the todo item the cursor is on." |
1047 | (interactive) | |
2f99433b | 1048 | (eval-and-compile (require 'hl-line)) |
8b27b080 | 1049 | (when (memq major-mode |
ddce2e3e | 1050 | '(todo-mode todo-archive-mode todo-filtered-items-mode)) |
8b27b080 SB |
1051 | (if hl-line-mode |
1052 | (hl-line-mode -1) | |
1053 | (hl-line-mode 1)))) | |
58c7641d | 1054 | |
ddce2e3e | 1055 | (defun todo-toggle-item-header () |
8b27b080 SB |
1056 | "Hide or show item date-time headers in the current file. |
1057 | With done items, this hides only the done date-time string, not | |
1058 | the the original date-time string." | |
1059 | (interactive) | |
1060 | (save-excursion | |
1061 | (save-restriction | |
1062 | (goto-char (point-min)) | |
ddce2e3e | 1063 | (let ((ov (todo-get-overlay 'header))) |
8b27b080 | 1064 | (if ov |
ddce2e3e | 1065 | (remove-overlays 1 (1+ (buffer-size)) 'todo 'header) |
8b27b080 SB |
1066 | (widen) |
1067 | (goto-char (point-min)) | |
1068 | (while (not (eobp)) | |
1069 | (when (re-search-forward | |
ddce2e3e | 1070 | (concat todo-item-start |
8b27b080 | 1071 | "\\( " diary-time-regexp "\\)?" |
ddce2e3e | 1072 | (regexp-quote todo-nondiary-end) "? ") |
8b27b080 SB |
1073 | nil t) |
1074 | (setq ov (make-overlay (match-beginning 0) (match-end 0) nil t)) | |
ddce2e3e | 1075 | (overlay-put ov 'todo 'header) |
8b27b080 | 1076 | (overlay-put ov 'display "")) |
ddce2e3e | 1077 | (todo-forward-item))))))) |
0e89c3fc | 1078 | |
8b27b080 SB |
1079 | ;; ----------------------------------------------------------------------------- |
1080 | ;;; File and category editing | |
1081 | ;; ----------------------------------------------------------------------------- | |
1082 | ||
ddce2e3e | 1083 | (defun todo-add-file () |
4fe738d3 | 1084 | "Name and initialize a new todo file. |
8b27b080 | 1085 | Interactively, prompt for a category and display it, and if |
ddce2e3e | 1086 | option `todo-add-item-if-new-category' is non-nil (the default), |
8b27b080 SB |
1087 | prompt for the first item. |
1088 | Noninteractively, return the name of the new file." | |
27139cd5 | 1089 | (interactive) |
d610f6dd SB |
1090 | (let* ((prompt (concat "Enter name of new todo file " |
1091 | "(TAB or SPC to see current names): ")) | |
1092 | (file (todo-read-file-name prompt))) | |
8b27b080 SB |
1093 | (with-current-buffer (get-buffer-create file) |
1094 | (erase-buffer) | |
1095 | (write-region (point-min) (point-max) file nil 'nomessage nil t) | |
1096 | (kill-buffer file)) | |
ddce2e3e SB |
1097 | (setq todo-files (funcall todo-files-function)) |
1098 | (todo-reevaluate-filelist-defcustoms) | |
8b27b080 SB |
1099 | (if (called-interactively-p 'any) |
1100 | (progn | |
1101 | (set-window-buffer (selected-window) | |
1102 | (set-buffer (find-file-noselect file))) | |
ddce2e3e SB |
1103 | (setq todo-current-todo-file file) |
1104 | (todo-show)) | |
8b27b080 | 1105 | file))) |
0e89c3fc | 1106 | |
ae43b66a SB |
1107 | (defun todo-rename-file (&optional arg) |
1108 | "Rename the current todo file. | |
1109 | With prefix ARG, prompt for a todo file and rename it. | |
1110 | If there are corresponding archive or filtered items files, | |
1111 | rename these accordingly. If there are live buffers visiting | |
1112 | these files, also rename them accordingly." | |
1113 | (interactive "P") | |
1114 | (let* ((oname (or (and arg | |
1115 | (todo-read-file-name "Choose a file to rename: " | |
1116 | nil t)) | |
1117 | (buffer-file-name))) | |
1118 | (soname (todo-short-file-name oname)) | |
1119 | (nname (todo-read-file-name "New name for this file: ")) | |
1120 | (snname (todo-short-file-name nname)) | |
1121 | (files (directory-files todo-directory t | |
1122 | (concat ".*" (regexp-quote soname) | |
1123 | ".*\.tod[aorty]$") t))) | |
1124 | (dolist (f files) | |
d5a845b4 SB |
1125 | (let* ((sfname (todo-short-file-name f)) |
1126 | (fext (file-name-extension f t)) | |
1127 | (fbuf (find-buffer-visiting f)) | |
1128 | (fbname (buffer-name fbuf))) | |
ae43b66a SB |
1129 | (when (string-match (regexp-quote soname) sfname) |
1130 | (let* ((snfname (replace-match snname t t sfname)) | |
1131 | (nfname (concat todo-directory snfname fext))) | |
1132 | (rename-file f nfname) | |
1133 | (when fbuf | |
1134 | (with-current-buffer fbuf | |
1135 | (set-visited-file-name nfname t t) | |
1136 | (cond ((member fext '(".todo" ".toda")) | |
1137 | (setq todo-current-todo-file (buffer-file-name)) | |
1138 | (setq mode-line-buffer-identification | |
1139 | (funcall todo-mode-line-function | |
1140 | (todo-current-category)))) | |
1141 | (t | |
1142 | (rename-buffer | |
1143 | (replace-regexp-in-string | |
d5a845b4 SB |
1144 | (regexp-quote soname) snname fbname)))))))))) |
1145 | (setq todo-files (funcall todo-files-function) | |
1146 | todo-archives (funcall todo-files-function t)) | |
1147 | (when (string= todo-default-todo-file soname) | |
1148 | (setq todo-default-todo-file snname)) | |
1149 | (when (string= todo-global-current-todo-file oname) | |
1150 | (setq todo-global-current-todo-file nname)) | |
1151 | (todo-reevaluate-filelist-defcustoms))) | |
ae43b66a | 1152 | |
d610f6dd SB |
1153 | (defun todo-delete-file () |
1154 | "Delete the current todo, archive or filtered items file. | |
1155 | If the todo file has a corresponding archive file, or vice versa, | |
1156 | prompt whether to delete that as well. Also kill the buffers | |
1157 | visiting the deleted files." | |
1158 | (interactive) | |
1159 | (let* ((file1 (buffer-file-name)) | |
1160 | (todo (eq major-mode 'todo-mode)) | |
1161 | (archive (eq major-mode 'todo-archive-mode)) | |
1162 | (filtered (eq major-mode 'todo-filtered-items-mode)) | |
1163 | (file1-sn (todo-short-file-name file1)) | |
1164 | (file2 (concat todo-directory file1-sn (cond (todo ".toda") | |
1165 | (archive ".todo")))) | |
1166 | (buf1 (current-buffer)) | |
1167 | (buf2 (when file2 (find-buffer-visiting file2))) | |
1168 | (prompt1 (concat "Delete " (cond (todo "todo") | |
1169 | (archive "archive") | |
1170 | (filtered "filtered items")) | |
1171 | " file \"%s\"? ")) | |
1172 | (prompt2 (concat "Also delete the corresponding " | |
1173 | (cond (todo "archive") (archive "todo")) " file " | |
1174 | (when buf2 "and kill the buffer visiting it? "))) | |
1175 | (delete1 (yes-or-no-p (format prompt1 file1-sn))) | |
1176 | (delete2 (when (and delete1 (or (file-exists-p file2) buf2)) | |
1177 | (yes-or-no-p prompt2)))) | |
1178 | (when delete1 | |
1179 | (when (file-exists-p file1) (delete-file file1)) | |
1180 | (setq todo-visited (delete file1 todo-visited)) | |
1181 | (kill-buffer buf1) | |
1182 | (when delete2 | |
1183 | (when (file-exists-p file2) (delete-file file2)) | |
1184 | (setq todo-visited (delete file2 todo-visited)) | |
1185 | (and buf2 (kill-buffer buf2))) | |
1186 | (setq todo-files (funcall todo-files-function) | |
1187 | todo-archives (funcall todo-files-function t)) | |
1188 | (when (or (string= file1-sn todo-default-todo-file) | |
1189 | (and delete2 (string= file1-sn todo-default-todo-file))) | |
1190 | (setq todo-default-todo-file (todo-short-file-name (car todo-files)))) | |
1191 | (when (or (string= file1 todo-global-current-todo-file) | |
1192 | (and delete2 (string= file2 todo-global-current-todo-file))) | |
1193 | (setq todo-global-current-todo-file nil)) | |
1194 | (todo-reevaluate-filelist-defcustoms) | |
1195 | (message (concat (cond (todo "Todo") (archive "Archive")) " file \"%s\" " | |
1196 | (when delete2 | |
1197 | (concat "and its " | |
1198 | (cond (todo "archive") (archive "todo")) | |
1199 | " file ")) | |
1200 | "deleted") file1-sn)))) | |
1201 | ||
ddce2e3e SB |
1202 | (defvar todo-edit-buffer "*Todo Edit*" |
1203 | "Name of current buffer in Todo Edit mode.") | |
58c7641d | 1204 | |
ddce2e3e SB |
1205 | (defun todo-edit-file () |
1206 | "Put current buffer in `todo-edit-mode'. | |
8b27b080 SB |
1207 | This makes the entire file visible and the buffer writeable and |
1208 | you can use the self-insertion keys and standard Emacs editing | |
ddce2e3e | 1209 | commands to make changes. To return to Todo mode, type |
adc5dbce | 1210 | \\[todo-edit-quit]. This runs a file format check, signaling |
8b27b080 SB |
1211 | an error if the format has become invalid. However, this check |
1212 | cannot tell if the number of items changed, which could result in | |
1213 | the file containing inconsistent information. For this reason | |
1214 | this command should be used with caution." | |
27139cd5 | 1215 | (interactive) |
8b27b080 | 1216 | (widen) |
ddce2e3e | 1217 | (todo-edit-mode) |
8b27b080 SB |
1218 | (remove-overlays) |
1219 | (message "%s" (substitute-command-keys | |
ddce2e3e SB |
1220 | (concat "Type \\[todo-edit-quit] to check file format " |
1221 | "validity and return to Todo mode.\n")))) | |
58c7641d | 1222 | |
ddce2e3e | 1223 | (defun todo-add-category (&optional file cat) |
4fe738d3 | 1224 | "Add a new category to a todo file. |
18aef8a3 | 1225 | |
8b27b080 SB |
1226 | Called interactively with prefix argument FILE, prompt for a file |
1227 | and then for a new category to add to that file, otherwise prompt | |
4fe738d3 | 1228 | just for a category to add to the current todo file. After |
ddce2e3e SB |
1229 | adding the category, visit it in Todo mode and if option |
1230 | `todo-add-item-if-new-category' is non-nil (the default), prompt | |
8b27b080 | 1231 | for the first item. |
58c7641d | 1232 | |
8b27b080 | 1233 | Non-interactively, add category CAT to file FILE; if FILE is nil, |
4fe738d3 | 1234 | add CAT to the current todo file. After adding the category, |
8b27b080 SB |
1235 | return the new category number." |
1236 | (interactive "P") | |
1237 | (let (catfil file0) | |
1238 | ;; If cat is passed from caller, don't prompt, unless it is "", | |
1239 | ;; which means the file was just added and has no category yet. | |
1240 | (if (and cat (> (length cat) 0)) | |
1241 | (setq file0 (or (and (stringp file) file) | |
ddce2e3e SB |
1242 | todo-current-todo-file)) |
1243 | (setq catfil (todo-read-category "Enter a new category name: " | |
8b27b080 SB |
1244 | 'add (when (called-interactively-p 'any) |
1245 | file)) | |
1246 | cat (car catfil) | |
1247 | file0 (if (called-interactively-p 'any) | |
1248 | (cdr catfil) | |
1249 | file))) | |
1250 | (find-file file0) | |
1251 | (let ((counts (make-vector 4 0)) ; [todo diary done archived] | |
ddce2e3e | 1252 | (num (1+ (length todo-categories))) |
8b27b080 | 1253 | (buffer-read-only nil)) |
ddce2e3e SB |
1254 | (setq todo-current-todo-file file0) |
1255 | (setq todo-categories (append todo-categories | |
8b27b080 SB |
1256 | (list (cons cat counts)))) |
1257 | (widen) | |
1258 | (goto-char (point-max)) | |
ddce2e3e SB |
1259 | (save-excursion ; Save point for todo-category-select. |
1260 | (insert todo-category-beg cat "\n\n" todo-category-done "\n")) | |
1261 | (todo-update-categories-sexp) | |
8b27b080 SB |
1262 | ;; If invoked by user, display the newly added category, if |
1263 | ;; called programmatically return the category number to the | |
1264 | ;; caller. | |
1265 | (if (called-interactively-p 'any) | |
1266 | (progn | |
ddce2e3e SB |
1267 | (setq todo-category-number num) |
1268 | (todo-category-select) | |
1269 | (when todo-add-item-if-new-category | |
1270 | (todo-basic-insert-item))) | |
8b27b080 | 1271 | num)))) |
6be04162 | 1272 | |
ddce2e3e | 1273 | (defun todo-rename-category () |
4fe738d3 | 1274 | "Rename current todo category. |
8b27b080 SB |
1275 | If this file has an archive containing this category, rename the |
1276 | category there as well." | |
1277 | (interactive) | |
ddce2e3e | 1278 | (let* ((cat (todo-current-category)) |
8b27b080 SB |
1279 | (new (read-from-minibuffer |
1280 | (format "Rename category \"%s\" to: " cat)))) | |
ddce2e3e SB |
1281 | (setq new (todo-validate-name new 'category)) |
1282 | (let* ((ofile todo-current-todo-file) | |
8b27b080 SB |
1283 | (archive (concat (file-name-sans-extension ofile) ".toda")) |
1284 | (buffers (append (list ofile) | |
ddce2e3e | 1285 | (unless (zerop (todo-get-count 'archived cat)) |
8b27b080 SB |
1286 | (list archive))))) |
1287 | (dolist (buf buffers) | |
1288 | (with-current-buffer (find-file-noselect buf) | |
1289 | (let (buffer-read-only) | |
ddce2e3e | 1290 | (setq todo-categories (todo-set-categories)) |
8b27b080 SB |
1291 | (save-excursion |
1292 | (save-restriction | |
ddce2e3e | 1293 | (setcar (assoc cat todo-categories) new) |
8b27b080 SB |
1294 | (widen) |
1295 | (goto-char (point-min)) | |
ddce2e3e SB |
1296 | (todo-update-categories-sexp) |
1297 | (re-search-forward (concat (regexp-quote todo-category-beg) | |
8b27b080 SB |
1298 | "\\(" (regexp-quote cat) "\\)\n") |
1299 | nil t) | |
1300 | (replace-match new t t nil 1))))))) | |
1301 | (force-mode-line-update)) | |
ddce2e3e | 1302 | (save-excursion (todo-category-select))) |
ee7412e4 | 1303 | |
ddce2e3e | 1304 | (defun todo-delete-category (&optional arg) |
d610f6dd SB |
1305 | "Delete current todo category provided it contains no items. |
1306 | With prefix ARG delete the category even if it does contain | |
1307 | todo or done items." | |
8b27b080 | 1308 | (interactive "P") |
ddce2e3e SB |
1309 | (let* ((file todo-current-todo-file) |
1310 | (cat (todo-current-category)) | |
1311 | (todo (todo-get-count 'todo cat)) | |
1312 | (done (todo-get-count 'done cat)) | |
1313 | (archived (todo-get-count 'archived cat))) | |
8b27b080 SB |
1314 | (if (and (not arg) |
1315 | (or (> todo 0) (> done 0))) | |
1316 | (message "%s" (substitute-command-keys | |
1317 | (concat "To delete a non-empty category, " | |
ddce2e3e SB |
1318 | "type C-u \\[todo-delete-category]."))) |
1319 | (when (cond ((= (length todo-categories) 1) | |
1320 | (todo-y-or-n-p | |
8b27b080 SB |
1321 | (concat "This is the only category in this file; " |
1322 | "deleting it will also delete the file.\n" | |
1323 | "Do you want to proceed? "))) | |
1324 | ((> archived 0) | |
ddce2e3e | 1325 | (todo-y-or-n-p (concat "This category has archived items; " |
8b27b080 SB |
1326 | "the archived category will remain\n" |
1327 | "after deleting the todo category. " | |
1328 | "Do you still want to delete it\n" | |
ddce2e3e | 1329 | "(see `todo-skip-archived-categories' " |
8b27b080 SB |
1330 | "for another option)? "))) |
1331 | (t | |
ddce2e3e | 1332 | (todo-y-or-n-p (concat "Permanently remove category \"" cat |
8b27b080 SB |
1333 | "\"" (and arg " and all its entries") |
1334 | "? ")))) | |
1335 | (widen) | |
1336 | (let ((buffer-read-only) | |
1337 | (beg (re-search-backward | |
ddce2e3e | 1338 | (concat "^" (regexp-quote (concat todo-category-beg cat)) |
8b27b080 SB |
1339 | "\n") nil t)) |
1340 | (end (if (re-search-forward | |
ddce2e3e | 1341 | (concat "\n\\(" (regexp-quote todo-category-beg) |
8b27b080 SB |
1342 | ".*\n\\)") nil t) |
1343 | (match-beginning 1) | |
1344 | (point-max)))) | |
1345 | (remove-overlays beg end) | |
1346 | (delete-region beg end) | |
ddce2e3e | 1347 | (if (= (length todo-categories) 1) |
8b27b080 SB |
1348 | ;; If deleted category was the only one, delete the file. |
1349 | (progn | |
ddce2e3e | 1350 | (todo-reevaluate-filelist-defcustoms) |
8b27b080 SB |
1351 | ;; Skip confirming killing the archive buffer if it has been |
1352 | ;; modified and not saved. | |
1353 | (set-buffer-modified-p nil) | |
1354 | (delete-file file) | |
1355 | (kill-buffer) | |
4fe738d3 | 1356 | (message "Deleted todo file %s." file)) |
ddce2e3e SB |
1357 | (setq todo-categories (delete (assoc cat todo-categories) |
1358 | todo-categories)) | |
1359 | (todo-update-categories-sexp) | |
1360 | (setq todo-category-number | |
1361 | (1+ (mod todo-category-number (length todo-categories)))) | |
1362 | (todo-category-select) | |
8b27b080 SB |
1363 | (goto-char (point-min)) |
1364 | (message "Deleted category %s." cat))))))) | |
58c7641d | 1365 | |
ddce2e3e | 1366 | (defun todo-move-category () |
4fe738d3 | 1367 | "Move current category to a different todo file. |
2f99433b SB |
1368 | If the todo file chosen does not exist, it is created. |
1369 | If the current category has archived items, also move those to | |
1370 | the archive of the file moved to, creating it if it does not exist." | |
27139cd5 | 1371 | (interactive) |
ddce2e3e SB |
1372 | (when (or (> (length todo-categories) 1) |
1373 | (todo-y-or-n-p (concat "This is the only category in this file; " | |
8b27b080 SB |
1374 | "moving it will also delete the file.\n" |
1375 | "Do you want to proceed? "))) | |
ddce2e3e SB |
1376 | (let* ((ofile todo-current-todo-file) |
1377 | (cat (todo-current-category)) | |
1378 | (nfile (todo-read-file-name | |
2f99433b | 1379 | "Todo file to move this category to: " nil)) |
8b27b080 SB |
1380 | (archive (concat (file-name-sans-extension ofile) ".toda")) |
1381 | (buffers (append (list ofile) | |
ddce2e3e | 1382 | (unless (zerop (todo-get-count 'archived cat)) |
8b27b080 SB |
1383 | (list archive)))) |
1384 | new) | |
2f99433b | 1385 | (while (equal nfile (file-truename ofile)) |
ddce2e3e | 1386 | (setq nfile (todo-read-file-name |
2f99433b SB |
1387 | "Choose a file distinct from this file: " nil))) |
1388 | (unless (member nfile todo-files) | |
1389 | (with-current-buffer (get-buffer-create nfile) | |
1390 | (erase-buffer) | |
1391 | (write-region (point-min) (point-max) nfile nil 'nomessage nil t) | |
1392 | (kill-buffer nfile)) | |
1393 | (setq todo-files (funcall todo-files-function)) | |
1394 | (todo-reevaluate-filelist-defcustoms)) | |
8b27b080 SB |
1395 | (dolist (buf buffers) |
1396 | (with-current-buffer (find-file-noselect buf) | |
1397 | (widen) | |
1398 | (goto-char (point-max)) | |
1399 | (let* ((beg (re-search-backward | |
1400 | (concat "^" | |
ddce2e3e | 1401 | (regexp-quote (concat todo-category-beg cat)) |
8b27b080 SB |
1402 | "$") |
1403 | nil t)) | |
1404 | (end (if (re-search-forward | |
ddce2e3e | 1405 | (concat "^" (regexp-quote todo-category-beg)) |
8b27b080 SB |
1406 | nil t 2) |
1407 | (match-beginning 0) | |
1408 | (point-max))) | |
1409 | (content (buffer-substring-no-properties beg end)) | |
ddce2e3e | 1410 | (counts (cdr (assoc cat todo-categories))) |
8b27b080 SB |
1411 | buffer-read-only) |
1412 | ;; Move the category to the new file. Also update or create | |
1413 | ;; archive file if necessary. | |
1414 | (with-current-buffer | |
1415 | (find-file-noselect | |
ddce2e3e | 1416 | ;; Regenerate todo-archives in case there |
8b27b080 | 1417 | ;; is a newly created archive. |
ddce2e3e | 1418 | (if (member buf (funcall todo-files-function t)) |
8b27b080 SB |
1419 | (concat (file-name-sans-extension nfile) ".toda") |
1420 | nfile)) | |
ddce2e3e | 1421 | (let* ((nfile-short (todo-short-file-name nfile)) |
8b27b080 | 1422 | (prompt (concat |
ddce2e3e | 1423 | (format "Todo file \"%s\" already has " |
8b27b080 SB |
1424 | nfile-short) |
1425 | (format "the category \"%s\";\n" cat) | |
1426 | "enter a new category name: ")) | |
1427 | buffer-read-only) | |
1428 | (widen) | |
1429 | (goto-char (point-max)) | |
1430 | (insert content) | |
1431 | ;; If the file moved to has a category with the same | |
1432 | ;; name, rename the moved category. | |
ddce2e3e | 1433 | (when (assoc cat todo-categories) |
8b27b080 | 1434 | (unless (member (file-truename (buffer-file-name)) |
ddce2e3e | 1435 | (funcall todo-files-function t)) |
8b27b080 | 1436 | (setq new (read-from-minibuffer prompt)) |
ddce2e3e | 1437 | (setq new (todo-validate-name new 'category)))) |
4fe738d3 | 1438 | ;; Replace old with new name in todo and archive files. |
8b27b080 SB |
1439 | (when new |
1440 | (goto-char (point-max)) | |
1441 | (re-search-backward | |
ddce2e3e | 1442 | (concat "^" (regexp-quote todo-category-beg) |
8b27b080 SB |
1443 | "\\(" (regexp-quote cat) "\\)$") nil t) |
1444 | (replace-match new nil nil nil 1))) | |
ddce2e3e SB |
1445 | (setq todo-categories |
1446 | (append todo-categories (list (cons new counts)))) | |
1447 | (todo-update-categories-sexp) | |
8b27b080 SB |
1448 | ;; If archive was just created, save it to avoid "File |
1449 | ;; <xyz> no longer exists!" message on invoking | |
ddce2e3e | 1450 | ;; `todo-view-archived-items'. |
8b27b080 SB |
1451 | (unless (file-exists-p (buffer-file-name)) |
1452 | (save-buffer)) | |
ddce2e3e SB |
1453 | (todo-category-number (or new cat)) |
1454 | (todo-category-select)) | |
8b27b080 SB |
1455 | ;; Delete the category from the old file, and if that was the |
1456 | ;; last category, delete the file. Also handle archive file | |
1457 | ;; if necessary. | |
1458 | (remove-overlays beg end) | |
1459 | (delete-region beg end) | |
1460 | (goto-char (point-min)) | |
ddce2e3e | 1461 | ;; Put point after todo-categories sexp. |
8b27b080 SB |
1462 | (forward-line) |
1463 | (if (eobp) ; Aside from sexp, file is empty. | |
1464 | (progn | |
1465 | ;; Skip confirming killing the archive buffer. | |
1466 | (set-buffer-modified-p nil) | |
ddce2e3e | 1467 | (delete-file todo-current-todo-file) |
8b27b080 | 1468 | (kill-buffer) |
ddce2e3e SB |
1469 | (when (member todo-current-todo-file todo-files) |
1470 | (todo-reevaluate-filelist-defcustoms))) | |
1471 | (setq todo-categories (delete (assoc cat todo-categories) | |
1472 | todo-categories)) | |
1473 | (todo-update-categories-sexp) | |
1474 | (todo-category-select))))) | |
27139cd5 | 1475 | (set-window-buffer (selected-window) |
8b27b080 | 1476 | (set-buffer (find-file-noselect nfile))) |
ddce2e3e SB |
1477 | (todo-category-number (or new cat)) |
1478 | (todo-category-select)))) | |
d04d6b95 | 1479 | |
ddce2e3e | 1480 | (defun todo-merge-category (&optional file) |
8b27b080 | 1481 | "Merge current category into another existing category. |
344187df | 1482 | |
4fe738d3 | 1483 | With prefix argument FILE, prompt for a specific todo file and |
8b27b080 SB |
1484 | choose (with TAB completion) a category in it to merge into; |
1485 | otherwise, choose and merge into a category in either the | |
4fe738d3 | 1486 | current todo file or a file in `todo-category-completions-files'. |
2c173503 | 1487 | |
8b27b080 SB |
1488 | After merging, the current category's todo and done items are |
1489 | appended to the chosen goal category's todo and done items, | |
1490 | respectively. The goal category becomes the current category, | |
1491 | and the previous current category is deleted. | |
3f031767 | 1492 | |
8b27b080 SB |
1493 | If both the first and goal categories also have archived items, |
1494 | the former are merged to the latter. If only the first category | |
1495 | has archived items, the archived category is renamed to the goal | |
1496 | category." | |
27139cd5 | 1497 | (interactive "P") |
ddce2e3e SB |
1498 | (let* ((tfile todo-current-todo-file) |
1499 | (cat (todo-current-category)) | |
1500 | (cat+file (todo-read-category "Merge into category: " 'todo file)) | |
8b27b080 SB |
1501 | (goal (car cat+file)) |
1502 | (gfile (cdr cat+file)) | |
1503 | (archive (concat (file-name-sans-extension (if file gfile tfile)) | |
1504 | ".toda")) | |
1505 | archived-count here) | |
1506 | ;; Merge in todo file. | |
1507 | (with-current-buffer (get-buffer (find-file-noselect tfile)) | |
1508 | (widen) | |
1509 | (let* ((buffer-read-only nil) | |
1510 | (cbeg (progn | |
1511 | (re-search-backward | |
ddce2e3e | 1512 | (concat "^" (regexp-quote todo-category-beg)) nil t) |
8b27b080 SB |
1513 | (point-marker))) |
1514 | (tbeg (progn (forward-line) (point-marker))) | |
1515 | (dbeg (progn | |
1516 | (re-search-forward | |
ddce2e3e | 1517 | (concat "^" (regexp-quote todo-category-done)) nil t) |
8b27b080 SB |
1518 | (forward-line) (point-marker))) |
1519 | ;; Omit empty line between todo and done items. | |
1520 | (tend (progn (forward-line -2) (point-marker))) | |
1521 | (cend (progn | |
1522 | (if (re-search-forward | |
ddce2e3e | 1523 | (concat "^" (regexp-quote todo-category-beg)) nil t) |
8b27b080 SB |
1524 | (progn |
1525 | (goto-char (match-beginning 0)) | |
1526 | (point-marker)) | |
1527 | (point-max-marker)))) | |
1528 | (todo (buffer-substring-no-properties tbeg tend)) | |
1529 | (done (buffer-substring-no-properties dbeg cend))) | |
1530 | (goto-char (point-min)) | |
1531 | ;; Merge any todo items. | |
1532 | (unless (zerop (length todo)) | |
1533 | (re-search-forward | |
ddce2e3e | 1534 | (concat "^" (regexp-quote (concat todo-category-beg goal)) "$") |
8b27b080 | 1535 | nil t) |
27139cd5 | 1536 | (re-search-forward |
ddce2e3e | 1537 | (concat "^" (regexp-quote todo-category-done)) nil t) |
8b27b080 SB |
1538 | (forward-line -1) |
1539 | (setq here (point-marker)) | |
1540 | (insert todo) | |
ddce2e3e | 1541 | (todo-update-count 'todo (todo-get-count 'todo cat) goal)) |
8b27b080 SB |
1542 | ;; Merge any done items. |
1543 | (unless (zerop (length done)) | |
1544 | (goto-char (if (re-search-forward | |
ddce2e3e | 1545 | (concat "^" (regexp-quote todo-category-beg)) nil t) |
27139cd5 | 1546 | (match-beginning 0) |
8b27b080 SB |
1547 | (point-max))) |
1548 | (when (zerop (length todo)) (setq here (point-marker))) | |
1549 | (insert done) | |
ddce2e3e | 1550 | (todo-update-count 'done (todo-get-count 'done cat) goal)) |
8b27b080 SB |
1551 | (remove-overlays cbeg cend) |
1552 | (delete-region cbeg cend) | |
ddce2e3e SB |
1553 | (setq todo-categories (delete (assoc cat todo-categories) |
1554 | todo-categories)) | |
1555 | (todo-update-categories-sexp) | |
8b27b080 SB |
1556 | (mapc (lambda (m) (set-marker m nil)) (list cbeg tbeg dbeg tend cend)))) |
1557 | (when (file-exists-p archive) | |
1558 | ;; Merge in archive file. | |
1559 | (with-current-buffer (get-buffer (find-file-noselect archive)) | |
1560 | (widen) | |
1561 | (goto-char (point-min)) | |
1562 | (let ((buffer-read-only nil) | |
1563 | (cbeg (save-excursion | |
1564 | (when (re-search-forward | |
1565 | (concat "^" (regexp-quote | |
ddce2e3e | 1566 | (concat todo-category-beg cat)) "$") |
8b27b080 SB |
1567 | nil t) |
1568 | (goto-char (match-beginning 0)) | |
1569 | (point-marker)))) | |
1570 | (gbeg (save-excursion | |
1571 | (when (re-search-forward | |
1572 | (concat "^" (regexp-quote | |
ddce2e3e | 1573 | (concat todo-category-beg goal)) "$") |
8b27b080 SB |
1574 | nil t) |
1575 | (goto-char (match-beginning 0)) | |
1576 | (point-marker)))) | |
1577 | cend carch) | |
1578 | (when cbeg | |
ddce2e3e | 1579 | (setq archived-count (todo-get-count 'done cat)) |
8b27b080 SB |
1580 | (setq cend (save-excursion |
1581 | (if (re-search-forward | |
ddce2e3e | 1582 | (concat "^" (regexp-quote todo-category-beg)) |
8b27b080 SB |
1583 | nil t) |
1584 | (match-beginning 0) | |
1585 | (point-max)))) | |
1586 | (setq carch (save-excursion (goto-char cbeg) (forward-line) | |
1587 | (buffer-substring-no-properties (point) cend))) | |
1588 | ;; If both categories of the merge have archived items, merge the | |
1589 | ;; source items to the goal items, else "merge" by renaming the | |
1590 | ;; source category to goal. | |
1591 | (if gbeg | |
1592 | (progn | |
1593 | (goto-char (if (re-search-forward | |
ddce2e3e | 1594 | (concat "^" (regexp-quote todo-category-beg)) |
8b27b080 SB |
1595 | nil t) |
1596 | (match-beginning 0) | |
1597 | (point-max))) | |
1598 | (insert carch) | |
1599 | (remove-overlays cbeg cend) | |
1600 | (delete-region cbeg cend)) | |
1601 | (goto-char cbeg) | |
1602 | (search-forward cat) | |
1603 | (replace-match goal)) | |
ddce2e3e SB |
1604 | (setq todo-categories (todo-make-categories-list t)) |
1605 | (todo-update-categories-sexp))))) | |
8b27b080 SB |
1606 | (with-current-buffer (get-file-buffer tfile) |
1607 | (when archived-count | |
1608 | (unless (zerop archived-count) | |
ddce2e3e SB |
1609 | (todo-update-count 'archived archived-count goal) |
1610 | (todo-update-categories-sexp))) | |
1611 | (todo-category-number goal) | |
8b27b080 | 1612 | ;; If there are only merged done items, show them. |
ddce2e3e SB |
1613 | (let ((todo-show-with-done (zerop (todo-get-count 'todo goal)))) |
1614 | (todo-category-select) | |
8b27b080 SB |
1615 | ;; Put point on the first merged item. |
1616 | (goto-char here))) | |
1617 | (set-marker here nil))) | |
ee7412e4 | 1618 | |
a9b0e28e | 1619 | ;; ----------------------------------------------------------------------------- |
8b27b080 | 1620 | ;;; Item editing |
a9b0e28e | 1621 | ;; ----------------------------------------------------------------------------- |
d04d6b95 | 1622 | |
ddce2e3e | 1623 | (defcustom todo-include-in-diary nil |
4fe738d3 | 1624 | "Non-nil to allow new todo items to be included in the diary." |
27139cd5 | 1625 | :type 'boolean |
ddce2e3e | 1626 | :group 'todo-edit) |
d16da867 | 1627 | |
ddce2e3e | 1628 | (defcustom todo-diary-nonmarking nil |
4fe738d3 | 1629 | "Non-nil to insert new todo diary items as nonmarking by default. |
8b27b080 | 1630 | This appends `diary-nonmarking-symbol' to the front of an item on |
ddce2e3e | 1631 | insertion provided it doesn't begin with `todo-nondiary-marker'." |
27139cd5 | 1632 | :type 'boolean |
ddce2e3e | 1633 | :group 'todo-edit) |
58c7641d | 1634 | |
ddce2e3e | 1635 | (defcustom todo-always-add-time-string nil |
8b27b080 | 1636 | "Non-nil adds current time to a new item's date header by default. |
4fe738d3 | 1637 | When the todo insertion commands have a non-nil \"maybe-notime\" |
8b27b080 | 1638 | argument, this reverses the effect of |
ddce2e3e | 1639 | `todo-always-add-time-string': if t, these commands omit the |
8b27b080 | 1640 | current time, if nil, they include it." |
27139cd5 | 1641 | :type 'boolean |
ddce2e3e | 1642 | :group 'todo-edit) |
58c7641d | 1643 | |
ddce2e3e | 1644 | (defcustom todo-use-only-highlighted-region t |
8b27b080 | 1645 | "Non-nil to enable inserting only highlighted region as new item." |
53e63b4c | 1646 | :type 'boolean |
ddce2e3e | 1647 | :group 'todo-edit) |
2c173503 | 1648 | |
2f99433b SB |
1649 | (defcustom todo-default-priority 'first |
1650 | "Default priority of new and moved items." | |
1651 | :type '(choice (const :tag "Highest priority" first) | |
1652 | (const :tag "Lowest priority" last)) | |
1653 | :group 'todo-edit) | |
1654 | ||
ddce2e3e | 1655 | (defcustom todo-item-mark "*" |
8b27b080 SB |
1656 | "String used to mark items. |
1657 | To ensure item marking works, change the value of this option | |
1658 | only when no items are marked." | |
1659 | :type '(string :validate | |
1660 | (lambda (widget) | |
ddce2e3e | 1661 | (when (string= (widget-value widget) todo-prefix) |
8b27b080 SB |
1662 | (widget-put |
1663 | widget :error | |
ddce2e3e | 1664 | "Invalid value: must be distinct from `todo-prefix'") |
8b27b080 SB |
1665 | widget))) |
1666 | :set (lambda (symbol value) | |
ddce2e3e SB |
1667 | (custom-set-default symbol (propertize value 'face 'todo-mark))) |
1668 | :group 'todo-edit) | |
58c7641d | 1669 | |
ddce2e3e | 1670 | (defcustom todo-comment-string "COMMENT" |
8b27b080 SB |
1671 | "String inserted before optional comment appended to done item." |
1672 | :type 'string | |
1673 | :initialize 'custom-initialize-default | |
ddce2e3e SB |
1674 | :set 'todo-reset-comment-string |
1675 | :group 'todo-edit) | |
58c7641d | 1676 | |
ddce2e3e | 1677 | (defcustom todo-undo-item-omit-comment 'ask |
8b27b080 SB |
1678 | "Whether to omit done item comment on undoing the item. |
1679 | Nil means never omit the comment, t means always omit it, `ask' | |
1680 | means prompt user and omit comment only on confirmation." | |
1681 | :type '(choice (const :tag "Never" nil) | |
1682 | (const :tag "Always" t) | |
1683 | (const :tag "Ask" ask)) | |
ddce2e3e | 1684 | :group 'todo-edit) |
27139cd5 | 1685 | |
ddce2e3e SB |
1686 | (defun todo-toggle-mark-item (&optional n) |
1687 | "Mark item with `todo-item-mark' if unmarked, otherwise unmark it. | |
8b27b080 SB |
1688 | With a positive numerical prefix argument N, change the |
1689 | marking of the next N items." | |
1690 | (interactive "p") | |
ddce2e3e | 1691 | (when (todo-item-string) |
8b27b080 SB |
1692 | (unless (> n 1) (setq n 1)) |
1693 | (dotimes (i n) | |
ddce2e3e SB |
1694 | (let* ((cat (todo-current-category)) |
1695 | (marks (assoc cat todo-categories-with-marks)) | |
8b27b080 | 1696 | (ov (progn |
ddce2e3e SB |
1697 | (unless (looking-at todo-item-start) |
1698 | (todo-item-start)) | |
1699 | (todo-get-overlay 'prefix))) | |
8b27b080 | 1700 | (pref (overlay-get ov 'before-string))) |
ddce2e3e | 1701 | (if (todo-marked-item-p) |
8b27b080 SB |
1702 | (progn |
1703 | (overlay-put ov 'before-string (substring pref 1)) | |
1704 | (if (= (cdr marks) 1) ; Deleted last mark in this category. | |
ddce2e3e SB |
1705 | (setq todo-categories-with-marks |
1706 | (assq-delete-all cat todo-categories-with-marks)) | |
8b27b080 | 1707 | (setcdr marks (1- (cdr marks))))) |
ddce2e3e | 1708 | (overlay-put ov 'before-string (concat todo-item-mark pref)) |
8b27b080 SB |
1709 | (if marks |
1710 | (setcdr marks (1+ (cdr marks))) | |
ddce2e3e SB |
1711 | (push (cons cat 1) todo-categories-with-marks)))) |
1712 | (todo-forward-item)))) | |
0e89c3fc | 1713 | |
ddce2e3e | 1714 | (defun todo-mark-category () |
adc5dbce | 1715 | "Mark all visible items in this category with `todo-item-mark'." |
27139cd5 | 1716 | (interactive) |
ddce2e3e SB |
1717 | (let* ((cat (todo-current-category)) |
1718 | (marks (assoc cat todo-categories-with-marks))) | |
8b27b080 | 1719 | (save-excursion |
27139cd5 | 1720 | (goto-char (point-min)) |
8b27b080 | 1721 | (while (not (eobp)) |
ddce2e3e | 1722 | (let* ((ov (todo-get-overlay 'prefix)) |
8b27b080 | 1723 | (pref (overlay-get ov 'before-string))) |
ddce2e3e SB |
1724 | (unless (todo-marked-item-p) |
1725 | (overlay-put ov 'before-string (concat todo-item-mark pref)) | |
8b27b080 SB |
1726 | (if marks |
1727 | (setcdr marks (1+ (cdr marks))) | |
ddce2e3e SB |
1728 | (push (cons cat 1) todo-categories-with-marks)))) |
1729 | (todo-forward-item))))) | |
f1806c78 | 1730 | |
ddce2e3e SB |
1731 | (defun todo-unmark-category () |
1732 | "Remove `todo-item-mark' from all visible items in this category." | |
27139cd5 | 1733 | (interactive) |
ddce2e3e SB |
1734 | (let* ((cat (todo-current-category)) |
1735 | (marks (assoc cat todo-categories-with-marks))) | |
8b27b080 SB |
1736 | (save-excursion |
1737 | (goto-char (point-min)) | |
1738 | (while (not (eobp)) | |
ddce2e3e | 1739 | (let* ((ov (todo-get-overlay 'prefix)) |
8b27b080 SB |
1740 | ;; No overlay on empty line between todo and done items. |
1741 | (pref (when ov (overlay-get ov 'before-string)))) | |
ddce2e3e | 1742 | (when (todo-marked-item-p) |
8b27b080 | 1743 | (overlay-put ov 'before-string (substring pref 1))) |
ddce2e3e SB |
1744 | (todo-forward-item)))) |
1745 | (setq todo-categories-with-marks | |
1746 | (delq marks todo-categories-with-marks)))) | |
f1806c78 | 1747 | |
ddce2e3e | 1748 | (defvar todo-date-from-calendar nil |
8b27b080 | 1749 | "Helper variable for setting item date from the Emacs Calendar.") |
27139cd5 | 1750 | |
f3a66082 SB |
1751 | (defvar todo-insert-item--keys-so-far) |
1752 | (defvar todo-insert-item--parameters) | |
1753 | ||
1754 | (defun todo-insert-item (&optional arg) | |
1755 | "Insert a new todo item into a category. | |
1756 | ||
1757 | With no prefix argument ARG, add the item to the current | |
1758 | category; with one prefix argument (`C-u'), prompt for a category | |
1759 | from the current todo file; with two prefix arguments (`C-u | |
1760 | C-u'), first prompt for a todo file, then a category in that | |
1761 | file. If a non-existing category is entered, ask whether to add | |
1762 | it to the todo file; if answered affirmatively, add the category | |
1763 | and insert the item there. | |
1764 | ||
1765 | There are a number of item insertion parameters which can be | |
1766 | combined by entering specific keys to produce different insertion | |
1767 | commands. After entering each key, a message shows which have | |
1768 | already been entered and which remain available. See | |
1769 | `todo-basic-insert-item' for details of the parameters and their | |
1770 | effects." | |
1771 | (interactive "P") | |
1772 | (setq todo-insert-item--keys-so-far "i") | |
1773 | (todo-insert-item--next-param nil (list arg) todo-insert-item--parameters)) | |
1774 | ||
ddce2e3e | 1775 | (defun todo-basic-insert-item (&optional arg diary nonmarking date-type time |
8b27b080 | 1776 | region-or-here) |
4fe738d3 SB |
1777 | "Insert a new todo item into a category. |
1778 | This is the function from which the generated Todo mode item | |
8b27b080 | 1779 | insertion commands derive. |
0e89c3fc | 1780 | |
adc5dbce | 1781 | The generated commands have mnemonic key bindings based on the |
8b27b080 SB |
1782 | arguments' values and their order in the command's argument list, |
1783 | as follows: (1) for DIARY `d', (2) for NONMARKING `k', (3) for | |
1784 | DATE-TYPE either `c' for calendar or `d' for date or `n' for | |
1785 | weekday name, (4) for TIME `t', (5) for REGION-OR-HERE either `r' | |
1786 | for region or `h' for here. Sequences of these keys are appended | |
1787 | to the insertion prefix key `i'. Keys that allow a following | |
1788 | key (i.e., any but `r' or `h') must be doubled when used finally. | |
1789 | For example, the command bound to the key sequence `i y h' will | |
1790 | insert a new item with today's date, marked according to the | |
1791 | DIARY argument described below, and with priority according to | |
1792 | the HERE argument; `i y y' does the same except that the priority | |
1793 | is not given by HERE but by prompting. | |
0e89c3fc | 1794 | |
8b27b080 SB |
1795 | In command invocations, ARG is passed as a prefix argument as |
1796 | follows. With no prefix argument, add the item to the current | |
1797 | category; with one prefix argument (`C-u'), prompt for a category | |
4fe738d3 SB |
1798 | from the current todo file; with two prefix arguments (`C-u C-u'), |
1799 | first prompt for a todo file, then a category in that file. If | |
8b27b080 | 1800 | a non-existing category is entered, ask whether to add it to the |
4fe738d3 | 1801 | todo file; if answered affirmatively, add the category and |
8b27b080 | 1802 | insert the item there. |
2c173503 | 1803 | |
8b27b080 SB |
1804 | The remaining arguments are set or left nil by the generated item |
1805 | insertion commands; their meanings are described in the follows | |
1806 | paragraphs. | |
6be04162 | 1807 | |
8b27b080 | 1808 | When argument DIARY is non-nil, this overrides the intent of the |
ddce2e3e SB |
1809 | user option `todo-include-in-diary' for this item: if |
1810 | `todo-include-in-diary' is nil, include the item in the Fancy | |
8b27b080 | 1811 | Diary display, and if it is non-nil, exclude the item from the |
ddce2e3e | 1812 | Fancy Diary display. When DIARY is nil, `todo-include-in-diary' |
8b27b080 | 1813 | has its intended effect. |
27139cd5 | 1814 | |
8b27b080 SB |
1815 | When the item is included in the Fancy Diary display and the |
1816 | argument NONMARKING is non-nil, this overrides the intent of the | |
ddce2e3e SB |
1817 | user option `todo-diary-nonmarking' for this item: if |
1818 | `todo-diary-nonmarking' is nil, append `diary-nonmarking-symbol' | |
8b27b080 | 1819 | to the item, and if it is non-nil, omit `diary-nonmarking-symbol'. |
27139cd5 | 1820 | |
8b27b080 SB |
1821 | The argument DATE-TYPE determines the content of the item's |
1822 | mandatory date header string and how it is added: | |
1823 | - If DATE-TYPE is the symbol `calendar', the Calendar pops up and | |
1824 | when the user puts the cursor on a date and hits RET, that | |
1825 | date, in the format set by `calendar-date-display-form', | |
1826 | becomes the date in the header. | |
1827 | - If DATE-TYPE is a string matching the regexp | |
ddce2e3e | 1828 | `todo-date-pattern', that string becomes the date in the |
8b27b080 | 1829 | header. This case is for the command |
ddce2e3e | 1830 | `todo-insert-item-from-calendar' which is called from the |
8b27b080 SB |
1831 | Calendar. |
1832 | - If DATE-TYPE is the symbol `date', the header contains the date | |
1833 | in the format set by `calendar-date-display-form', with year, | |
1834 | month and day individually prompted for (month with tab | |
1835 | completion). | |
1836 | - If DATE-TYPE is the symbol `dayname' the header contains a | |
1837 | weekday name instead of a date, prompted for with tab | |
1838 | completion. | |
1839 | - If DATE-TYPE has any other value (including nil or none) the | |
1840 | header contains the current date (in the format set by | |
1841 | `calendar-date-display-form'). | |
27139cd5 | 1842 | |
8b27b080 SB |
1843 | With non-nil argument TIME prompt for a time string, which must |
1844 | match `diary-time-regexp'. Typing `<return>' at the prompt | |
1845 | returns the current time, if the user option | |
ddce2e3e | 1846 | `todo-always-add-time-string' is non-nil, otherwise the empty |
8b27b080 SB |
1847 | string (i.e., no time string). If TIME is absent or nil, add or |
1848 | omit the current time string according as | |
ddce2e3e | 1849 | `todo-always-add-time-string' is non-nil or nil, respectively. |
27139cd5 | 1850 | |
8b27b080 SB |
1851 | The argument REGION-OR-HERE determines the source and location of |
1852 | the new item: | |
1853 | - If the REGION-OR-HERE is the symbol `here', prompt for the text of | |
1854 | the new item and, if the command was invoked with point in the todo | |
1855 | items section of the current category, give the new item the | |
1856 | priority of the item at point, lowering the latter's priority and | |
1857 | the priority of the remaining items. If point is in the done items | |
1858 | section of the category, insert the new item as the first todo item | |
1859 | in the category. Likewise, if the command with `here' is invoked | |
1860 | outside of the current category, jump to the chosen category and | |
1861 | insert the new item as the first item in the category. | |
1862 | - If REGION-OR-HERE is the symbol `region', use the region of the | |
1863 | current buffer as the text of the new item, depending on the | |
ddce2e3e | 1864 | value of user option `todo-use-only-highlighted-region': if |
8b27b080 SB |
1865 | this is non-nil, then use the region only when it is |
1866 | highlighted; otherwise, use the region regardless of | |
1867 | highlighting. An error is signalled if there is no region in | |
1868 | the current buffer. Prompt for the item's priority in the | |
1869 | category (an integer between 1 and one more than the number of | |
1870 | items in the category), and insert the item accordingly. | |
1871 | - If REGION-OR-HERE has any other value (in particular, nil or | |
1872 | none), prompt for the text and the item's priority, and insert | |
1873 | the item accordingly." | |
ddce2e3e | 1874 | ;; If invoked outside of Todo mode and there is not yet any Todo |
8b27b080 | 1875 | ;; file, initialize one. |
d610f6dd | 1876 | (if (null (funcall todo-files-function)) |
ddce2e3e | 1877 | (todo-show) |
8b27b080 SB |
1878 | (let ((region (eq region-or-here 'region)) |
1879 | (here (eq region-or-here 'here))) | |
1880 | (when region | |
1881 | (let (use-empty-active-region) | |
ddce2e3e | 1882 | (unless (and todo-use-only-highlighted-region (use-region-p)) |
8b27b080 SB |
1883 | (user-error "There is no active region")))) |
1884 | (let* ((obuf (current-buffer)) | |
ddce2e3e | 1885 | (ocat (todo-current-category)) |
8b27b080 | 1886 | (opoint (point)) |
ddce2e3e | 1887 | (todo-mm (eq major-mode 'todo-mode)) |
8b27b080 | 1888 | (cat+file (cond ((equal arg '(4)) |
ddce2e3e | 1889 | (todo-read-category "Insert in category: ")) |
8b27b080 | 1890 | ((equal arg '(16)) |
ddce2e3e | 1891 | (todo-read-category "Insert in category: " |
8b27b080 SB |
1892 | nil 'file)) |
1893 | (t | |
ddce2e3e SB |
1894 | (cons (todo-current-category) |
1895 | (or todo-current-todo-file | |
1896 | (and todo-show-current-file | |
1897 | todo-global-current-todo-file) | |
1898 | (todo-absolute-file-name | |
1899 | todo-default-todo-file)))))) | |
8b27b080 SB |
1900 | (cat (car cat+file)) |
1901 | (file (cdr cat+file)) | |
1902 | (new-item (if region | |
1903 | (buffer-substring-no-properties | |
1904 | (region-beginning) (region-end)) | |
1905 | (read-from-minibuffer "Todo item: "))) | |
1906 | (date-string (cond | |
1907 | ((eq date-type 'date) | |
ddce2e3e | 1908 | (todo-read-date)) |
8b27b080 | 1909 | ((eq date-type 'dayname) |
ddce2e3e | 1910 | (todo-read-dayname)) |
8b27b080 | 1911 | ((eq date-type 'calendar) |
ddce2e3e SB |
1912 | (setq todo-date-from-calendar t) |
1913 | (or (todo-set-date-from-calendar) | |
8b27b080 SB |
1914 | ;; If user exits Calendar before choosing |
1915 | ;; a date, cancel item insertion. | |
1916 | (keyboard-quit))) | |
1917 | ((and (stringp date-type) | |
ddce2e3e SB |
1918 | (string-match todo-date-pattern date-type)) |
1919 | (setq todo-date-from-calendar date-type) | |
1920 | (todo-set-date-from-calendar)) | |
8b27b080 SB |
1921 | (t |
1922 | (calendar-date-string | |
1923 | (calendar-current-date) t t)))) | |
ddce2e3e SB |
1924 | (time-string (or (and time (todo-read-time)) |
1925 | (and todo-always-add-time-string | |
8b27b080 | 1926 | (substring (current-time-string) 11 16))))) |
ddce2e3e | 1927 | (setq todo-date-from-calendar nil) |
8b27b080 SB |
1928 | (find-file-noselect file 'nowarn) |
1929 | (set-window-buffer (selected-window) | |
1930 | (set-buffer (find-buffer-visiting file))) | |
4fe738d3 SB |
1931 | ;; If this command was invoked outside of a Todo mode buffer, |
1932 | ;; the call to todo-current-category above returned nil. If | |
1933 | ;; we just entered Todo mode now, then cat was set to the | |
1934 | ;; file's first category, but if todo-mode was already | |
1935 | ;; enabled, cat did not get set, so we have to do that. | |
8b27b080 | 1936 | (unless cat |
ddce2e3e SB |
1937 | (setq cat (todo-current-category))) |
1938 | (setq todo-current-todo-file file) | |
1939 | (unless todo-global-current-todo-file | |
1940 | (setq todo-global-current-todo-file todo-current-todo-file)) | |
8b27b080 | 1941 | (let ((buffer-read-only nil) |
ddce2e3e | 1942 | (called-from-outside (not (and todo-mm (equal cat ocat)))) |
8b27b080 SB |
1943 | done-only item-added) |
1944 | (setq new-item | |
1945 | ;; Add date, time and diary marking as required. | |
ddce2e3e SB |
1946 | (concat (if (not (and diary (not todo-include-in-diary))) |
1947 | todo-nondiary-start | |
1948 | (when (and nonmarking (not todo-diary-nonmarking)) | |
8b27b080 SB |
1949 | diary-nonmarking-symbol)) |
1950 | date-string (when (and time-string ; Can be empty. | |
1951 | (not (zerop (length | |
1952 | time-string)))) | |
1953 | (concat " " time-string)) | |
ddce2e3e SB |
1954 | (when (not (and diary (not todo-include-in-diary))) |
1955 | todo-nondiary-end) | |
8b27b080 SB |
1956 | " " new-item)) |
1957 | ;; Indent newlines inserted by C-q C-j if nonspace char follows. | |
1958 | (setq new-item (replace-regexp-in-string "\\(\n\\)[^[:blank:]]" | |
1959 | "\n\t" new-item nil nil 1)) | |
1960 | (unwind-protect | |
1961 | (progn | |
1962 | ;; Make sure the correct category is selected. There | |
1963 | ;; are two cases: (i) we just visited the file, so no | |
1964 | ;; category is selected yet, or (ii) we invoked | |
1965 | ;; insertion "here" from outside the category we want | |
1966 | ;; to insert in (with priority insertion, category | |
ddce2e3e | 1967 | ;; selection is done by todo-set-item-priority). |
8b27b080 SB |
1968 | (when (or (= (- (point-max) (point-min)) (buffer-size)) |
1969 | (and here called-from-outside)) | |
ddce2e3e SB |
1970 | (todo-category-number cat) |
1971 | (todo-category-select)) | |
8b27b080 SB |
1972 | ;; If only done items are displayed in category, |
1973 | ;; toggle to todo items before inserting new item. | |
1974 | (when (save-excursion | |
1975 | (goto-char (point-min)) | |
ddce2e3e | 1976 | (looking-at todo-done-string-start)) |
8b27b080 | 1977 | (setq done-only t) |
ddce2e3e | 1978 | (todo-toggle-view-done-only)) |
8b27b080 SB |
1979 | (if here |
1980 | (progn | |
1981 | ;; If command was invoked with point in done | |
1982 | ;; items section or outside of the current | |
1983 | ;; category, can't insert "here", so to be | |
1984 | ;; useful give new item top priority. | |
ddce2e3e | 1985 | (when (or (todo-done-item-section-p) |
8b27b080 SB |
1986 | called-from-outside |
1987 | done-only) | |
1988 | (goto-char (point-min))) | |
ddce2e3e SB |
1989 | (todo-insert-with-overlays new-item)) |
1990 | (todo-set-item-priority new-item cat t)) | |
8b27b080 SB |
1991 | (setq item-added t)) |
1992 | ;; If user cancels before setting priority, restore | |
1993 | ;; display. | |
1994 | (unless item-added | |
1995 | (if ocat | |
1996 | (progn | |
1997 | (unless (equal cat ocat) | |
ddce2e3e SB |
1998 | (todo-category-number ocat) |
1999 | (todo-category-select)) | |
2000 | (and done-only (todo-toggle-view-done-only))) | |
8b27b080 SB |
2001 | (set-window-buffer (selected-window) (set-buffer obuf))) |
2002 | (goto-char opoint)) | |
2003 | ;; If the todo items section is not visible when the | |
2004 | ;; insertion command is called (either because only done | |
2005 | ;; items were shown or because the category was not in the | |
2006 | ;; current buffer), then if the item is inserted at the | |
2007 | ;; end of the category, point is at eob and eob at | |
2008 | ;; window-start, so that higher priority todo items are | |
2009 | ;; out of view. So we recenter to make sure the todo | |
2010 | ;; items are displayed in the window. | |
2011 | (when item-added (recenter))) | |
ddce2e3e SB |
2012 | (todo-update-count 'todo 1) |
2013 | (if (or diary todo-include-in-diary) (todo-update-count 'diary 1)) | |
2014 | (todo-update-categories-sexp)))))) | |
8b27b080 | 2015 | |
ddce2e3e | 2016 | (defun todo-set-date-from-calendar () |
8b27b080 | 2017 | "Return string of date chosen from Calendar." |
ddce2e3e SB |
2018 | (cond ((and (stringp todo-date-from-calendar) |
2019 | (string-match todo-date-pattern todo-date-from-calendar)) | |
2020 | todo-date-from-calendar) | |
2021 | (todo-date-from-calendar | |
8b27b080 SB |
2022 | (let (calendar-view-diary-initially-flag) |
2023 | (calendar)) ; *Calendar* is now current buffer. | |
2024 | (define-key calendar-mode-map [remap newline] 'exit-recursive-edit) | |
2025 | ;; If user exits Calendar before choosing a date, clean up properly. | |
2026 | (define-key calendar-mode-map | |
2027 | [remap calendar-exit] (lambda () | |
2028 | (interactive) | |
2029 | (progn | |
2030 | (calendar-exit) | |
2031 | (exit-recursive-edit)))) | |
2032 | (message "Put cursor on a date and type <return> to set it.") | |
2033 | (recursive-edit) | |
2034 | (unwind-protect | |
2035 | (when (equal (buffer-name) calendar-buffer) | |
ddce2e3e | 2036 | (setq todo-date-from-calendar |
8b27b080 SB |
2037 | (calendar-date-string (calendar-cursor-to-date t) t t)) |
2038 | (calendar-exit) | |
ddce2e3e | 2039 | todo-date-from-calendar) |
8b27b080 SB |
2040 | (define-key calendar-mode-map [remap newline] nil) |
2041 | (define-key calendar-mode-map [remap calendar-exit] nil) | |
2042 | (unless (zerop (recursion-depth)) (exit-recursive-edit)) | |
ddce2e3e SB |
2043 | (when (stringp todo-date-from-calendar) |
2044 | todo-date-from-calendar))))) | |
27139cd5 | 2045 | |
ddce2e3e | 2046 | (defun todo-insert-item-from-calendar (&optional arg) |
8b27b080 SB |
2047 | "Prompt for and insert a new item with date selected from calendar. |
2048 | Invoked without prefix argument ARG, insert the item into the | |
2049 | current category, without one prefix argument, prompt for the | |
2050 | category from the current todo file or from one listed in | |
ddce2e3e | 2051 | `todo-category-completions-files'; with two prefix arguments, |
8b27b080 SB |
2052 | prompt for a todo file and then for a category in it." |
2053 | (interactive "P") | |
ddce2e3e | 2054 | (setq todo-date-from-calendar |
8b27b080 SB |
2055 | (calendar-date-string (calendar-cursor-to-date t) t t)) |
2056 | (calendar-exit) | |
ddce2e3e | 2057 | (todo-basic-insert-item arg nil nil todo-date-from-calendar)) |
a9b0e28e | 2058 | |
ddce2e3e | 2059 | (define-key calendar-mode-map "it" 'todo-insert-item-from-calendar) |
a9b0e28e | 2060 | |
ddce2e3e | 2061 | (defun todo-copy-item () |
8b27b080 SB |
2062 | "Copy item at point and insert the copy as a new item." |
2063 | (interactive) | |
ddce2e3e SB |
2064 | (unless (or (todo-done-item-p) (looking-at "^$")) |
2065 | (let ((copy (todo-item-string)) | |
2066 | (diary-item (todo-diary-item-p))) | |
2067 | (todo-set-item-priority copy (todo-current-category) t) | |
2068 | (todo-update-count 'todo 1) | |
2069 | (when diary-item (todo-update-count 'diary 1)) | |
2070 | (todo-update-categories-sexp)))) | |
2071 | ||
2072 | (defun todo-delete-item () | |
8b27b080 SB |
2073 | "Delete at least one item in this category. |
2074 | If there are marked items, delete all of these; otherwise, delete | |
2075 | the item at point." | |
2076 | (interactive) | |
2077 | (let (ov) | |
2078 | (unwind-protect | |
ddce2e3e SB |
2079 | (let* ((cat (todo-current-category)) |
2080 | (marked (assoc cat todo-categories-with-marks)) | |
2081 | (item (unless marked (todo-item-string))) | |
8b27b080 | 2082 | (answer (if marked |
ddce2e3e | 2083 | (todo-y-or-n-p |
8b27b080 SB |
2084 | "Permanently delete all marked items? ") |
2085 | (when item | |
2086 | (setq ov (make-overlay | |
ddce2e3e SB |
2087 | (save-excursion (todo-item-start)) |
2088 | (save-excursion (todo-item-end)))) | |
2089 | (overlay-put ov 'face 'todo-search) | |
2090 | (todo-y-or-n-p "Permanently delete this item? ")))) | |
8b27b080 SB |
2091 | buffer-read-only) |
2092 | (when answer | |
2093 | (and marked (goto-char (point-min))) | |
2094 | (catch 'done | |
2095 | (while (not (eobp)) | |
ddce2e3e | 2096 | (if (or (and marked (todo-marked-item-p)) item) |
8b27b080 | 2097 | (progn |
ddce2e3e SB |
2098 | (if (todo-done-item-p) |
2099 | (todo-update-count 'done -1) | |
2100 | (todo-update-count 'todo -1 cat) | |
2101 | (and (todo-diary-item-p) | |
2102 | (todo-update-count 'diary -1))) | |
8b27b080 | 2103 | (if ov (delete-overlay ov)) |
ddce2e3e | 2104 | (todo-remove-item) |
8b27b080 SB |
2105 | ;; Don't leave point below last item. |
2106 | (and item (bolp) (eolp) (< (point-min) (point-max)) | |
ddce2e3e | 2107 | (todo-backward-item)) |
8b27b080 SB |
2108 | (when item |
2109 | (throw 'done (setq item nil)))) | |
ddce2e3e | 2110 | (todo-forward-item)))) |
8b27b080 | 2111 | (when marked |
ddce2e3e SB |
2112 | (setq todo-categories-with-marks |
2113 | (assq-delete-all cat todo-categories-with-marks))) | |
2114 | (todo-update-categories-sexp) | |
2115 | (todo-prefix-overlays))) | |
8b27b080 | 2116 | (if ov (delete-overlay ov))))) |
a9b0e28e | 2117 | |
ddce2e3e | 2118 | (defun todo-edit-item (&optional arg) |
4fe738d3 | 2119 | "Edit the todo item at point. |
8b27b080 SB |
2120 | With non-nil prefix argument ARG, include the item's date/time |
2121 | header, making it also editable; otherwise, include only the item | |
2122 | content. | |
a9b0e28e | 2123 | |
8b27b080 | 2124 | If the item consists of only one logical line, edit it in the |
ddce2e3e | 2125 | minibuffer; otherwise, edit it in Todo Edit mode." |
8b27b080 | 2126 | (interactive "P") |
ddce2e3e | 2127 | (when (todo-item-string) |
8b27b080 | 2128 | (let* ((opoint (point)) |
ddce2e3e | 2129 | (start (todo-item-start)) |
8b27b080 SB |
2130 | (item-beg (progn |
2131 | (re-search-forward | |
ddce2e3e | 2132 | (concat todo-date-string-start todo-date-pattern |
8b27b080 | 2133 | "\\( " diary-time-regexp "\\)?" |
ddce2e3e | 2134 | (regexp-quote todo-nondiary-end) "?") |
8b27b080 SB |
2135 | (line-end-position) t) |
2136 | (1+ (- (point) start)))) | |
ddce2e3e SB |
2137 | (header (substring (todo-item-string) 0 item-beg)) |
2138 | (item (if arg (todo-item-string) | |
2139 | (substring (todo-item-string) item-beg))) | |
8b27b080 SB |
2140 | (multiline (> (length (split-string item "\n")) 1)) |
2141 | (buffer-read-only nil)) | |
2142 | (if multiline | |
ddce2e3e | 2143 | (todo-edit-multiline-item) |
8b27b080 SB |
2144 | (let ((new (concat (if arg "" header) |
2145 | (read-string "Edit: " (if arg | |
2146 | (cons item item-beg) | |
2147 | (cons item 0)))))) | |
2148 | (when arg | |
ddce2e3e SB |
2149 | (while (not (string-match (concat todo-date-string-start |
2150 | todo-date-pattern) new)) | |
8b27b080 SB |
2151 | (setq new (read-from-minibuffer |
2152 | "Item must start with a date: " new)))) | |
2153 | ;; Ensure lines following hard newlines are indented. | |
2154 | (setq new (replace-regexp-in-string "\\(\n\\)[^[:blank:]]" | |
2155 | "\n\t" new nil nil 1)) | |
2156 | ;; If user moved point during editing, make sure it moves back. | |
2157 | (goto-char opoint) | |
ddce2e3e SB |
2158 | (todo-remove-item) |
2159 | (todo-insert-with-overlays new) | |
8b27b080 | 2160 | (move-to-column item-beg)))))) |
a9b0e28e | 2161 | |
ddce2e3e | 2162 | (defun todo-edit-multiline-item () |
4fe738d3 | 2163 | "Edit current todo item in Todo Edit mode. |
ddce2e3e | 2164 | Use of newlines invokes `todo-indent' to insure compliance with |
8b27b080 SB |
2165 | the format of Diary entries." |
2166 | (interactive) | |
ddce2e3e SB |
2167 | (when (todo-item-string) |
2168 | (let ((buf todo-edit-buffer)) | |
8b27b080 SB |
2169 | (set-window-buffer (selected-window) |
2170 | (set-buffer (make-indirect-buffer (buffer-name) buf))) | |
ddce2e3e SB |
2171 | (narrow-to-region (todo-item-start) (todo-item-end)) |
2172 | (todo-edit-mode) | |
8b27b080 | 2173 | (message "%s" (substitute-command-keys |
ddce2e3e SB |
2174 | (concat "Type \\[todo-edit-quit] " |
2175 | "to return to Todo mode.\n")))))) | |
a9b0e28e | 2176 | |
ddce2e3e SB |
2177 | (defun todo-edit-quit () |
2178 | "Return from Todo Edit mode to Todo mode. | |
8b27b080 | 2179 | If the item contains hard line breaks, make sure the following |
ddce2e3e | 2180 | lines are indented by `todo-indent-to-here' to conform to diary |
8b27b080 SB |
2181 | format. |
2182 | ||
ddce2e3e | 2183 | If the whole file was in Todo Edit mode, check before returning |
4fe738d3 SB |
2184 | whether the file is still a valid todo file and if so, also |
2185 | recalculate the todo file's categories sexp, in case changes were | |
2186 | made in the number or names of categories." | |
8b27b080 SB |
2187 | (interactive) |
2188 | (if (> (buffer-size) (- (point-max) (point-min))) | |
2189 | ;; We got here via `e m'. | |
2190 | (let ((item (buffer-string)) | |
2191 | (regex "\\(\n\\)[^[:blank:]]") | |
2192 | (buf (buffer-base-buffer))) | |
ddce2e3e SB |
2193 | (while (not (string-match (concat todo-date-string-start |
2194 | todo-date-pattern) item)) | |
8b27b080 SB |
2195 | (setq item (read-from-minibuffer |
2196 | "Item must start with a date: " item))) | |
2197 | ;; Ensure lines following hard newlines are indented. | |
2198 | (when (string-match regex (buffer-string)) | |
2199 | (setq item (replace-regexp-in-string regex "\n\t" item nil nil 1)) | |
2200 | (delete-region (point-min) (point-max)) | |
2201 | (insert item)) | |
2202 | (kill-buffer) | |
2203 | (unless (eq (current-buffer) buf) | |
2204 | (set-window-buffer (selected-window) (set-buffer buf)))) | |
2205 | ;; We got here via `F e'. | |
ddce2e3e | 2206 | (when (todo-check-format) |
8b27b080 SB |
2207 | ;; FIXME: separate out sexp check? |
2208 | ;; If manual editing makes e.g. item counts change, have to | |
ddce2e3e | 2209 | ;; call this to update todo-categories, but it restores |
8b27b080 | 2210 | ;; category order to list order. |
ddce2e3e SB |
2211 | ;; (todo-repair-categories-sexp) |
2212 | ;; Compare (todo-make-categories-list t) with sexp and if | |
2213 | ;; different ask (todo-update-categories-sexp) ? | |
2214 | (todo-mode) | |
2215 | (let* ((cat-beg (concat "^" (regexp-quote todo-category-beg) | |
8b27b080 SB |
2216 | "\\(.*\\)$")) |
2217 | (curline (buffer-substring-no-properties | |
2218 | (line-beginning-position) (line-end-position))) | |
2219 | (cat (cond ((string-match cat-beg curline) | |
2220 | (match-string-no-properties 1 curline)) | |
2221 | ((or (re-search-backward cat-beg nil t) | |
2222 | (re-search-forward cat-beg nil t)) | |
2223 | (match-string-no-properties 1))))) | |
ddce2e3e SB |
2224 | (todo-category-number cat) |
2225 | (todo-category-select) | |
8b27b080 | 2226 | (goto-char (point-min)))))) |
a9b0e28e | 2227 | |
ddce2e3e | 2228 | (defun todo-basic-edit-item-header (what &optional inc) |
8b27b080 | 2229 | "Function underlying commands to edit item date/time header. |
f1806c78 | 2230 | |
8b27b080 SB |
2231 | The argument WHAT (passed by invoking commands) specifies what |
2232 | part of the header to edit; possible values are these symbols: | |
2233 | `date', to edit the year, month, and day of the date string; | |
2234 | `time', to edit just the time string; `calendar', to select the | |
2235 | date from the Calendar; `today', to set the date to today's date; | |
2236 | `dayname', to set the date string to the name of a day or to | |
2237 | change the day name; and `year', `month' or `day', to edit only | |
2238 | these respective parts of the date string (`day' is the number of | |
2239 | the given day of the month, and `month' is either the name of the | |
2240 | given month or its number, depending on the value of | |
2241 | `calendar-date-display-form'). | |
f1806c78 | 2242 | |
8b27b080 SB |
2243 | The optional argument INC is a positive or negative integer |
2244 | \(passed by invoking commands as a numerical prefix argument) | |
2245 | that in conjunction with the WHAT values `year', `month' or | |
2246 | `day', increments or decrements the specified date string | |
2247 | component by the specified number of suitable units, i.e., years, | |
2248 | months, or days, with automatic adjustment of the other date | |
2249 | string components as necessary. | |
d04d6b95 | 2250 | |
8b27b080 SB |
2251 | If there are marked items, apply the same edit to all of these; |
2252 | otherwise, edit just the item at point." | |
ddce2e3e SB |
2253 | (let* ((cat (todo-current-category)) |
2254 | (marked (assoc cat todo-categories-with-marks)) | |
8b27b080 | 2255 | (first t) |
ddce2e3e | 2256 | (todo-date-from-calendar t) |
8b27b080 SB |
2257 | (buffer-read-only nil) |
2258 | ndate ntime year monthname month day | |
2259 | dayname) ; Needed by calendar-date-display-form. | |
2260 | (save-excursion | |
ddce2e3e | 2261 | (or (and marked (goto-char (point-min))) (todo-item-start)) |
8b27b080 SB |
2262 | (catch 'end |
2263 | (while (not (eobp)) | |
2264 | (and marked | |
ddce2e3e SB |
2265 | (while (not (todo-marked-item-p)) |
2266 | (todo-forward-item) | |
8b27b080 | 2267 | (and (eobp) (throw 'end nil)))) |
ddce2e3e SB |
2268 | (re-search-forward (concat todo-date-string-start "\\(?1:" |
2269 | todo-date-pattern | |
8b27b080 | 2270 | "\\)\\(?2: " diary-time-regexp "\\)?" |
ddce2e3e | 2271 | (regexp-quote todo-nondiary-end) "?") |
8b27b080 SB |
2272 | (line-end-position) t) |
2273 | (let* ((odate (match-string-no-properties 1)) | |
2274 | (otime (match-string-no-properties 2)) | |
d7a49dae | 2275 | (odayname (match-string-no-properties 5)) |
8b27b080 SB |
2276 | (omonthname (match-string-no-properties 6)) |
2277 | (omonth (match-string-no-properties 7)) | |
2278 | (oday (match-string-no-properties 8)) | |
2279 | (oyear (match-string-no-properties 9)) | |
ddce2e3e | 2280 | (tmn-array todo-month-name-array) |
8b27b080 | 2281 | (mlist (append tmn-array nil)) |
ddce2e3e | 2282 | (tma-array todo-month-abbrev-array) |
8b27b080 SB |
2283 | (mablist (append tma-array nil)) |
2284 | (yy (and oyear (unless (string= oyear "*") | |
2285 | (string-to-number oyear)))) | |
2286 | (mm (or (and omonth (unless (string= omonth "*") | |
2287 | (string-to-number omonth))) | |
2288 | (1+ (- (length mlist) | |
2289 | (length (or (member omonthname mlist) | |
2290 | (member omonthname mablist))))))) | |
2291 | (dd (and oday (unless (string= oday "*") | |
2292 | (string-to-number oday))))) | |
2293 | ;; If there are marked items, use only the first to set | |
2294 | ;; header changes, and apply these to all marked items. | |
2295 | (when first | |
2296 | (cond | |
2297 | ((eq what 'date) | |
ddce2e3e | 2298 | (setq ndate (todo-read-date))) |
8b27b080 | 2299 | ((eq what 'calendar) |
ddce2e3e | 2300 | (setq ndate (save-match-data (todo-set-date-from-calendar)))) |
8b27b080 SB |
2301 | ((eq what 'today) |
2302 | (setq ndate (calendar-date-string (calendar-current-date) t t))) | |
2303 | ((eq what 'dayname) | |
ddce2e3e | 2304 | (setq ndate (todo-read-dayname))) |
8b27b080 | 2305 | ((eq what 'time) |
ddce2e3e | 2306 | (setq ntime (save-match-data (todo-read-time))) |
8b27b080 SB |
2307 | (when (> (length ntime) 0) |
2308 | (setq ntime (concat " " ntime)))) | |
2309 | ;; When date string consists only of a day name, | |
d7a49dae SB |
2310 | ;; passing other date components is a noop. |
2311 | ((and odayname (memq what '(year month day)))) | |
8b27b080 SB |
2312 | ((eq what 'year) |
2313 | (setq day oday | |
2314 | monthname omonthname | |
2315 | month omonth | |
2316 | year (cond ((not current-prefix-arg) | |
ddce2e3e | 2317 | (todo-read-date 'year)) |
8b27b080 SB |
2318 | ((string= oyear "*") |
2319 | (user-error "Cannot increment *")) | |
2320 | (t | |
2321 | (number-to-string (+ yy inc)))))) | |
2322 | ((eq what 'month) | |
2323 | (setf day oday | |
2324 | year oyear | |
2325 | (if (memq 'month calendar-date-display-form) | |
2326 | month | |
2327 | monthname) | |
2328 | (cond ((not current-prefix-arg) | |
ddce2e3e | 2329 | (todo-read-date 'month)) |
8b27b080 SB |
2330 | ((or (string= omonth "*") (= mm 13)) |
2331 | (user-error "Cannot increment *")) | |
2332 | (t | |
2333 | (let ((mminc (+ mm inc))) | |
2334 | ;; Increment or decrement month by INC | |
2335 | ;; modulo 12. | |
2336 | (setq mm (% mminc 12)) | |
2337 | ;; If result is 0, make month December. | |
2338 | (setq mm (if (= mm 0) 12 (abs mm))) | |
2339 | ;; Adjust year if necessary. | |
2340 | (setq year (or (and (cond ((> mminc 12) | |
2341 | (+ yy (/ mminc 12))) | |
2342 | ((< mminc 1) | |
2343 | (- yy (/ mminc 12) 1)) | |
2344 | (t yy)) | |
2345 | (number-to-string yy)) | |
2346 | oyear))) | |
2347 | ;; Return the changed numerical month as | |
2348 | ;; a string or the corresponding month name. | |
2349 | (if omonth | |
2350 | (number-to-string mm) | |
2351 | (aref tma-array (1- mm)))))) | |
2352 | (let ((yy (string-to-number year)) ; 0 if year is "*". | |
2353 | ;; When mm is 13 (corresponding to "*" as value | |
2354 | ;; of month), this raises an args-out-of-range | |
2355 | ;; error in calendar-last-day-of-month, so use 1 | |
2356 | ;; (corresponding to January) to get 31 days. | |
2357 | (mm (if (= mm 13) 1 mm))) | |
2358 | (if (> (string-to-number day) | |
2359 | (calendar-last-day-of-month mm yy)) | |
2360 | (user-error "%s %s does not have %s days" | |
2361 | (aref tmn-array (1- mm)) | |
2362 | (if (= mm 2) yy "") day)))) | |
2363 | ((eq what 'day) | |
2364 | (setq year oyear | |
2365 | month omonth | |
2366 | monthname omonthname | |
2367 | day (cond | |
2368 | ((not current-prefix-arg) | |
ddce2e3e | 2369 | (todo-read-date 'day mm oyear)) |
8b27b080 SB |
2370 | ((string= oday "*") |
2371 | (user-error "Cannot increment *")) | |
2372 | ((or (string= omonth "*") (string= omonthname "*")) | |
2373 | (setq dd (+ dd inc)) | |
2374 | (if (> dd 31) | |
2375 | (user-error "A month cannot have more than 31 days") | |
2376 | (number-to-string dd))) | |
2377 | ;; Increment or decrement day by INC, | |
2378 | ;; adjusting month and year if necessary | |
2379 | ;; (if year is "*" assume current year to | |
2380 | ;; calculate adjustment). | |
2381 | (t | |
2382 | (let* ((yy (or yy (calendar-extract-year | |
2383 | (calendar-current-date)))) | |
2384 | (date (calendar-gregorian-from-absolute | |
2385 | (+ (calendar-absolute-from-gregorian | |
2386 | (list mm dd yy)) inc))) | |
2387 | (adjmm (nth 0 date))) | |
2388 | ;; Set year and month(name) to adjusted values. | |
2389 | (unless (string= year "*") | |
2390 | (setq year (number-to-string (nth 2 date)))) | |
2391 | (if month | |
2392 | (setq month (number-to-string adjmm)) | |
2393 | (setq monthname (aref tma-array (1- adjmm)))) | |
2394 | ;; Return changed numerical day as a string. | |
2395 | (number-to-string (nth 1 date))))))))) | |
d7a49dae SB |
2396 | (unless odayname |
2397 | ;; If year, month or day date string components were | |
2398 | ;; changed, rebuild the date string. | |
2399 | (when (memq what '(year month day)) | |
2400 | (setq ndate (mapconcat 'eval calendar-date-display-form "")))) | |
8b27b080 SB |
2401 | (when ndate (replace-match ndate nil nil nil 1)) |
2402 | ;; Add new time string to the header, if it was supplied. | |
2403 | (when ntime | |
2404 | (if otime | |
2405 | (replace-match ntime nil nil nil 2) | |
2406 | (goto-char (match-end 1)) | |
2407 | (insert ntime))) | |
ddce2e3e | 2408 | (setq todo-date-from-calendar nil) |
8b27b080 SB |
2409 | (setq first nil)) |
2410 | ;; Apply the changes to the first marked item header to the | |
2411 | ;; remaining marked items. If there are no marked items, | |
2412 | ;; we're finished. | |
2413 | (if marked | |
ddce2e3e | 2414 | (todo-forward-item) |
8b27b080 | 2415 | (goto-char (point-max)))))))) |
20166aea | 2416 | |
ddce2e3e | 2417 | (defun todo-edit-item-header () |
8b27b080 | 2418 | "Interactively edit at least the date of item's date/time header. |
ddce2e3e | 2419 | If user option `todo-always-add-time-string' is non-nil, also |
8b27b080 SB |
2420 | edit item's time string." |
2421 | (interactive) | |
ddce2e3e SB |
2422 | (todo-basic-edit-item-header 'date) |
2423 | (when todo-always-add-time-string | |
2424 | (todo-edit-item-time))) | |
20166aea | 2425 | |
ddce2e3e | 2426 | (defun todo-edit-item-time () |
8b27b080 SB |
2427 | "Interactively edit the time string of item's date/time header." |
2428 | (interactive) | |
ddce2e3e | 2429 | (todo-basic-edit-item-header 'time)) |
f1806c78 | 2430 | |
ddce2e3e | 2431 | (defun todo-edit-item-date-from-calendar () |
8b27b080 SB |
2432 | "Interactively edit item's date using the Calendar." |
2433 | (interactive) | |
ddce2e3e | 2434 | (todo-basic-edit-item-header 'calendar)) |
20166aea | 2435 | |
ddce2e3e | 2436 | (defun todo-edit-item-date-to-today () |
8b27b080 SB |
2437 | "Set item's date to today's date." |
2438 | (interactive) | |
ddce2e3e | 2439 | (todo-basic-edit-item-header 'today)) |
58c7641d | 2440 | |
ddce2e3e | 2441 | (defun todo-edit-item-date-day-name () |
8b27b080 SB |
2442 | "Replace item's date with the name of a day of the week." |
2443 | (interactive) | |
ddce2e3e | 2444 | (todo-basic-edit-item-header 'dayname)) |
58c7641d | 2445 | |
ddce2e3e | 2446 | (defun todo-edit-item-date-year (&optional inc) |
8b27b080 SB |
2447 | "Interactively edit the year of item's date string. |
2448 | With prefix argument INC a positive or negative integer, | |
2449 | increment or decrement the year by INC." | |
2450 | (interactive "p") | |
ddce2e3e | 2451 | (todo-basic-edit-item-header 'year inc)) |
b58fa72f | 2452 | |
ddce2e3e | 2453 | (defun todo-edit-item-date-month (&optional inc) |
8b27b080 SB |
2454 | "Interactively edit the month of item's date string. |
2455 | With prefix argument INC a positive or negative integer, | |
2456 | increment or decrement the month by INC." | |
2457 | (interactive "p") | |
ddce2e3e | 2458 | (todo-basic-edit-item-header 'month inc)) |
58c7641d | 2459 | |
ddce2e3e | 2460 | (defun todo-edit-item-date-day (&optional inc) |
8b27b080 SB |
2461 | "Interactively edit the day of the month of item's date string. |
2462 | With prefix argument INC a positive or negative integer, | |
2463 | increment or decrement the day by INC." | |
2464 | (interactive "p") | |
ddce2e3e | 2465 | (todo-basic-edit-item-header 'day inc)) |
58c7641d | 2466 | |
ddce2e3e | 2467 | (defun todo-edit-item-diary-inclusion () |
8b27b080 | 2468 | "Change diary status of one or more todo items in this category. |
ddce2e3e | 2469 | That is, insert `todo-nondiary-marker' if the candidate items |
8b27b080 | 2470 | lack this marking; otherwise, remove it. |
58c7641d | 2471 | |
8b27b080 SB |
2472 | If there are marked todo items, change the diary status of all |
2473 | and only these, otherwise change the diary status of the item at | |
2474 | point." | |
27139cd5 | 2475 | (interactive) |
8b27b080 | 2476 | (let ((buffer-read-only) |
ddce2e3e SB |
2477 | (marked (assoc (todo-current-category) |
2478 | todo-categories-with-marks))) | |
8b27b080 SB |
2479 | (catch 'stop |
2480 | (save-excursion | |
2481 | (when marked (goto-char (point-min))) | |
2482 | (while (not (eobp)) | |
ddce2e3e | 2483 | (if (todo-done-item-p) |
8b27b080 | 2484 | (throw 'stop (message "Done items cannot be edited")) |
ddce2e3e SB |
2485 | (unless (and marked (not (todo-marked-item-p))) |
2486 | (let* ((beg (todo-item-start)) | |
2487 | (lim (save-excursion (todo-item-end))) | |
8b27b080 | 2488 | (end (save-excursion |
ddce2e3e SB |
2489 | (or (todo-time-string-matcher lim) |
2490 | (todo-date-string-matcher lim))))) | |
2491 | (if (looking-at (regexp-quote todo-nondiary-start)) | |
8b27b080 SB |
2492 | (progn |
2493 | (replace-match "") | |
ddce2e3e | 2494 | (search-forward todo-nondiary-end (1+ end) t) |
8b27b080 | 2495 | (replace-match "") |
ddce2e3e | 2496 | (todo-update-count 'diary 1)) |
8b27b080 | 2497 | (when end |
ddce2e3e | 2498 | (insert todo-nondiary-start) |
8b27b080 | 2499 | (goto-char (1+ end)) |
ddce2e3e SB |
2500 | (insert todo-nondiary-end) |
2501 | (todo-update-count 'diary -1))))) | |
8b27b080 | 2502 | (unless marked (throw 'stop nil)) |
ddce2e3e SB |
2503 | (todo-forward-item))))) |
2504 | (todo-update-categories-sexp))) | |
d04d6b95 | 2505 | |
ddce2e3e | 2506 | (defun todo-edit-category-diary-inclusion (arg) |
8b27b080 SB |
2507 | "Make all items in this category diary items. |
2508 | With prefix ARG, make all items in this category non-diary | |
2509 | items." | |
2510 | (interactive "P") | |
27139cd5 SB |
2511 | (save-excursion |
2512 | (goto-char (point-min)) | |
ddce2e3e SB |
2513 | (let ((todo-count (todo-get-count 'todo)) |
2514 | (diary-count (todo-get-count 'diary)) | |
8b27b080 SB |
2515 | (buffer-read-only)) |
2516 | (catch 'stop | |
2517 | (while (not (eobp)) | |
ddce2e3e | 2518 | (if (todo-done-item-p) ; We've gone too far. |
8b27b080 | 2519 | (throw 'stop nil) |
ddce2e3e SB |
2520 | (let* ((beg (todo-item-start)) |
2521 | (lim (save-excursion (todo-item-end))) | |
8b27b080 | 2522 | (end (save-excursion |
ddce2e3e SB |
2523 | (or (todo-time-string-matcher lim) |
2524 | (todo-date-string-matcher lim))))) | |
8b27b080 | 2525 | (if arg |
ddce2e3e SB |
2526 | (unless (looking-at (regexp-quote todo-nondiary-start)) |
2527 | (insert todo-nondiary-start) | |
8b27b080 | 2528 | (goto-char (1+ end)) |
ddce2e3e SB |
2529 | (insert todo-nondiary-end)) |
2530 | (when (looking-at (regexp-quote todo-nondiary-start)) | |
8b27b080 | 2531 | (replace-match "") |
ddce2e3e | 2532 | (search-forward todo-nondiary-end (1+ end) t) |
8b27b080 | 2533 | (replace-match ""))))) |
ddce2e3e | 2534 | (todo-forward-item)) |
8b27b080 | 2535 | (unless (if arg (zerop diary-count) (= diary-count todo-count)) |
ddce2e3e | 2536 | (todo-update-count 'diary (if arg |
8b27b080 SB |
2537 | (- diary-count) |
2538 | (- todo-count diary-count)))) | |
ddce2e3e | 2539 | (todo-update-categories-sexp))))) |
ee7412e4 | 2540 | |
ddce2e3e | 2541 | (defun todo-edit-item-diary-nonmarking () |
8b27b080 SB |
2542 | "Change non-marking of one or more diary items in this category. |
2543 | That is, insert `diary-nonmarking-symbol' if the candidate items | |
2544 | lack this marking; otherwise, remove it. | |
2545 | ||
2546 | If there are marked todo items, change the non-marking status of | |
2547 | all and only these, otherwise change the non-marking status of | |
2548 | the item at point." | |
27139cd5 | 2549 | (interactive) |
8b27b080 | 2550 | (let ((buffer-read-only) |
ddce2e3e SB |
2551 | (marked (assoc (todo-current-category) |
2552 | todo-categories-with-marks))) | |
8b27b080 SB |
2553 | (catch 'stop |
2554 | (save-excursion | |
2555 | (when marked (goto-char (point-min))) | |
2556 | (while (not (eobp)) | |
ddce2e3e | 2557 | (if (todo-done-item-p) |
8b27b080 | 2558 | (throw 'stop (message "Done items cannot be edited")) |
ddce2e3e SB |
2559 | (unless (and marked (not (todo-marked-item-p))) |
2560 | (todo-item-start) | |
2561 | (unless (looking-at (regexp-quote todo-nondiary-start)) | |
8b27b080 SB |
2562 | (if (looking-at (regexp-quote diary-nonmarking-symbol)) |
2563 | (replace-match "") | |
2564 | (insert diary-nonmarking-symbol)))) | |
2565 | (unless marked (throw 'stop nil)) | |
ddce2e3e | 2566 | (todo-forward-item))))))) |
8b27b080 | 2567 | |
ddce2e3e | 2568 | (defun todo-edit-category-diary-nonmarking (arg) |
8b27b080 SB |
2569 | "Add `diary-nonmarking-symbol' to all diary items in this category. |
2570 | With prefix ARG, remove `diary-nonmarking-symbol' from all diary | |
2571 | items in this category." | |
2572 | (interactive "P") | |
27139cd5 SB |
2573 | (save-excursion |
2574 | (goto-char (point-min)) | |
8b27b080 SB |
2575 | (let (buffer-read-only) |
2576 | (catch 'stop | |
2577 | (while (not (eobp)) | |
ddce2e3e | 2578 | (if (todo-done-item-p) ; We've gone too far. |
8b27b080 | 2579 | (throw 'stop nil) |
ddce2e3e | 2580 | (unless (looking-at (regexp-quote todo-nondiary-start)) |
8b27b080 SB |
2581 | (if arg |
2582 | (when (looking-at (regexp-quote diary-nonmarking-symbol)) | |
2583 | (replace-match "")) | |
2584 | (unless (looking-at (regexp-quote diary-nonmarking-symbol)) | |
2585 | (insert diary-nonmarking-symbol)))) | |
ddce2e3e | 2586 | (todo-forward-item))))))) |
8b27b080 | 2587 | |
ddce2e3e | 2588 | (defun todo-set-item-priority (&optional item cat new arg) |
8b27b080 SB |
2589 | "Prompt for and set ITEM's priority in CATegory. |
2590 | ||
2591 | Interactively, ITEM is the todo item at point, CAT is the current | |
2592 | category, and the priority is a number between 1 and the number | |
2593 | of items in the category. Non-interactively, non-nil NEW means | |
2594 | ITEM is a new item and the lowest priority is one more than the | |
2595 | number of items in CAT. | |
2596 | ||
2597 | The new priority is set either interactively by prompt or by a | |
2598 | numerical prefix argument, or noninteractively by argument ARG, | |
2599 | whose value can be either of the symbols `raise' or `lower', | |
2600 | meaning to raise or lower the item's priority by one." | |
2601 | (interactive) | |
2602 | (unless (and (called-interactively-p 'any) | |
ddce2e3e SB |
2603 | (or (todo-done-item-p) (looking-at "^$"))) |
2604 | (let* ((item (or item (todo-item-string))) | |
2605 | (marked (todo-marked-item-p)) | |
2606 | (cat (or cat (cond ((eq major-mode 'todo-mode) | |
2607 | (todo-current-category)) | |
2608 | ((eq major-mode 'todo-filtered-items-mode) | |
8b27b080 | 2609 | (let* ((regexp1 |
ddce2e3e SB |
2610 | (concat todo-date-string-start |
2611 | todo-date-pattern | |
8b27b080 | 2612 | "\\( " diary-time-regexp "\\)?" |
ddce2e3e | 2613 | (regexp-quote todo-nondiary-end) |
8b27b080 SB |
2614 | "?\\(?1: \\[\\(.+:\\)?.+\\]\\)"))) |
2615 | (save-excursion | |
2616 | (re-search-forward regexp1 nil t) | |
2617 | (match-string-no-properties 1))))))) | |
2618 | curnum | |
2619 | (todo (cond ((or (eq arg 'raise) (eq arg 'lower) | |
ddce2e3e | 2620 | (eq major-mode 'todo-filtered-items-mode)) |
8b27b080 | 2621 | (save-excursion |
ddce2e3e | 2622 | (let ((curstart (todo-item-start)) |
8b27b080 SB |
2623 | (count 0)) |
2624 | (goto-char (point-min)) | |
ddce2e3e | 2625 | (while (looking-at todo-item-start) |
8b27b080 SB |
2626 | (setq count (1+ count)) |
2627 | (when (= (point) curstart) (setq curnum count)) | |
ddce2e3e | 2628 | (todo-forward-item)) |
8b27b080 | 2629 | count))) |
ddce2e3e SB |
2630 | ((eq major-mode 'todo-mode) |
2631 | (todo-get-count 'todo cat)))) | |
8b27b080 SB |
2632 | (maxnum (if new (1+ todo) todo)) |
2633 | (prompt (format "Set item priority (1-%d): " maxnum)) | |
2634 | (priority (cond ((and (not arg) (numberp current-prefix-arg)) | |
2635 | current-prefix-arg) | |
2636 | ((and (eq arg 'raise) (>= curnum 1)) | |
2637 | (1- curnum)) | |
2638 | ((and (eq arg 'lower) (<= curnum maxnum)) | |
2639 | (1+ curnum)))) | |
2640 | candidate | |
2641 | buffer-read-only) | |
2642 | (unless (and priority | |
2643 | (or (and (eq arg 'raise) (zerop priority)) | |
2644 | (and (eq arg 'lower) (> priority maxnum)))) | |
2645 | ;; When moving item to another category, show the category before | |
2646 | ;; prompting for its priority. | |
2647 | (unless (or arg (called-interactively-p 'any)) | |
ddce2e3e | 2648 | (todo-category-number cat) |
8b27b080 | 2649 | ;; If done items in category are visible, keep them visible. |
ddce2e3e | 2650 | (let ((done todo-show-with-done)) |
8b27b080 SB |
2651 | (when (> (buffer-size) (- (point-max) (point-min))) |
2652 | (save-excursion | |
2653 | (goto-char (point-min)) | |
ddce2e3e SB |
2654 | (setq done (re-search-forward todo-done-string-start nil t)))) |
2655 | (let ((todo-show-with-done done)) | |
2656 | (todo-category-select) | |
8b27b080 SB |
2657 | ;; Keep top of category in view while setting priority. |
2658 | (goto-char (point-min))))) | |
2659 | ;; Prompt for priority only when the category has at least one | |
2660 | ;; todo item. | |
2661 | (when (> maxnum 1) | |
2662 | (while (not priority) | |
2f99433b SB |
2663 | (setq candidate (read-number prompt |
2664 | (if (eq todo-default-priority 'first) | |
2665 | 1 maxnum))) | |
8b27b080 SB |
2666 | (setq prompt (when (or (< candidate 1) (> candidate maxnum)) |
2667 | (format "Priority must be an integer between 1 and %d.\n" | |
2668 | maxnum))) | |
2669 | (unless prompt (setq priority candidate)))) | |
2670 | ;; In Top Priorities buffer, an item's priority can be changed | |
2671 | ;; wrt items in another category, but not wrt items in the same | |
2672 | ;; category. | |
ddce2e3e SB |
2673 | (when (eq major-mode 'todo-filtered-items-mode) |
2674 | (let* ((regexp2 (concat todo-date-string-start todo-date-pattern | |
8b27b080 | 2675 | "\\( " diary-time-regexp "\\)?" |
ddce2e3e | 2676 | (regexp-quote todo-nondiary-end) |
8b27b080 SB |
2677 | "?\\(?1:" (regexp-quote cat) "\\)")) |
2678 | (end (cond ((< curnum priority) | |
ddce2e3e | 2679 | (save-excursion (todo-item-end))) |
8b27b080 | 2680 | ((> curnum priority) |
ddce2e3e | 2681 | (save-excursion (todo-item-start))))) |
8b27b080 SB |
2682 | (match (save-excursion |
2683 | (cond ((< curnum priority) | |
ddce2e3e | 2684 | (todo-forward-item (1+ (- priority curnum))) |
8b27b080 SB |
2685 | (when (re-search-backward regexp2 end t) |
2686 | (match-string-no-properties 1))) | |
2687 | ((> curnum priority) | |
ddce2e3e | 2688 | (todo-backward-item (- curnum priority)) |
8b27b080 SB |
2689 | (when (re-search-forward regexp2 end t) |
2690 | (match-string-no-properties 1))))))) | |
2691 | (when match | |
2692 | (user-error (concat "Cannot reprioritize items from the same " | |
ddce2e3e | 2693 | "category in this mode, only in Todo mode"))))) |
8b27b080 SB |
2694 | ;; Interactively or with non-nil ARG, relocate the item within its |
2695 | ;; category. | |
2696 | (when (or arg (called-interactively-p 'any)) | |
ddce2e3e | 2697 | (todo-remove-item)) |
8b27b080 SB |
2698 | (goto-char (point-min)) |
2699 | (when priority | |
2700 | (unless (= priority 1) | |
ddce2e3e SB |
2701 | (todo-forward-item (1- priority)) |
2702 | ;; When called from todo-item-undone and the highest priority | |
8b27b080 SB |
2703 | ;; is chosen, this advances point to the first done item, so |
2704 | ;; move it up to the empty line above the done items | |
2705 | ;; separator. | |
2706 | (when (looking-back (concat "^" | |
ddce2e3e | 2707 | (regexp-quote todo-category-done) |
8b27b080 | 2708 | "\n")) |
ddce2e3e SB |
2709 | (todo-backward-item)))) |
2710 | (todo-insert-with-overlays item) | |
8b27b080 SB |
2711 | ;; If item was marked, restore the mark. |
2712 | (and marked | |
ddce2e3e | 2713 | (let* ((ov (todo-get-overlay 'prefix)) |
8b27b080 SB |
2714 | (pref (overlay-get ov 'before-string))) |
2715 | (overlay-put ov 'before-string | |
ddce2e3e | 2716 | (concat todo-item-mark pref)))))))) |
ee7412e4 | 2717 | |
ddce2e3e | 2718 | (defun todo-raise-item-priority () |
8b27b080 | 2719 | "Raise priority of current item by moving it up by one item." |
27139cd5 | 2720 | (interactive) |
ddce2e3e | 2721 | (todo-set-item-priority nil nil nil 'raise)) |
ee7412e4 | 2722 | |
ddce2e3e | 2723 | (defun todo-lower-item-priority () |
8b27b080 | 2724 | "Lower priority of current item by moving it down by one item." |
27139cd5 | 2725 | (interactive) |
ddce2e3e | 2726 | (todo-set-item-priority nil nil nil 'lower)) |
459c6e93 | 2727 | |
ddce2e3e | 2728 | (defun todo-move-item (&optional file) |
8b27b080 SB |
2729 | "Move at least one todo or done item to another category. |
2730 | If there are marked items, move all of these; otherwise, move | |
2731 | the item at point. | |
d04d6b95 | 2732 | |
4fe738d3 | 2733 | With prefix argument FILE, prompt for a specific todo file and |
8b27b080 SB |
2734 | choose (with TAB completion) a category in it to move the item or |
2735 | items to; otherwise, choose and move to any category in either | |
4fe738d3 | 2736 | the current todo file or one of the files in |
ddce2e3e | 2737 | `todo-category-completions-files'. If the chosen category is |
8b27b080 SB |
2738 | not an existing categories, then it is created and the item(s) |
2739 | become(s) the first entry/entries in that category. | |
0e89c3fc | 2740 | |
4fe738d3 | 2741 | With moved todo items, prompt to set the priority in the category |
ddce2e3e | 2742 | moved to (with multiple todo items, the one that had the highest |
8b27b080 SB |
2743 | priority in the category moved from gets the new priority and the |
2744 | rest of the moved todo items are inserted in sequence below it). | |
2745 | Moved done items are appended to the top of the done items | |
2746 | section in the category moved to." | |
2747 | (interactive "P") | |
ddce2e3e SB |
2748 | (let* ((cat1 (todo-current-category)) |
2749 | (marked (assoc cat1 todo-categories-with-marks))) | |
8b27b080 SB |
2750 | ;; Noop if point is not on an item and there are no marked items. |
2751 | (unless (and (looking-at "^$") | |
2752 | (not marked)) | |
2753 | (let* ((buffer-read-only) | |
ddce2e3e SB |
2754 | (file1 todo-current-todo-file) |
2755 | (num todo-category-number) | |
2756 | (item (todo-item-string)) | |
2757 | (diary-item (todo-diary-item-p)) | |
2758 | (done-item (and (todo-done-item-p) (concat item "\n"))) | |
2759 | (omark (save-excursion (todo-item-start) (point-marker))) | |
8b27b080 SB |
2760 | (todo 0) |
2761 | (diary 0) | |
2762 | (done 0) | |
2763 | ov cat2 file2 moved nmark todo-items done-items) | |
2764 | (unwind-protect | |
2765 | (progn | |
2766 | (unless marked | |
ddce2e3e SB |
2767 | (setq ov (make-overlay (save-excursion (todo-item-start)) |
2768 | (save-excursion (todo-item-end)))) | |
2769 | (overlay-put ov 'face 'todo-search)) | |
8b27b080 | 2770 | (let* ((pl (if (and marked (> (cdr marked) 1)) "s" "")) |
ddce2e3e | 2771 | (cat+file (todo-read-category (concat "Move item" pl |
8b27b080 SB |
2772 | " to category: ") |
2773 | nil file))) | |
2774 | (while (and (equal (car cat+file) cat1) | |
2775 | (equal (cdr cat+file) file1)) | |
ddce2e3e | 2776 | (setq cat+file (todo-read-category |
8b27b080 SB |
2777 | "Choose a different category: "))) |
2778 | (setq cat2 (car cat+file) | |
2779 | file2 (cdr cat+file)))) | |
2780 | (if ov (delete-overlay ov))) | |
2781 | (set-buffer (find-buffer-visiting file1)) | |
2782 | (if marked | |
2783 | (progn | |
2784 | (goto-char (point-min)) | |
2785 | (while (not (eobp)) | |
ddce2e3e SB |
2786 | (when (todo-marked-item-p) |
2787 | (if (todo-done-item-p) | |
8b27b080 | 2788 | (setq done-items (concat done-items |
ddce2e3e | 2789 | (todo-item-string) "\n") |
8b27b080 SB |
2790 | done (1+ done)) |
2791 | (setq todo-items (concat todo-items | |
ddce2e3e | 2792 | (todo-item-string) "\n") |
8b27b080 | 2793 | todo (1+ todo)) |
ddce2e3e | 2794 | (when (todo-diary-item-p) |
8b27b080 | 2795 | (setq diary (1+ diary))))) |
ddce2e3e | 2796 | (todo-forward-item)) |
8b27b080 SB |
2797 | ;; Chop off last newline of multiple todo item string, |
2798 | ;; since it will be reinserted when setting priority | |
2799 | ;; (but with done items priority is not set, so keep | |
2800 | ;; last newline). | |
2801 | (and todo-items | |
2802 | (setq todo-items (substring todo-items 0 -1)))) | |
ddce2e3e | 2803 | (if (todo-done-item-p) |
8b27b080 SB |
2804 | (setq done 1) |
2805 | (setq todo 1) | |
ddce2e3e | 2806 | (when (todo-diary-item-p) (setq diary 1)))) |
8b27b080 SB |
2807 | (set-window-buffer (selected-window) |
2808 | (set-buffer (find-file-noselect file2 'nowarn))) | |
2809 | (unwind-protect | |
2810 | (progn | |
2811 | (when (or todo-items (and item (not done-item))) | |
ddce2e3e | 2812 | (todo-set-item-priority (or todo-items item) cat2 t)) |
8b27b080 SB |
2813 | ;; Move done items en bloc to top of done items section. |
2814 | (when (or done-items done-item) | |
ddce2e3e | 2815 | (todo-category-number cat2) |
8b27b080 SB |
2816 | (widen) |
2817 | (goto-char (point-min)) | |
2818 | (re-search-forward | |
ddce2e3e | 2819 | (concat "^" (regexp-quote (concat todo-category-beg cat2)) |
8b27b080 SB |
2820 | "$") nil t) |
2821 | (re-search-forward | |
ddce2e3e | 2822 | (concat "^" (regexp-quote todo-category-done)) nil t) |
8b27b080 SB |
2823 | (forward-line) |
2824 | (insert (or done-items done-item))) | |
2825 | (setq moved t)) | |
2826 | (cond | |
2827 | ;; Move succeeded, so remove item from starting category, | |
2828 | ;; update item counts and display the category containing | |
2829 | ;; the moved item. | |
2830 | (moved | |
2831 | (setq nmark (point-marker)) | |
ddce2e3e SB |
2832 | (when todo (todo-update-count 'todo todo)) |
2833 | (when diary (todo-update-count 'diary diary)) | |
2834 | (when done (todo-update-count 'done done)) | |
2835 | (todo-update-categories-sexp) | |
8b27b080 SB |
2836 | (with-current-buffer (find-buffer-visiting file1) |
2837 | (save-excursion | |
2838 | (save-restriction | |
2839 | (widen) | |
2840 | (goto-char omark) | |
2841 | (if marked | |
2842 | (let (beg end) | |
2843 | (setq item nil) | |
2844 | (re-search-backward | |
ddce2e3e | 2845 | (concat "^" (regexp-quote todo-category-beg)) nil t) |
8b27b080 SB |
2846 | (forward-line) |
2847 | (setq beg (point)) | |
2848 | (setq end (if (re-search-forward | |
2849 | (concat "^" (regexp-quote | |
ddce2e3e | 2850 | todo-category-beg)) nil t) |
8b27b080 SB |
2851 | (match-beginning 0) |
2852 | (point-max))) | |
2853 | (goto-char beg) | |
2854 | (while (< (point) end) | |
ddce2e3e SB |
2855 | (if (todo-marked-item-p) |
2856 | (todo-remove-item) | |
2857 | (todo-forward-item))) | |
2858 | (setq todo-categories-with-marks | |
2859 | (assq-delete-all cat1 todo-categories-with-marks))) | |
8b27b080 | 2860 | (if ov (delete-overlay ov)) |
ddce2e3e SB |
2861 | (todo-remove-item)))) |
2862 | (when todo (todo-update-count 'todo (- todo) cat1)) | |
2863 | (when diary (todo-update-count 'diary (- diary) cat1)) | |
2864 | (when done (todo-update-count 'done (- done) cat1)) | |
2865 | (todo-update-categories-sexp)) | |
8b27b080 SB |
2866 | (set-window-buffer (selected-window) |
2867 | (set-buffer (find-file-noselect file2 'nowarn))) | |
ddce2e3e SB |
2868 | (setq todo-category-number (todo-category-number cat2)) |
2869 | (let ((todo-show-with-done (or done-items done-item))) | |
2870 | (todo-category-select)) | |
8b27b080 SB |
2871 | (goto-char nmark) |
2872 | ;; If item is moved to end of (just first?) category, make | |
2873 | ;; sure the items above it are displayed in the window. | |
2874 | (recenter)) | |
2875 | ;; User quit before setting priority of todo item(s), so | |
2876 | ;; return to starting category. | |
2877 | (t | |
2878 | (set-window-buffer (selected-window) | |
2879 | (set-buffer (find-file-noselect file1 'nowarn))) | |
ddce2e3e SB |
2880 | (todo-category-number cat1) |
2881 | (todo-category-select) | |
8b27b080 | 2882 | (goto-char omark)))))))) |
27139cd5 | 2883 | |
ddce2e3e | 2884 | (defun todo-item-done (&optional arg) |
8b27b080 | 2885 | "Tag a todo item in this category as done and relocate it. |
ee7412e4 | 2886 | |
8b27b080 SB |
2887 | With prefix argument ARG prompt for a comment and append it to |
2888 | the done item; this is only possible if there are no marked | |
2889 | items. If there are marked items, tag all of these with | |
ddce2e3e SB |
2890 | `todo-done-string' plus the current date and, if |
2891 | `todo-always-add-time-string' is non-nil, the current time; | |
8b27b080 SB |
2892 | otherwise, just tag the item at point. Items tagged as done are |
2893 | relocated to the category's (by default hidden) done section. If | |
2894 | done items are visible on invoking this command, they remain | |
2895 | visible." | |
e99a2125 | 2896 | (interactive "P") |
ddce2e3e SB |
2897 | (let* ((cat (todo-current-category)) |
2898 | (marked (assoc cat todo-categories-with-marks))) | |
8b27b080 SB |
2899 | (when marked |
2900 | (save-excursion | |
2901 | (save-restriction | |
2902 | (goto-char (point-max)) | |
ddce2e3e SB |
2903 | (todo-backward-item) |
2904 | (unless (todo-done-item-p) | |
8b27b080 SB |
2905 | (widen) |
2906 | (unless (re-search-forward | |
ddce2e3e | 2907 | (concat "^" (regexp-quote todo-category-beg)) nil t) |
8b27b080 SB |
2908 | (goto-char (point-max))) |
2909 | (forward-line -1)) | |
ddce2e3e SB |
2910 | (while (todo-done-item-p) |
2911 | (when (todo-marked-item-p) | |
8b27b080 | 2912 | (user-error "This command does not apply to done items")) |
ddce2e3e | 2913 | (todo-backward-item))))) |
8b27b080 | 2914 | (unless (and (not marked) |
ddce2e3e | 2915 | (or (todo-done-item-p) |
8b27b080 SB |
2916 | ;; Point is between todo and done items. |
2917 | (looking-at "^$"))) | |
2918 | (let* ((date-string (calendar-date-string (calendar-current-date) t t)) | |
ddce2e3e | 2919 | (time-string (if todo-always-add-time-string |
8b27b080 SB |
2920 | (concat " " (substring (current-time-string) |
2921 | 11 16)) | |
2922 | "")) | |
ddce2e3e | 2923 | (done-prefix (concat "[" todo-done-string date-string time-string |
8b27b080 SB |
2924 | "] ")) |
2925 | (comment (and arg (read-string "Enter a comment: "))) | |
2926 | (item-count 0) | |
2927 | (diary-count 0) | |
2928 | (show-done (save-excursion | |
2929 | (goto-char (point-min)) | |
ddce2e3e | 2930 | (re-search-forward todo-done-string-start nil t))) |
27139cd5 | 2931 | (buffer-read-only nil) |
8b27b080 SB |
2932 | item done-item opoint) |
2933 | ;; Don't add empty comment to done item. | |
2934 | (setq comment (unless (zerop (length comment)) | |
ddce2e3e | 2935 | (concat " [" todo-comment-string ": " comment "]"))) |
8b27b080 SB |
2936 | (and marked (goto-char (point-min))) |
2937 | (catch 'done | |
2938 | ;; Stop looping when we hit the empty line below the last | |
2939 | ;; todo item (this is eobp if only done items are hidden). | |
2940 | (while (not (looking-at "^$")) | |
ddce2e3e | 2941 | (if (or (not marked) (and marked (todo-marked-item-p))) |
8b27b080 | 2942 | (progn |
ddce2e3e | 2943 | (setq item (todo-item-string)) |
8b27b080 SB |
2944 | (setq done-item (concat done-item done-prefix item |
2945 | comment (and marked "\n"))) | |
2946 | (setq item-count (1+ item-count)) | |
ddce2e3e | 2947 | (when (todo-diary-item-p) |
8b27b080 | 2948 | (setq diary-count (1+ diary-count))) |
ddce2e3e | 2949 | (todo-remove-item) |
8b27b080 | 2950 | (unless marked (throw 'done nil))) |
ddce2e3e | 2951 | (todo-forward-item)))) |
8b27b080 SB |
2952 | (when marked |
2953 | ;; Chop off last newline of done item string. | |
2954 | (setq done-item (substring done-item 0 -1)) | |
ddce2e3e SB |
2955 | (setq todo-categories-with-marks |
2956 | (assq-delete-all cat todo-categories-with-marks))) | |
8b27b080 SB |
2957 | (save-excursion |
2958 | (widen) | |
2959 | (re-search-forward | |
ddce2e3e | 2960 | (concat "^" (regexp-quote todo-category-done)) nil t) |
8b27b080 SB |
2961 | (forward-char) |
2962 | (when show-done (setq opoint (point))) | |
2963 | (insert done-item "\n")) | |
ddce2e3e SB |
2964 | (todo-update-count 'todo (- item-count)) |
2965 | (todo-update-count 'done item-count) | |
2966 | (todo-update-count 'diary (- diary-count)) | |
2967 | (todo-update-categories-sexp) | |
2968 | (let ((todo-show-with-done show-done)) | |
2969 | (todo-category-select) | |
8b27b080 SB |
2970 | ;; When done items are shown, put cursor on first just done item. |
2971 | (when opoint (goto-char opoint))))))) | |
ee7412e4 | 2972 | |
ddce2e3e | 2973 | (defun todo-edit-done-item-comment (&optional arg) |
8b27b080 SB |
2974 | "Add a comment to this done item or edit an existing comment. |
2975 | With prefix ARG delete an existing comment." | |
2976 | (interactive "P") | |
ddce2e3e SB |
2977 | (when (todo-done-item-p) |
2978 | (let ((item (todo-item-string)) | |
8b27b080 | 2979 | (opoint (point)) |
ddce2e3e | 2980 | (end (save-excursion (todo-item-end))) |
8b27b080 SB |
2981 | comment buffer-read-only) |
2982 | (save-excursion | |
ddce2e3e | 2983 | (todo-item-start) |
8b27b080 | 2984 | (if (re-search-forward (concat " \\[" |
ddce2e3e | 2985 | (regexp-quote todo-comment-string) |
8b27b080 SB |
2986 | ": \\([^]]+\\)\\]") end t) |
2987 | (if arg | |
ddce2e3e | 2988 | (when (todo-y-or-n-p "Delete comment? ") |
8b27b080 SB |
2989 | (delete-region (match-beginning 0) (match-end 0))) |
2990 | (setq comment (read-string "Edit comment: " | |
2991 | (cons (match-string 1) 1))) | |
2992 | (replace-match comment nil nil nil 1)) | |
2993 | (setq comment (read-string "Enter a comment: ")) | |
2994 | ;; If user moved point during editing, make sure it moves back. | |
2995 | (goto-char opoint) | |
ddce2e3e SB |
2996 | (todo-item-end) |
2997 | (insert " [" todo-comment-string ": " comment "]")))))) | |
7464f422 | 2998 | |
ddce2e3e | 2999 | (defun todo-item-undone () |
8b27b080 SB |
3000 | "Restore at least one done item to this category's todo section. |
3001 | Prompt for the new priority. If there are marked items, undo all | |
3002 | of these, giving the first undone item the new priority and the | |
3003 | rest following directly in sequence; otherwise, undo just the | |
3004 | item at point. | |
3005 | ||
3006 | If the done item has a comment, ask whether to omit the comment | |
3007 | from the restored item. With multiple marked done items with | |
3008 | comments, only ask once, and if affirmed, omit subsequent | |
3009 | comments without asking." | |
27139cd5 | 3010 | (interactive) |
ddce2e3e SB |
3011 | (let* ((cat (todo-current-category)) |
3012 | (marked (assoc cat todo-categories-with-marks)) | |
8b27b080 | 3013 | (pl (if (and marked (> (cdr marked) 1)) "s" ""))) |
ddce2e3e | 3014 | (when (or marked (todo-done-item-p)) |
8b27b080 SB |
3015 | (let ((buffer-read-only) |
3016 | (opoint (point)) | |
3017 | (omark (point-marker)) | |
3018 | (first 'first) | |
3019 | (item-count 0) | |
3020 | (diary-count 0) | |
3021 | start end item ov npoint undone) | |
3022 | (and marked (goto-char (point-min))) | |
3023 | (catch 'done | |
3024 | (while (not (eobp)) | |
ddce2e3e SB |
3025 | (when (or (not marked) (and marked (todo-marked-item-p))) |
3026 | (if (not (todo-done-item-p)) | |
8b27b080 | 3027 | (user-error "Only done items can be undone") |
ddce2e3e | 3028 | (todo-item-start) |
8b27b080 | 3029 | (unless marked |
ddce2e3e SB |
3030 | (setq ov (make-overlay (save-excursion (todo-item-start)) |
3031 | (save-excursion (todo-item-end)))) | |
3032 | (overlay-put ov 'face 'todo-search)) | |
8b27b080 SB |
3033 | ;; Find the end of the date string added upon tagging item as |
3034 | ;; done. | |
3035 | (setq start (search-forward "] ")) | |
3036 | (setq item-count (1+ item-count)) | |
ddce2e3e | 3037 | (unless (looking-at (regexp-quote todo-nondiary-start)) |
8b27b080 | 3038 | (setq diary-count (1+ diary-count))) |
ddce2e3e | 3039 | (setq end (save-excursion (todo-item-end))) |
8b27b080 SB |
3040 | ;; Ask (once) whether to omit done item's comment. If |
3041 | ;; affirmed, omit subsequent comments without asking. | |
3042 | (when (re-search-forward | |
ddce2e3e | 3043 | (concat " \\[" (regexp-quote todo-comment-string) |
8b27b080 SB |
3044 | ": [^]]+\\]") end t) |
3045 | (unwind-protect | |
3046 | (if (eq first 'first) | |
3047 | (setq first | |
ddce2e3e SB |
3048 | (if (eq todo-undo-item-omit-comment 'ask) |
3049 | (when (todo-y-or-n-p | |
8b27b080 SB |
3050 | (concat "Omit comment" pl |
3051 | " from restored item" | |
3052 | pl "? ")) | |
3053 | 'omit) | |
ddce2e3e | 3054 | (when todo-undo-item-omit-comment 'omit))) |
8b27b080 SB |
3055 | t) |
3056 | (when (and (eq first 'first) ov) (delete-overlay ov))) | |
3057 | (when (eq first 'omit) | |
3058 | (setq end (match-beginning 0)))) | |
3059 | (setq item (concat item | |
3060 | (buffer-substring-no-properties start end) | |
3061 | (when marked "\n"))) | |
3062 | (unless marked (throw 'done nil)))) | |
ddce2e3e | 3063 | (todo-forward-item))) |
8b27b080 SB |
3064 | (unwind-protect |
3065 | (progn | |
3066 | ;; Chop off last newline of multiple items string, since | |
3067 | ;; it will be reinserted on setting priority. | |
3068 | (and marked (setq item (substring item 0 -1))) | |
ddce2e3e | 3069 | (todo-set-item-priority item cat t) |
8b27b080 SB |
3070 | (setq npoint (point)) |
3071 | (setq undone t)) | |
3072 | (when ov (delete-overlay ov)) | |
3073 | (if (not undone) | |
3074 | (goto-char opoint) | |
3075 | (if marked | |
3076 | (progn | |
3077 | (setq item nil) | |
3078 | (re-search-forward | |
ddce2e3e | 3079 | (concat "^" (regexp-quote todo-category-done)) nil t) |
8b27b080 | 3080 | (while (not (eobp)) |
ddce2e3e SB |
3081 | (if (todo-marked-item-p) |
3082 | (todo-remove-item) | |
3083 | (todo-forward-item))) | |
3084 | (setq todo-categories-with-marks | |
3085 | (assq-delete-all cat todo-categories-with-marks))) | |
8b27b080 | 3086 | (goto-char omark) |
ddce2e3e SB |
3087 | (todo-remove-item)) |
3088 | (todo-update-count 'todo item-count) | |
3089 | (todo-update-count 'done (- item-count)) | |
3090 | (when diary-count (todo-update-count 'diary diary-count)) | |
3091 | (todo-update-categories-sexp) | |
3092 | (let ((todo-show-with-done (> (todo-get-count 'done) 0))) | |
3093 | (todo-category-select)) | |
8b27b080 SB |
3094 | ;; Put cursor on undone item. |
3095 | (goto-char npoint))) | |
3096 | (set-marker omark nil))))) | |
7464f422 | 3097 | |
a9b0e28e | 3098 | ;; ----------------------------------------------------------------------------- |
8b27b080 | 3099 | ;;; Done item archives |
a9b0e28e | 3100 | ;; ----------------------------------------------------------------------------- |
0e89c3fc | 3101 | |
ddce2e3e | 3102 | (defun todo-find-archive (&optional ask) |
4fe738d3 | 3103 | "Visit the archive of the current todo category, if it exists. |
8b27b080 SB |
3104 | If the category has no archived items, prompt to visit the |
3105 | archive anyway. If there is no archive for this file or with | |
3106 | non-nil argument ASK, prompt to visit another archive. | |
3107 | ||
ddce2e3e | 3108 | The buffer showing the archive is in Todo Archive mode. The |
8b27b080 SB |
3109 | first visit in a session displays the first category in the |
3110 | archive, subsequent visits return to the last category | |
3111 | displayed." | |
27139cd5 | 3112 | (interactive) |
d610f6dd SB |
3113 | (if (null (funcall todo-files-function t)) |
3114 | (message "There are no archive files") | |
3115 | (let* ((cat (todo-current-category)) | |
3116 | (count (todo-get-count 'archived cat)) | |
3117 | (archive (concat (file-name-sans-extension todo-current-todo-file) | |
3118 | ".toda")) | |
3119 | (place (cond (ask 'other-archive) | |
3120 | ((file-exists-p archive) 'this-archive) | |
3121 | (t (when (todo-y-or-n-p | |
3122 | (concat "This file has no archive; " | |
3123 | "visit another archive? ")) | |
3124 | 'other-archive))))) | |
3125 | (when (eq place 'other-archive) | |
3126 | (setq archive (todo-read-file-name "Choose a todo archive: " t t))) | |
3127 | (when (and (eq place 'this-archive) (zerop count)) | |
3128 | (setq place (when (todo-y-or-n-p | |
3129 | (concat "This category has no archived items;" | |
3130 | " visit archive anyway? ")) | |
3131 | 'other-cat))) | |
3132 | (when place | |
3133 | (set-window-buffer (selected-window) | |
3134 | (set-buffer (find-file-noselect archive))) | |
3135 | (if (member place '(other-archive other-cat)) | |
3136 | (setq todo-category-number 1) | |
3137 | (todo-category-number cat)) | |
3138 | (todo-category-select))))) | |
ee7412e4 | 3139 | |
ddce2e3e | 3140 | (defun todo-choose-archive () |
8b27b080 | 3141 | "Choose an archive and visit it." |
27139cd5 | 3142 | (interactive) |
ddce2e3e | 3143 | (todo-find-archive t)) |
d04d6b95 | 3144 | |
ddce2e3e | 3145 | (defun todo-archive-done-item (&optional all) |
8b27b080 | 3146 | "Archive at least one done item in this category. |
a9b0e28e | 3147 | |
8b27b080 SB |
3148 | With prefix argument ALL, prompt whether to archive all done |
3149 | items in this category and on confirmation archive them. | |
3150 | Otherwise, if there are marked done items (and no marked todo | |
3151 | items), archive all of these; otherwise, archive the done item at | |
3152 | point. | |
ee7412e4 | 3153 | |
8b27b080 SB |
3154 | If the archive of this file does not exist, it is created. If |
3155 | this category does not exist in the archive, it is created." | |
3156 | (interactive "P") | |
ddce2e3e SB |
3157 | (when (eq major-mode 'todo-mode) |
3158 | (if (and all (zerop (todo-get-count 'done))) | |
8b27b080 SB |
3159 | (message "No done items in this category") |
3160 | (catch 'end | |
ddce2e3e | 3161 | (let* ((cat (todo-current-category)) |
8b27b080 | 3162 | (tbuf (current-buffer)) |
ddce2e3e | 3163 | (marked (assoc cat todo-categories-with-marks)) |
8b27b080 | 3164 | (afile (concat (file-name-sans-extension |
ddce2e3e | 3165 | todo-current-todo-file) ".toda")) |
d610f6dd | 3166 | (archive (find-file-noselect afile t)) |
ddce2e3e SB |
3167 | (item (and (todo-done-item-p) |
3168 | (concat (todo-item-string) "\n"))) | |
8b27b080 | 3169 | (count 0) |
ddce2e3e | 3170 | (opoint (unless (todo-done-item-p) (point))) |
8b27b080 SB |
3171 | marked-items beg end all-done |
3172 | buffer-read-only) | |
3173 | (cond | |
3174 | (all | |
ddce2e3e | 3175 | (if (todo-y-or-n-p "Archive all done items in this category? ") |
8b27b080 SB |
3176 | (save-excursion |
3177 | (save-restriction | |
3178 | (goto-char (point-min)) | |
3179 | (widen) | |
3180 | (setq beg (progn | |
ddce2e3e | 3181 | (re-search-forward todo-done-string-start |
8b27b080 SB |
3182 | nil t) |
3183 | (match-beginning 0)) | |
3184 | end (if (re-search-forward | |
3185 | (concat "^" | |
ddce2e3e | 3186 | (regexp-quote todo-category-beg)) |
8b27b080 SB |
3187 | nil t) |
3188 | (match-beginning 0) | |
3189 | (point-max)) | |
3190 | all-done (buffer-substring-no-properties beg end) | |
ddce2e3e | 3191 | count (todo-get-count 'done)) |
8b27b080 SB |
3192 | ;; Restore starting point, unless it was on a done |
3193 | ;; item, since they will all be deleted. | |
3194 | (when opoint (goto-char opoint)))) | |
3195 | (throw 'end nil))) | |
3196 | (marked | |
3197 | (save-excursion | |
3198 | (goto-char (point-min)) | |
3199 | (while (not (eobp)) | |
ddce2e3e SB |
3200 | (when (todo-marked-item-p) |
3201 | (if (not (todo-done-item-p)) | |
8b27b080 SB |
3202 | (throw 'end (message "Only done items can be archived")) |
3203 | (setq marked-items | |
ddce2e3e | 3204 | (concat marked-items (todo-item-string) "\n")) |
8b27b080 | 3205 | (setq count (1+ count)))) |
ddce2e3e | 3206 | (todo-forward-item))))) |
8b27b080 SB |
3207 | (if (not (or marked all item)) |
3208 | (throw 'end (message "Only done items can be archived")) | |
3209 | (with-current-buffer archive | |
8b27b080 SB |
3210 | (let (buffer-read-only) |
3211 | (widen) | |
3212 | (goto-char (point-min)) | |
3213 | (if (and (re-search-forward | |
3214 | (concat "^" (regexp-quote | |
ddce2e3e | 3215 | (concat todo-category-beg cat)) "$") |
8b27b080 | 3216 | nil t) |
ddce2e3e | 3217 | (re-search-forward (regexp-quote todo-category-done) |
8b27b080 SB |
3218 | nil t)) |
3219 | ;; Start of done items section in existing category. | |
3220 | (forward-char) | |
ddce2e3e | 3221 | (todo-add-category nil cat) |
8b27b080 SB |
3222 | ;; Start of done items section in new category. |
3223 | (goto-char (point-max))) | |
3224 | (insert (cond (marked marked-items) | |
3225 | (all all-done) | |
3226 | (item))) | |
ddce2e3e SB |
3227 | (todo-update-count 'done (if (or marked all) count 1) cat) |
3228 | (todo-update-categories-sexp) | |
d610f6dd SB |
3229 | ;; If archive is new, save to file now (with |
3230 | ;; write-region to avoid prompt for file to save to) | |
3231 | ;; to update todo-archives, and to let auto-mode-alist | |
3232 | ;; take effect below on visiting the archive. | |
3233 | (unless (nth 7 (file-attributes afile)) | |
3234 | (write-region nil nil afile t t) | |
3235 | (setq todo-archives (funcall todo-files-function t)) | |
8b27b080 SB |
3236 | (kill-buffer)))) |
3237 | (with-current-buffer tbuf | |
3238 | (cond | |
3239 | (all | |
3240 | (save-excursion | |
3241 | (save-restriction | |
3242 | ;; Make sure done items are accessible. | |
3243 | (widen) | |
3244 | (remove-overlays beg end) | |
3245 | (delete-region beg end) | |
ddce2e3e SB |
3246 | (todo-update-count 'done (- count)) |
3247 | (todo-update-count 'archived count)))) | |
8b27b080 SB |
3248 | ((or marked |
3249 | ;; If we're archiving all done items, can't | |
3250 | ;; first archive item point was on, since | |
3251 | ;; that will short-circuit the rest. | |
3252 | (and item (not all))) | |
3253 | (and marked (goto-char (point-min))) | |
3254 | (catch 'done | |
3255 | (while (not (eobp)) | |
ddce2e3e | 3256 | (if (or (and marked (todo-marked-item-p)) item) |
8b27b080 | 3257 | (progn |
ddce2e3e SB |
3258 | (todo-remove-item) |
3259 | (todo-update-count 'done -1) | |
3260 | (todo-update-count 'archived 1) | |
8b27b080 SB |
3261 | ;; Don't leave point below last item. |
3262 | (and item (bolp) (eolp) (< (point-min) (point-max)) | |
ddce2e3e | 3263 | (todo-backward-item)) |
8b27b080 SB |
3264 | (when item |
3265 | (throw 'done (setq item nil)))) | |
ddce2e3e | 3266 | (todo-forward-item)))))) |
8b27b080 | 3267 | (when marked |
ddce2e3e SB |
3268 | (setq todo-categories-with-marks |
3269 | (assq-delete-all cat todo-categories-with-marks))) | |
3270 | (todo-update-categories-sexp) | |
3271 | (todo-prefix-overlays))) | |
8b27b080 | 3272 | (find-file afile) |
ddce2e3e SB |
3273 | (todo-category-number cat) |
3274 | (todo-category-select) | |
8b27b080 SB |
3275 | (split-window-below) |
3276 | (set-window-buffer (selected-window) tbuf) | |
3277 | ;; Make todo file current to select category. | |
3278 | (find-file (buffer-file-name tbuf)) | |
3279 | ;; Make sure done item separator is hidden (if done items | |
3280 | ;; were initially visible). | |
ddce2e3e | 3281 | (let (todo-show-with-done) (todo-category-select))))))) |
d04d6b95 | 3282 | |
ddce2e3e | 3283 | (defun todo-unarchive-items () |
8b27b080 SB |
3284 | "Unarchive at least one item in this archive category. |
3285 | If there are marked items, unarchive all of these; otherwise, | |
3286 | unarchive the item at point. | |
d04d6b95 | 3287 | |
8b27b080 | 3288 | Unarchived items are restored as done items to the corresponding |
4fe738d3 | 3289 | category in the todo file, inserted at the top of done items |
8b27b080 SB |
3290 | section. If all items in the archive category have been |
3291 | restored, the category is deleted from the archive. If this was | |
3292 | the only category in the archive, the archive file is deleted." | |
3293 | (interactive) | |
ddce2e3e SB |
3294 | (when (eq major-mode 'todo-archive-mode) |
3295 | (let* ((cat (todo-current-category)) | |
8b27b080 | 3296 | (tbuf (find-file-noselect |
ddce2e3e | 3297 | (concat (file-name-sans-extension todo-current-todo-file) |
8b27b080 | 3298 | ".todo") t)) |
ddce2e3e SB |
3299 | (marked (assoc cat todo-categories-with-marks)) |
3300 | (item (concat (todo-item-string) "\n")) | |
8b27b080 SB |
3301 | (marked-count 0) |
3302 | marked-items | |
3303 | buffer-read-only) | |
3304 | (when marked | |
3305 | (save-excursion | |
3306 | (goto-char (point-min)) | |
3307 | (while (not (eobp)) | |
ddce2e3e SB |
3308 | (when (todo-marked-item-p) |
3309 | (setq marked-items (concat marked-items (todo-item-string) "\n")) | |
8b27b080 | 3310 | (setq marked-count (1+ marked-count))) |
ddce2e3e | 3311 | (todo-forward-item)))) |
8b27b080 SB |
3312 | ;; Restore items to top of category's done section and update counts. |
3313 | (with-current-buffer tbuf | |
3314 | (let (buffer-read-only newcat) | |
3315 | (widen) | |
3316 | (goto-char (point-min)) | |
3317 | ;; Find the corresponding todo category, or if there isn't | |
3318 | ;; one, add it. | |
3319 | (unless (re-search-forward | |
ddce2e3e | 3320 | (concat "^" (regexp-quote (concat todo-category-beg cat)) |
8b27b080 | 3321 | "$") nil t) |
ddce2e3e | 3322 | (todo-add-category nil cat) |
8b27b080 SB |
3323 | (setq newcat t)) |
3324 | ;; Go to top of category's done section. | |
3325 | (re-search-forward | |
ddce2e3e | 3326 | (concat "^" (regexp-quote todo-category-done)) nil t) |
8b27b080 SB |
3327 | (forward-line) |
3328 | (cond (marked | |
3329 | (insert marked-items) | |
ddce2e3e | 3330 | (todo-update-count 'done marked-count cat) |
8b27b080 | 3331 | (unless newcat ; Newly added category has no archive. |
ddce2e3e | 3332 | (todo-update-count 'archived (- marked-count) cat))) |
8b27b080 SB |
3333 | (t |
3334 | (insert item) | |
ddce2e3e | 3335 | (todo-update-count 'done 1 cat) |
8b27b080 | 3336 | (unless newcat ; Newly added category has no archive. |
ddce2e3e SB |
3337 | (todo-update-count 'archived -1 cat)))) |
3338 | (todo-update-categories-sexp))) | |
8b27b080 SB |
3339 | ;; Delete restored items from archive. |
3340 | (when marked | |
3341 | (setq item nil) | |
3342 | (goto-char (point-min))) | |
3343 | (catch 'done | |
3344 | (while (not (eobp)) | |
ddce2e3e | 3345 | (if (or (todo-marked-item-p) item) |
8b27b080 | 3346 | (progn |
ddce2e3e | 3347 | (todo-remove-item) |
8b27b080 SB |
3348 | (when item |
3349 | (throw 'done (setq item nil)))) | |
ddce2e3e SB |
3350 | (todo-forward-item)))) |
3351 | (todo-update-count 'done (if marked (- marked-count) -1) cat) | |
8b27b080 | 3352 | ;; If that was the last category in the archive, delete the whole file. |
ddce2e3e | 3353 | (if (= (length todo-categories) 1) |
8b27b080 | 3354 | (progn |
ddce2e3e | 3355 | (delete-file todo-current-todo-file) |
8b27b080 SB |
3356 | ;; Kill the archive buffer silently. |
3357 | (set-buffer-modified-p nil) | |
3358 | (kill-buffer)) | |
3359 | ;; Otherwise, if the archive category is now empty, delete it. | |
3360 | (when (eq (point-min) (point-max)) | |
3361 | (widen) | |
3362 | (let ((beg (re-search-backward | |
ddce2e3e | 3363 | (concat "^" (regexp-quote todo-category-beg) cat "$") |
8b27b080 SB |
3364 | nil t)) |
3365 | (end (if (re-search-forward | |
ddce2e3e | 3366 | (concat "^" (regexp-quote todo-category-beg)) |
8b27b080 SB |
3367 | nil t 2) |
3368 | (match-beginning 0) | |
3369 | (point-max)))) | |
3370 | (remove-overlays beg end) | |
3371 | (delete-region beg end) | |
ddce2e3e SB |
3372 | (setq todo-categories (delete (assoc cat todo-categories) |
3373 | todo-categories)) | |
3374 | (todo-update-categories-sexp)))) | |
4fe738d3 | 3375 | ;; Visit category in todo file and show restored done items. |
8b27b080 | 3376 | (let ((tfile (buffer-file-name tbuf)) |
ddce2e3e | 3377 | (todo-show-with-done t)) |
8b27b080 SB |
3378 | (set-window-buffer (selected-window) |
3379 | (set-buffer (find-file-noselect tfile))) | |
ddce2e3e SB |
3380 | (todo-category-number cat) |
3381 | (todo-category-select) | |
8b27b080 | 3382 | (message "Items unarchived."))))) |
3f031767 | 3383 | |
ddce2e3e | 3384 | (defun todo-jump-to-archive-category (&optional file) |
4fe738d3 | 3385 | "Prompt for a category in a todo archive and jump to it. |
8b27b080 SB |
3386 | With prefix argument FILE, prompt for an archive and choose (with |
3387 | TAB completion) a category in it to jump to; otherwise, choose | |
3388 | and jump to any category in the current archive." | |
3389 | (interactive "P") | |
ddce2e3e | 3390 | (todo-jump-to-category file 'archive)) |
db2c5d34 | 3391 | |
a9b0e28e | 3392 | ;; ----------------------------------------------------------------------------- |
8b27b080 | 3393 | ;;; Displaying and sorting tables of categories |
a9b0e28e | 3394 | ;; ----------------------------------------------------------------------------- |
db2c5d34 | 3395 | |
ddce2e3e SB |
3396 | (defcustom todo-categories-category-label "Category" |
3397 | "Category button label in Todo Categories mode." | |
8b27b080 | 3398 | :type 'string |
ddce2e3e | 3399 | :group 'todo-categories) |
d04d6b95 | 3400 | |
ddce2e3e SB |
3401 | (defcustom todo-categories-todo-label "Todo" |
3402 | "Todo button label in Todo Categories mode." | |
8b27b080 | 3403 | :type 'string |
ddce2e3e | 3404 | :group 'todo-categories) |
0e89c3fc | 3405 | |
ddce2e3e SB |
3406 | (defcustom todo-categories-diary-label "Diary" |
3407 | "Diary button label in Todo Categories mode." | |
8b27b080 | 3408 | :type 'string |
ddce2e3e | 3409 | :group 'todo-categories) |
0e89c3fc | 3410 | |
ddce2e3e SB |
3411 | (defcustom todo-categories-done-label "Done" |
3412 | "Done button label in Todo Categories mode." | |
8b27b080 | 3413 | :type 'string |
ddce2e3e | 3414 | :group 'todo-categories) |
0e89c3fc | 3415 | |
ddce2e3e SB |
3416 | (defcustom todo-categories-archived-label "Archived" |
3417 | "Archived button label in Todo Categories mode." | |
8b27b080 | 3418 | :type 'string |
ddce2e3e | 3419 | :group 'todo-categories) |
0e89c3fc | 3420 | |
ddce2e3e SB |
3421 | (defcustom todo-categories-totals-label "Totals" |
3422 | "String to label total item counts in Todo Categories mode." | |
8b27b080 | 3423 | :type 'string |
ddce2e3e | 3424 | :group 'todo-categories) |
0e89c3fc | 3425 | |
ddce2e3e SB |
3426 | (defcustom todo-categories-number-separator " | " |
3427 | "String between number and category in Todo Categories mode. | |
8b27b080 SB |
3428 | This separates the number from the category name in the default |
3429 | categories display according to priority." | |
3430 | :type 'string | |
ddce2e3e | 3431 | :group 'todo-categories) |
6be04162 | 3432 | |
ddce2e3e SB |
3433 | (defcustom todo-categories-align 'center |
3434 | "Alignment of category names in Todo Categories mode." | |
8b27b080 | 3435 | :type '(radio (const left) (const center) (const right)) |
ddce2e3e | 3436 | :group 'todo-categories) |
0e89c3fc | 3437 | |
ddce2e3e | 3438 | (defun todo-show-categories-table () |
8b27b080 | 3439 | "Display a table of the current file's categories and item counts. |
0e89c3fc | 3440 | |
d610f6dd SB |
3441 | In the initial display the lines of the table are numbered, |
3442 | indicating the current order of the categories when sequentially | |
3443 | navigating through the todo file with `\\[todo-forward-category]' | |
3444 | and `\\[todo-backward-category]'. You can reorder the lines, and | |
3445 | hence the category sequence, by typing `\\[todo-raise-category]' | |
3446 | or `\\[todo-lower-category]' to raise or lower the category at | |
3447 | point, or by typing `\\[todo-set-category-number]' and entering a | |
3448 | number at the prompt or by typing `\\[todo-set-category-number]' | |
3449 | with a numeric prefix. If you save the todo file after | |
3450 | reordering the categories, the new order persists in subsequent | |
3451 | Emacs sessions. | |
0e89c3fc | 3452 | |
8b27b080 SB |
3453 | The labels above the category names and item counts are buttons, |
3454 | and clicking these changes the display: sorted by category name | |
3455 | or by the respective item counts (alternately descending or | |
3456 | ascending). In these displays the categories are not numbered | |
d610f6dd SB |
3457 | and `\\[todo-set-category-number]', `\\[todo-raise-category]' and |
3458 | `\\[todo-lower-category]' are disabled. (Programmatically, the | |
8b27b080 | 3459 | sorting is triggered by passing a non-nil SORTKEY argument.) |
0e89c3fc | 3460 | |
8b27b080 SB |
3461 | In addition, the lines with the category names and item counts |
3462 | are buttonized, and pressing one of these button jumps to the | |
ddce2e3e | 3463 | category in Todo mode (or Todo Archive mode, for categories |
8b27b080 | 3464 | containing only archived items, provided user option |
ddce2e3e SB |
3465 | `todo-skip-archived-categories' is non-nil. These categories |
3466 | are shown in `todo-archived-only' face." | |
27139cd5 | 3467 | (interactive) |
ddce2e3e | 3468 | (todo-display-categories) |
8b27b080 | 3469 | (let (sortkey) |
ddce2e3e | 3470 | (todo-update-categories-display sortkey))) |
0e89c3fc | 3471 | |
ddce2e3e | 3472 | (defun todo-next-button (n) |
8b27b080 SB |
3473 | "Move point to the Nth next button in the table of categories." |
3474 | (interactive "p") | |
3475 | (forward-button n 'wrap 'display-message) | |
3476 | (and (bolp) (button-at (point)) | |
3477 | ;; Align with beginning of category label. | |
ddce2e3e | 3478 | (forward-char (+ 4 (length todo-categories-number-separator))))) |
0e89c3fc | 3479 | |
ddce2e3e | 3480 | (defun todo-previous-button (n) |
8b27b080 SB |
3481 | "Move point to the Nth previous button in the table of categories." |
3482 | (interactive "p") | |
3483 | (backward-button n 'wrap 'display-message) | |
3484 | (and (bolp) (button-at (point)) | |
3485 | ;; Align with beginning of category label. | |
ddce2e3e | 3486 | (forward-char (+ 4 (length todo-categories-number-separator))))) |
0e89c3fc | 3487 | |
ddce2e3e | 3488 | (defun todo-set-category-number (&optional arg) |
8b27b080 | 3489 | "Change number of category at point in the table of categories. |
0e89c3fc | 3490 | |
8b27b080 SB |
3491 | With ARG nil, prompt for the new number. Alternatively, the |
3492 | enter the new number with numerical prefix ARG. Otherwise, if | |
3493 | ARG is either of the symbols `raise' or `lower', raise or lower | |
3494 | the category line in the table by one, respectively, thereby | |
3495 | decreasing or increasing its number." | |
3496 | (interactive "P") | |
3497 | (let ((curnum (save-excursion | |
3498 | ;; Get the number representing the priority of the category | |
3499 | ;; on the current line. | |
3500 | (forward-line 0) (skip-chars-forward " ") (number-at-point)))) | |
3501 | (when curnum ; Do nothing if we're not on a category line. | |
ddce2e3e | 3502 | (let* ((maxnum (length todo-categories)) |
8b27b080 SB |
3503 | (prompt (format "Set category priority (1-%d): " maxnum)) |
3504 | (col (current-column)) | |
3505 | (buffer-read-only nil) | |
3506 | (priority (cond ((and (eq arg 'raise) (> curnum 1)) | |
3507 | (1- curnum)) | |
3508 | ((and (eq arg 'lower) (< curnum maxnum)) | |
3509 | (1+ curnum)))) | |
3510 | candidate) | |
3511 | (while (not priority) | |
3512 | (setq candidate (or arg (read-number prompt))) | |
3513 | (setq arg nil) | |
3514 | (setq prompt | |
3515 | (cond ((or (< candidate 1) (> candidate maxnum)) | |
3516 | (format "Priority must be an integer between 1 and %d: " | |
3517 | maxnum)) | |
3518 | ((= candidate curnum) | |
3519 | "Choose a different priority than the current one: "))) | |
3520 | (unless prompt (setq priority candidate))) | |
3521 | (let* ((lower (< curnum priority)) ; Priority is being lowered. | |
ddce2e3e | 3522 | (head (butlast todo-categories |
8b27b080 SB |
3523 | (apply (if lower 'identity '1+) |
3524 | (list (- maxnum priority))))) | |
3525 | (tail (nthcdr (apply (if lower 'identity '1-) (list priority)) | |
ddce2e3e | 3526 | todo-categories)) |
8b27b080 | 3527 | ;; Category's name and items counts list. |
ddce2e3e SB |
3528 | (catcons (nth (1- curnum) todo-categories)) |
3529 | (todo-categories (nconc head (list catcons) tail)) | |
8b27b080 | 3530 | newcats) |
ddce2e3e SB |
3531 | (when lower (setq todo-categories (nreverse todo-categories))) |
3532 | (setq todo-categories (delete-dups todo-categories)) | |
3533 | (when lower (setq todo-categories (nreverse todo-categories))) | |
3534 | (setq newcats todo-categories) | |
8b27b080 | 3535 | (kill-buffer) |
ddce2e3e SB |
3536 | (with-current-buffer (find-buffer-visiting todo-current-todo-file) |
3537 | (setq todo-categories newcats) | |
3538 | (todo-update-categories-sexp)) | |
3539 | (todo-show-categories-table) | |
8b27b080 SB |
3540 | (forward-line (1+ priority)) |
3541 | (forward-char col)))))) | |
0e89c3fc | 3542 | |
ddce2e3e | 3543 | (defun todo-raise-category () |
4fe738d3 | 3544 | "Raise priority of category at point in the table of categories." |
27139cd5 | 3545 | (interactive) |
ddce2e3e | 3546 | (todo-set-category-number 'raise)) |
d04d6b95 | 3547 | |
ddce2e3e | 3548 | (defun todo-lower-category () |
4fe738d3 | 3549 | "Lower priority of category at point in the table of categories." |
27139cd5 | 3550 | (interactive) |
ddce2e3e | 3551 | (todo-set-category-number 'lower)) |
58c7641d | 3552 | |
ddce2e3e | 3553 | (defun todo-sort-categories-alphabetically-or-numerically () |
8b27b080 SB |
3554 | "Sort table of categories alphabetically or numerically." |
3555 | (interactive) | |
3556 | (save-excursion | |
3557 | (goto-char (point-min)) | |
3558 | (forward-line 2) | |
ddce2e3e | 3559 | (if (member 'alpha todo-descending-counts) |
8b27b080 | 3560 | (progn |
ddce2e3e SB |
3561 | (todo-update-categories-display nil) |
3562 | (setq todo-descending-counts | |
3563 | (delete 'alpha todo-descending-counts))) | |
3564 | (todo-update-categories-display 'alpha)))) | |
58c7641d | 3565 | |
ddce2e3e | 3566 | (defun todo-sort-categories-by-todo () |
8b27b080 SB |
3567 | "Sort table of categories by number of todo items." |
3568 | (interactive) | |
3569 | (save-excursion | |
3570 | (goto-char (point-min)) | |
3571 | (forward-line 2) | |
ddce2e3e | 3572 | (todo-update-categories-display 'todo))) |
58c7641d | 3573 | |
ddce2e3e | 3574 | (defun todo-sort-categories-by-diary () |
8b27b080 SB |
3575 | "Sort table of categories by number of diary items." |
3576 | (interactive) | |
3577 | (save-excursion | |
3578 | (goto-char (point-min)) | |
3579 | (forward-line 2) | |
ddce2e3e | 3580 | (todo-update-categories-display 'diary))) |
8b27b080 | 3581 | |
ddce2e3e | 3582 | (defun todo-sort-categories-by-done () |
8b27b080 | 3583 | "Sort table of categories by number of non-archived done items." |
27139cd5 | 3584 | (interactive) |
8b27b080 SB |
3585 | (save-excursion |
3586 | (goto-char (point-min)) | |
3587 | (forward-line 2) | |
ddce2e3e | 3588 | (todo-update-categories-display 'done))) |
58c7641d | 3589 | |
ddce2e3e | 3590 | (defun todo-sort-categories-by-archived () |
8b27b080 SB |
3591 | "Sort table of categories by number of archived items." |
3592 | (interactive) | |
3593 | (save-excursion | |
3594 | (goto-char (point-min)) | |
3595 | (forward-line 2) | |
ddce2e3e | 3596 | (todo-update-categories-display 'archived))) |
58c7641d | 3597 | |
ddce2e3e SB |
3598 | (defvar todo-categories-buffer "*Todo Categories*" |
3599 | "Name of buffer in Todo Categories mode.") | |
cc416fd3 | 3600 | |
ddce2e3e | 3601 | (defun todo-longest-category-name-length (categories) |
8b27b080 SB |
3602 | "Return the length of the longest name in list CATEGORIES." |
3603 | (let ((longest 0)) | |
3604 | (dolist (c categories longest) | |
3605 | (setq longest (max longest (length c)))))) | |
cc416fd3 | 3606 | |
ddce2e3e | 3607 | (defun todo-adjusted-category-label-length () |
8b27b080 | 3608 | "Return adjusted length of category label button. |
ddce2e3e | 3609 | The adjustment ensures proper tabular alignment in Todo |
8b27b080 | 3610 | Categories mode." |
ddce2e3e SB |
3611 | (let* ((categories (mapcar 'car todo-categories)) |
3612 | (longest (todo-longest-category-name-length categories)) | |
3613 | (catlablen (length todo-categories-category-label)) | |
8b27b080 SB |
3614 | (lc-diff (- longest catlablen))) |
3615 | (if (and (natnump lc-diff) (cl-oddp lc-diff)) | |
3616 | (1+ longest) | |
3617 | (max longest catlablen)))) | |
58c7641d | 3618 | |
ddce2e3e | 3619 | (defun todo-padded-string (str) |
8b27b080 SB |
3620 | "Return category name or label string STR padded with spaces. |
3621 | The placement of the padding is determined by the value of user | |
ddce2e3e SB |
3622 | option `todo-categories-align'." |
3623 | (let* ((len (todo-adjusted-category-label-length)) | |
8b27b080 SB |
3624 | (strlen (length str)) |
3625 | (strlen-odd (eq (logand strlen 1) 1)) | |
3626 | (padding (max 0 (/ (- len strlen) 2))) | |
ddce2e3e SB |
3627 | (padding-left (cond ((eq todo-categories-align 'left) 0) |
3628 | ((eq todo-categories-align 'center) padding) | |
3629 | ((eq todo-categories-align 'right) | |
8b27b080 | 3630 | (if strlen-odd (1+ (* padding 2)) (* padding 2))))) |
ddce2e3e | 3631 | (padding-right (cond ((eq todo-categories-align 'left) |
8b27b080 | 3632 | (if strlen-odd (1+ (* padding 2)) (* padding 2))) |
ddce2e3e | 3633 | ((eq todo-categories-align 'center) |
8b27b080 | 3634 | (if strlen-odd (1+ padding) padding)) |
ddce2e3e | 3635 | ((eq todo-categories-align 'right) 0)))) |
8b27b080 | 3636 | (concat (make-string padding-left 32) str (make-string padding-right 32)))) |
0e89c3fc | 3637 | |
ddce2e3e | 3638 | (defvar todo-descending-counts nil |
8b27b080 | 3639 | "List of keys for category counts sorted in descending order.") |
0e89c3fc | 3640 | |
ddce2e3e | 3641 | (defun todo-sort (list &optional key) |
8b27b080 SB |
3642 | "Return a copy of LIST, possibly sorted according to KEY." |
3643 | (let* ((l (copy-sequence list)) | |
3644 | (fn (if (eq key 'alpha) | |
3645 | (lambda (x) (upcase x)) ; Alphabetize case insensitively. | |
ddce2e3e | 3646 | (lambda (x) (todo-get-count key x)))) |
8b27b080 SB |
3647 | ;; Keep track of whether the last sort by key was descending or |
3648 | ;; ascending. | |
ddce2e3e | 3649 | (descending (member key todo-descending-counts)) |
8b27b080 SB |
3650 | (cmp (if (eq key 'alpha) |
3651 | 'string< | |
3652 | (if descending '< '>))) | |
3653 | (pred (lambda (s1 s2) (let ((t1 (funcall fn (car s1))) | |
3654 | (t2 (funcall fn (car s2)))) | |
3655 | (funcall cmp t1 t2))))) | |
3656 | (when key | |
3657 | (setq l (sort l pred)) | |
3658 | ;; Switch between descending and ascending sort order. | |
3659 | (if descending | |
ddce2e3e SB |
3660 | (setq todo-descending-counts |
3661 | (delete key todo-descending-counts)) | |
3662 | (push key todo-descending-counts))) | |
8b27b080 | 3663 | l)) |
0e89c3fc | 3664 | |
ddce2e3e | 3665 | (defun todo-display-sorted (type) |
8b27b080 SB |
3666 | "Keep point on the TYPE count sorting button just clicked." |
3667 | (let ((opoint (point))) | |
ddce2e3e | 3668 | (todo-update-categories-display type) |
8b27b080 | 3669 | (goto-char opoint))) |
c898b975 | 3670 | |
ddce2e3e | 3671 | (defun todo-label-to-key (label) |
8b27b080 SB |
3672 | "Return symbol for sort key associated with LABEL." |
3673 | (let (key) | |
ddce2e3e | 3674 | (cond ((string= label todo-categories-category-label) |
8b27b080 | 3675 | (setq key 'alpha)) |
ddce2e3e | 3676 | ((string= label todo-categories-todo-label) |
8b27b080 | 3677 | (setq key 'todo)) |
ddce2e3e | 3678 | ((string= label todo-categories-diary-label) |
8b27b080 | 3679 | (setq key 'diary)) |
ddce2e3e | 3680 | ((string= label todo-categories-done-label) |
8b27b080 | 3681 | (setq key 'done)) |
ddce2e3e | 3682 | ((string= label todo-categories-archived-label) |
8b27b080 SB |
3683 | (setq key 'archived))) |
3684 | key)) | |
c523b0aa | 3685 | |
ddce2e3e | 3686 | (defun todo-insert-sort-button (label) |
8b27b080 SB |
3687 | "Insert button for displaying categories sorted by item counts. |
3688 | LABEL determines which type of count is sorted." | |
ddce2e3e SB |
3689 | (let* ((str (if (string= label todo-categories-category-label) |
3690 | (todo-padded-string label) | |
8b27b080 SB |
3691 | label)) |
3692 | (beg (point)) | |
3693 | (end (+ beg (length str))) | |
3694 | ov) | |
3695 | (insert-button str 'face nil | |
3696 | 'action | |
3697 | `(lambda (button) | |
ddce2e3e SB |
3698 | (let ((key (todo-label-to-key ,label))) |
3699 | (if (and (member key todo-descending-counts) | |
8b27b080 SB |
3700 | (eq key 'alpha)) |
3701 | (progn | |
3702 | ;; If display is alphabetical, switch back to | |
3703 | ;; category priority order. | |
ddce2e3e SB |
3704 | (todo-display-sorted nil) |
3705 | (setq todo-descending-counts | |
3706 | (delete key todo-descending-counts))) | |
3707 | (todo-display-sorted key))))) | |
8b27b080 | 3708 | (setq ov (make-overlay beg end)) |
ddce2e3e | 3709 | (overlay-put ov 'face 'todo-button))) |
27139cd5 | 3710 | |
ddce2e3e | 3711 | (defun todo-total-item-counts () |
8b27b080 SB |
3712 | "Return a list of total item counts for the current file." |
3713 | (mapcar (lambda (i) (apply '+ (mapcar (lambda (l) (aref l i)) | |
ddce2e3e | 3714 | (mapcar 'cdr todo-categories)))) |
8b27b080 | 3715 | (list 0 1 2 3))) |
c523b0aa | 3716 | |
ddce2e3e SB |
3717 | (defvar todo-categories-category-number 0 |
3718 | "Variable for numbering categories in Todo Categories mode.") | |
0e89c3fc | 3719 | |
ddce2e3e | 3720 | (defun todo-insert-category-line (cat &optional nonum) |
8b27b080 SB |
3721 | "Insert button with category CAT's name and item counts. |
3722 | With non-nil argument NONUM show only these; otherwise, insert a | |
3723 | number in front of the button indicating the category's priority. | |
3724 | The number and the category name are separated by the string | |
3725 | which is the value of the user option | |
ddce2e3e SB |
3726 | `todo-categories-number-separator'." |
3727 | (let ((archive (member todo-current-todo-file todo-archives)) | |
3728 | (num todo-categories-category-number) | |
3729 | (str (todo-padded-string cat)) | |
8b27b080 | 3730 | (opoint (point))) |
ddce2e3e | 3731 | (setq num (1+ num) todo-categories-category-number num) |
8b27b080 SB |
3732 | (insert-button |
3733 | (concat (if nonum | |
ddce2e3e | 3734 | (make-string (+ 4 (length todo-categories-number-separator)) |
8b27b080 | 3735 | 32) |
ddce2e3e | 3736 | (format " %3d%s" num todo-categories-number-separator)) |
8b27b080 SB |
3737 | str |
3738 | (mapconcat (lambda (elt) | |
3739 | (concat | |
3740 | (make-string (1+ (/ (length (car elt)) 2)) 32) ; label | |
ddce2e3e | 3741 | (format "%3d" (todo-get-count (cdr elt) cat)) ; count |
8b27b080 SB |
3742 | ;; Add an extra space if label length is odd. |
3743 | (when (cl-oddp (length (car elt))) " "))) | |
3744 | (if archive | |
ddce2e3e SB |
3745 | (list (cons todo-categories-done-label 'done)) |
3746 | (list (cons todo-categories-todo-label 'todo) | |
3747 | (cons todo-categories-diary-label 'diary) | |
3748 | (cons todo-categories-done-label 'done) | |
3749 | (cons todo-categories-archived-label | |
8b27b080 SB |
3750 | 'archived))) |
3751 | "") | |
3752 | " ") ; Make highlighting on last column look better. | |
ddce2e3e SB |
3753 | 'face (if (and todo-skip-archived-categories |
3754 | (zerop (todo-get-count 'todo cat)) | |
3755 | (zerop (todo-get-count 'done cat)) | |
3756 | (not (zerop (todo-get-count 'archived cat)))) | |
3757 | 'todo-archived-only | |
8b27b080 SB |
3758 | nil) |
3759 | 'action `(lambda (button) (let ((buf (current-buffer))) | |
ddce2e3e | 3760 | (todo-jump-to-category nil ,cat) |
8b27b080 SB |
3761 | (kill-buffer buf)))) |
3762 | ;; Highlight the sorted count column. | |
3763 | (let* ((beg (+ opoint 7 (length str))) | |
3764 | end ovl) | |
3765 | (cond ((eq nonum 'todo) | |
ddce2e3e | 3766 | (setq beg (+ beg 1 (/ (length todo-categories-todo-label) 2)))) |
8b27b080 | 3767 | ((eq nonum 'diary) |
ddce2e3e SB |
3768 | (setq beg (+ beg 1 (length todo-categories-todo-label) |
3769 | 2 (/ (length todo-categories-diary-label) 2)))) | |
8b27b080 | 3770 | ((eq nonum 'done) |
ddce2e3e SB |
3771 | (setq beg (+ beg 1 (length todo-categories-todo-label) |
3772 | 2 (length todo-categories-diary-label) | |
3773 | 2 (/ (length todo-categories-done-label) 2)))) | |
8b27b080 | 3774 | ((eq nonum 'archived) |
ddce2e3e SB |
3775 | (setq beg (+ beg 1 (length todo-categories-todo-label) |
3776 | 2 (length todo-categories-diary-label) | |
3777 | 2 (length todo-categories-done-label) | |
3778 | 2 (/ (length todo-categories-archived-label) 2))))) | |
8b27b080 SB |
3779 | (unless (= beg (+ opoint 7 (length str))) ; Don't highlight categories. |
3780 | (setq end (+ beg 4)) | |
3781 | (setq ovl (make-overlay beg end)) | |
ddce2e3e | 3782 | (overlay-put ovl 'face 'todo-sorted-column))) |
8b27b080 | 3783 | (newline))) |
2a9e69d6 | 3784 | |
ddce2e3e | 3785 | (defun todo-display-categories () |
8b27b080 | 3786 | "Prepare buffer for displaying table of categories and item counts." |
ddce2e3e SB |
3787 | (unless (eq major-mode 'todo-categories-mode) |
3788 | (setq todo-global-current-todo-file | |
3789 | (or todo-current-todo-file | |
3790 | (todo-absolute-file-name todo-default-todo-file))) | |
8b27b080 | 3791 | (set-window-buffer (selected-window) |
ddce2e3e | 3792 | (set-buffer (get-buffer-create todo-categories-buffer))) |
8b27b080 | 3793 | (kill-all-local-variables) |
ddce2e3e SB |
3794 | (todo-categories-mode) |
3795 | (let ((archive (member todo-current-todo-file todo-archives)) | |
8b27b080 SB |
3796 | buffer-read-only) |
3797 | (erase-buffer) | |
4fe738d3 | 3798 | (insert (format (concat "Category counts for todo " |
8b27b080 SB |
3799 | (if archive "archive" "file") |
3800 | " \"%s\".") | |
ddce2e3e | 3801 | (todo-short-file-name todo-current-todo-file))) |
8b27b080 SB |
3802 | (newline 2) |
3803 | ;; Make space for the column of category numbers. | |
ddce2e3e | 3804 | (insert (make-string (+ 4 (length todo-categories-number-separator)) 32)) |
8b27b080 SB |
3805 | ;; Add the category and item count buttons (if this is the list of |
3806 | ;; categories in an archive, show only done item counts). | |
ddce2e3e | 3807 | (todo-insert-sort-button todo-categories-category-label) |
8b27b080 SB |
3808 | (if archive |
3809 | (progn | |
3810 | (insert (make-string 3 32)) | |
ddce2e3e | 3811 | (todo-insert-sort-button todo-categories-done-label)) |
8b27b080 | 3812 | (insert (make-string 3 32)) |
ddce2e3e | 3813 | (todo-insert-sort-button todo-categories-todo-label) |
8b27b080 | 3814 | (insert (make-string 2 32)) |
ddce2e3e | 3815 | (todo-insert-sort-button todo-categories-diary-label) |
8b27b080 | 3816 | (insert (make-string 2 32)) |
ddce2e3e | 3817 | (todo-insert-sort-button todo-categories-done-label) |
8b27b080 | 3818 | (insert (make-string 2 32)) |
ddce2e3e | 3819 | (todo-insert-sort-button todo-categories-archived-label)) |
8b27b080 | 3820 | (newline 2)))) |
d04d6b95 | 3821 | |
ddce2e3e | 3822 | (defun todo-update-categories-display (sortkey) |
8b27b080 | 3823 | "Populate table of categories and sort by SORTKEY." |
ddce2e3e SB |
3824 | (let* ((cats0 todo-categories) |
3825 | (cats (todo-sort cats0 sortkey)) | |
3826 | (archive (member todo-current-todo-file todo-archives)) | |
3827 | (todo-categories-category-number 0) | |
3828 | ;; Find start of Category button if we just entered Todo Categories | |
8b27b080 SB |
3829 | ;; mode. |
3830 | (pt (if (eq (point) (point-max)) | |
3831 | (save-excursion | |
3832 | (forward-line -2) | |
3833 | (goto-char (next-single-char-property-change | |
3834 | (point) 'face nil (line-end-position)))))) | |
3835 | (buffer-read-only)) | |
3836 | (forward-line 2) | |
3837 | (delete-region (point) (point-max)) | |
3838 | ;; Fill in the table with buttonized lines, each showing a category and | |
3839 | ;; its item counts. | |
ddce2e3e | 3840 | (mapc (lambda (cat) (todo-insert-category-line cat sortkey)) |
8b27b080 SB |
3841 | (mapcar 'car cats)) |
3842 | (newline) | |
3843 | ;; Add a line showing item count totals. | |
ddce2e3e SB |
3844 | (insert (make-string (+ 4 (length todo-categories-number-separator)) 32) |
3845 | (todo-padded-string todo-categories-totals-label) | |
8b27b080 SB |
3846 | (mapconcat |
3847 | (lambda (elt) | |
3848 | (concat | |
3849 | (make-string (1+ (/ (length (car elt)) 2)) 32) | |
ddce2e3e | 3850 | (format "%3d" (nth (cdr elt) (todo-total-item-counts))) |
8b27b080 SB |
3851 | ;; Add an extra space if label length is odd. |
3852 | (when (cl-oddp (length (car elt))) " "))) | |
3853 | (if archive | |
ddce2e3e SB |
3854 | (list (cons todo-categories-done-label 2)) |
3855 | (list (cons todo-categories-todo-label 0) | |
3856 | (cons todo-categories-diary-label 1) | |
3857 | (cons todo-categories-done-label 2) | |
3858 | (cons todo-categories-archived-label 3))) | |
8b27b080 SB |
3859 | "")) |
3860 | ;; Put cursor on Category button initially. | |
3861 | (if pt (goto-char pt)) | |
3862 | (setq buffer-read-only t))) | |
0e89c3fc | 3863 | |
a9b0e28e | 3864 | ;; ----------------------------------------------------------------------------- |
8b27b080 | 3865 | ;;; Searching and item filtering |
a9b0e28e | 3866 | ;; ----------------------------------------------------------------------------- |
0e89c3fc | 3867 | |
ddce2e3e | 3868 | (defun todo-search () |
4fe738d3 | 3869 | "Search for a regular expression in this todo file. |
8b27b080 SB |
3870 | The search runs through the whole file and encompasses all and |
3871 | only todo and done items; it excludes category names. Multiple | |
ddce2e3e | 3872 | matches are shown sequentially, highlighted in `todo-search' |
8b27b080 SB |
3873 | face." |
3874 | (interactive) | |
3875 | (let ((regex (read-from-minibuffer "Enter a search string (regexp): ")) | |
3876 | (opoint (point)) | |
3877 | matches match cat in-done ov mlen msg) | |
27139cd5 | 3878 | (widen) |
a820dfe8 | 3879 | (goto-char (point-min)) |
8b27b080 SB |
3880 | (while (not (eobp)) |
3881 | (setq match (re-search-forward regex nil t)) | |
3882 | (goto-char (line-beginning-position)) | |
3883 | (unless (or (equal (point) 1) | |
ddce2e3e | 3884 | (looking-at (concat "^" (regexp-quote todo-category-beg)))) |
8b27b080 SB |
3885 | (if match (push match matches))) |
3886 | (forward-line)) | |
3887 | (setq matches (reverse matches)) | |
3888 | (if matches | |
3889 | (catch 'stop | |
3890 | (while matches | |
3891 | (setq match (pop matches)) | |
3892 | (goto-char match) | |
ddce2e3e SB |
3893 | (todo-item-start) |
3894 | (when (looking-at todo-done-string-start) | |
8b27b080 | 3895 | (setq in-done t)) |
ddce2e3e | 3896 | (re-search-backward (concat "^" (regexp-quote todo-category-beg) |
8b27b080 SB |
3897 | "\\(.*\\)\n") nil t) |
3898 | (setq cat (match-string-no-properties 1)) | |
ddce2e3e SB |
3899 | (todo-category-number cat) |
3900 | (todo-category-select) | |
8b27b080 | 3901 | (if in-done |
ddce2e3e | 3902 | (unless todo-show-with-done (todo-toggle-view-done-items))) |
8b27b080 SB |
3903 | (goto-char match) |
3904 | (setq ov (make-overlay (- (point) (length regex)) (point))) | |
ddce2e3e | 3905 | (overlay-put ov 'face 'todo-search) |
8b27b080 SB |
3906 | (when matches |
3907 | (setq mlen (length matches)) | |
ddce2e3e | 3908 | (if (todo-y-or-n-p |
8b27b080 SB |
3909 | (if (> mlen 1) |
3910 | (format "There are %d more matches; go to next match? " | |
3911 | mlen) | |
3912 | "There is one more match; go to it? ")) | |
3913 | (widen) | |
3914 | (throw 'stop (setq msg (if (> mlen 1) | |
3915 | (format "There are %d more matches." | |
3916 | mlen) | |
3917 | "There is one more match.")))))) | |
3918 | (setq msg "There are no more matches.")) | |
ddce2e3e | 3919 | (todo-category-select) |
8b27b080 SB |
3920 | (goto-char opoint) |
3921 | (message "No match for \"%s\"" regex)) | |
3922 | (when msg | |
ddce2e3e SB |
3923 | (if (todo-y-or-n-p (concat msg "\nUnhighlight matches? ")) |
3924 | (todo-clear-matches) | |
8b27b080 SB |
3925 | (message "You can unhighlight the matches later by typing %s" |
3926 | (key-description (car (where-is-internal | |
ddce2e3e | 3927 | 'todo-clear-matches)))))))) |
58c7641d | 3928 | |
ddce2e3e SB |
3929 | (defun todo-clear-matches () |
3930 | "Remove highlighting on matches found by todo-search." | |
8b27b080 | 3931 | (interactive) |
ddce2e3e | 3932 | (remove-overlays 1 (1+ (buffer-size)) 'face 'todo-search)) |
58c7641d | 3933 | |
ddce2e3e | 3934 | (defcustom todo-top-priorities-overrides nil |
8b27b080 | 3935 | "List of rules specifying number of top priority items to show. |
ddce2e3e SB |
3936 | These rules override `todo-top-priorities' on invocations of |
3937 | `\\[todo-filter-top-priorities]' and | |
3938 | `\\[todo-filter-top-priorities-multifile]'. Each rule is a list | |
8b27b080 | 3939 | of the form (FILE NUM ALIST), where FILE is a member of |
ddce2e3e | 3940 | `todo-files', NUM is a number specifying the default number of |
8b27b080 SB |
3941 | top priority items for each category in that file, and ALIST, |
3942 | when non-nil, consists of conses of a category name in FILE and a | |
3943 | number specifying the default number of top priority items in | |
3944 | that category, which overrides NUM. | |
0e89c3fc | 3945 | |
8b27b080 | 3946 | This variable should be set interactively by |
ddce2e3e SB |
3947 | `\\[todo-set-top-priorities-in-file]' or |
3948 | `\\[todo-set-top-priorities-in-category]'." | |
8b27b080 | 3949 | :type 'sexp |
ddce2e3e | 3950 | :group 'todo-filtered) |
0e89c3fc | 3951 | |
ddce2e3e SB |
3952 | (defcustom todo-top-priorities 1 |
3953 | "Default number of top priorities shown by `todo-filter-top-priorities'." | |
8b27b080 | 3954 | :type 'integer |
ddce2e3e | 3955 | :group 'todo-filtered) |
3af3cd0b | 3956 | |
ddce2e3e | 3957 | (defcustom todo-filter-files nil |
8b27b080 SB |
3958 | "List of default files for multifile item filtering." |
3959 | :type `(set ,@(mapcar (lambda (f) (list 'const f)) | |
ddce2e3e SB |
3960 | (mapcar 'todo-short-file-name |
3961 | (funcall todo-files-function)))) | |
3962 | :group 'todo-filtered) | |
58c7641d | 3963 | |
ddce2e3e | 3964 | (defcustom todo-filter-done-items nil |
8b27b080 SB |
3965 | "Non-nil to include done items when processing regexp filters. |
3966 | Done items from corresponding archive files are also included." | |
3967 | :type 'boolean | |
ddce2e3e | 3968 | :group 'todo-filtered) |
f4228ddc | 3969 | |
ddce2e3e | 3970 | (defun todo-set-top-priorities-in-file () |
8b27b080 | 3971 | "Set number of top priorities for this file. |
ddce2e3e | 3972 | See `todo-set-top-priorities' for more details." |
8b27b080 | 3973 | (interactive) |
ddce2e3e | 3974 | (todo-set-top-priorities)) |
58c7641d | 3975 | |
ddce2e3e | 3976 | (defun todo-set-top-priorities-in-category () |
8b27b080 | 3977 | "Set number of top priorities for this category. |
ddce2e3e | 3978 | See `todo-set-top-priorities' for more details." |
8b27b080 | 3979 | (interactive) |
ddce2e3e | 3980 | (todo-set-top-priorities t)) |
8b27b080 | 3981 | |
ddce2e3e | 3982 | (defun todo-filter-top-priorities (&optional arg) |
8b27b080 | 3983 | "Display a list of top priority items from different categories. |
4fe738d3 | 3984 | The categories can be any of those in the current todo file. |
d04d6b95 | 3985 | |
8b27b080 SB |
3986 | With numerical prefix ARG show at most ARG top priority items |
3987 | from each category. With `C-u' as prefix argument show the | |
3988 | numbers of top priority items specified by category in | |
ddce2e3e SB |
3989 | `todo-top-priorities-overrides', if this has an entry for the file(s); |
3990 | otherwise show `todo-top-priorities' items per category in the | |
8b27b080 | 3991 | file(s). With no prefix argument, if a top priorities file for |
4fe738d3 | 3992 | the current todo file has previously been saved (see |
ddce2e3e | 3993 | `todo-save-filtered-items-buffer'), visit this file; if there is |
8b27b080 | 3994 | no such file, build the list as with prefix argument `C-u'. |
d04d6b95 | 3995 | |
8b27b080 SB |
3996 | The prefix ARG regulates how many top priorities from |
3997 | each category to show, as described above." | |
3998 | (interactive "P") | |
ddce2e3e | 3999 | (todo-filter-items 'top arg)) |
2c173503 | 4000 | |
ddce2e3e | 4001 | (defun todo-filter-top-priorities-multifile (&optional arg) |
8b27b080 SB |
4002 | "Display a list of top priority items from different categories. |
4003 | The categories are a subset of the categories in the files listed | |
ddce2e3e | 4004 | in `todo-filter-files', or if this nil, in the files chosen from |
8b27b080 | 4005 | a file selection dialog that pops up in this case. |
d04d6b95 | 4006 | |
8b27b080 SB |
4007 | With numerical prefix ARG show at most ARG top priority items |
4008 | from each category in each file. With `C-u' as prefix argument | |
4009 | show the numbers of top priority items specified in | |
ddce2e3e SB |
4010 | `todo-top-priorities-overrides', if this is non-nil; otherwise show |
4011 | `todo-top-priorities' items per category. With no prefix | |
4fe738d3 | 4012 | argument, if a top priorities file for the chosen todo files |
ddce2e3e | 4013 | exists (see `todo-save-filtered-items-buffer'), visit this file; |
8b27b080 SB |
4014 | if there is no such file, do the same as with prefix argument |
4015 | `C-u'." | |
4016 | (interactive "P") | |
ddce2e3e | 4017 | (todo-filter-items 'top arg t)) |
2c173503 | 4018 | |
ddce2e3e | 4019 | (defun todo-filter-diary-items (&optional arg) |
8b27b080 | 4020 | "Display a list of todo diary items from different categories. |
4fe738d3 | 4021 | The categories can be any of those in the current todo file. |
0e89c3fc | 4022 | |
8b27b080 | 4023 | Called with no prefix ARG, if a diary items file for the current |
4fe738d3 | 4024 | todo file has previously been saved (see |
ddce2e3e | 4025 | `todo-save-filtered-items-buffer'), visit this file; if there is |
8b27b080 SB |
4026 | no such file, build the list of diary items. Called with a |
4027 | prefix argument, build the list even if there is a saved file of | |
4028 | diary items." | |
4029 | (interactive "P") | |
ddce2e3e | 4030 | (todo-filter-items 'diary arg)) |
27139cd5 | 4031 | |
ddce2e3e | 4032 | (defun todo-filter-diary-items-multifile (&optional arg) |
8b27b080 SB |
4033 | "Display a list of todo diary items from different categories. |
4034 | The categories are a subset of the categories in the files listed | |
ddce2e3e | 4035 | in `todo-filter-files', or if this nil, in the files chosen from |
8b27b080 | 4036 | a file selection dialog that pops up in this case. |
27139cd5 | 4037 | |
8b27b080 | 4038 | Called with no prefix ARG, if a diary items file for the chosen |
4fe738d3 | 4039 | todo files has previously been saved (see |
ddce2e3e | 4040 | `todo-save-filtered-items-buffer'), visit this file; if there is |
8b27b080 SB |
4041 | no such file, build the list of diary items. Called with a |
4042 | prefix argument, build the list even if there is a saved file of | |
4043 | diary items." | |
4044 | (interactive "P") | |
ddce2e3e | 4045 | (todo-filter-items 'diary arg t)) |
58c7641d | 4046 | |
ddce2e3e | 4047 | (defun todo-filter-regexp-items (&optional arg) |
8b27b080 | 4048 | "Prompt for a regular expression and display items that match it. |
4fe738d3 | 4049 | The matches can be from any categories in the current todo file |
ddce2e3e | 4050 | and with non-nil option `todo-filter-done-items', can include |
8b27b080 SB |
4051 | not only todo items but also done items, including those in |
4052 | Archive files. | |
58c7641d | 4053 | |
8b27b080 | 4054 | Called with no prefix ARG, if a regexp items file for the current |
4fe738d3 | 4055 | todo file has previously been saved (see |
ddce2e3e | 4056 | `todo-save-filtered-items-buffer'), visit this file; if there is |
8b27b080 SB |
4057 | no such file, build the list of regexp items. Called with a |
4058 | prefix argument, build the list even if there is a saved file of | |
4059 | regexp items." | |
4060 | (interactive "P") | |
ddce2e3e | 4061 | (todo-filter-items 'regexp arg)) |
a2730169 | 4062 | |
ddce2e3e | 4063 | (defun todo-filter-regexp-items-multifile (&optional arg) |
8b27b080 SB |
4064 | "Prompt for a regular expression and display items that match it. |
4065 | The matches can be from any categories in the files listed in | |
ddce2e3e | 4066 | `todo-filter-files', or if this nil, in the files chosen from a |
8b27b080 | 4067 | file selection dialog that pops up in this case. With non-nil |
ddce2e3e | 4068 | option `todo-filter-done-items', the matches can include not |
8b27b080 SB |
4069 | only todo items but also done items, including those in Archive |
4070 | files. | |
0e89c3fc | 4071 | |
8b27b080 | 4072 | Called with no prefix ARG, if a regexp items file for the current |
4fe738d3 | 4073 | todo file has previously been saved (see |
ddce2e3e | 4074 | `todo-save-filtered-items-buffer'), visit this file; if there is |
8b27b080 SB |
4075 | no such file, build the list of regexp items. Called with a |
4076 | prefix argument, build the list even if there is a saved file of | |
4077 | regexp items." | |
4078 | (interactive "P") | |
ddce2e3e | 4079 | (todo-filter-items 'regexp arg t)) |
04c9cdf7 | 4080 | |
ddce2e3e | 4081 | (defun todo-find-filtered-items-file () |
8b27b080 SB |
4082 | "Choose a filtered items file and visit it." |
4083 | (interactive) | |
ddce2e3e | 4084 | (let ((files (directory-files todo-directory t "\.tod[rty]$" t)) |
8b27b080 SB |
4085 | falist file) |
4086 | (dolist (f files) | |
4087 | (let ((type (cond ((equal (file-name-extension f) "todr") "regexp") | |
4088 | ((equal (file-name-extension f) "todt") "top") | |
4089 | ((equal (file-name-extension f) "tody") "diary")))) | |
ddce2e3e | 4090 | (push (cons (concat (todo-short-file-name f) " (" type ")") f) |
8b27b080 SB |
4091 | falist))) |
4092 | (setq file (completing-read "Choose a filtered items file: " | |
4093 | falist nil t nil nil (car falist))) | |
4094 | (setq file (cdr (assoc-string file falist))) | |
4095 | (find-file file))) | |
4096 | ||
ddce2e3e | 4097 | (defun todo-go-to-source-item () |
8b27b080 SB |
4098 | "Display the file and category of the filtered item at point." |
4099 | (interactive) | |
ddce2e3e | 4100 | (let* ((str (todo-item-string)) |
8b27b080 | 4101 | (buf (current-buffer)) |
ddce2e3e | 4102 | (res (todo-find-item str)) |
8b27b080 SB |
4103 | (found (nth 0 res)) |
4104 | (file (nth 1 res)) | |
4105 | (cat (nth 2 res))) | |
4106 | (if (not found) | |
4107 | (message "Category %s does not contain this item." cat) | |
4108 | (kill-buffer buf) | |
4109 | (set-window-buffer (selected-window) | |
4110 | (set-buffer (find-buffer-visiting file))) | |
ddce2e3e SB |
4111 | (setq todo-current-todo-file file) |
4112 | (setq todo-category-number (todo-category-number cat)) | |
4113 | (let ((todo-show-with-done (if (or todo-filter-done-items | |
8b27b080 SB |
4114 | (eq (cdr found) 'done)) |
4115 | t | |
ddce2e3e SB |
4116 | todo-show-with-done))) |
4117 | (todo-category-select)) | |
8b27b080 SB |
4118 | (goto-char (car found))))) |
4119 | ||
ddce2e3e SB |
4120 | (defvar todo-multiple-filter-files nil |
4121 | "List of files selected from `todo-multiple-filter-files' widget.") | |
58c7641d | 4122 | |
ddce2e3e SB |
4123 | (defvar todo-multiple-filter-files-widget nil |
4124 | "Variable holding widget created by `todo-multiple-filter-files'.") | |
04c9cdf7 | 4125 | |
ddce2e3e | 4126 | (defun todo-multiple-filter-files () |
8b27b080 SB |
4127 | "Pop to a buffer with a widget for choosing multiple filter files." |
4128 | (require 'widget) | |
4129 | (eval-when-compile | |
4130 | (require 'wid-edit)) | |
ddce2e3e | 4131 | (with-current-buffer (get-buffer-create "*Todo Filter Files*") |
8b27b080 SB |
4132 | (pop-to-buffer (current-buffer)) |
4133 | (erase-buffer) | |
4134 | (kill-all-local-variables) | |
4135 | (widget-insert "Select files for generating the top priorities list.\n\n") | |
ddce2e3e | 4136 | (setq todo-multiple-filter-files-widget |
8b27b080 SB |
4137 | (widget-create |
4138 | `(set ,@(mapcar (lambda (x) (list 'const x)) | |
ddce2e3e SB |
4139 | (mapcar 'todo-short-file-name |
4140 | (funcall todo-files-function)))))) | |
8b27b080 SB |
4141 | (widget-insert "\n") |
4142 | (widget-create 'push-button | |
4143 | :notify (lambda (widget &rest ignore) | |
ddce2e3e | 4144 | (setq todo-multiple-filter-files 'quit) |
8b27b080 SB |
4145 | (quit-window t) |
4146 | (exit-recursive-edit)) | |
4147 | "Cancel") | |
4148 | (widget-insert " ") | |
4149 | (widget-create 'push-button | |
4150 | :notify (lambda (&rest ignore) | |
ddce2e3e | 4151 | (setq todo-multiple-filter-files |
8b27b080 SB |
4152 | (mapcar (lambda (f) |
4153 | (file-truename | |
ddce2e3e | 4154 | (concat todo-directory |
8b27b080 SB |
4155 | f ".todo"))) |
4156 | (widget-value | |
ddce2e3e | 4157 | todo-multiple-filter-files-widget))) |
8b27b080 SB |
4158 | (quit-window t) |
4159 | (exit-recursive-edit)) | |
4160 | "Apply") | |
4161 | (use-local-map widget-keymap) | |
4162 | (widget-setup)) | |
4163 | (message "Click \"Apply\" after selecting files.") | |
4164 | (recursive-edit)) | |
27139cd5 | 4165 | |
ddce2e3e SB |
4166 | (defconst todo-filtered-items-buffer "Todo filtered items" |
4167 | "Initial name of buffer in Todo Filter Items mode.") | |
0e89c3fc | 4168 | |
ddce2e3e SB |
4169 | (defconst todo-top-priorities-buffer "Todo top priorities" |
4170 | "Buffer type string for `todo-filter-items'.") | |
caa229d5 | 4171 | |
ddce2e3e SB |
4172 | (defconst todo-diary-items-buffer "Todo diary items" |
4173 | "Buffer type string for `todo-filter-items'.") | |
344187df | 4174 | |
ddce2e3e SB |
4175 | (defconst todo-regexp-items-buffer "Todo regexp items" |
4176 | "Buffer type string for `todo-filter-items'.") | |
caa229d5 | 4177 | |
ddce2e3e | 4178 | (defun todo-filter-items (filter &optional new multifile) |
d610f6dd | 4179 | "Display a list of items filtered by FILTER. |
8b27b080 SB |
4180 | The values of FILTER can be `top' for top priority items, a cons |
4181 | of `top' and a number passed by the caller, `diary' for diary | |
d610f6dd SB |
4182 | items, or `regexp' for items matching a regular expression |
4183 | entered by the user. The items can come from any categories in | |
4184 | the current todo file or, with non-nil MULTIFILE, from several | |
4185 | files. If NEW is nil, visit an appropriate file containing the | |
4186 | list of filtered items; if there is no such file, or with non-nil | |
4187 | NEW, build the list and display it. | |
27139cd5 | 4188 | |
ebc83885 | 4189 | See the documentation strings of the commands |
ddce2e3e SB |
4190 | `todo-filter-top-priorities', `todo-filter-diary-items', |
4191 | `todo-filter-regexp-items', and those of the corresponding | |
8b27b080 SB |
4192 | multifile commands for further details." |
4193 | (let* ((top (eq filter 'top)) | |
4194 | (diary (eq filter 'diary)) | |
4195 | (regexp (eq filter 'regexp)) | |
ddce2e3e SB |
4196 | (buf (cond (top todo-top-priorities-buffer) |
4197 | (diary todo-diary-items-buffer) | |
4198 | (regexp todo-regexp-items-buffer))) | |
8b27b080 | 4199 | (flist (if multifile |
ddce2e3e SB |
4200 | (or todo-filter-files |
4201 | (progn (todo-multiple-filter-files) | |
4202 | todo-multiple-filter-files)) | |
4203 | (list todo-current-todo-file))) | |
8b27b080 SB |
4204 | (multi (> (length flist) 1)) |
4205 | (fname (if (equal flist 'quit) | |
4206 | ;; Pressed `cancel' in t-m-f-f file selection dialog. | |
4207 | (keyboard-quit) | |
ddce2e3e SB |
4208 | (concat todo-directory |
4209 | (mapconcat 'todo-short-file-name flist "-") | |
8b27b080 SB |
4210 | (cond (top ".todt") |
4211 | (diary ".tody") | |
4212 | (regexp ".todr"))))) | |
4213 | (rxfiles (when regexp | |
ddce2e3e | 4214 | (directory-files todo-directory t ".*\\.todr$" t))) |
d5a845b4 SB |
4215 | (file-exists (or (file-exists-p fname) rxfiles)) |
4216 | bufname) | |
8b27b080 | 4217 | (cond ((and top new (natnump new)) |
ddce2e3e | 4218 | (todo-filter-items-1 (cons 'top new) flist)) |
8b27b080 SB |
4219 | ((and (not new) file-exists) |
4220 | (when (and rxfiles (> (length rxfiles) 1)) | |
ddce2e3e SB |
4221 | (let ((rxf (mapcar 'todo-short-file-name rxfiles))) |
4222 | (setq fname (todo-absolute-file-name | |
8b27b080 SB |
4223 | (completing-read "Choose a regexp items file: " |
4224 | rxf) 'regexp)))) | |
4225 | (find-file fname) | |
ddce2e3e SB |
4226 | (todo-prefix-overlays) |
4227 | (todo-check-filtered-items-file)) | |
8b27b080 | 4228 | (t |
ddce2e3e | 4229 | (todo-filter-items-1 filter flist))) |
d5a845b4 SB |
4230 | (dolist (s (split-string (todo-short-file-name fname) "-")) |
4231 | (setq bufname (if bufname | |
4232 | (concat bufname (if (member s (mapcar | |
4233 | 'todo-short-file-name | |
4234 | todo-files)) | |
4235 | ", " "-") s) | |
4236 | s))) | |
8b27b080 | 4237 | (rename-buffer (format (concat "%s for file" (if multi "s" "") |
d5a845b4 | 4238 | " \"%s\"") buf bufname)))) |
27139cd5 | 4239 | |
ddce2e3e | 4240 | (defun todo-filter-items-1 (filter file-list) |
8b27b080 | 4241 | "Build a list of items by applying FILTER to FILE-LIST. |
ddce2e3e | 4242 | Internal subroutine called by `todo-filter-items', which passes |
8b27b080 | 4243 | the values of FILTER and FILE-LIST." |
ddce2e3e SB |
4244 | (let ((num (if (consp filter) (cdr filter) todo-top-priorities)) |
4245 | (buf (get-buffer-create todo-filtered-items-buffer)) | |
8b27b080 SB |
4246 | (multifile (> (length file-list) 1)) |
4247 | regexp fname bufstr cat beg end done) | |
4248 | (if (null file-list) | |
4249 | (user-error "No files have been chosen for filtering") | |
4250 | (with-current-buffer buf | |
4251 | (erase-buffer) | |
4252 | (kill-all-local-variables) | |
ddce2e3e | 4253 | (todo-filtered-items-mode)) |
8b27b080 SB |
4254 | (when (eq filter 'regexp) |
4255 | (setq regexp (read-string "Enter a regular expression: "))) | |
4256 | (save-current-buffer | |
4257 | (dolist (f file-list) | |
4258 | ;; Before inserting file contents into temp buffer, save a modified | |
4259 | ;; buffer visiting it. | |
4260 | (let ((bf (find-buffer-visiting f))) | |
4261 | (when (buffer-modified-p bf) | |
4262 | (with-current-buffer bf (save-buffer)))) | |
ddce2e3e | 4263 | (setq fname (todo-short-file-name f)) |
8b27b080 | 4264 | (with-temp-buffer |
ddce2e3e | 4265 | (when (and todo-filter-done-items (eq filter 'regexp)) |
8b27b080 | 4266 | ;; If there is a corresponding archive file for the |
4fe738d3 | 4267 | ;; todo file, insert it first and add identifiers for |
ddce2e3e | 4268 | ;; todo-go-to-source-item. |
8b27b080 SB |
4269 | (let ((arch (concat (file-name-sans-extension f) ".toda"))) |
4270 | (when (file-exists-p arch) | |
4271 | (insert-file-contents arch) | |
4fe738d3 | 4272 | ;; Delete todo archive file's categories sexp. |
8b27b080 SB |
4273 | (delete-region (line-beginning-position) |
4274 | (1+ (line-end-position))) | |
4275 | (save-excursion | |
4276 | (while (not (eobp)) | |
4277 | (when (re-search-forward | |
ddce2e3e SB |
4278 | (concat (if todo-filter-done-items |
4279 | (concat "\\(?:" todo-done-string-start | |
4280 | "\\|" todo-date-string-start | |
8b27b080 | 4281 | "\\)") |
ddce2e3e SB |
4282 | todo-date-string-start) |
4283 | todo-date-pattern "\\(?: " | |
8b27b080 | 4284 | diary-time-regexp "\\)?" |
ddce2e3e | 4285 | (if todo-filter-done-items |
8b27b080 | 4286 | "\\]" |
ddce2e3e | 4287 | (regexp-quote todo-nondiary-end)) "?") |
8b27b080 SB |
4288 | nil t) |
4289 | (insert "(archive) ")) | |
4290 | (forward-line)))))) | |
4291 | (insert-file-contents f) | |
4fe738d3 | 4292 | ;; Delete todo file's categories sexp. |
8b27b080 SB |
4293 | (delete-region (line-beginning-position) (1+ (line-end-position))) |
4294 | (let (fnum) | |
4295 | ;; Unless the number of top priorities to show was | |
4296 | ;; passed by the caller, the file-wide value from | |
ddce2e3e SB |
4297 | ;; `todo-top-priorities-overrides', if non-nil, overrides |
4298 | ;; `todo-top-priorities'. | |
8b27b080 | 4299 | (unless (consp filter) |
ddce2e3e SB |
4300 | (setq fnum (or (nth 1 (assoc f todo-top-priorities-overrides)) |
4301 | todo-top-priorities))) | |
8b27b080 | 4302 | (while (re-search-forward |
ddce2e3e | 4303 | (concat "^" (regexp-quote todo-category-beg) |
8b27b080 SB |
4304 | "\\(.+\\)\n") nil t) |
4305 | (setq cat (match-string 1)) | |
4306 | (let (cnum) | |
4307 | ;; Unless the number of top priorities to show was | |
4308 | ;; passed by the caller, the category-wide value | |
ddce2e3e | 4309 | ;; from `todo-top-priorities-overrides', if non-nil, |
8b27b080 | 4310 | ;; overrides a non-nil file-wide value from |
ddce2e3e SB |
4311 | ;; `todo-top-priorities-overrides' as well as |
4312 | ;; `todo-top-priorities'. | |
8b27b080 | 4313 | (unless (consp filter) |
ddce2e3e | 4314 | (let ((cats (nth 2 (assoc f todo-top-priorities-overrides)))) |
8b27b080 SB |
4315 | (setq cnum (or (cdr (assoc cat cats)) fnum)))) |
4316 | (delete-region (match-beginning 0) (match-end 0)) | |
4317 | (setq beg (point)) ; First item in the current category. | |
4318 | (setq end (if (re-search-forward | |
ddce2e3e | 4319 | (concat "^" (regexp-quote todo-category-beg)) |
8b27b080 SB |
4320 | nil t) |
4321 | (match-beginning 0) | |
4322 | (point-max))) | |
4323 | (goto-char beg) | |
4324 | (setq done | |
4325 | (if (re-search-forward | |
ddce2e3e | 4326 | (concat "\n" (regexp-quote todo-category-done)) |
8b27b080 SB |
4327 | end t) |
4328 | (match-beginning 0) | |
4329 | end)) | |
ddce2e3e | 4330 | (unless (and todo-filter-done-items (eq filter 'regexp)) |
8b27b080 SB |
4331 | ;; Leave done items. |
4332 | (delete-region done end) | |
4333 | (setq end done)) | |
4334 | (narrow-to-region beg end) ; Process only current category. | |
4335 | (goto-char (point-min)) | |
4336 | ;; Apply the filter. | |
4337 | (cond ((eq filter 'diary) | |
4338 | (while (not (eobp)) | |
ddce2e3e SB |
4339 | (if (looking-at (regexp-quote todo-nondiary-start)) |
4340 | (todo-remove-item) | |
4341 | (todo-forward-item)))) | |
8b27b080 SB |
4342 | ((eq filter 'regexp) |
4343 | (while (not (eobp)) | |
ddce2e3e SB |
4344 | (if (looking-at todo-item-start) |
4345 | (if (string-match regexp (todo-item-string)) | |
4346 | (todo-forward-item) | |
4347 | (todo-remove-item)) | |
8b27b080 | 4348 | ;; Kill lines that aren't part of a todo or done |
ddce2e3e | 4349 | ;; item (empty or todo-category-done). |
8b27b080 SB |
4350 | (delete-region (line-beginning-position) |
4351 | (1+ (line-end-position)))) | |
4352 | ;; If last todo item in file matches regexp and | |
4353 | ;; there are no following done items, | |
ddce2e3e SB |
4354 | ;; todo-category-done string is left dangling, |
4355 | ;; because todo-forward-item jumps over it. | |
8b27b080 SB |
4356 | (if (and (eobp) |
4357 | (looking-back | |
ddce2e3e | 4358 | (concat (regexp-quote todo-done-string) |
8b27b080 SB |
4359 | "\n"))) |
4360 | (delete-region (point) (progn | |
4361 | (forward-line -2) | |
4362 | (point)))))) | |
4363 | (t ; Filter top priority items. | |
4364 | (setq num (or cnum fnum num)) | |
4365 | (unless (zerop num) | |
ddce2e3e | 4366 | (todo-forward-item num)))) |
8b27b080 SB |
4367 | (setq beg (point)) |
4368 | ;; Delete non-top-priority items. | |
4369 | (unless (member filter '(diary regexp)) | |
4370 | (delete-region beg end)) | |
4371 | (goto-char (point-min)) | |
4372 | ;; Add file (if using multiple files) and category tags to | |
4373 | ;; item. | |
4374 | (while (not (eobp)) | |
4375 | (when (re-search-forward | |
ddce2e3e SB |
4376 | (concat (if todo-filter-done-items |
4377 | (concat "\\(?:" todo-done-string-start | |
4378 | "\\|" todo-date-string-start | |
8b27b080 | 4379 | "\\)") |
ddce2e3e SB |
4380 | todo-date-string-start) |
4381 | todo-date-pattern "\\(?: " diary-time-regexp | |
4382 | "\\)?" (if todo-filter-done-items | |
8b27b080 | 4383 | "\\]" |
ddce2e3e | 4384 | (regexp-quote todo-nondiary-end)) |
8b27b080 SB |
4385 | "?") |
4386 | nil t) | |
4387 | (insert " [") | |
4388 | (when (looking-at "(archive) ") (goto-char (match-end 0))) | |
4389 | (insert (if multifile (concat fname ":") "") cat "]")) | |
4390 | (forward-line)) | |
4391 | (widen))) | |
4392 | (setq bufstr (buffer-string)) | |
4393 | (with-current-buffer buf | |
4394 | (let (buffer-read-only) | |
4395 | (insert bufstr))))))) | |
4396 | (set-window-buffer (selected-window) (set-buffer buf)) | |
ddce2e3e | 4397 | (todo-prefix-overlays) |
8b27b080 | 4398 | (goto-char (point-min))))) |
db5ea477 | 4399 | |
ddce2e3e SB |
4400 | (defun todo-set-top-priorities (&optional arg) |
4401 | "Set number of top priorities shown by `todo-filter-top-priorities'. | |
4402 | With non-nil ARG, set the number only for the current Todo | |
8b27b080 | 4403 | category; otherwise, set the number for all categories in the |
4fe738d3 | 4404 | current todo file. |
27139cd5 | 4405 | |
8b27b080 | 4406 | Calling this function via either of the commands |
ddce2e3e SB |
4407 | `todo-set-top-priorities-in-file' or |
4408 | `todo-set-top-priorities-in-category' is the recommended way to | |
4409 | set the user customizable option `todo-top-priorities-overrides'." | |
4410 | (let* ((cat (todo-current-category)) | |
4411 | (file todo-current-todo-file) | |
4412 | (rules todo-top-priorities-overrides) | |
8b27b080 SB |
4413 | (frule (assoc-string file rules)) |
4414 | (crule (assoc-string cat (nth 2 frule))) | |
4415 | (crules (nth 2 frule)) | |
4416 | (cur (or (if arg (cdr crule) (nth 1 frule)) | |
ddce2e3e | 4417 | todo-top-priorities)) |
8b27b080 SB |
4418 | (prompt (if arg (concat "Number of top priorities in this category" |
4419 | " (currently %d): ") | |
4420 | (concat "Default number of top priorities per category" | |
4421 | " in this file (currently %d): "))) | |
4422 | (new -1) | |
4423 | nrule) | |
4424 | (while (< new 0) | |
4425 | (let ((cur0 cur)) | |
4426 | (setq new (read-number (format prompt cur0)) | |
4427 | prompt "Enter a non-negative number: " | |
4428 | cur0 nil))) | |
4429 | (setq nrule (if arg | |
4430 | (append (delete crule crules) (list (cons cat new))) | |
4431 | (append (list file new) (list crules)))) | |
4432 | (setq rules (cons (if arg | |
4433 | (list file cur nrule) | |
4434 | nrule) | |
4435 | (delete frule rules))) | |
ddce2e3e SB |
4436 | (customize-save-variable 'todo-top-priorities-overrides rules) |
4437 | (todo-prefix-overlays))) | |
27139cd5 | 4438 | |
ddce2e3e | 4439 | (defun todo-find-item (str) |
4fe738d3 | 4440 | "Search for filtered item STR in its saved todo file. |
8b27b080 SB |
4441 | Return the list (FOUND FILE CAT), where CAT and FILE are the |
4442 | item's category and file, and FOUND is a cons cell if the search | |
4443 | succeeds, whose car is the start of the item in FILE and whose | |
4444 | cdr is `done', if the item is now a done item, `changed', if its | |
4445 | text was truncated or augmented or, for a top priority item, if | |
4446 | its priority has changed, and `same' otherwise." | |
ddce2e3e SB |
4447 | (string-match (concat (if todo-filter-done-items |
4448 | (concat "\\(?:" todo-done-string-start "\\|" | |
4449 | todo-date-string-start "\\)") | |
4450 | todo-date-string-start) | |
4451 | todo-date-pattern "\\(?: " diary-time-regexp "\\)?" | |
4452 | (if todo-filter-done-items | |
8b27b080 | 4453 | "\\]" |
ddce2e3e | 4454 | (regexp-quote todo-nondiary-end)) "?" |
8b27b080 SB |
4455 | "\\(?4: \\[\\(?3:(archive) \\)?\\(?2:.*:\\)?" |
4456 | "\\(?1:.*\\)\\]\\).*$") str) | |
4457 | (let ((cat (match-string 1 str)) | |
4458 | (file (match-string 2 str)) | |
4459 | (archive (string= (match-string 3 str) "(archive) ")) | |
4460 | (filcat (match-string 4 str)) | |
4461 | (tpriority 1) | |
4462 | (tpbuf (save-match-data (string-match "top" (buffer-name)))) | |
4463 | found) | |
4464 | (setq str (replace-match "" nil nil str 4)) | |
4465 | (when tpbuf | |
4466 | ;; Calculate priority of STR wrt its category. | |
4467 | (save-excursion | |
4468 | (while (search-backward filcat nil t) | |
4469 | (setq tpriority (1+ tpriority))))) | |
4470 | (setq file (if file | |
ddce2e3e | 4471 | (concat todo-directory (substring file 0 -1) |
8b27b080 SB |
4472 | (if archive ".toda" ".todo")) |
4473 | (if archive | |
4474 | (concat (file-name-sans-extension | |
ddce2e3e SB |
4475 | todo-global-current-todo-file) ".toda") |
4476 | todo-global-current-todo-file))) | |
8b27b080 SB |
4477 | (find-file-noselect file) |
4478 | (with-current-buffer (find-buffer-visiting file) | |
4479 | (save-restriction | |
4480 | (widen) | |
4481 | (goto-char (point-min)) | |
4482 | (let ((beg (re-search-forward | |
ddce2e3e | 4483 | (concat "^" (regexp-quote (concat todo-category-beg cat)) |
8b27b080 SB |
4484 | "$") |
4485 | nil t)) | |
4486 | (done (save-excursion | |
4487 | (re-search-forward | |
ddce2e3e | 4488 | (concat "^" (regexp-quote todo-category-done)) nil t))) |
8b27b080 SB |
4489 | (end (save-excursion |
4490 | (or (re-search-forward | |
ddce2e3e | 4491 | (concat "^" (regexp-quote todo-category-beg)) |
8b27b080 SB |
4492 | nil t) |
4493 | (point-max))))) | |
4494 | (setq found (when (search-forward str end t) | |
4495 | (goto-char (match-beginning 0)))) | |
4496 | (when found | |
4497 | (setq found | |
4498 | (cons found (if (> (point) done) | |
4499 | 'done | |
4500 | (let ((cpriority 1)) | |
4501 | (when tpbuf | |
4502 | (save-excursion | |
4503 | ;; Not top item in category. | |
4504 | (while (> (point) (1+ beg)) | |
4505 | (let ((opoint (point))) | |
ddce2e3e | 4506 | (todo-backward-item) |
8b27b080 SB |
4507 | ;; Can't move backward beyond |
4508 | ;; first item in file. | |
4509 | (unless (= (point) opoint) | |
4510 | (setq cpriority (1+ cpriority))))))) | |
4511 | (if (and (= tpriority cpriority) | |
4512 | ;; Proper substring is not the same. | |
ddce2e3e | 4513 | (string= (todo-item-string) |
8b27b080 SB |
4514 | str)) |
4515 | 'same | |
4516 | 'changed))))))))) | |
4517 | (list found file cat))) | |
27139cd5 | 4518 | |
ddce2e3e | 4519 | (defun todo-check-filtered-items-file () |
8b27b080 SB |
4520 | "Check if filtered items file is up to date and a show suitable message." |
4521 | ;; (catch 'old | |
4522 | (let ((count 0)) | |
4523 | (while (not (eobp)) | |
ddce2e3e SB |
4524 | (let* ((item (todo-item-string)) |
4525 | (found (car (todo-find-item item)))) | |
8b27b080 SB |
4526 | (unless (eq (cdr found) 'same) |
4527 | (save-excursion | |
ddce2e3e SB |
4528 | (overlay-put (make-overlay (todo-item-start) (todo-item-end)) |
4529 | 'face 'todo-search)) | |
8b27b080 SB |
4530 | (setq count (1+ count)))) |
4531 | ;; (throw 'old (message "The marked item is not up to date."))) | |
ddce2e3e | 4532 | (todo-forward-item)) |
8b27b080 SB |
4533 | (if (zerop count) |
4534 | (message "Filtered items file is up to date.") | |
4535 | (message (concat "The highlighted item" (if (= count 1) " is " "s are ") | |
4536 | "not up to date." | |
4537 | ;; "\nType <return> on item for details." | |
4538 | ))))) | |
27139cd5 | 4539 | |
ddce2e3e | 4540 | (defun todo-filter-items-filename () |
8b27b080 SB |
4541 | "Return absolute file name for saving this Filtered Items buffer." |
4542 | (let ((bufname (buffer-name))) | |
4543 | (string-match "\"\\([^\"]+\\)\"" bufname) | |
4544 | (let* ((filename-str (substring bufname (match-beginning 1) (match-end 1))) | |
4545 | (filename-base (replace-regexp-in-string ", " "-" filename-str)) | |
4546 | (top-priorities (string-match "top priorities" bufname)) | |
4547 | (diary-items (string-match "diary items" bufname)) | |
4548 | (regexp-items (string-match "regexp items" bufname))) | |
4549 | (when regexp-items | |
4550 | (let ((prompt (concat "Enter a short identifying string" | |
4551 | " to make this file name unique: "))) | |
4552 | (setq filename-base (concat filename-base "-" (read-string prompt))))) | |
ddce2e3e | 4553 | (concat todo-directory filename-base |
8b27b080 SB |
4554 | (cond (top-priorities ".todt") |
4555 | (diary-items ".tody") | |
4556 | (regexp-items ".todr")))))) | |
caa229d5 | 4557 | |
ddce2e3e | 4558 | (defun todo-save-filtered-items-buffer () |
8b27b080 SB |
4559 | "Save current Filtered Items buffer to a file. |
4560 | If the file already exists, overwrite it only on confirmation." | |
ddce2e3e | 4561 | (let ((filename (or (buffer-file-name) (todo-filter-items-filename)))) |
8b27b080 | 4562 | (write-file filename t))) |
b28872ce | 4563 | |
a9b0e28e | 4564 | ;; ----------------------------------------------------------------------------- |
4fe738d3 | 4565 | ;;; Printing Todo mode buffers |
a9b0e28e | 4566 | ;; ----------------------------------------------------------------------------- |
18aef8a3 | 4567 | |
ddce2e3e SB |
4568 | (defcustom todo-print-buffer-function 'ps-print-buffer-with-faces |
4569 | "Function called by the command `todo-print-buffer'." | |
8b27b080 | 4570 | :type 'symbol |
ddce2e3e | 4571 | :group 'todo) |
b28872ce | 4572 | |
ddce2e3e | 4573 | (defvar todo-print-buffer "*Todo Print*" |
4fe738d3 | 4574 | "Name of buffer with printable version of Todo mode buffer.") |
b28872ce | 4575 | |
ddce2e3e | 4576 | (defun todo-print-buffer (&optional to-file) |
4fe738d3 | 4577 | "Produce a printable version of the current Todo mode buffer. |
8b27b080 | 4578 | This converts overlays and soft line wrapping and, depending on |
ddce2e3e | 4579 | the value of `todo-print-buffer-function', includes faces. With |
8b27b080 SB |
4580 | non-nil argument TO-FILE write the printable version to a file; |
4581 | otherwise, send it to the default printer." | |
4582 | (interactive) | |
ddce2e3e | 4583 | (let ((buf todo-print-buffer) |
8b27b080 | 4584 | (header (cond |
ddce2e3e SB |
4585 | ((eq major-mode 'todo-mode) |
4586 | (concat "Todo File: " | |
4587 | (todo-short-file-name todo-current-todo-file) | |
4588 | "\nCategory: " (todo-current-category))) | |
4589 | ((eq major-mode 'todo-filtered-items-mode) | |
8b27b080 | 4590 | (buffer-name)))) |
ddce2e3e SB |
4591 | (prefix (propertize (concat todo-prefix " ") |
4592 | 'face 'todo-prefix-string)) | |
8b27b080 | 4593 | (num 0) |
ddce2e3e | 4594 | (fill-prefix (make-string todo-indent-to-here 32)) |
8b27b080 SB |
4595 | (content (buffer-string)) |
4596 | file) | |
4597 | (with-current-buffer (get-buffer-create buf) | |
4598 | (insert content) | |
4599 | (goto-char (point-min)) | |
4600 | (while (not (eobp)) | |
4601 | (let ((beg (point)) | |
ddce2e3e SB |
4602 | (end (save-excursion (todo-item-end)))) |
4603 | (when todo-number-prefix | |
8b27b080 SB |
4604 | (setq num (1+ num)) |
4605 | (setq prefix (propertize (concat (number-to-string num) " ") | |
ddce2e3e | 4606 | 'face 'todo-prefix-string))) |
8b27b080 SB |
4607 | (insert prefix) |
4608 | (fill-region beg end)) | |
ddce2e3e | 4609 | ;; Calling todo-forward-item infloops at todo-item-start due to |
8b27b080 | 4610 | ;; non-overlay prefix, so search for item start instead. |
ddce2e3e | 4611 | (if (re-search-forward todo-item-start nil t) |
8b27b080 SB |
4612 | (beginning-of-line) |
4613 | (goto-char (point-max)))) | |
ddce2e3e | 4614 | (if (re-search-backward (concat "^" (regexp-quote todo-category-done)) |
8b27b080 | 4615 | nil t) |
ddce2e3e | 4616 | (replace-match todo-done-separator)) |
8b27b080 SB |
4617 | (goto-char (point-min)) |
4618 | (insert header) | |
4619 | (newline 2) | |
4620 | (if to-file | |
4621 | (let ((file (read-file-name "Print to file: "))) | |
ddce2e3e SB |
4622 | (funcall todo-print-buffer-function file)) |
4623 | (funcall todo-print-buffer-function))) | |
8b27b080 | 4624 | (kill-buffer buf))) |
b28872ce | 4625 | |
ddce2e3e | 4626 | (defun todo-print-buffer-to-file () |
4fe738d3 | 4627 | "Save printable version of this Todo mode buffer to a file." |
8b27b080 | 4628 | (interactive) |
ddce2e3e | 4629 | (todo-print-buffer t)) |
b28872ce | 4630 | |
8b27b080 SB |
4631 | ;; ----------------------------------------------------------------------------- |
4632 | ;;; Legacy Todo mode files | |
4633 | ;; ----------------------------------------------------------------------------- | |
b28872ce | 4634 | |
ddce2e3e | 4635 | (defcustom todo-legacy-date-time-regexp |
8b27b080 SB |
4636 | (concat "\\(?1:[0-9]\\{4\\}\\)-\\(?2:[0-9]\\{2\\}\\)-" |
4637 | "\\(?3:[0-9]\\{2\\}\\) \\(?4:[0-9]\\{2\\}:[0-9]\\{2\\}\\)") | |
4638 | "Regexp matching legacy todo-mode.el item date-time strings. | |
4fe738d3 SB |
4639 | In order for `todo-convert-legacy-files' to correctly convert |
4640 | this string to the current Todo mode format, the regexp must | |
4641 | contain four explicitly numbered groups (see `(elisp) Regexp | |
4642 | Backslash'), where group 1 matches a string for the year, group 2 | |
4643 | a string for the month, group 3 a string for the day and group 4 | |
4644 | a string for the time. The default value converts date-time | |
4645 | strings built using the default value of | |
4646 | `todo-time-string-format' from todo-mode.el." | |
8b27b080 | 4647 | :type 'regexp |
ddce2e3e | 4648 | :group 'todo) |
b28872ce | 4649 | |
ddce2e3e | 4650 | (defun todo-convert-legacy-date-time () |
8b27b080 | 4651 | "Return converted date-time string. |
ddce2e3e | 4652 | Helper function for `todo-convert-legacy-files'." |
8b27b080 SB |
4653 | (let* ((year (match-string 1)) |
4654 | (month (match-string 2)) | |
4655 | (monthname (calendar-month-name (string-to-number month) t)) | |
4656 | (day (match-string 3)) | |
4657 | (time (match-string 4)) | |
4658 | dayname) | |
4659 | (replace-match "") | |
4660 | (insert (mapconcat 'eval calendar-date-display-form "") | |
4661 | (when time (concat " " time))))) | |
b28872ce | 4662 | |
ddce2e3e | 4663 | (defun todo-convert-legacy-files () |
4fe738d3 | 4664 | "Convert legacy todo files to the current Todo mode format. |
5e7b7e2b SB |
4665 | The old-style files named by the variables `todo-file-do' and |
4666 | `todo-file-done' from the old package are converted to the new | |
4fe738d3 | 4667 | format and saved (the latter as a todo archive file) with a new |
ddce2e3e SB |
4668 | name in `todo-directory'. See also the documentation string of |
4669 | `todo-legacy-date-time-regexp' for further details." | |
8b27b080 | 4670 | (interactive) |
e2ff2f69 SB |
4671 | ;; If there are user customizations of legacy options, use them, |
4672 | ;; otherwise use the legacy default values. | |
4673 | (let ((todo-file-do-tem (if (boundp 'todo-file-do) | |
4674 | todo-file-do | |
4675 | (locate-user-emacs-file "todo-do" ".todo-do"))) | |
4676 | (todo-file-done-tem (if (boundp 'todo-file-done) | |
4677 | todo-file-done | |
4678 | (locate-user-emacs-file "todo-done" ".todo-done"))) | |
4679 | (todo-initials-tem (and (boundp 'todo-initials) todo-initials)) | |
4680 | (todo-entry-prefix-function-tem (and (boundp 'todo-entry-prefix-function) | |
4681 | todo-entry-prefix-function)) | |
03e6d469 | 4682 | todo-prefix-tem) |
e2ff2f69 SB |
4683 | ;; Convert `todo-file-do'. |
4684 | (if (not (file-exists-p todo-file-do-tem)) | |
4fe738d3 | 4685 | (message "No legacy todo file exists") |
e2ff2f69 SB |
4686 | (let ((default "todo-do-conv") |
4687 | file archive-sexp) | |
4688 | (with-temp-buffer | |
4689 | (insert-file-contents todo-file-do-tem) | |
4690 | ;; Eliminate old-style local variables list in first line. | |
4691 | (delete-region (line-beginning-position) (1+ (line-end-position))) | |
4692 | (search-forward " --- " nil t) ; Legacy todo-category-beg. | |
4693 | (setq todo-prefix-tem (buffer-substring-no-properties | |
4694 | (line-beginning-position) (match-beginning 0))) | |
4695 | (goto-char (point-min)) | |
4696 | (while (not (eobp)) | |
4697 | (cond | |
4698 | ;; Old-style category start delimiter. | |
4699 | ((looking-at (regexp-quote (concat todo-prefix-tem " --- "))) | |
4700 | (replace-match todo-category-beg)) | |
4701 | ;; Old-style category end delimiter. | |
4702 | ((looking-at (regexp-quote "--- End")) | |
4703 | (replace-match "")) | |
4704 | ;; Old-style category separator. | |
4705 | ((looking-at (regexp-quote | |
4706 | (concat todo-prefix-tem " " | |
4707 | (make-string 75 ?-)))) | |
4708 | (replace-match todo-category-done)) | |
4709 | ;; Old-style item header (date/time/initials). | |
4710 | ((looking-at (concat (regexp-quote todo-prefix-tem) " " | |
4711 | (if todo-entry-prefix-function-tem | |
4712 | (funcall todo-entry-prefix-function-tem) | |
4713 | (concat todo-legacy-date-time-regexp " " | |
4714 | (if todo-initials-tem | |
4715 | (regexp-quote todo-initials-tem) | |
4716 | "[^:]*") | |
4717 | ":")))) | |
4718 | (todo-convert-legacy-date-time))) | |
4719 | (forward-line)) | |
4720 | (setq file (concat todo-directory | |
4721 | (read-string | |
4722 | (format "Save file as (default \"%s\"): " default) | |
4723 | nil nil default) | |
4724 | ".todo")) | |
03e6d469 SB |
4725 | (unless (file-exists-p todo-directory) |
4726 | (make-directory todo-directory)) | |
e2ff2f69 SB |
4727 | (write-region (point-min) (point-max) file nil 'nomessage nil t)) |
4728 | (with-temp-buffer | |
4729 | (insert-file-contents file) | |
4730 | (let ((todo-categories (todo-make-categories-list t))) | |
03e6d469 SB |
4731 | (todo-update-categories-sexp) |
4732 | (todo-check-format)) | |
e2ff2f69 SB |
4733 | (write-region (point-min) (point-max) file nil 'nomessage)) |
4734 | (setq todo-files (funcall todo-files-function)) | |
4735 | ;; Convert `todo-file-done'. | |
4736 | (when (file-exists-p todo-file-done-tem) | |
4737 | (with-temp-buffer | |
4738 | (insert-file-contents todo-file-done-tem) | |
4739 | (let ((beg (make-marker)) | |
4740 | (end (make-marker)) | |
4741 | cat cats comment item) | |
8b27b080 | 4742 | (while (not (eobp)) |
e2ff2f69 SB |
4743 | (when (looking-at todo-legacy-date-time-regexp) |
4744 | (set-marker beg (point)) | |
4745 | (todo-convert-legacy-date-time) | |
4746 | (set-marker end (point)) | |
4747 | (goto-char beg) | |
4748 | (insert "[" todo-done-string) | |
4749 | (goto-char end) | |
4750 | (insert "]") | |
4751 | (forward-char) | |
4752 | (when (looking-at todo-legacy-date-time-regexp) | |
4753 | (todo-convert-legacy-date-time)) | |
4754 | (when (looking-at (concat " " (if todo-initials-tem | |
4755 | (regexp-quote | |
4756 | todo-initials-tem) | |
4757 | "[^:]*") | |
4758 | ":")) | |
4759 | (replace-match ""))) | |
4760 | (if (re-search-forward | |
4761 | (concat "^" todo-legacy-date-time-regexp) nil t) | |
4762 | (goto-char (match-beginning 0)) | |
4763 | (goto-char (point-max))) | |
4764 | (backward-char) | |
4765 | (when (looking-back "\\[\\([^][]+\\)\\]") | |
4766 | (setq cat (match-string 1)) | |
4767 | (goto-char (match-beginning 0)) | |
8b27b080 | 4768 | (replace-match "")) |
e2ff2f69 SB |
4769 | ;; If the item ends with a non-comment parenthesis not |
4770 | ;; followed by a period, we lose (but we inherit that | |
4771 | ;; problem from the legacy code). | |
4772 | (when (looking-back "(\\(.*\\)) ") | |
4773 | (setq comment (match-string 1)) | |
4774 | (replace-match "") | |
4775 | (insert "[" todo-comment-string ": " comment "]")) | |
4776 | (set-marker end (point)) | |
4777 | (if (member cat cats) | |
4778 | ;; If item is already in its category, leave it there. | |
4779 | (unless (save-excursion | |
4780 | (re-search-backward | |
4781 | (concat "^" (regexp-quote todo-category-beg) | |
5e7b7e2b | 4782 | "\\(.*\\)$") nil t) |
e2ff2f69 SB |
4783 | (string= (match-string 1) cat)) |
4784 | ;; Else move it to its category. | |
4785 | (setq item (buffer-substring-no-properties beg end)) | |
4786 | (delete-region beg (1+ end)) | |
4787 | (set-marker beg (point)) | |
4788 | (re-search-backward | |
4789 | (concat "^" | |
4790 | (regexp-quote (concat todo-category-beg cat)) | |
4791 | "$") | |
4792 | nil t) | |
4793 | (forward-line) | |
4794 | (if (re-search-forward | |
4795 | (concat "^" (regexp-quote todo-category-beg) | |
4796 | "\\(.*\\)$") nil t) | |
4797 | (progn (goto-char (match-beginning 0)) | |
4798 | (newline) | |
4799 | (forward-line -1)) | |
4800 | (goto-char (point-max))) | |
4801 | (insert item "\n") | |
4802 | (goto-char beg)) | |
4803 | (push cat cats) | |
4804 | (goto-char beg) | |
4805 | (insert todo-category-beg cat "\n\n" | |
4806 | todo-category-done "\n")) | |
4807 | (forward-line)) | |
4808 | (set-marker beg nil) | |
4809 | (set-marker end nil)) | |
4810 | (setq file (concat (file-name-sans-extension file) ".toda")) | |
4811 | (write-region (point-min) (point-max) file nil 'nomessage nil t)) | |
4812 | (with-temp-buffer | |
4813 | (insert-file-contents file) | |
4814 | (let* ((todo-categories (todo-make-categories-list t))) | |
03e6d469 SB |
4815 | (todo-update-categories-sexp) |
4816 | (todo-check-format)) | |
e2ff2f69 SB |
4817 | (write-region (point-min) (point-max) file nil 'nomessage) |
4818 | (setq archive-sexp (read (buffer-substring-no-properties | |
4819 | (line-beginning-position) | |
4820 | (line-end-position))))) | |
4821 | (setq file (concat (file-name-sans-extension file) ".todo")) | |
4fe738d3 | 4822 | ;; Update categories sexp of converted todo file again, adding |
e2ff2f69 SB |
4823 | ;; counts of archived items. |
4824 | (with-temp-buffer | |
4825 | (insert-file-contents file) | |
4826 | (let ((sexp (read (buffer-substring-no-properties | |
4827 | (line-beginning-position) | |
4828 | (line-end-position))))) | |
4829 | (dolist (cat sexp) | |
4830 | (let ((archive-cat (assoc (car cat) archive-sexp))) | |
4831 | (if archive-cat | |
4832 | (aset (cdr cat) 3 (aref (cdr archive-cat) 2))))) | |
4833 | (delete-region (line-beginning-position) (line-end-position)) | |
4834 | (prin1 sexp (current-buffer))) | |
4835 | (write-region (point-min) (point-max) file nil 'nomessage)) | |
4836 | (setq todo-archives (funcall todo-files-function t))) | |
4837 | (todo-reevaluate-filelist-defcustoms) | |
03e6d469 SB |
4838 | (when (y-or-n-p (concat "Format conversion done; do you want to " |
4839 | "visit the converted file now? ")) | |
4840 | (setq todo-current-todo-file file) | |
4841 | (unless todo-default-todo-file | |
4842 | ;; We just initialized the first todo file, so make it the | |
4843 | ;; default now to avoid an infinite recursion with todo-show. | |
4844 | (setq todo-default-todo-file (todo-short-file-name file))) | |
4845 | (todo-show)))))) | |
b28872ce | 4846 | |
a9b0e28e | 4847 | ;; ----------------------------------------------------------------------------- |
4fe738d3 | 4848 | ;;; Utility functions for todo files, categories and items |
a9b0e28e | 4849 | ;; ----------------------------------------------------------------------------- |
b28872ce | 4850 | |
ddce2e3e | 4851 | (defun todo-absolute-file-name (name &optional type) |
4fe738d3 | 4852 | "Return the absolute file name of short todo file NAME. |
8b27b080 | 4853 | With TYPE `archive' or `top' return the absolute file name of the |
4fe738d3 SB |
4854 | short todo archive or top priorities file name, respectively." |
4855 | ;; No-op if there is no todo file yet (i.e. don't concatenate nil). | |
8b27b080 SB |
4856 | (when name |
4857 | (file-truename | |
ddce2e3e | 4858 | (concat todo-directory name |
8b27b080 SB |
4859 | (cond ((eq type 'archive) ".toda") |
4860 | ((eq type 'top) ".todt") | |
4861 | ((eq type 'diary) ".tody") | |
4862 | ((eq type 'regexp) ".todr") | |
4863 | (t ".todo")))))) | |
b28872ce | 4864 | |
d610f6dd SB |
4865 | (defun todo-check-file (file) |
4866 | "Check the state associated with FILE and update it if necessary. | |
4867 | If FILE exists, return t. If it does not exist and there is no | |
4868 | live buffer with its content, return nil; if there is such a | |
4869 | buffer and the user tries to show it, ask whether to restore | |
4870 | FILE, and if confirmed, do so and return t; else delete the | |
4871 | buffer, clean up the state and return nil." | |
4872 | (setq todo-files (funcall todo-files-function)) | |
4873 | (setq todo-archives (funcall todo-files-function t)) | |
4874 | (if (file-exists-p file) | |
4875 | t | |
4876 | (setq todo-visited (delete file todo-visited)) | |
4877 | (let ((buf (find-buffer-visiting file))) | |
4878 | (if (and buf | |
4879 | (y-or-n-p | |
4880 | (concat | |
4881 | (format (concat "Todo file \"%s\" has been deleted but " | |
4882 | "its content is still in a buffer!\n") | |
4883 | (todo-short-file-name file)) | |
4884 | "Save that buffer and restore the todo file? "))) | |
4885 | (progn | |
4886 | (with-current-buffer buf (save-buffer)) | |
4887 | (setq todo-files (funcall todo-files-function)) | |
4888 | (setq todo-archives (funcall todo-files-function t)) | |
4889 | t) | |
4890 | (let* ((files (append todo-files todo-archives)) | |
4891 | (tctf todo-current-todo-file) | |
4892 | (tgctf todo-global-current-todo-file) | |
4893 | (tdtf (todo-absolute-file-name todo-default-todo-file))) | |
4894 | (unless (or (not todo-current-todo-file) | |
4895 | (member todo-current-todo-file files)) | |
4896 | (setq todo-current-todo-file nil)) | |
4897 | (unless (or (not todo-global-current-todo-file) | |
4898 | (member todo-global-current-todo-file files)) | |
4899 | (setq todo-global-current-todo-file nil)) | |
4900 | (unless (or (not todo-default-todo-file) | |
4901 | (member todo-default-todo-file files)) | |
4902 | (setq todo-default-todo-file (todo-short-file-name | |
4903 | (car todo-files)))) | |
4904 | (todo-reevaluate-filelist-defcustoms) | |
4905 | (when buf (kill-buffer buf)) | |
4906 | nil))))) | |
4907 | ||
ddce2e3e | 4908 | (defun todo-category-number (cat) |
4fe738d3 | 4909 | "Return the number of category CAT in this todo file. |
ddce2e3e | 4910 | The buffer-local variable `todo-category-number' holds this |
8b27b080 | 4911 | number as its value." |
ddce2e3e SB |
4912 | (let ((categories (mapcar 'car todo-categories))) |
4913 | (setq todo-category-number | |
d610f6dd SB |
4914 | ;; Increment by one, so that the number of the first |
4915 | ;; category is one rather than zero. | |
8b27b080 SB |
4916 | (1+ (- (length categories) |
4917 | (length (member cat categories))))))) | |
20166aea | 4918 | |
ddce2e3e | 4919 | (defun todo-current-category () |
8b27b080 | 4920 | "Return the name of the current category." |
ddce2e3e | 4921 | (car (nth (1- todo-category-number) todo-categories))) |
20166aea | 4922 | |
ddce2e3e | 4923 | (defun todo-category-select () |
8b27b080 | 4924 | "Display the current category correctly." |
ddce2e3e | 4925 | (let ((name (todo-current-category)) |
8b27b080 SB |
4926 | cat-begin cat-end done-start done-sep-start done-end) |
4927 | (widen) | |
4928 | (goto-char (point-min)) | |
4929 | (re-search-forward | |
ddce2e3e | 4930 | (concat "^" (regexp-quote (concat todo-category-beg name)) "$") nil t) |
8b27b080 SB |
4931 | (setq cat-begin (1+ (line-end-position))) |
4932 | (setq cat-end (if (re-search-forward | |
ddce2e3e | 4933 | (concat "^" (regexp-quote todo-category-beg)) nil t) |
8b27b080 SB |
4934 | (match-beginning 0) |
4935 | (point-max))) | |
4936 | (setq mode-line-buffer-identification | |
ddce2e3e | 4937 | (funcall todo-mode-line-function name)) |
8b27b080 | 4938 | (narrow-to-region cat-begin cat-end) |
ddce2e3e | 4939 | (todo-prefix-overlays) |
8b27b080 | 4940 | (goto-char (point-min)) |
ddce2e3e | 4941 | (if (re-search-forward (concat "\n\\(" (regexp-quote todo-category-done) |
8b27b080 SB |
4942 | "\\)") nil t) |
4943 | (progn | |
4944 | (setq done-start (match-beginning 0)) | |
4945 | (setq done-sep-start (match-beginning 1)) | |
4946 | (setq done-end (match-end 0))) | |
ddce2e3e SB |
4947 | (error "Category %s is missing todo-category-done string" name)) |
4948 | (if todo-show-done-only | |
8b27b080 | 4949 | (narrow-to-region (1+ done-end) (point-max)) |
ddce2e3e SB |
4950 | (when (and todo-show-with-done |
4951 | (re-search-forward todo-done-string-start nil t)) | |
8b27b080 SB |
4952 | ;; Now we want to see the done items, so reset displayed end to end of |
4953 | ;; done items. | |
4954 | (setq done-start cat-end) | |
4955 | ;; Make display overlay for done items separator string, unless there | |
4956 | ;; already is one. | |
ddce2e3e | 4957 | (let* ((done-sep todo-done-separator) |
8b27b080 | 4958 | (ov (progn (goto-char done-sep-start) |
ddce2e3e | 4959 | (todo-get-overlay 'separator)))) |
8b27b080 SB |
4960 | (unless ov |
4961 | (setq ov (make-overlay done-sep-start done-end)) | |
ddce2e3e | 4962 | (overlay-put ov 'todo 'separator) |
8b27b080 SB |
4963 | (overlay-put ov 'display done-sep)))) |
4964 | (narrow-to-region (point-min) done-start) | |
ddce2e3e SB |
4965 | ;; Loading this from todo-mode, or adding it to the mode hook, causes |
4966 | ;; Emacs to hang in todo-item-start, at (looking-at todo-item-start). | |
4967 | (when todo-highlight-item | |
8b27b080 SB |
4968 | (require 'hl-line) |
4969 | (hl-line-mode 1))))) | |
b28872ce | 4970 | |
ddce2e3e | 4971 | (defun todo-get-count (type &optional category) |
8b27b080 SB |
4972 | "Return count of TYPE items in CATEGORY. |
4973 | If CATEGORY is nil, default to the current category." | |
ddce2e3e SB |
4974 | (let* ((cat (or category (todo-current-category))) |
4975 | (counts (cdr (assoc cat todo-categories))) | |
8b27b080 SB |
4976 | (idx (cond ((eq type 'todo) 0) |
4977 | ((eq type 'diary) 1) | |
4978 | ((eq type 'done) 2) | |
4979 | ((eq type 'archived) 3)))) | |
4980 | (aref counts idx))) | |
20166aea | 4981 | |
ddce2e3e | 4982 | (defun todo-update-count (type increment &optional category) |
8b27b080 SB |
4983 | "Change count of TYPE items in CATEGORY by integer INCREMENT. |
4984 | With nil or omitted CATEGORY, default to the current category." | |
ddce2e3e SB |
4985 | (let* ((cat (or category (todo-current-category))) |
4986 | (counts (cdr (assoc cat todo-categories))) | |
8b27b080 SB |
4987 | (idx (cond ((eq type 'todo) 0) |
4988 | ((eq type 'diary) 1) | |
4989 | ((eq type 'done) 2) | |
4990 | ((eq type 'archived) 3)))) | |
4991 | (aset counts idx (+ increment (aref counts idx))))) | |
20166aea | 4992 | |
ddce2e3e SB |
4993 | (defun todo-set-categories () |
4994 | "Set `todo-categories' from the sexp at the top of the file." | |
4995 | ;; New archive files created by `todo-move-category' are empty, which would | |
8b27b080 SB |
4996 | ;; make the sexp test fail and raise an error, so in this case we skip it. |
4997 | (unless (zerop (buffer-size)) | |
4998 | (save-excursion | |
4999 | (save-restriction | |
5000 | (widen) | |
5001 | (goto-char (point-min)) | |
ddce2e3e | 5002 | (setq todo-categories |
8b27b080 SB |
5003 | (if (looking-at "\(\(\"") |
5004 | (read (buffer-substring-no-properties | |
5005 | (line-beginning-position) | |
5006 | (line-end-position))) | |
ddce2e3e | 5007 | (error "Invalid or missing todo-categories sexp"))))))) |
f1806c78 | 5008 | |
ddce2e3e SB |
5009 | (defun todo-update-categories-sexp () |
5010 | "Update the `todo-categories' sexp at the top of the file." | |
8b27b080 SB |
5011 | (let (buffer-read-only) |
5012 | (save-excursion | |
5013 | (save-restriction | |
5014 | (widen) | |
5015 | (goto-char (point-min)) | |
ddce2e3e | 5016 | (if (looking-at (concat "^" (regexp-quote todo-category-beg))) |
8b27b080 | 5017 | (progn (newline) (goto-char (point-min)) ; Make space for sexp. |
ddce2e3e | 5018 | (setq todo-categories (todo-make-categories-list t))) |
8b27b080 | 5019 | (delete-region (line-beginning-position) (line-end-position))) |
ddce2e3e | 5020 | (prin1 todo-categories (current-buffer)))))) |
f1806c78 | 5021 | |
ddce2e3e | 5022 | (defun todo-make-categories-list (&optional force) |
4fe738d3 | 5023 | "Return an alist of todo categories and their item counts. |
8b27b080 SB |
5024 | With non-nil argument FORCE parse the entire file to build the |
5025 | list; otherwise, get the value by reading the sexp at the top of | |
5026 | the file." | |
ddce2e3e | 5027 | (setq todo-categories nil) |
8b27b080 SB |
5028 | (save-excursion |
5029 | (save-restriction | |
5030 | (widen) | |
5031 | (goto-char (point-min)) | |
5032 | (let (counts cat archive) | |
5033 | ;; If the file is a todo file and has archived items, identify the | |
5034 | ;; archive, in order to count its items. But skip this with | |
ddce2e3e | 5035 | ;; `todo-convert-legacy-files', since that converts filed items to |
8b27b080 SB |
5036 | ;; archived items. |
5037 | (when buffer-file-name ; During conversion there is no file yet. | |
5038 | ;; If the file is an archive, it doesn't have an archive. | |
5039 | (unless (member (file-truename buffer-file-name) | |
ddce2e3e | 5040 | (funcall todo-files-function t)) |
8b27b080 | 5041 | (setq archive (concat (file-name-sans-extension |
ddce2e3e | 5042 | todo-current-todo-file) ".toda")))) |
8b27b080 | 5043 | (while (not (eobp)) |
ddce2e3e | 5044 | (cond ((looking-at (concat (regexp-quote todo-category-beg) |
8b27b080 SB |
5045 | "\\(.*\\)\n")) |
5046 | (setq cat (match-string-no-properties 1)) | |
5047 | ;; Counts for each category: [todo diary done archive] | |
5048 | (setq counts (make-vector 4 0)) | |
ddce2e3e SB |
5049 | (setq todo-categories |
5050 | (append todo-categories (list (cons cat counts)))) | |
8b27b080 SB |
5051 | ;; Add archived item count to the todo file item counts. |
5052 | ;; Make sure to include newly created archives, e.g. due to | |
ddce2e3e SB |
5053 | ;; todo-move-category. |
5054 | (when (member archive (funcall todo-files-function t)) | |
8b27b080 SB |
5055 | (let ((archive-count 0)) |
5056 | (with-current-buffer (find-file-noselect archive) | |
5057 | (widen) | |
5058 | (goto-char (point-min)) | |
5059 | (when (re-search-forward | |
ddce2e3e | 5060 | (concat "^" (regexp-quote todo-category-beg) |
8b27b080 SB |
5061 | cat "$") |
5062 | (point-max) t) | |
5063 | (forward-line) | |
5064 | (while (not (or (looking-at | |
5065 | (concat | |
ddce2e3e | 5066 | (regexp-quote todo-category-beg) |
8b27b080 SB |
5067 | "\\(.*\\)\n")) |
5068 | (eobp))) | |
ddce2e3e | 5069 | (when (looking-at todo-done-string-start) |
8b27b080 SB |
5070 | (setq archive-count (1+ archive-count))) |
5071 | (forward-line)))) | |
ddce2e3e SB |
5072 | (todo-update-count 'archived archive-count cat)))) |
5073 | ((looking-at todo-done-string-start) | |
5074 | (todo-update-count 'done 1 cat)) | |
8b27b080 SB |
5075 | ((looking-at (concat "^\\(" |
5076 | (regexp-quote diary-nonmarking-symbol) | |
ddce2e3e SB |
5077 | "\\)?" todo-date-pattern)) |
5078 | (todo-update-count 'diary 1 cat) | |
5079 | (todo-update-count 'todo 1 cat)) | |
5080 | ((looking-at (concat todo-date-string-start todo-date-pattern)) | |
5081 | (todo-update-count 'todo 1 cat)) | |
5082 | ;; If first line is todo-categories list, use it and end loop | |
8b27b080 SB |
5083 | ;; -- unless FORCEd to scan whole file. |
5084 | ((bobp) | |
5085 | (unless force | |
ddce2e3e | 5086 | (setq todo-categories (read (buffer-substring-no-properties |
8b27b080 SB |
5087 | (line-beginning-position) |
5088 | (line-end-position)))) | |
5089 | (goto-char (1- (point-max)))))) | |
5090 | (forward-line))))) | |
ddce2e3e | 5091 | todo-categories) |
20166aea | 5092 | |
ddce2e3e | 5093 | (defun todo-repair-categories-sexp () |
4fe738d3 | 5094 | "Repair corrupt todo file categories sexp. |
8b27b080 | 5095 | This should only be needed as a consequence of careless manual |
ddce2e3e | 5096 | editing or a bug in todo.el. |
f1806c78 | 5097 | |
8b27b080 | 5098 | *Warning*: Calling this command restores the category order to |
4fe738d3 SB |
5099 | the list element order in the todo file categories sexp, so any |
5100 | order changes made in Todo Categories mode will have to be made | |
5101 | again." | |
8b27b080 | 5102 | (interactive) |
ddce2e3e SB |
5103 | (let ((todo-categories (todo-make-categories-list t))) |
5104 | (todo-update-categories-sexp))) | |
8b27b080 | 5105 | |
ddce2e3e | 5106 | (defun todo-check-format () |
4fe738d3 | 5107 | "Signal an error if the current todo file is ill-formatted. |
8b27b080 SB |
5108 | Otherwise return t. Display a message if the file is well-formed |
5109 | but the categories sexp differs from the current value of | |
ddce2e3e | 5110 | `todo-categories'." |
8b27b080 SB |
5111 | (save-excursion |
5112 | (save-restriction | |
5113 | (widen) | |
5114 | (goto-char (point-min)) | |
ddce2e3e | 5115 | (let* ((cats (prin1-to-string todo-categories)) |
8b27b080 SB |
5116 | (ssexp (buffer-substring-no-properties (line-beginning-position) |
5117 | (line-end-position))) | |
5118 | (sexp (read ssexp))) | |
ddce2e3e | 5119 | ;; Check the first line for `todo-categories' sexp. |
8b27b080 SB |
5120 | (dolist (c sexp) |
5121 | (let ((v (cdr c))) | |
5122 | (unless (and (stringp (car c)) | |
5123 | (vectorp v) | |
5124 | (= 4 (length v))) | |
ddce2e3e | 5125 | (user-error "Invalid or missing todo-categories sexp")))) |
8b27b080 SB |
5126 | (forward-line) |
5127 | ;; Check well-formedness of categories. | |
5128 | (let ((legit (concat | |
ddce2e3e SB |
5129 | "\\(^" (regexp-quote todo-category-beg) "\\)" |
5130 | "\\|\\(" todo-date-string-start todo-date-pattern "\\)" | |
8b27b080 SB |
5131 | "\\|\\(^[ \t]+[^ \t]*\\)" |
5132 | "\\|^$" | |
ddce2e3e SB |
5133 | "\\|\\(^" (regexp-quote todo-category-done) "\\)" |
5134 | "\\|\\(" todo-done-string-start "\\)"))) | |
8b27b080 SB |
5135 | (while (not (eobp)) |
5136 | (unless (looking-at legit) | |
4fe738d3 | 5137 | (user-error "Illegitimate todo file format at line %d" |
8b27b080 SB |
5138 | (line-number-at-pos (point)))) |
5139 | (forward-line))) | |
5140 | ;; Warn user if categories sexp has changed. | |
5141 | (unless (string= ssexp cats) | |
5142 | (message (concat "The sexp at the beginning of the file differs " | |
ddce2e3e | 5143 | "from the value of `todo-categories.\n" |
8b27b080 | 5144 | "If the sexp is wrong, you can fix it with " |
ddce2e3e | 5145 | "M-x todo-repair-categories-sexp,\n" |
8b27b080 SB |
5146 | "but note this reverts any changes you have " |
5147 | "made in the order of the categories.")))))) | |
5148 | t) | |
f1806c78 | 5149 | |
ddce2e3e | 5150 | (defun todo-item-start () |
4fe738d3 | 5151 | "Move to start of current todo item and return its position." |
8b27b080 | 5152 | (unless (or |
ddce2e3e SB |
5153 | ;; Buffer is empty (invocation possible e.g. via todo-forward-item |
5154 | ;; from todo-filter-items when processing category with no todo | |
8b27b080 SB |
5155 | ;; items). |
5156 | (eq (point-min) (point-max)) | |
5157 | ;; Point is on the empty line below category's last todo item... | |
5158 | (and (looking-at "^$") | |
5159 | (or (eobp) ; ...and done items are hidden... | |
5160 | (save-excursion ; ...or done items are visible. | |
5161 | (forward-line) | |
5162 | (looking-at (concat "^" | |
ddce2e3e | 5163 | (regexp-quote todo-category-done)))))) |
8b27b080 | 5164 | ;; Buffer is widened. |
ddce2e3e | 5165 | (looking-at (regexp-quote todo-category-beg))) |
8b27b080 | 5166 | (goto-char (line-beginning-position)) |
ddce2e3e | 5167 | (while (not (looking-at todo-item-start)) |
8b27b080 SB |
5168 | (forward-line -1)) |
5169 | (point))) | |
20166aea | 5170 | |
ddce2e3e | 5171 | (defun todo-item-end () |
4fe738d3 | 5172 | "Move to end of current todo item and return its position." |
8b27b080 SB |
5173 | ;; Items cannot end with a blank line. |
5174 | (unless (looking-at "^$") | |
ddce2e3e | 5175 | (let* ((done (todo-done-item-p)) |
8b27b080 SB |
5176 | (to-lim nil) |
5177 | ;; For todo items, end is before the done items section, for done | |
5178 | ;; items, end is before the next category. If these limits are | |
5179 | ;; missing or inaccessible, end it before the end of the buffer. | |
5180 | (lim (if (save-excursion | |
5181 | (re-search-forward | |
5182 | (concat "^" (regexp-quote (if done | |
ddce2e3e SB |
5183 | todo-category-beg |
5184 | todo-category-done))) | |
8b27b080 SB |
5185 | nil t)) |
5186 | (progn (setq to-lim t) (match-beginning 0)) | |
5187 | (point-max)))) | |
5188 | (when (bolp) (forward-char)) ; Find start of next item. | |
ddce2e3e | 5189 | (goto-char (if (re-search-forward todo-item-start lim t) |
8b27b080 SB |
5190 | (match-beginning 0) |
5191 | (if to-lim lim (point-max)))) | |
5192 | ;; For last todo item, skip back over the empty line before the done | |
5193 | ;; items section, else just back to the end of the previous line. | |
85ea34e2 | 5194 | (backward-char (when (and to-lim (not done) (eq (point) lim)) 2)) |
8b27b080 | 5195 | (point)))) |
f1806c78 | 5196 | |
ddce2e3e | 5197 | (defun todo-item-string () |
8b27b080 SB |
5198 | "Return bare text of current item as a string." |
5199 | (let ((opoint (point)) | |
ddce2e3e SB |
5200 | (start (todo-item-start)) |
5201 | (end (todo-item-end))) | |
8b27b080 SB |
5202 | (goto-char opoint) |
5203 | (and start end (buffer-substring-no-properties start end)))) | |
58c7641d | 5204 | |
ddce2e3e | 5205 | (defun todo-forward-item (&optional count) |
8b27b080 | 5206 | "Move point COUNT items down (by default, move down by one item)." |
ddce2e3e | 5207 | (let* ((not-done (not (or (todo-done-item-p) (looking-at "^$")))) |
8b27b080 SB |
5208 | (start (line-end-position))) |
5209 | (goto-char start) | |
ddce2e3e | 5210 | (if (re-search-forward todo-item-start nil t (or count 1)) |
8b27b080 SB |
5211 | (goto-char (match-beginning 0)) |
5212 | (goto-char (point-max))) | |
5213 | ;; If points advances by one from a todo to a done item, go back | |
ddce2e3e | 5214 | ;; to the space above todo-done-separator, since that is a |
8b27b080 SB |
5215 | ;; legitimate place to insert an item. But skip this space if |
5216 | ;; count > 1, since that should only stop on an item. | |
ddce2e3e | 5217 | (when (and not-done (todo-done-item-p) (not count)) |
8b27b080 SB |
5218 | ;; (if (or (not count) (= count 1)) |
5219 | (re-search-backward "^$" start t))));) | |
5220 | ;; The preceding sexp is insufficient when buffer is not narrowed, | |
5221 | ;; since there could be no done items in this category, so the | |
5222 | ;; search puts us on first todo item of next category. Does this | |
5223 | ;; ever happen? If so: | |
5224 | ;; (let ((opoint) (point)) | |
5225 | ;; (forward-line -1) | |
5226 | ;; (when (or (not count) (= count 1)) | |
ddce2e3e | 5227 | ;; (cond ((looking-at (concat "^" (regexp-quote todo-category-beg))) |
8b27b080 | 5228 | ;; (forward-line -2)) |
ddce2e3e | 5229 | ;; ((looking-at (concat "^" (regexp-quote todo-category-done))) |
8b27b080 SB |
5230 | ;; (forward-line -1)) |
5231 | ;; (t | |
5232 | ;; (goto-char opoint))))))) | |
58c7641d | 5233 | |
ddce2e3e | 5234 | (defun todo-backward-item (&optional count) |
8b27b080 SB |
5235 | "Move point up to start of item with next higher priority. |
5236 | With positive numerical prefix COUNT, move point COUNT items | |
5237 | upward. | |
0e89c3fc | 5238 | |
8b27b080 SB |
5239 | If the category's done items are visible, this command called |
5240 | with a prefix argument only moves point to a higher item, e.g., | |
5241 | with point on the first done item and called with prefix 1, it | |
5242 | moves to the last todo item; but if called with point on the | |
5243 | first done item without a prefix argument, it moves point the the | |
5244 | empty line above the done items separator." | |
ddce2e3e SB |
5245 | (let* ((done (todo-done-item-p))) |
5246 | (todo-item-start) | |
8b27b080 | 5247 | (unless (bobp) |
ddce2e3e | 5248 | (re-search-backward todo-item-start nil t (or count 1))) |
8b27b080 SB |
5249 | ;; Unless this is a regexp filtered items buffer (which can contain |
5250 | ;; intermixed todo and done items), if points advances by one from a | |
5251 | ;; done to a todo item, go back to the space above | |
ddce2e3e | 5252 | ;; todo-done-separator, since that is a legitimate place to insert an |
8b27b080 SB |
5253 | ;; item. But skip this space if count > 1, since that should only |
5254 | ;; stop on an item. | |
ddce2e3e | 5255 | (when (and done (not (todo-done-item-p)) (not count) |
8b27b080 | 5256 | ;(or (not count) (= count 1)) |
ddce2e3e SB |
5257 | (not (equal (buffer-name) todo-regexp-items-buffer))) |
5258 | (re-search-forward (concat "^" (regexp-quote todo-category-done)) | |
8b27b080 SB |
5259 | nil t) |
5260 | (forward-line -1)))) | |
b28872ce | 5261 | |
ddce2e3e | 5262 | (defun todo-remove-item () |
8b27b080 | 5263 | "Internal function called in editing, deleting or moving items." |
ddce2e3e SB |
5264 | (let* ((end (progn (todo-item-end) (1+ (point)))) |
5265 | (beg (todo-item-start)) | |
5266 | (ov (todo-get-overlay 'prefix))) | |
8b27b080 SB |
5267 | (when ov (delete-overlay ov)) |
5268 | (delete-region beg end))) | |
a2730169 | 5269 | |
ddce2e3e | 5270 | (defun todo-diary-item-p () |
8b27b080 SB |
5271 | "Return non-nil if item at point has diary entry format." |
5272 | (save-excursion | |
ddce2e3e SB |
5273 | (when (todo-item-string) ; Exclude empty lines. |
5274 | (todo-item-start) | |
5275 | (not (looking-at (regexp-quote todo-nondiary-start)))))) | |
a2730169 | 5276 | |
a8f4bb83 | 5277 | ;; This duplicates the item locating code from diary-goto-entry, but |
adc5dbce | 5278 | ;; without the marker code, to test whether the latter is dispensable. |
a8f4bb83 SB |
5279 | ;; If it is, diary-goto-entry can be simplified. The code duplication |
5280 | ;; here can also be eliminated, leaving only the widening and category | |
5281 | ;; selection, and instead of :override advice :around can be used. | |
5282 | ||
ddce2e3e | 5283 | (defun todo-diary-goto-entry (button) |
a8f4bb83 SB |
5284 | "Jump to the diary entry for the BUTTON at point. |
5285 | If the entry is a todo item, display its category properly. | |
5286 | Overrides `diary-goto-entry'." | |
5287 | ;; Locate the diary item in its source file. | |
5288 | (let* ((locator (button-get button 'locator)) | |
5289 | (file (cadr locator)) | |
5290 | (date (regexp-quote (nth 2 locator))) | |
5291 | (content (regexp-quote (nth 3 locator)))) | |
5292 | (if (not (and (file-exists-p file) | |
5293 | (find-file-other-window file))) | |
5294 | (message "Unable to locate this diary entry") | |
ddce2e3e | 5295 | (when (eq major-mode 'todo-mode) (widen)) |
a8f4bb83 SB |
5296 | (goto-char (point-min)) |
5297 | (when (re-search-forward (format "%s.*\\(%s\\)" date content) nil t) | |
5298 | (goto-char (match-beginning 1))) | |
5299 | ;; If it's a todo item, determine its category and display the | |
5300 | ;; category properly. | |
ddce2e3e | 5301 | (when (eq major-mode 'todo-mode) |
a8f4bb83 | 5302 | (let ((opoint (point))) |
ddce2e3e | 5303 | (re-search-backward (concat "^" (regexp-quote todo-category-beg) |
a8f4bb83 | 5304 | "\\(.*\\)\n") nil t) |
ddce2e3e SB |
5305 | (todo-category-number (match-string 1)) |
5306 | (todo-category-select) | |
a8f4bb83 SB |
5307 | (goto-char opoint)))))) |
5308 | ||
ddce2e3e | 5309 | (add-function :override diary-goto-entry-function #'todo-diary-goto-entry) |
0e89c3fc | 5310 | |
2f99433b SB |
5311 | (defun todo-desktop-save-buffer (_dir) |
5312 | `((catnum . ,(todo-category-number (todo-current-category))))) | |
5313 | ||
5314 | (declare-function desktop-restore-file-buffer "desktop" | |
5315 | (buffer-filename buffer-name buffer-misc)) | |
5316 | ||
5317 | (defun todo-restore-desktop-buffer (file buffer misc) | |
5318 | (desktop-restore-file-buffer file buffer misc) | |
5319 | (with-current-buffer buffer | |
5320 | (widen) | |
5321 | (let ((todo-category-number (cdr (assq 'catnum misc)))) | |
5322 | (todo-category-select)))) | |
5323 | ||
5324 | (add-to-list 'desktop-buffer-mode-handlers | |
5325 | '(todo-mode . todo-restore-desktop-buffer)) | |
5326 | ||
ddce2e3e | 5327 | (defun todo-done-item-p () |
8b27b080 SB |
5328 | "Return non-nil if item at point is a done item." |
5329 | (save-excursion | |
ddce2e3e SB |
5330 | (todo-item-start) |
5331 | (looking-at todo-done-string-start))) | |
27139cd5 | 5332 | |
ddce2e3e | 5333 | (defun todo-done-item-section-p () |
8b27b080 SB |
5334 | "Return non-nil if point is in category's done items section." |
5335 | (save-excursion | |
ddce2e3e | 5336 | (or (re-search-backward (concat "^" (regexp-quote todo-category-done)) |
8b27b080 SB |
5337 | nil t) |
5338 | (progn (goto-char (point-min)) | |
ddce2e3e | 5339 | (looking-at todo-done-string-start))))) |
0e89c3fc | 5340 | |
ddce2e3e | 5341 | (defun todo-reset-done-separator (sep) |
8b27b080 SB |
5342 | "Replace existing overlays of done items separator string SEP." |
5343 | (save-excursion | |
5344 | (save-restriction | |
5345 | (widen) | |
5346 | (goto-char (point-min)) | |
5347 | (while (re-search-forward | |
ddce2e3e | 5348 | (concat "\n\\(" (regexp-quote todo-category-done) "\\)") nil t) |
8b27b080 SB |
5349 | (let* ((beg (match-beginning 1)) |
5350 | (end (match-end 0)) | |
5351 | (ov (progn (goto-char beg) | |
ddce2e3e | 5352 | (todo-get-overlay 'separator))) |
8b27b080 SB |
5353 | (old-sep (when ov (overlay-get ov 'display))) |
5354 | new-ov) | |
5355 | (when old-sep | |
5356 | (unless (string= old-sep sep) | |
5357 | (setq new-ov (make-overlay beg end)) | |
ddce2e3e SB |
5358 | (overlay-put new-ov 'todo 'separator) |
5359 | (overlay-put new-ov 'display todo-done-separator) | |
8b27b080 | 5360 | (delete-overlay ov)))))))) |
3f031767 | 5361 | |
ddce2e3e SB |
5362 | (defun todo-get-overlay (val) |
5363 | "Return the overlay at point whose `todo' property has value VAL." | |
8b27b080 SB |
5364 | ;; Use overlays-in to find prefix overlays and check over two |
5365 | ;; positions to find done separator overlay. | |
5366 | (let ((ovs (overlays-in (point) (1+ (point)))) | |
5367 | ov) | |
5368 | (catch 'done | |
5369 | (while ovs | |
5370 | (setq ov (pop ovs)) | |
ddce2e3e | 5371 | (when (eq (overlay-get ov 'todo) val) |
8b27b080 | 5372 | (throw 'done ov)))))) |
27139cd5 | 5373 | |
ddce2e3e SB |
5374 | (defun todo-marked-item-p () |
5375 | "Non-nil if this item begins with `todo-item-mark'. | |
8b27b080 | 5376 | In that case, return the item's prefix overlay." |
ddce2e3e | 5377 | (let* ((ov (todo-get-overlay 'prefix)) |
4fe738d3 | 5378 | ;; If an item insertion command is called on a todo file |
8b27b080 SB |
5379 | ;; before it is visited, it has no prefix overlays yet, so |
5380 | ;; check for this. | |
5381 | (pref (when ov (overlay-get ov 'before-string))) | |
5382 | (marked (when pref | |
ddce2e3e | 5383 | (string-match (concat "^" (regexp-quote todo-item-mark)) |
8b27b080 SB |
5384 | pref)))) |
5385 | (when marked ov))) | |
27139cd5 | 5386 | |
ddce2e3e | 5387 | (defun todo-insert-with-overlays (item) |
8b27b080 | 5388 | "Insert ITEM at point and update prefix/priority number overlays." |
ddce2e3e | 5389 | (todo-item-start) |
8b27b080 SB |
5390 | ;; Insertion pushes item down but not its prefix overlay. When the |
5391 | ;; overlay includes a mark, this would now mark the inserted ITEM, | |
5392 | ;; so move it to the pushed down item. | |
ddce2e3e SB |
5393 | (let ((ov (todo-get-overlay 'prefix)) |
5394 | (marked (todo-marked-item-p))) | |
8b27b080 SB |
5395 | (insert item "\n") |
5396 | (when marked (move-overlay ov (point) (point)))) | |
ddce2e3e SB |
5397 | (todo-backward-item) |
5398 | (todo-prefix-overlays)) | |
2c173503 | 5399 | |
ddce2e3e | 5400 | (defun todo-prefix-overlays () |
8b27b080 | 5401 | "Update the prefix overlays of the current category's items. |
ddce2e3e SB |
5402 | The overlay's value is the string `todo-prefix' or with non-nil |
5403 | `todo-number-prefix' an integer in the sequence from 1 to | |
8b27b080 SB |
5404 | the number of todo or done items in the category indicating the |
5405 | item's priority. Todo and done items are numbered independently | |
5406 | of each other." | |
5407 | (let ((num 0) | |
5408 | (cat-tp (or (cdr (assoc-string | |
ddce2e3e SB |
5409 | (todo-current-category) |
5410 | (nth 2 (assoc-string todo-current-todo-file | |
5411 | todo-top-priorities-overrides)))) | |
5412 | todo-top-priorities)) | |
8b27b080 SB |
5413 | done prefix) |
5414 | (save-excursion | |
5415 | (goto-char (point-min)) | |
5416 | (while (not (eobp)) | |
ddce2e3e SB |
5417 | (when (or (todo-date-string-matcher (line-end-position)) |
5418 | (todo-done-string-matcher (line-end-position))) | |
8b27b080 SB |
5419 | (goto-char (match-beginning 0)) |
5420 | (setq num (1+ num)) | |
5421 | ;; Reset number to 1 for first done item. | |
ddce2e3e SB |
5422 | (when (and (eq major-mode 'todo-mode) |
5423 | (looking-at todo-done-string-start) | |
8b27b080 | 5424 | (looking-back (concat "^" |
ddce2e3e | 5425 | (regexp-quote todo-category-done) |
8b27b080 SB |
5426 | "\n"))) |
5427 | (setq num 1 | |
5428 | done t)) | |
5429 | (setq prefix (concat (propertize | |
ddce2e3e | 5430 | (if todo-number-prefix |
8b27b080 | 5431 | (number-to-string num) |
ddce2e3e | 5432 | todo-prefix) |
8b27b080 SB |
5433 | 'face |
5434 | ;; Prefix of top priority items has a | |
ddce2e3e SB |
5435 | ;; distinct face in Todo mode. |
5436 | (if (and (eq major-mode 'todo-mode) | |
8b27b080 SB |
5437 | (not done) |
5438 | (<= num cat-tp)) | |
ddce2e3e SB |
5439 | 'todo-top-priority |
5440 | 'todo-prefix-string)) | |
8b27b080 | 5441 | " ")) |
ddce2e3e SB |
5442 | (let ((ov (todo-get-overlay 'prefix)) |
5443 | (marked (todo-marked-item-p))) | |
8b27b080 SB |
5444 | ;; Prefix overlay must be at a single position so its |
5445 | ;; bounds aren't changed when (re)moving an item. | |
5446 | (unless ov (setq ov (make-overlay (point) (point)))) | |
ddce2e3e | 5447 | (overlay-put ov 'todo 'prefix) |
8b27b080 | 5448 | (overlay-put ov 'before-string (if marked |
ddce2e3e | 5449 | (concat todo-item-mark prefix) |
8b27b080 SB |
5450 | prefix)))) |
5451 | (forward-line))))) | |
18aef8a3 | 5452 | |
a9b0e28e | 5453 | ;; ----------------------------------------------------------------------------- |
8b27b080 | 5454 | ;;; Utilities for generating item insertion commands and key bindings |
a9b0e28e | 5455 | ;; ----------------------------------------------------------------------------- |
a2730169 | 5456 | |
f3a66082 SB |
5457 | ;; Thanks to Stefan Monnier for suggesting dynamically generating item |
5458 | ;; insertion commands and their key bindings, and offering an elegant | |
5459 | ;; implementation, which, however, relies on lexical scoping and so | |
5460 | ;; cannot be used here until the Calendar code used by todo-mode.el is | |
5461 | ;; converted to lexical binding. Hence, the following implementation | |
5462 | ;; uses dynamic binding. | |
5463 | ||
5464 | (defconst todo-insert-item--parameters | |
5465 | '((default copy) diary nonmarking (calendar date dayname) time (here region)) | |
5466 | "List of all item insertion parameters. | |
5467 | Passed by `todo-insert-item' to `todo-insert-item--next-param' to | |
5468 | dynamically create item insertion commands.") | |
5469 | ||
5470 | (defconst todo-insert-item--param-key-alist | |
5471 | '((default . "i") | |
5472 | (copy . "p") | |
5473 | (diary . "y") | |
5474 | (nonmarking . "k") | |
5475 | (calendar . "c") | |
5476 | (date . "d") | |
5477 | (dayname . "n") | |
5478 | (time . "t") | |
5479 | (here . "h") | |
5480 | (region . "r")) | |
5481 | "List pairing item insertion parameters with their completion keys.") | |
5482 | ||
5483 | (defsubst todo-insert-item--keyof (param) | |
5484 | "Return key paired with item insertion PARAM." | |
5485 | (cdr (assoc param todo-insert-item--param-key-alist))) | |
5486 | ||
5487 | (defun todo-insert-item--argsleft (key list) | |
5488 | "Return sublist of LIST whose first member corresponds to KEY." | |
5489 | (let (l sym) | |
5490 | (mapc (lambda (m) | |
5491 | (when (consp m) | |
5492 | (catch 'found1 | |
5493 | (dolist (s m) | |
5494 | (when (equal key (todo-insert-item--keyof s)) | |
5495 | (throw 'found1 (setq sym s)))))) | |
5496 | (if sym | |
5497 | (progn | |
5498 | (push sym l) | |
5499 | (setq sym nil)) | |
5500 | (push m l))) | |
5501 | list) | |
5502 | (setq list (reverse l))) | |
5503 | (memq (catch 'found2 | |
5504 | (dolist (e todo-insert-item--param-key-alist) | |
5505 | (when (equal key (cdr e)) | |
5506 | (throw 'found2 (car e))))) | |
5507 | list)) | |
5508 | ||
5509 | (defsubst todo-insert-item--this-key () (char-to-string last-command-event)) | |
5510 | ||
5511 | (defvar todo-insert-item--keys-so-far "" | |
5512 | "String of item insertion keys so far entered for this command.") | |
5513 | ||
5514 | (defvar todo-insert-item--args nil) | |
5515 | (defvar todo-insert-item--argleft nil) | |
5516 | (defvar todo-insert-item--argsleft nil) | |
5517 | (defvar todo-insert-item--newargsleft nil) | |
5518 | ||
5519 | (defun todo-insert-item--apply-args () | |
5520 | "Build list of arguments for item insertion and apply them. | |
5521 | The list consists of item insertion parameters that can be passed | |
5522 | as insertion command arguments in fixed positions. If a position | |
5523 | in the list is not occupied by the corresponding parameter, it is | |
5524 | occupied by `nil'." | |
5525 | (let* ((arg (list (car todo-insert-item--args))) | |
5526 | (args (nconc (cdr todo-insert-item--args) | |
5527 | (list (car (todo-insert-item--argsleft | |
5528 | (todo-insert-item--this-key) | |
5529 | todo-insert-item--argsleft))))) | |
5530 | (arglist (unless (= 5 (length args)) | |
5531 | (let ((v (make-vector 5 nil)) elt) | |
5532 | (while args | |
5533 | (setq elt (pop args)) | |
5534 | (cond ((eq elt 'diary) | |
5535 | (aset v 0 elt)) | |
5536 | ((eq elt 'nonmarking) | |
5537 | (aset v 1 elt)) | |
5538 | ((or (eq elt 'calendar) | |
5539 | (eq elt 'date) | |
5540 | (eq elt 'dayname)) | |
5541 | (aset v 2 elt)) | |
5542 | ((eq elt 'time) | |
5543 | (aset v 3 elt)) | |
5544 | ((or (eq elt 'here) | |
5545 | (eq elt 'region)) | |
5546 | (aset v 4 elt)))) | |
5547 | (append v nil))))) | |
5548 | (apply #'todo-basic-insert-item (nconc arg arglist)))) | |
5549 | ||
5550 | (defun todo-insert-item--next-param (last args argsleft) | |
5551 | "Build item insertion command from LAST, ARGS and ARGSLEFT and call it. | |
5552 | Dynamically generate key bindings, prompting with the keys | |
5553 | already entered and those still available." | |
5554 | (cl-assert argsleft) | |
5555 | (let* ((map (make-sparse-keymap)) | |
5556 | (prompt nil) | |
5557 | (addprompt (lambda (k name) | |
5558 | (setq prompt (concat prompt | |
5559 | (format (concat | |
5560 | (if (or (eq name 'default) | |
5561 | (eq name 'calendar) | |
5562 | (eq name 'here)) | |
5563 | " { " " ") | |
5564 | "%s=>%s" | |
5565 | (when (or (eq name 'copy) | |
5566 | (eq name 'dayname) | |
5567 | (eq name 'region)) | |
5568 | " }")) | |
5569 | (propertize k 'face | |
5570 | 'todo-key-prompt) | |
5571 | name)))))) | |
5572 | (setq todo-insert-item--args args) | |
5573 | (setq todo-insert-item--argsleft argsleft) | |
5574 | (when last | |
5575 | (cond ((eq last 'default) | |
5576 | (apply #'todo-basic-insert-item (car todo-insert-item--args)) | |
5577 | (setq todo-insert-item--argsleft nil)) | |
5578 | ((eq last 'copy) | |
5579 | (todo-copy-item) | |
5580 | (setq todo-insert-item--argsleft nil)) | |
5581 | (t (let ((k (todo-insert-item--keyof last))) | |
5582 | (funcall addprompt k 'GO!) | |
5583 | (define-key map (todo-insert-item--keyof last) | |
5584 | (lambda () (interactive) | |
5585 | (todo-insert-item--apply-args))))))) | |
5586 | (while todo-insert-item--argsleft | |
5587 | (let ((x (car todo-insert-item--argsleft))) | |
5588 | (setq todo-insert-item--newargsleft (cdr todo-insert-item--argsleft)) | |
5589 | (dolist (argleft (if (consp x) x (list x))) | |
5590 | (let ((k (todo-insert-item--keyof argleft))) | |
5591 | (funcall addprompt k argleft) | |
5592 | (define-key map k | |
5593 | (if (null todo-insert-item--newargsleft) | |
5594 | (lambda () (interactive) | |
5595 | (todo-insert-item--apply-args)) | |
5596 | (lambda () (interactive) | |
5597 | (when (equal "k" (todo-insert-item--this-key)) | |
5598 | (unless (string-match "y" todo-insert-item--keys-so-far) | |
5599 | (when (y-or-n-p (concat "`k' only takes effect with `y';" | |
5600 | " add `y'? ")) | |
5601 | (setq todo-insert-item--keys-so-far | |
5602 | (concat todo-insert-item--keys-so-far " y")) | |
5603 | (setq todo-insert-item--args | |
5604 | (nconc todo-insert-item--args (list 'diary)))))) | |
5605 | (setq todo-insert-item--keys-so-far | |
5606 | (concat todo-insert-item--keys-so-far " " | |
5607 | (todo-insert-item--this-key))) | |
5608 | (todo-insert-item--next-param | |
5609 | (car (todo-insert-item--argsleft | |
5610 | (todo-insert-item--this-key) | |
5611 | todo-insert-item--argsleft)) | |
5612 | (nconc todo-insert-item--args | |
5613 | (list (car (todo-insert-item--argsleft | |
5614 | (todo-insert-item--this-key) | |
5615 | todo-insert-item--argsleft)))) | |
5616 | (cdr (todo-insert-item--argsleft | |
5617 | (todo-insert-item--this-key) | |
5618 | todo-insert-item--argsleft))))))))) | |
5619 | (setq todo-insert-item--argsleft todo-insert-item--newargsleft)) | |
5620 | (when prompt (message "Enter a key (so far `%s'): %s" | |
5621 | todo-insert-item--keys-so-far prompt)) | |
8cd22a08 | 5622 | (set-transient-map map) |
f3a66082 | 5623 | (setq todo-insert-item--argsleft argsleft))) |
2c173503 | 5624 | |
8b27b080 | 5625 | ;; ----------------------------------------------------------------------------- |
ddce2e3e | 5626 | ;;; Todo minibuffer utilities |
8b27b080 | 5627 | ;; ----------------------------------------------------------------------------- |
616ffa8b | 5628 | |
ddce2e3e | 5629 | (defcustom todo-y-with-space nil |
8b27b080 SB |
5630 | "Non-nil means allow SPC to affirm a \"y or n\" question." |
5631 | :type 'boolean | |
ddce2e3e | 5632 | :group 'todo) |
8b27b080 | 5633 | |
ddce2e3e | 5634 | (defun todo-y-or-n-p (prompt) |
8b27b080 SB |
5635 | "Ask \"y or n\" question PROMPT and return t if answer is \"y\". |
5636 | Also return t if answer is \"Y\", but unlike `y-or-n-p', allow | |
ddce2e3e | 5637 | SPC to affirm the question only if option `todo-y-with-space' is |
8b27b080 | 5638 | non-nil." |
ddce2e3e | 5639 | (unless todo-y-with-space |
8b27b080 SB |
5640 | (define-key query-replace-map " " 'ignore)) |
5641 | (prog1 | |
5642 | (y-or-n-p prompt) | |
5643 | (define-key query-replace-map " " 'act))) | |
5644 | ||
ddce2e3e SB |
5645 | (defun todo-category-completions (&optional archive) |
5646 | "Return a list of completions for `todo-read-category'. | |
8b27b080 SB |
5647 | Each element of the list is a cons of a category name and the |
5648 | file or list of files (as short file names) it is in. The files | |
5649 | are either the current (or if there is none, the default) todo | |
ddce2e3e | 5650 | file plus the files listed in `todo-category-completions-files', |
d610f6dd SB |
5651 | or, with non-nil ARCHIVE, the current archive file. |
5652 | ||
5653 | Before calculating the completions, update the value of | |
5654 | `todo-category-completions-files' in case any files named in it | |
5655 | have been removed." | |
5656 | (let (deleted) | |
5657 | (dolist (f todo-category-completions-files) | |
5658 | (unless (file-exists-p (todo-absolute-file-name f)) | |
5659 | (setq todo-category-completions-files | |
5660 | (delete f todo-category-completions-files)) | |
5661 | (push f deleted))) | |
5662 | (when deleted | |
5663 | (let ((pl (> (length deleted) 1)) | |
5664 | (names (mapconcat (lambda (f) (concat "\"" f "\"")) deleted ", "))) | |
5665 | (message (concat "File" (if pl "s" "") " " names " ha" (if pl "ve" "s") | |
5666 | " been deleted and removed from\n" | |
5667 | "the list of category completion files"))) | |
5668 | (todo-reevaluate-category-completions-files-defcustom) | |
5669 | (custom-set-default 'todo-category-completions-files | |
5670 | (symbol-value 'todo-category-completions-files)) | |
5671 | (sleep-for 1.5))) | |
ddce2e3e SB |
5672 | (let* ((curfile (or todo-current-todo-file |
5673 | (and todo-show-current-file | |
5674 | todo-global-current-todo-file) | |
5675 | (todo-absolute-file-name todo-default-todo-file))) | |
8b27b080 | 5676 | (files (or (unless archive |
ddce2e3e SB |
5677 | (mapcar 'todo-absolute-file-name |
5678 | todo-category-completions-files)) | |
8b27b080 SB |
5679 | (list curfile))) |
5680 | listall listf) | |
5681 | ;; If file was just added, it has no category completions. | |
5682 | (unless (zerop (buffer-size (find-buffer-visiting curfile))) | |
ddce2e3e | 5683 | (unless (member curfile todo-archives) |
8b27b080 SB |
5684 | (add-to-list 'files curfile)) |
5685 | (dolist (f files listall) | |
5686 | (with-current-buffer (find-file-noselect f 'nowarn) | |
5687 | ;; Ensure category is properly displayed in case user | |
4fe738d3 SB |
5688 | ;; switches to file via a non-Todo mode command. And if |
5689 | ;; done items in category are visible, keep them visible. | |
ddce2e3e | 5690 | (let ((done todo-show-with-done)) |
8b27b080 SB |
5691 | (when (> (buffer-size) (- (point-max) (point-min))) |
5692 | (save-excursion | |
5693 | (goto-char (point-min)) | |
ddce2e3e SB |
5694 | (setq done (re-search-forward todo-done-string-start nil t)))) |
5695 | (let ((todo-show-with-done done)) | |
5696 | (save-excursion (todo-category-select)))) | |
8b27b080 SB |
5697 | (save-excursion |
5698 | (save-restriction | |
5699 | (widen) | |
5700 | (goto-char (point-min)) | |
5701 | (setq listf (read (buffer-substring-no-properties | |
5702 | (line-beginning-position) | |
5703 | (line-end-position))))))) | |
5704 | (mapc (lambda (elt) (let* ((cat (car elt)) | |
5705 | (la-elt (assoc cat listall))) | |
5706 | (if la-elt | |
5707 | (setcdr la-elt (append (list (cdr la-elt)) | |
5708 | (list f))) | |
5709 | (push (cons cat f) listall)))) | |
5710 | listf))))) | |
b28872ce | 5711 | |
ddce2e3e | 5712 | (defun todo-read-file-name (prompt &optional archive mustmatch) |
4fe738d3 | 5713 | "Choose and return the name of a todo file, prompting with PROMPT. |
b28872ce | 5714 | |
8b27b080 SB |
5715 | Show completions with TAB or SPC; the names are shown in short |
5716 | form but the absolute truename is returned. With non-nil ARCHIVE | |
4fe738d3 | 5717 | return the absolute truename of a todo archive file. With non-nil |
8b27b080 SB |
5718 | MUSTMATCH the name of an existing file must be chosen; |
5719 | otherwise, a new file name is allowed." | |
ddce2e3e SB |
5720 | (let* ((completion-ignore-case todo-completion-ignore-case) |
5721 | (files (mapcar 'todo-short-file-name | |
d610f6dd | 5722 | ;; (funcall todo-files-function archive))) |
ddce2e3e | 5723 | (if archive todo-archives todo-files))) |
8b27b080 SB |
5724 | (file (completing-read prompt files nil mustmatch nil nil |
5725 | (if files | |
5726 | ;; If user hit RET without | |
5727 | ;; choosing a file, default to | |
5728 | ;; current or default file. | |
ddce2e3e SB |
5729 | (todo-short-file-name |
5730 | (or todo-current-todo-file | |
5731 | (and todo-show-current-file | |
5732 | todo-global-current-todo-file) | |
5733 | (todo-absolute-file-name | |
5734 | todo-default-todo-file))) | |
8b27b080 SB |
5735 | ;; Trigger prompt for initial file. |
5736 | "")))) | |
ddce2e3e SB |
5737 | (unless (file-exists-p todo-directory) |
5738 | (make-directory todo-directory)) | |
8b27b080 | 5739 | (unless mustmatch |
ddce2e3e SB |
5740 | (setq file (todo-validate-name file 'file))) |
5741 | (setq file (file-truename (concat todo-directory file | |
8b27b080 | 5742 | (if archive ".toda" ".todo")))))) |
b28872ce | 5743 | |
ddce2e3e | 5744 | (defun todo-read-category (prompt &optional match-type file) |
8b27b080 SB |
5745 | "Choose and return a category name, prompting with PROMPT. |
5746 | Show completions for existing categories with TAB or SPC. | |
b28872ce | 5747 | |
8b27b080 SB |
5748 | The argument MATCH-TYPE specifies the matching requirements on |
5749 | the category name: with the value `todo' or `archive' the name | |
5750 | must complete to that of an existing todo or archive category, | |
5751 | respectively; with the value `add' the name must not be that of | |
5752 | an existing category; with all other values both existing and new | |
5753 | valid category names are accepted. | |
f730d273 | 5754 | |
8b27b080 SB |
5755 | With non-nil argument FILE prompt for a file and complete only |
5756 | against categories in that file; otherwise complete against all | |
ddce2e3e | 5757 | categories from `todo-category-completions-files'." |
8b27b080 SB |
5758 | ;; Allow SPC to insert spaces, for adding new category names. |
5759 | (let ((map minibuffer-local-completion-map)) | |
5760 | (define-key map " " nil) | |
5761 | (let* ((add (eq match-type 'add)) | |
5762 | (archive (eq match-type 'archive)) | |
ddce2e3e SB |
5763 | (file0 (when (and file (> (length todo-files) 1)) |
5764 | (todo-read-file-name (concat "Choose a" (if archive | |
8b27b080 SB |
5765 | "n archive" |
5766 | " todo") | |
5767 | " file: ") archive t))) | |
ddce2e3e | 5768 | (completions (unless file0 (todo-category-completions archive))) |
8b27b080 SB |
5769 | (categories (cond (file0 |
5770 | (with-current-buffer | |
5771 | (find-file-noselect file0 'nowarn) | |
ddce2e3e SB |
5772 | (let ((todo-current-todo-file file0)) |
5773 | todo-categories))) | |
8b27b080 SB |
5774 | ((and add (not file)) |
5775 | (with-current-buffer | |
ddce2e3e SB |
5776 | (find-file-noselect todo-current-todo-file) |
5777 | todo-categories)) | |
8b27b080 SB |
5778 | (t |
5779 | completions))) | |
ddce2e3e | 5780 | (completion-ignore-case todo-completion-ignore-case) |
8b27b080 SB |
5781 | (cat (completing-read prompt categories nil |
5782 | (eq match-type 'todo) nil nil | |
5783 | ;; Unless we're adding a category via | |
ddce2e3e | 5784 | ;; todo-add-category, set default |
8b27b080 SB |
5785 | ;; for existing categories to the |
5786 | ;; current category of the chosen | |
5787 | ;; file or else of the current file. | |
5788 | (if (and categories (not add)) | |
5789 | (with-current-buffer | |
5790 | (find-file-noselect | |
5791 | (or file0 | |
ddce2e3e SB |
5792 | todo-current-todo-file |
5793 | (todo-absolute-file-name | |
5794 | todo-default-todo-file))) | |
5795 | (todo-current-category)) | |
8b27b080 SB |
5796 | ;; Trigger prompt for initial category. |
5797 | ""))) | |
5798 | (catfil (cdr (assoc cat completions))) | |
5799 | (str "Category \"%s\" from which file (TAB for choices)? ")) | |
5800 | ;; If we do category completion and the chosen category name | |
5801 | ;; occurs in more than one file, prompt to choose one file. | |
5802 | (unless (or file0 add (not catfil)) | |
5803 | (setq file0 (file-truename | |
5804 | (if (atom catfil) | |
5805 | catfil | |
ddce2e3e SB |
5806 | (todo-absolute-file-name |
5807 | (let ((files (mapcar 'todo-short-file-name catfil))) | |
8b27b080 SB |
5808 | (completing-read (format str cat) files))))))) |
5809 | ;; Default to the current file. | |
ddce2e3e | 5810 | (unless file0 (setq file0 todo-current-todo-file)) |
8b27b080 | 5811 | ;; First validate only a name passed interactively from |
adc5dbce | 5812 | ;; todo-add-category, which must be of a nonexistent category. |
8b27b080 SB |
5813 | (unless (and (assoc cat categories) (not add)) |
5814 | ;; Validate only against completion categories. | |
ddce2e3e SB |
5815 | (let ((todo-categories categories)) |
5816 | (setq cat (todo-validate-name cat 'category))) | |
d610f6dd | 5817 | ;; When user enters a nonexistent category name by jumping or |
8b27b080 SB |
5818 | ;; moving, confirm that it should be added, then validate. |
5819 | (unless add | |
ddce2e3e SB |
5820 | (if (todo-y-or-n-p (format "Add new category \"%s\" to file \"%s\"? " |
5821 | cat (todo-short-file-name file0))) | |
8b27b080 SB |
5822 | (progn |
5823 | (when (assoc cat categories) | |
ddce2e3e SB |
5824 | (let ((todo-categories categories)) |
5825 | (setq cat (todo-validate-name cat 'category)))) | |
8b27b080 SB |
5826 | ;; Restore point and narrowing after adding new |
5827 | ;; category, to avoid moving to beginning of file when | |
5828 | ;; moving marked items to a new category | |
ddce2e3e | 5829 | ;; (todo-move-item). |
8b27b080 SB |
5830 | (save-excursion |
5831 | (save-restriction | |
ddce2e3e | 5832 | (todo-add-category file0 cat)))) |
8b27b080 SB |
5833 | ;; If we decide not to add a category, exit without returning. |
5834 | (keyboard-quit)))) | |
5835 | (cons cat file0)))) | |
5836 | ||
ddce2e3e | 5837 | (defun todo-validate-name (name type) |
8b27b080 SB |
5838 | "Prompt for new NAME for TYPE until it is valid, then return it. |
5839 | TYPE can be either of the symbols `file' or `category'." | |
ddce2e3e SB |
5840 | (let ((categories todo-categories) |
5841 | (files (mapcar 'todo-short-file-name todo-files)) | |
8b27b080 SB |
5842 | prompt) |
5843 | (while | |
5844 | (and | |
5845 | (cond ((string= "" name) | |
5846 | (setq prompt | |
5847 | (cond ((eq type 'file) | |
5848 | (if files | |
5849 | "Enter a non-empty file name: " | |
ddce2e3e | 5850 | ;; Empty string passed by todo-show to |
4fe738d3 | 5851 | ;; prompt for initial todo file. |
8b27b080 | 5852 | (concat "Initial file name [" |
ddce2e3e | 5853 | todo-initial-file "]: "))) |
8b27b080 SB |
5854 | ((eq type 'category) |
5855 | (if categories | |
5856 | "Enter a non-empty category name: " | |
ddce2e3e | 5857 | ;; Empty string passed by todo-show to |
8b27b080 | 5858 | ;; prompt for initial category of a new |
4fe738d3 | 5859 | ;; todo file. |
8b27b080 | 5860 | (concat "Initial category name [" |
ddce2e3e | 5861 | todo-initial-category "]: ")))))) |
8b27b080 SB |
5862 | ((string-match "\\`\\s-+\\'" name) |
5863 | (setq prompt | |
5864 | "Enter a name that does not contain only white space: ")) | |
5865 | ((and (eq type 'file) (member name files)) | |
5866 | (setq prompt "Enter a non-existing file name: ")) | |
5867 | ((and (eq type 'category) (assoc name categories)) | |
5868 | (setq prompt "Enter a non-existing category name: "))) | |
5869 | (setq name (if (or (and (eq type 'file) files) | |
5870 | (and (eq type 'category) categories)) | |
5871 | (completing-read prompt (cond ((eq type 'file) | |
5872 | files) | |
5873 | ((eq type 'category) | |
5874 | categories))) | |
5875 | ;; Offer default initial name. | |
5876 | (completing-read prompt (if (eq type 'file) | |
5877 | files | |
5878 | categories) | |
5879 | nil nil (if (eq type 'file) | |
ddce2e3e SB |
5880 | todo-initial-file |
5881 | todo-initial-category)))))) | |
8b27b080 | 5882 | name)) |
d04d6b95 | 5883 | |
8b27b080 | 5884 | ;; Adapted from calendar-read-date and calendar-date-string. |
ddce2e3e | 5885 | (defun todo-read-date (&optional arg mo yr) |
8b27b080 | 5886 | "Prompt for Gregorian date and return it in the current format. |
58c7641d | 5887 | |
8b27b080 SB |
5888 | With non-nil ARG, prompt for and return only the date component |
5889 | specified by ARG, which can be one of these symbols: | |
5890 | `month' (prompt for name, return name or number according to | |
5891 | value of `calendar-date-display-form'), `day' of month, or | |
5892 | `year'. The value of each of these components can be `*', | |
5893 | indicating an unspecified month, day, or year. | |
d04d6b95 | 5894 | |
8b27b080 SB |
5895 | When ARG is `day', non-nil arguments MO and YR determine the |
5896 | number of the last the day of the month." | |
5897 | (let (year monthname month day | |
5898 | dayname) ; Needed by calendar-date-display-form. | |
5899 | (when (or (not arg) (eq arg 'year)) | |
5900 | (while (if (natnump year) (< year 1) (not (eq year '*))) | |
5901 | (setq year (read-from-minibuffer | |
5902 | "Year (>0 or RET for this year or * for any year): " | |
5903 | nil nil t nil (number-to-string | |
5904 | (calendar-extract-year | |
5905 | (calendar-current-date))))))) | |
5906 | (when (or (not arg) (eq arg 'month)) | |
ddce2e3e | 5907 | (let* ((marray todo-month-name-array) |
8b27b080 | 5908 | (mlist (append marray nil)) |
ddce2e3e | 5909 | (mabarray todo-month-abbrev-array) |
8b27b080 | 5910 | (mablist (append mabarray nil)) |
ddce2e3e | 5911 | (completion-ignore-case todo-completion-ignore-case)) |
8b27b080 SB |
5912 | (setq monthname (completing-read |
5913 | "Month name (RET for current month, * for any month): " | |
8b27b080 SB |
5914 | mlist nil t nil nil |
5915 | (calendar-month-name (calendar-extract-month | |
5916 | (calendar-current-date)) t)) | |
8b27b080 SB |
5917 | month (1+ (- (length mlist) |
5918 | (length (or (member monthname mlist) | |
5919 | (member monthname mablist)))))) | |
5920 | (setq monthname (aref mabarray (1- month))))) | |
5921 | (when (or (not arg) (eq arg 'day)) | |
5922 | (let ((last (let ((mm (or month mo)) | |
5923 | (yy (or year yr))) | |
5924 | ;; If month is unspecified, use a month with 31 | |
5925 | ;; days for checking day of month input. Does | |
5926 | ;; Calendar do anything special when * is | |
5927 | ;; currently a shorter month? | |
5928 | (if (= mm 13) (setq mm 1)) | |
5929 | ;; If year is unspecified, use a leap year to | |
5930 | ;; allow Feb. 29. | |
5931 | (if (eq year '*) (setq yy 2012)) | |
5932 | (calendar-last-day-of-month mm yy)))) | |
5933 | (while (if (natnump day) (or (< day 1) (> day last)) (not (eq day '*))) | |
5934 | (setq day (read-from-minibuffer | |
5935 | (format "Day (1-%d or RET for today or * for any day): " | |
5936 | last) | |
5937 | nil nil t nil (number-to-string | |
5938 | (calendar-extract-day | |
5939 | (calendar-current-date)))))))) | |
5940 | ;; Stringify read values (monthname is already a string). | |
5941 | (and year (setq year (if (eq year '*) | |
5942 | (symbol-name '*) | |
5943 | (number-to-string year)))) | |
5944 | (and day (setq day (if (eq day '*) | |
5945 | (symbol-name '*) | |
5946 | (number-to-string day)))) | |
5947 | (and month (setq month (if (eq month '*) | |
5948 | (symbol-name '*) | |
5949 | (number-to-string month)))) | |
5950 | (if arg | |
5951 | (cond ((eq arg 'year) year) | |
5952 | ((eq arg 'day) day) | |
5953 | ((eq arg 'month) | |
5954 | (if (memq 'month calendar-date-display-form) | |
5955 | month | |
5956 | monthname))) | |
5957 | (mapconcat 'eval calendar-date-display-form "")))) | |
5958 | ||
ddce2e3e | 5959 | (defun todo-read-dayname () |
8b27b080 | 5960 | "Choose name of a day of the week with completion and return it." |
ddce2e3e | 5961 | (let ((completion-ignore-case todo-completion-ignore-case)) |
8b27b080 SB |
5962 | (completing-read "Enter a day name: " |
5963 | (append calendar-day-name-array nil) | |
5964 | nil t))) | |
adc5dbce | 5965 | |
ddce2e3e | 5966 | (defun todo-read-time () |
8b27b080 SB |
5967 | "Prompt for and return a valid clock time as a string. |
5968 | ||
5969 | Valid time strings are those matching `diary-time-regexp'. | |
5970 | Typing `<return>' at the prompt returns the current time, if the | |
ddce2e3e | 5971 | user option `todo-always-add-time-string' is non-nil, otherwise |
8b27b080 SB |
5972 | the empty string (i.e., no time string)." |
5973 | (let (valid answer) | |
5974 | (while (not valid) | |
5975 | (setq answer (read-string "Enter a clock time: " nil nil | |
ddce2e3e | 5976 | (when todo-always-add-time-string |
8b27b080 SB |
5977 | (substring (current-time-string) 11 16)))) |
5978 | (when (or (string= "" answer) | |
5979 | (string-match diary-time-regexp answer)) | |
5980 | (setq valid t))) | |
5981 | answer)) | |
58c7641d | 5982 | |
a9b0e28e | 5983 | ;; ----------------------------------------------------------------------------- |
8b27b080 | 5984 | ;;; Customization groups and utilities |
a9b0e28e | 5985 | ;; ----------------------------------------------------------------------------- |
58c7641d | 5986 | |
ddce2e3e | 5987 | (defgroup todo nil |
27139cd5 | 5988 | "Create and maintain categorized lists of todo items." |
ddce2e3e | 5989 | :link '(emacs-commentary-link "todo") |
53e63b4c | 5990 | :version "24.4" |
27139cd5 SB |
5991 | :group 'calendar) |
5992 | ||
ddce2e3e | 5993 | (defgroup todo-edit nil |
53e63b4c SB |
5994 | "User options for adding and editing todo items." |
5995 | :version "24.4" | |
ddce2e3e | 5996 | :group 'todo) |
27139cd5 | 5997 | |
ddce2e3e SB |
5998 | (defgroup todo-categories nil |
5999 | "User options for Todo Categories mode." | |
53e63b4c | 6000 | :version "24.4" |
ddce2e3e | 6001 | :group 'todo) |
58c7641d | 6002 | |
ddce2e3e SB |
6003 | (defgroup todo-filtered nil |
6004 | "User options for Todo Filter Items mode." | |
53e63b4c | 6005 | :version "24.4" |
ddce2e3e | 6006 | :group 'todo) |
27139cd5 | 6007 | |
ddce2e3e SB |
6008 | (defgroup todo-display nil |
6009 | "User display options for Todo mode." | |
53e63b4c | 6010 | :version "24.4" |
ddce2e3e | 6011 | :group 'todo) |
27139cd5 | 6012 | |
ddce2e3e SB |
6013 | (defgroup todo-faces nil |
6014 | "Faces for the Todo modes." | |
53e63b4c | 6015 | :version "24.4" |
ddce2e3e | 6016 | :group 'todo) |
27139cd5 | 6017 | |
ddce2e3e SB |
6018 | (defun todo-set-show-current-file (symbol value) |
6019 | "The :set function for user option `todo-show-current-file'." | |
27139cd5 SB |
6020 | (custom-set-default symbol value) |
6021 | (if value | |
ddce2e3e SB |
6022 | (add-hook 'pre-command-hook 'todo-show-current-file nil t) |
6023 | (remove-hook 'pre-command-hook 'todo-show-current-file t))) | |
27139cd5 | 6024 | |
ddce2e3e SB |
6025 | (defun todo-reset-prefix (symbol value) |
6026 | "The :set function for `todo-prefix' and `todo-number-prefix'." | |
27139cd5 | 6027 | (let ((oldvalue (symbol-value symbol)) |
ddce2e3e | 6028 | (files todo-file-buffers)) |
27139cd5 SB |
6029 | (custom-set-default symbol value) |
6030 | (when (not (equal value oldvalue)) | |
6031 | (dolist (f files) | |
6032 | (with-current-buffer (find-file-noselect f) | |
6033 | ;; Activate the new setting in the current category. | |
ddce2e3e | 6034 | (save-excursion (todo-category-select))))))) |
27139cd5 | 6035 | |
ddce2e3e SB |
6036 | (defun todo-reset-nondiary-marker (symbol value) |
6037 | "The :set function for user option `todo-nondiary-marker'." | |
27139cd5 | 6038 | (let ((oldvalue (symbol-value symbol)) |
ddce2e3e | 6039 | (files (append todo-files todo-archives))) |
27139cd5 SB |
6040 | (custom-set-default symbol value) |
6041 | ;; Need to reset these to get font-locking right. | |
ddce2e3e SB |
6042 | (setq todo-nondiary-start (nth 0 todo-nondiary-marker) |
6043 | todo-nondiary-end (nth 1 todo-nondiary-marker) | |
6044 | todo-date-string-start | |
6045 | ;; See comment in defvar of `todo-date-string-start'. | |
6046 | (concat "^\\(" (regexp-quote todo-nondiary-start) "\\|" | |
27139cd5 SB |
6047 | (regexp-quote diary-nonmarking-symbol) "\\)?")) |
6048 | (when (not (equal value oldvalue)) | |
6049 | (dolist (f files) | |
6050 | (with-current-buffer (find-file-noselect f) | |
6051 | (let (buffer-read-only) | |
6052 | (widen) | |
6053 | (goto-char (point-min)) | |
6054 | (while (not (eobp)) | |
6055 | (if (re-search-forward | |
ddce2e3e | 6056 | (concat "^\\(" todo-done-string-start "[^][]+] \\)?" |
27139cd5 | 6057 | "\\(?1:" (regexp-quote (car oldvalue)) |
ddce2e3e | 6058 | "\\)" todo-date-pattern "\\( " |
27139cd5 SB |
6059 | diary-time-regexp "\\)?\\(?2:" |
6060 | (regexp-quote (cadr oldvalue)) "\\)") | |
6061 | nil t) | |
aa91082d | 6062 | (progn |
27139cd5 SB |
6063 | (replace-match (nth 0 value) t t nil 1) |
6064 | (replace-match (nth 1 value) t t nil 2)) | |
6065 | (forward-line))) | |
ddce2e3e | 6066 | (todo-category-select))))))) |
d04d6b95 | 6067 | |
ddce2e3e SB |
6068 | (defun todo-reset-done-separator-string (symbol value) |
6069 | "The :set function for `todo-done-separator-string'." | |
27139cd5 | 6070 | (let ((oldvalue (symbol-value symbol)) |
ddce2e3e SB |
6071 | (files todo-file-buffers) |
6072 | (sep todo-done-separator)) | |
27139cd5 SB |
6073 | (custom-set-default symbol value) |
6074 | (when (not (equal value oldvalue)) | |
6075 | (dolist (f files) | |
6076 | (with-current-buffer (find-file-noselect f) | |
6077 | (let (buffer-read-only) | |
ddce2e3e | 6078 | (setq todo-done-separator (todo-done-separator)) |
27139cd5 | 6079 | (when (= 1 (length value)) |
ddce2e3e SB |
6080 | (todo-reset-done-separator sep))) |
6081 | (todo-category-select)))))) | |
27139cd5 | 6082 | |
ddce2e3e SB |
6083 | (defun todo-reset-done-string (symbol value) |
6084 | "The :set function for user option `todo-done-string'." | |
27139cd5 | 6085 | (let ((oldvalue (symbol-value symbol)) |
ddce2e3e | 6086 | (files (append todo-files todo-archives))) |
27139cd5 SB |
6087 | (custom-set-default symbol value) |
6088 | ;; Need to reset this to get font-locking right. | |
ddce2e3e SB |
6089 | (setq todo-done-string-start |
6090 | (concat "^\\[" (regexp-quote todo-done-string))) | |
27139cd5 SB |
6091 | (when (not (equal value oldvalue)) |
6092 | (dolist (f files) | |
6093 | (with-current-buffer (find-file-noselect f) | |
6094 | (let (buffer-read-only) | |
6095 | (widen) | |
6096 | (goto-char (point-min)) | |
6097 | (while (not (eobp)) | |
6098 | (if (re-search-forward | |
ddce2e3e | 6099 | (concat "^" (regexp-quote todo-nondiary-start) |
27139cd5 SB |
6100 | "\\(" (regexp-quote oldvalue) "\\)") |
6101 | nil t) | |
6102 | (replace-match value t t nil 1) | |
6103 | (forward-line))) | |
ddce2e3e | 6104 | (todo-category-select))))))) |
fd6c6328 | 6105 | |
ddce2e3e SB |
6106 | (defun todo-reset-comment-string (symbol value) |
6107 | "The :set function for user option `todo-comment-string'." | |
27139cd5 | 6108 | (let ((oldvalue (symbol-value symbol)) |
ddce2e3e | 6109 | (files (append todo-files todo-archives))) |
27139cd5 SB |
6110 | (custom-set-default symbol value) |
6111 | (when (not (equal value oldvalue)) | |
6112 | (dolist (f files) | |
6113 | (with-current-buffer (find-file-noselect f) | |
6114 | (let (buffer-read-only) | |
6115 | (save-excursion | |
6116 | (widen) | |
6117 | (goto-char (point-min)) | |
6118 | (while (not (eobp)) | |
6119 | (if (re-search-forward | |
6120 | (concat | |
6121 | "\\[\\(" (regexp-quote oldvalue) "\\): [^]]*\\]") | |
6122 | nil t) | |
6123 | (replace-match value t t nil 1) | |
6124 | (forward-line))) | |
ddce2e3e | 6125 | (todo-category-select)))))))) |
2c173503 | 6126 | |
ddce2e3e SB |
6127 | (defun todo-reset-highlight-item (symbol value) |
6128 | "The :set function for `todo-toggle-item-highlighting'." | |
27139cd5 | 6129 | (let ((oldvalue (symbol-value symbol)) |
ddce2e3e | 6130 | (files (append todo-files todo-archives))) |
27139cd5 SB |
6131 | (custom-set-default symbol value) |
6132 | (when (not (equal value oldvalue)) | |
6133 | (dolist (f files) | |
6134 | (let ((buf (find-buffer-visiting f))) | |
6135 | (when buf | |
6136 | (with-current-buffer buf | |
6137 | (require 'hl-line) | |
6138 | (if value | |
6139 | (hl-line-mode 1) | |
6140 | (hl-line-mode -1))))))))) | |
d04d6b95 | 6141 | |
ddce2e3e | 6142 | (defun todo-reevaluate-filelist-defcustoms () |
4fe738d3 | 6143 | "Reevaluate defcustoms that provide choice list of todo files." |
ddce2e3e SB |
6144 | (custom-set-default 'todo-default-todo-file |
6145 | (symbol-value 'todo-default-todo-file)) | |
6146 | (todo-reevaluate-default-file-defcustom) | |
6147 | (custom-set-default 'todo-filter-files (symbol-value 'todo-filter-files)) | |
6148 | (todo-reevaluate-filter-files-defcustom) | |
6149 | (custom-set-default 'todo-category-completions-files | |
6150 | (symbol-value 'todo-category-completions-files)) | |
6151 | (todo-reevaluate-category-completions-files-defcustom)) | |
6152 | ||
6153 | (defun todo-reevaluate-default-file-defcustom () | |
6154 | "Reevaluate defcustom of `todo-default-todo-file'. | |
d610f6dd SB |
6155 | Called after adding or deleting a todo file. If the value of |
6156 | `todo-default-todo-file' before calling this function was | |
6157 | associated with an existing file, keep that value." | |
6158 | ;; (let ((curval todo-default-todo-file)) | |
6159 | (eval | |
6160 | (defcustom todo-default-todo-file (todo-short-file-name | |
6161 | (car (funcall todo-files-function))) | |
6162 | "Todo file visited by first session invocation of `todo-show'." | |
6163 | :type (when todo-files | |
6164 | `(radio ,@(mapcar (lambda (f) (list 'const f)) | |
6165 | (mapcar 'todo-short-file-name | |
6166 | (funcall todo-files-function))))) | |
6167 | :group 'todo)) | |
6168 | ;; (when (and curval (file-exists-p (todo-absolute-file-name curval))) | |
6169 | ;; (custom-set-default 'todo-default-todo-file curval) | |
6170 | ;; ;; (custom-reevaluate-setting 'todo-default-todo-file) | |
6171 | ;; ))) | |
6172 | ) | |
ddce2e3e SB |
6173 | |
6174 | (defun todo-reevaluate-category-completions-files-defcustom () | |
6175 | "Reevaluate defcustom of `todo-category-completions-files'. | |
4fe738d3 | 6176 | Called after adding or deleting a todo file." |
ddce2e3e SB |
6177 | (eval (defcustom todo-category-completions-files nil |
6178 | "List of files for building `todo-read-category' completions." | |
8b27b080 | 6179 | :type `(set ,@(mapcar (lambda (f) (list 'const f)) |
ddce2e3e SB |
6180 | (mapcar 'todo-short-file-name |
6181 | (funcall todo-files-function)))) | |
6182 | :group 'todo))) | |
6183 | ||
6184 | (defun todo-reevaluate-filter-files-defcustom () | |
6185 | "Reevaluate defcustom of `todo-filter-files'. | |
4fe738d3 | 6186 | Called after adding or deleting a todo file." |
ddce2e3e | 6187 | (eval (defcustom todo-filter-files nil |
8b27b080 SB |
6188 | "List of files for multifile item filtering." |
6189 | :type `(set ,@(mapcar (lambda (f) (list 'const f)) | |
ddce2e3e SB |
6190 | (mapcar 'todo-short-file-name |
6191 | (funcall todo-files-function)))) | |
6192 | :group 'todo))) | |
8b27b080 | 6193 | |
a9b0e28e | 6194 | ;; ----------------------------------------------------------------------------- |
27139cd5 | 6195 | ;;; Font locking |
a9b0e28e | 6196 | ;; ----------------------------------------------------------------------------- |
3f031767 | 6197 | |
ddce2e3e | 6198 | (defun todo-nondiary-marker-matcher (lim) |
4fe738d3 | 6199 | "Search for todo item nondiary markers within LIM for font-locking." |
ddce2e3e SB |
6200 | (re-search-forward (concat "^\\(?1:" (regexp-quote todo-nondiary-start) "\\)" |
6201 | todo-date-pattern "\\(?: " diary-time-regexp | |
6202 | "\\)?\\(?2:" (regexp-quote todo-nondiary-end) "\\)") | |
27139cd5 | 6203 | lim t)) |
d16da867 | 6204 | |
ddce2e3e | 6205 | (defun todo-diary-nonmarking-matcher (lim) |
27139cd5 SB |
6206 | "Search for diary nonmarking symbol within LIM for font-locking." |
6207 | (re-search-forward (concat "^\\(?1:" (regexp-quote diary-nonmarking-symbol) | |
ddce2e3e | 6208 | "\\)" todo-date-pattern) lim t)) |
d16da867 | 6209 | |
ddce2e3e | 6210 | (defun todo-date-string-matcher (lim) |
4fe738d3 | 6211 | "Search for todo item date string within LIM for font-locking." |
8b27b080 | 6212 | (re-search-forward |
ddce2e3e | 6213 | (concat todo-date-string-start "\\(?1:" todo-date-pattern "\\)") lim t)) |
8b27b080 | 6214 | |
ddce2e3e | 6215 | (defun todo-time-string-matcher (lim) |
4fe738d3 | 6216 | "Search for todo item time string within LIM for font-locking." |
ddce2e3e | 6217 | (re-search-forward (concat todo-date-string-start todo-date-pattern |
8b27b080 SB |
6218 | " \\(?1:" diary-time-regexp "\\)") lim t)) |
6219 | ||
ddce2e3e | 6220 | (defun todo-diary-expired-matcher (lim) |
27139cd5 SB |
6221 | "Search for expired diary item date within LIM for font-locking." |
6222 | (when (re-search-forward (concat "^\\(?:" | |
6223 | (regexp-quote diary-nonmarking-symbol) | |
ddce2e3e | 6224 | "\\)?\\(?1:" todo-date-pattern "\\) \\(?2:" |
27139cd5 SB |
6225 | diary-time-regexp "\\)?") lim t) |
6226 | (let* ((date (match-string-no-properties 1)) | |
6227 | (time (match-string-no-properties 2)) | |
6228 | ;; Function days-between requires a non-empty time string. | |
6229 | (date-time (concat date " " (or time "00:00")))) | |
6230 | (or (and (not (string-match ".+day\\|\\*" date)) | |
6231 | (< (days-between date-time (current-time-string)) 0)) | |
ddce2e3e | 6232 | (todo-diary-expired-matcher lim))))) |
58c7641d | 6233 | |
ddce2e3e | 6234 | (defun todo-done-string-matcher (lim) |
4fe738d3 | 6235 | "Search for done todo item header within LIM for font-locking." |
ddce2e3e | 6236 | (re-search-forward (concat todo-done-string-start |
27139cd5 SB |
6237 | "[^][]+]") |
6238 | lim t)) | |
d16da867 | 6239 | |
ddce2e3e | 6240 | (defun todo-comment-string-matcher (lim) |
4fe738d3 | 6241 | "Search for done todo item comment within LIM for font-locking." |
ddce2e3e | 6242 | (re-search-forward (concat "\\[\\(?1:" todo-comment-string "\\):") |
27139cd5 | 6243 | lim t)) |
58c7641d | 6244 | |
ddce2e3e | 6245 | (defun todo-category-string-matcher-1 (lim) |
4fe738d3 | 6246 | "Search for todo category name within LIM for font-locking. |
ddce2e3e | 6247 | This is for fontifying category and file names appearing in Todo |
27139cd5 | 6248 | Filtered Items mode following done items." |
ddce2e3e SB |
6249 | (if (eq major-mode 'todo-filtered-items-mode) |
6250 | (re-search-forward (concat todo-done-string-start todo-date-pattern | |
27139cd5 SB |
6251 | "\\(?: " diary-time-regexp |
6252 | ;; Use non-greedy operator to prevent | |
6253 | ;; capturing possible following non-diary | |
6254 | ;; date string. | |
6255 | "\\)?] \\(?1:\\[.+?\\]\\)") | |
6256 | lim t))) | |
d16da867 | 6257 | |
ddce2e3e | 6258 | (defun todo-category-string-matcher-2 (lim) |
4fe738d3 | 6259 | "Search for todo category name within LIM for font-locking. |
ddce2e3e | 6260 | This is for fontifying category and file names appearing in Todo |
27139cd5 | 6261 | Filtered Items mode following todo (not done) items." |
ddce2e3e SB |
6262 | (if (eq major-mode 'todo-filtered-items-mode) |
6263 | (re-search-forward (concat todo-date-string-start todo-date-pattern | |
27139cd5 | 6264 | "\\(?: " diary-time-regexp "\\)?\\(?:" |
ddce2e3e | 6265 | (regexp-quote todo-nondiary-end) |
27139cd5 SB |
6266 | "\\)? \\(?1:\\[.+\\]\\)") |
6267 | lim t))) | |
d16da867 | 6268 | |
ddce2e3e SB |
6269 | (defvar todo-nondiary-face 'todo-nondiary) |
6270 | (defvar todo-date-face 'todo-date) | |
6271 | (defvar todo-time-face 'todo-time) | |
6272 | (defvar todo-diary-expired-face 'todo-diary-expired) | |
6273 | (defvar todo-done-sep-face 'todo-done-sep) | |
6274 | (defvar todo-done-face 'todo-done) | |
6275 | (defvar todo-comment-face 'todo-comment) | |
6276 | (defvar todo-category-string-face 'todo-category-string) | |
6277 | (defvar todo-font-lock-keywords | |
27139cd5 | 6278 | (list |
ddce2e3e SB |
6279 | '(todo-nondiary-marker-matcher 1 todo-nondiary-face t) |
6280 | '(todo-nondiary-marker-matcher 2 todo-nondiary-face t) | |
27139cd5 | 6281 | ;; diary-lib.el uses font-lock-constant-face for diary-nonmarking-symbol. |
ddce2e3e SB |
6282 | '(todo-diary-nonmarking-matcher 1 font-lock-constant-face t) |
6283 | '(todo-date-string-matcher 1 todo-date-face t) | |
6284 | '(todo-time-string-matcher 1 todo-time-face t) | |
6285 | '(todo-done-string-matcher 0 todo-done-face t) | |
6286 | '(todo-comment-string-matcher 1 todo-comment-face t) | |
6287 | '(todo-category-string-matcher-1 1 todo-category-string-face t t) | |
6288 | '(todo-category-string-matcher-2 1 todo-category-string-face t t) | |
6289 | '(todo-diary-expired-matcher 1 todo-diary-expired-face t) | |
6290 | '(todo-diary-expired-matcher 2 todo-diary-expired-face t t) | |
27139cd5 | 6291 | ) |
ddce2e3e | 6292 | "Font-locking for Todo modes.") |
d16da867 | 6293 | |
a9b0e28e | 6294 | ;; ----------------------------------------------------------------------------- |
8b27b080 | 6295 | ;;; Key binding |
a9b0e28e | 6296 | ;; ----------------------------------------------------------------------------- |
d16da867 | 6297 | |
ddce2e3e | 6298 | (defvar todo-key-bindings-t |
27139cd5 | 6299 | `( |
ddce2e3e SB |
6300 | ("Af" todo-find-archive) |
6301 | ("Ac" todo-choose-archive) | |
6302 | ("Ad" todo-archive-done-item) | |
6303 | ("Cv" todo-toggle-view-done-items) | |
6304 | ("v" todo-toggle-view-done-items) | |
6305 | ("Ca" todo-add-category) | |
6306 | ("Cr" todo-rename-category) | |
6307 | ("Cg" todo-merge-category) | |
6308 | ("Cm" todo-move-category) | |
6309 | ("Ck" todo-delete-category) | |
6310 | ("Cts" todo-set-top-priorities-in-category) | |
6311 | ("Cey" todo-edit-category-diary-inclusion) | |
6312 | ("Cek" todo-edit-category-diary-nonmarking) | |
6313 | ("Fa" todo-add-file) | |
ae43b66a | 6314 | ("Fr" todo-rename-file) |
ddce2e3e SB |
6315 | ("Ff" todo-find-filtered-items-file) |
6316 | ("FV" todo-toggle-view-done-only) | |
6317 | ("V" todo-toggle-view-done-only) | |
6318 | ("Ftt" todo-filter-top-priorities) | |
6319 | ("Ftm" todo-filter-top-priorities-multifile) | |
6320 | ("Fts" todo-set-top-priorities-in-file) | |
6321 | ("Fyy" todo-filter-diary-items) | |
6322 | ("Fym" todo-filter-diary-items-multifile) | |
ae43b66a SB |
6323 | ("Fxx" todo-filter-regexp-items) |
6324 | ("Fxm" todo-filter-regexp-items-multifile) | |
ddce2e3e SB |
6325 | ("ee" todo-edit-item) |
6326 | ("em" todo-edit-multiline-item) | |
6327 | ("edt" todo-edit-item-header) | |
6328 | ("edc" todo-edit-item-date-from-calendar) | |
6329 | ("eda" todo-edit-item-date-to-today) | |
6330 | ("edn" todo-edit-item-date-day-name) | |
6331 | ("edy" todo-edit-item-date-year) | |
6332 | ("edm" todo-edit-item-date-month) | |
6333 | ("edd" todo-edit-item-date-day) | |
6334 | ("et" todo-edit-item-time) | |
6335 | ("eyy" todo-edit-item-diary-inclusion) | |
6336 | ("eyk" todo-edit-item-diary-nonmarking) | |
6337 | ("ec" todo-edit-done-item-comment) | |
6338 | ("d" todo-item-done) | |
f3a66082 | 6339 | ("i" todo-insert-item) |
ddce2e3e SB |
6340 | ("k" todo-delete-item) |
6341 | ("m" todo-move-item) | |
6342 | ("u" todo-item-undone) | |
a9b0e28e | 6343 | ([remap newline] newline-and-indent) |
27139cd5 | 6344 | ) |
ddce2e3e | 6345 | "List of key bindings for Todo mode only.") |
a9b0e28e | 6346 | |
ddce2e3e | 6347 | (defvar todo-key-bindings-t+a+f |
a9b0e28e | 6348 | `( |
ddce2e3e SB |
6349 | ("C*" todo-mark-category) |
6350 | ("Cu" todo-unmark-category) | |
6351 | ("Fh" todo-toggle-item-header) | |
6352 | ("h" todo-toggle-item-header) | |
d610f6dd | 6353 | ("Fk" todo-delete-file) |
ddce2e3e SB |
6354 | ("Fe" todo-edit-file) |
6355 | ("FH" todo-toggle-item-highlighting) | |
6356 | ("H" todo-toggle-item-highlighting) | |
6357 | ("FN" todo-toggle-prefix-numbers) | |
6358 | ("N" todo-toggle-prefix-numbers) | |
6359 | ("PB" todo-print-buffer) | |
6360 | ("PF" todo-print-buffer-to-file) | |
6361 | ("b" todo-backward-category) | |
6362 | ("d" todo-item-done) | |
6363 | ("f" todo-forward-category) | |
6364 | ("j" todo-jump-to-category) | |
6365 | ("n" todo-next-item) | |
6366 | ("p" todo-previous-item) | |
6367 | ("q" todo-quit) | |
6368 | ("s" todo-save) | |
6369 | ("t" todo-show) | |
a9b0e28e | 6370 | ) |
ddce2e3e | 6371 | "List of key bindings for Todo, Archive, and Filtered Items modes.") |
a9b0e28e | 6372 | |
ddce2e3e | 6373 | (defvar todo-key-bindings-t+a |
a9b0e28e | 6374 | `( |
ddce2e3e SB |
6375 | ("Fc" todo-show-categories-table) |
6376 | ("S" todo-search) | |
6377 | ("X" todo-clear-matches) | |
6378 | ("*" todo-toggle-mark-item) | |
a9b0e28e | 6379 | ) |
ddce2e3e | 6380 | "List of key bindings for Todo and Todo Archive modes.") |
a9b0e28e | 6381 | |
ddce2e3e | 6382 | (defvar todo-key-bindings-t+f |
a9b0e28e | 6383 | `( |
ddce2e3e SB |
6384 | ("l" todo-lower-item-priority) |
6385 | ("r" todo-raise-item-priority) | |
6386 | ("#" todo-set-item-priority) | |
a9b0e28e | 6387 | ) |
ddce2e3e | 6388 | "List of key bindings for Todo and Todo Filtered Items modes.") |
d04d6b95 | 6389 | |
ddce2e3e | 6390 | (defvar todo-mode-map |
27139cd5 SB |
6391 | (let ((map (make-keymap))) |
6392 | ;; Don't suppress digit keys, so they can supply prefix arguments. | |
6393 | (suppress-keymap map) | |
ddce2e3e | 6394 | (dolist (kb todo-key-bindings-t) |
a9b0e28e | 6395 | (define-key map (nth 0 kb) (nth 1 kb))) |
ddce2e3e | 6396 | (dolist (kb todo-key-bindings-t+a+f) |
a9b0e28e | 6397 | (define-key map (nth 0 kb) (nth 1 kb))) |
ddce2e3e | 6398 | (dolist (kb todo-key-bindings-t+a) |
a9b0e28e | 6399 | (define-key map (nth 0 kb) (nth 1 kb))) |
ddce2e3e | 6400 | (dolist (kb todo-key-bindings-t+f) |
a9b0e28e | 6401 | (define-key map (nth 0 kb) (nth 1 kb))) |
27139cd5 | 6402 | map) |
ddce2e3e | 6403 | "Todo mode keymap.") |
58c7641d | 6404 | |
ddce2e3e | 6405 | (defvar todo-archive-mode-map |
27139cd5 | 6406 | (let ((map (make-sparse-keymap))) |
a9b0e28e | 6407 | (suppress-keymap map) |
ddce2e3e | 6408 | (dolist (kb todo-key-bindings-t+a+f) |
a9b0e28e | 6409 | (define-key map (nth 0 kb) (nth 1 kb))) |
ddce2e3e | 6410 | (dolist (kb todo-key-bindings-t+a) |
a9b0e28e | 6411 | (define-key map (nth 0 kb) (nth 1 kb))) |
ddce2e3e SB |
6412 | (define-key map "a" 'todo-jump-to-archive-category) |
6413 | (define-key map "u" 'todo-unarchive-items) | |
27139cd5 | 6414 | map) |
ddce2e3e | 6415 | "Todo Archive mode keymap.") |
d04d6b95 | 6416 | |
ddce2e3e | 6417 | (defvar todo-edit-mode-map |
27139cd5 | 6418 | (let ((map (make-sparse-keymap))) |
ddce2e3e | 6419 | (define-key map "\C-x\C-q" 'todo-edit-quit) |
27139cd5 SB |
6420 | (define-key map [remap newline] 'newline-and-indent) |
6421 | map) | |
ddce2e3e | 6422 | "Todo Edit mode keymap.") |
58c7641d | 6423 | |
ddce2e3e | 6424 | (defvar todo-categories-mode-map |
27139cd5 | 6425 | (let ((map (make-sparse-keymap))) |
a9b0e28e | 6426 | (suppress-keymap map) |
ddce2e3e SB |
6427 | (define-key map "c" 'todo-sort-categories-alphabetically-or-numerically) |
6428 | (define-key map "t" 'todo-sort-categories-by-todo) | |
6429 | (define-key map "y" 'todo-sort-categories-by-diary) | |
6430 | (define-key map "d" 'todo-sort-categories-by-done) | |
6431 | (define-key map "a" 'todo-sort-categories-by-archived) | |
6432 | (define-key map "#" 'todo-set-category-number) | |
6433 | (define-key map "l" 'todo-lower-category) | |
6434 | (define-key map "r" 'todo-raise-category) | |
6435 | (define-key map "n" 'todo-next-button) | |
6436 | (define-key map "p" 'todo-previous-button) | |
6437 | (define-key map [tab] 'todo-next-button) | |
6438 | (define-key map [backtab] 'todo-previous-button) | |
6439 | (define-key map "q" 'todo-quit) | |
27139cd5 | 6440 | map) |
ddce2e3e | 6441 | "Todo Categories mode keymap.") |
58c7641d | 6442 | |
ddce2e3e | 6443 | (defvar todo-filtered-items-mode-map |
a9b0e28e SB |
6444 | (let ((map (make-sparse-keymap))) |
6445 | (suppress-keymap map) | |
ddce2e3e | 6446 | (dolist (kb todo-key-bindings-t+a+f) |
a9b0e28e | 6447 | (define-key map (nth 0 kb) (nth 1 kb))) |
ddce2e3e | 6448 | (dolist (kb todo-key-bindings-t+f) |
a9b0e28e | 6449 | (define-key map (nth 0 kb) (nth 1 kb))) |
ddce2e3e SB |
6450 | (define-key map "g" 'todo-go-to-source-item) |
6451 | (define-key map [remap newline] 'todo-go-to-source-item) | |
27139cd5 | 6452 | map) |
ddce2e3e | 6453 | "Todo Filtered Items mode keymap.") |
a9b0e28e | 6454 | |
8b27b080 | 6455 | ;; FIXME: Is it worth having a menu and if so, which commands? |
a9b0e28e | 6456 | ;; (easy-menu-define |
ddce2e3e SB |
6457 | ;; todo-menu todo-mode-map "Todo Menu" |
6458 | ;; '("Todo" | |
a9b0e28e | 6459 | ;; ("Navigation" |
ddce2e3e SB |
6460 | ;; ["Next Item" todo-forward-item t] |
6461 | ;; ["Previous Item" todo-backward-item t] | |
a9b0e28e | 6462 | ;; "---" |
ddce2e3e SB |
6463 | ;; ["Next Category" todo-forward-category t] |
6464 | ;; ["Previous Category" todo-backward-category t] | |
6465 | ;; ["Jump to Category" todo-jump-to-category t] | |
a9b0e28e | 6466 | ;; "---" |
ddce2e3e SB |
6467 | ;; ["Search Todo File" todo-search t] |
6468 | ;; ["Clear Highlighting on Search Matches" todo-category-done t]) | |
a9b0e28e | 6469 | ;; ("Display" |
ddce2e3e SB |
6470 | ;; ["List Current Categories" todo-show-categories-table t] |
6471 | ;; ;; ["List Categories Alphabetically" todo-display-categories-alphabetically t] | |
6472 | ;; ["Turn Item Highlighting on/off" todo-toggle-item-highlighting t] | |
6473 | ;; ["Turn Item Numbering on/off" todo-toggle-prefix-numbers t] | |
6474 | ;; ["Turn Item Time Stamp on/off" todo-toggle-item-header t] | |
6475 | ;; ["View/Hide Done Items" todo-toggle-view-done-items t] | |
a9b0e28e | 6476 | ;; "---" |
ddce2e3e SB |
6477 | ;; ["View Diary Items" todo-filter-diary-items t] |
6478 | ;; ["View Top Priority Items" todo-filter-top-priorities t] | |
6479 | ;; ["View Multifile Top Priority Items" todo-filter-top-priorities-multifile t] | |
a9b0e28e | 6480 | ;; "---" |
ddce2e3e | 6481 | ;; ["Print Category" todo-print-buffer t]) |
a9b0e28e | 6482 | ;; ("Editing" |
ddce2e3e SB |
6483 | ;; ["Insert New Item" todo-insert-item t] |
6484 | ;; ["Insert Item Here" todo-insert-item-here t] | |
a9b0e28e | 6485 | ;; ("More Insertion Commands") |
ddce2e3e SB |
6486 | ;; ["Edit Item" todo-edit-item t] |
6487 | ;; ["Edit Multiline Item" todo-edit-multiline-item t] | |
6488 | ;; ["Edit Item Header" todo-edit-item-header t] | |
6489 | ;; ["Edit Item Date" todo-edit-item-date t] | |
6490 | ;; ["Edit Item Time" todo-edit-item-time t] | |
a9b0e28e | 6491 | ;; "---" |
ddce2e3e SB |
6492 | ;; ["Lower Item Priority" todo-lower-item-priority t] |
6493 | ;; ["Raise Item Priority" todo-raise-item-priority t] | |
6494 | ;; ["Set Item Priority" todo-set-item-priority t] | |
6495 | ;; ["Move (Recategorize) Item" todo-move-item t] | |
6496 | ;; ["Delete Item" todo-delete-item t] | |
6497 | ;; ["Undo Done Item" todo-item-undone t] | |
6498 | ;; ["Mark/Unmark Item for Diary" todo-toggle-item-diary-inclusion t] | |
6499 | ;; ["Mark/Unmark Items for Diary" todo-edit-item-diary-inclusion t] | |
6500 | ;; ["Mark & Hide Done Item" todo-item-done t] | |
6501 | ;; ["Archive Done Items" todo-archive-category-done-items t] | |
a9b0e28e | 6502 | ;; "---" |
ddce2e3e SB |
6503 | ;; ["Add New Todo File" todo-add-file t] |
6504 | ;; ["Add New Category" todo-add-category t] | |
6505 | ;; ["Delete Current Category" todo-delete-category t] | |
6506 | ;; ["Rename Current Category" todo-rename-category t] | |
a9b0e28e | 6507 | ;; "---" |
ddce2e3e | 6508 | ;; ["Save Todo File" todo-save t] |
a9b0e28e SB |
6509 | ;; ) |
6510 | ;; "---" | |
ddce2e3e | 6511 | ;; ["Quit" todo-quit t] |
a9b0e28e SB |
6512 | ;; )) |
6513 | ||
6514 | ;; ----------------------------------------------------------------------------- | |
adc5dbce | 6515 | ;;; Hook functions and mode definitions |
a9b0e28e | 6516 | ;; ----------------------------------------------------------------------------- |
616ffa8b | 6517 | |
ddce2e3e | 6518 | (defun todo-show-current-file () |
4fe738d3 | 6519 | "Visit current instead of default todo file with `todo-show'. |
d610f6dd | 6520 | Added to `pre-command-hook' in Todo mode when user option |
ddce2e3e SB |
6521 | `todo-show-current-file' is set to non-nil." |
6522 | (setq todo-global-current-todo-file todo-current-todo-file)) | |
3f031767 | 6523 | |
ddce2e3e | 6524 | (defun todo-display-as-todo-file () |
d610f6dd SB |
6525 | "Show todo files correctly when visited from outside of Todo mode. |
6526 | Added to `find-file-hook' in Todo mode and Todo Archive mode." | |
ddce2e3e | 6527 | (and (member this-command todo-visit-files-commands) |
27139cd5 | 6528 | (= (- (point-max) (point-min)) (buffer-size)) |
ddce2e3e SB |
6529 | (member major-mode '(todo-mode todo-archive-mode)) |
6530 | (todo-category-select))) | |
ee7412e4 | 6531 | |
ddce2e3e | 6532 | (defun todo-add-to-buffer-list () |
4fe738d3 | 6533 | "Add name of just visited todo file to `todo-file-buffers'. |
ddce2e3e | 6534 | This function is added to `find-file-hook' in Todo mode." |
27139cd5 | 6535 | (let ((filename (file-truename (buffer-file-name)))) |
ddce2e3e SB |
6536 | (when (member filename todo-files) |
6537 | (add-to-list 'todo-file-buffers filename)))) | |
2a9e69d6 | 6538 | |
ddce2e3e SB |
6539 | (defun todo-update-buffer-list () |
6540 | "Make current Todo mode buffer file car of `todo-file-buffers'. | |
6541 | This function is added to `post-command-hook' in Todo mode." | |
27139cd5 | 6542 | (let ((filename (file-truename (buffer-file-name)))) |
ddce2e3e SB |
6543 | (unless (eq (car todo-file-buffers) filename) |
6544 | (setq todo-file-buffers | |
6545 | (cons filename (delete filename todo-file-buffers)))))) | |
6546 | ||
6547 | (defun todo-reset-global-current-todo-file () | |
6548 | "Update the value of `todo-global-current-todo-file'. | |
4fe738d3 | 6549 | This becomes the latest existing todo file or, if there is none, |
ddce2e3e SB |
6550 | the value of `todo-default-todo-file'. |
6551 | This function is added to `kill-buffer-hook' in Todo mode." | |
27139cd5 | 6552 | (let ((filename (file-truename (buffer-file-name)))) |
ddce2e3e SB |
6553 | (setq todo-file-buffers (delete filename todo-file-buffers)) |
6554 | (setq todo-global-current-todo-file | |
6555 | (or (car todo-file-buffers) | |
6556 | (todo-absolute-file-name todo-default-todo-file))))) | |
c4bf3e3d | 6557 | |
ddce2e3e | 6558 | (defun todo-reset-and-enable-done-separator () |
27139cd5 | 6559 | "Show resized done items separator overlay after window change. |
d610f6dd | 6560 | Added to `window-configuration-change-hook' in Todo mode." |
ddce2e3e SB |
6561 | (when (= 1 (length todo-done-separator-string)) |
6562 | (let ((sep todo-done-separator)) | |
6563 | (setq todo-done-separator (todo-done-separator)) | |
6564 | (save-match-data (todo-reset-done-separator sep))))) | |
6565 | ||
6566 | (defun todo-modes-set-1 () | |
6567 | "Make some settings that apply to multiple Todo modes." | |
6568 | (setq-local font-lock-defaults '(todo-font-lock-keywords t)) | |
6569 | (setq-local tab-width todo-indent-to-here) | |
6570 | (setq-local indent-line-function 'todo-indent) | |
6571 | (when todo-wrap-lines | |
27139cd5 | 6572 | (visual-line-mode) |
ddce2e3e | 6573 | (setq wrap-prefix (make-string todo-indent-to-here 32)))) |
27139cd5 | 6574 | |
ddce2e3e SB |
6575 | (defun todo-modes-set-2 () |
6576 | "Make some settings that apply to multiple Todo modes." | |
6577 | (add-to-invisibility-spec 'todo) | |
27139cd5 | 6578 | (setq buffer-read-only t) |
2f99433b SB |
6579 | (when (and (boundp 'desktop-save-mode) desktop-save-mode) |
6580 | (setq-local desktop-save-buffer 'todo-desktop-save-buffer)) | |
1d59b723 SB |
6581 | (when (boundp 'hl-line-range-function) |
6582 | (setq-local hl-line-range-function | |
6583 | (lambda() (save-excursion | |
ddce2e3e SB |
6584 | (when (todo-item-end) |
6585 | (cons (todo-item-start) | |
6586 | (todo-item-end)))))))) | |
27139cd5 | 6587 | |
ddce2e3e SB |
6588 | (defun todo-modes-set-3 () |
6589 | "Make some settings that apply to multiple Todo modes." | |
6590 | (setq-local todo-categories (todo-set-categories)) | |
6591 | (setq-local todo-category-number 1) | |
6592 | (add-hook 'find-file-hook 'todo-display-as-todo-file nil t)) | |
27139cd5 | 6593 | |
ddce2e3e | 6594 | (put 'todo-mode 'mode-class 'special) |
27139cd5 | 6595 | |
2f99433b | 6596 | ;;;###autoload |
ddce2e3e | 6597 | (define-derived-mode todo-mode special-mode "Todo" |
4fe738d3 | 6598 | "Major mode for displaying, navigating and editing todo lists. |
27139cd5 | 6599 | |
ddce2e3e SB |
6600 | \\{todo-mode-map}" |
6601 | ;; (easy-menu-add todo-menu) | |
6602 | (todo-modes-set-1) | |
6603 | (todo-modes-set-2) | |
6604 | (todo-modes-set-3) | |
6605 | ;; Initialize todo-current-todo-file. | |
27139cd5 | 6606 | (when (member (file-truename (buffer-file-name)) |
ddce2e3e SB |
6607 | (funcall todo-files-function)) |
6608 | (setq-local todo-current-todo-file (file-truename (buffer-file-name)))) | |
6609 | (setq-local todo-show-done-only nil) | |
6610 | (setq-local todo-categories-with-marks nil) | |
6611 | (add-hook 'find-file-hook 'todo-add-to-buffer-list nil t) | |
6612 | (add-hook 'post-command-hook 'todo-update-buffer-list nil t) | |
6613 | (when todo-show-current-file | |
6614 | (add-hook 'pre-command-hook 'todo-show-current-file nil t)) | |
27139cd5 | 6615 | (add-hook 'window-configuration-change-hook |
ddce2e3e SB |
6616 | 'todo-reset-and-enable-done-separator nil t) |
6617 | (add-hook 'kill-buffer-hook 'todo-reset-global-current-todo-file nil t)) | |
6618 | ||
6619 | (put 'todo-archive-mode 'mode-class 'special) | |
6620 | ||
6621 | ;; If todo-mode is parent, all todo-mode key bindings appear to be | |
6622 | ;; available in todo-archive-mode (e.g. shown by C-h m). | |
2f99433b | 6623 | ;;;###autoload |
ddce2e3e | 6624 | (define-derived-mode todo-archive-mode special-mode "Todo-Arch" |
4fe738d3 | 6625 | "Major mode for archived todo categories. |
ddce2e3e SB |
6626 | |
6627 | \\{todo-archive-mode-map}" | |
6628 | (todo-modes-set-1) | |
6629 | (todo-modes-set-2) | |
6630 | (todo-modes-set-3) | |
6631 | (setq-local todo-current-todo-file (file-truename (buffer-file-name))) | |
6632 | (setq-local todo-show-done-only t)) | |
6633 | ||
6634 | (defun todo-mode-external-set () | |
6635 | "Set `todo-categories' externally to `todo-current-todo-file'." | |
6636 | (setq-local todo-current-todo-file todo-global-current-todo-file) | |
27139cd5 SB |
6637 | (let ((cats (with-current-buffer |
6638 | ;; Can't use find-buffer-visiting when | |
ddce2e3e SB |
6639 | ;; `todo-show-categories-table' is called on first |
6640 | ;; invocation of `todo-show', since there is then | |
27139cd5 | 6641 | ;; no buffer visiting the current file. |
ddce2e3e SB |
6642 | (find-file-noselect todo-current-todo-file 'nowarn) |
6643 | (or todo-categories | |
6644 | ;; In Todo Edit mode todo-categories is now nil | |
6645 | ;; since it uses same buffer as Todo mode but | |
27139cd5 SB |
6646 | ;; doesn't have the latter's local variables. |
6647 | (save-excursion | |
6648 | (goto-char (point-min)) | |
6649 | (read (buffer-substring-no-properties | |
6650 | (line-beginning-position) | |
6651 | (line-end-position)))))))) | |
ddce2e3e | 6652 | (setq-local todo-categories cats))) |
308f5beb | 6653 | |
ddce2e3e | 6654 | (define-derived-mode todo-edit-mode text-mode "Todo-Ed" |
4fe738d3 | 6655 | "Major mode for editing multiline todo items. |
27139cd5 | 6656 | |
ddce2e3e SB |
6657 | \\{todo-edit-mode-map}" |
6658 | (todo-modes-set-1) | |
6659 | (todo-mode-external-set) | |
27139cd5 | 6660 | (setq buffer-read-only nil)) |
58c7641d | 6661 | |
ddce2e3e | 6662 | (put 'todo-categories-mode 'mode-class 'special) |
d04d6b95 | 6663 | |
ddce2e3e | 6664 | (define-derived-mode todo-categories-mode special-mode "Todo-Cats" |
4fe738d3 | 6665 | "Major mode for displaying and editing todo categories. |
d04d6b95 | 6666 | |
ddce2e3e SB |
6667 | \\{todo-categories-mode-map}" |
6668 | (todo-mode-external-set)) | |
d04d6b95 | 6669 | |
ddce2e3e | 6670 | (put 'todo-filtered-items-mode 'mode-class 'special) |
d04d6b95 | 6671 | |
2f99433b | 6672 | ;;;###autoload |
ddce2e3e SB |
6673 | (define-derived-mode todo-filtered-items-mode special-mode "Todo-Fltr" |
6674 | "Mode for displaying and reprioritizing top priority Todo. | |
3f031767 | 6675 | |
ddce2e3e SB |
6676 | \\{todo-filtered-items-mode-map}" |
6677 | (todo-modes-set-1) | |
6678 | (todo-modes-set-2)) | |
3f031767 | 6679 | |
2f99433b | 6680 | ;;;###autoload |
ddce2e3e | 6681 | (add-to-list 'auto-mode-alist '("\\.todo\\'" . todo-mode)) |
2f99433b | 6682 | ;;;###autoload |
ddce2e3e | 6683 | (add-to-list 'auto-mode-alist '("\\.toda\\'" . todo-archive-mode)) |
2f99433b | 6684 | ;;;###autoload |
ddce2e3e | 6685 | (add-to-list 'auto-mode-alist '("\\.tod[tyr]\\'" . todo-filtered-items-mode)) |
7464f422 | 6686 | |
e4ae44d9 | 6687 | ;; ----------------------------------------------------------------------------- |
ddce2e3e | 6688 | (provide 'todo-mode) |
520d912e | 6689 | |
ddce2e3e | 6690 | ;;; todo-mode.el ends here |