aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lisp/ChangeLog225
-rw-r--r--lisp/calendar/todos.el3168
2 files changed, 2497 insertions, 896 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index fc8bbbac000..db18c225cde 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,228 @@
12012-09-18 Stephen Berman <stephen.berman@gmx.net>
2
3 * calendar/todos.el Add and revise various doc strings, remove
4 further commented out code; add further comments; further code
5 rearrangement.
6 (todos-file-do, todos-archive-file, todos-mode-hook)
7 (todos-edit-mode-hook, todos-exclusion-start, todos-exclusion-end)
8 (todos-view-archive, todos-search-string)
9 (todos-jump-to-category-noninteractively, todos-initial-setup):
10 Remove.
11 (todos-files): Remove this defcustom.
12 (todos-initial-category, todos-display-categories-first)
13 (todos-auto-switch-todos-file, todos-default-todos-file)
14 (todos-categories-category-label, todos-categories-todo-label)
15 (todos-categories-diary-label, todos-categories-done-label)
16 (todos-categories-archived-label)
17 (todos-categories-number-separator, todos-categories-align)
18 (todos-ignore-archived-categories, todos-nondiary-marker):
19 New defcustoms.
20 (todos-prefix, todos-done-separator, todos-file-top)
21 (todos-categories-buffer, todos-archived-categories-buffer)
22 (todos-edit-buffer, todos-always-add-time-string, todos-button):
23 Change default value.
24 (todos-done-string): Add todos-reset-done-string as :set function,
25 but keep this commented out.
26 (todos-files, todos-archives, todos-insertion-map)
27 (todos-category-done, todos-nondiary-start, todos-nondiary-end)
28 (todos-show-done-only, todos-date-string-start)
29 (todos-done-string-start): New variables.
30 (todos-files-directory, todos-files-function, todos-merged-files)
31 (todos-prompt-merged-files, todos-files, todos-modes-set-1)
32 (todos-modes-set-2, todos-reset-done-string, todos-reset-categories)
33 (todos-toggle-switch-todos-file-noninteractively)
34 (todos-switch-todos-file, todos-counts, todos-get-count)
35 (todos-set-count, todos-set-categories)
36 (todos-truncate-categories-list, todos-update-categories-sexp)
37 (todos-read-file-name, todos-sort, todos-display-sorted)
38 (todos-label-to-key, todos-insert-sort-button): New functions.
39 (todos-display-categories-sorted-by-todo)
40 (todos-display-categories-sorted-by-diary)
41 (todos-display-categories-sorted-by-done)
42 (todos-display-categories-sorted-by-archived)
43 (todos-update-merged-files, todos-switch-to-archive)
44 (todos-choose-archive, todos-merged-top-priorities)
45 (todos-jump-to-category-other-file, todos-clear-matches)
46 (todos-add-file, todos-change-default-file, todos-move-category)
47 (todos-merge-category, todos-merge-categories)
48 (todos-edit-item-time, todos-move-item-to-file)
49 (todos-unarchive-category, todos-toggle-item-diary-nonmarking)
50 (todos-toggle-diary-nonmarking): New commands.
51 (todos-toggle-show-done-only): New command replacing todos-view-archive.
52 (todos-faces): New defgroup; use in all face definitions.
53 (todos-sorted-column, todos-archived-only, todos-search): New faces.
54 (todos-font-lock-keywords): Use subexpression 1 with matcher
55 todos-category-string-match.
56 (todos-mode-map, todos-archive-mode-map, todos-edit-mode-map)
57 (todos-categories-mode-map): Add new key bindings; change some
58 existing bindings.
59 (todos-top-priorities-mode-map): New keymap.
60 (todos-menu): Add submenues and new entries.
61 (auto-mode-alist): Add extension of Todos and Todos archive files.
62 (todos-mode, todos-archive-mode): Make derived mode; use
63 todos-modes-set-1, todos-modes-set-2, todos-auto-switch-todos-file
64 and todos-switch-todos-file; make todos-show-done-only local
65 variable.
66 (todos-edit-mode): Make derived mode; use todos-modes-set-1.
67 (todos-categories-mode): Make derived mode.
68 (todos-top-priorities-mode): New derived major mode.
69 (todos-save): Remove unused code.
70 (todos-quit): Handle todos-categories-mode; save archive buffer.
71 (todos-show): Add optional argument to prompt for a Todos file; if
72 called interactively or with prefix arg or from an archive, don't
73 make a no-op but reset todos-current-todos-file, todos-categories
74 and todos-category-number; use todos-read-file-name,
75 todos-display-categories-first, todos-ignore-archived-categories.
76 (todos-display-categories): Change argument name; refactor code
77 for inserting table labels and lines, using
78 todos-ignore-archived-categories, todos-sort,
79 todos-categories-number-separator, todos-insert-sort-button,
80 todos-categories-*-labels, and todos-insert-category-line.
81 (todos-display-categories-alphabetically): Use todos-display-sorted.
82 (todos-toggle-view-done-items): Use todos-done-string-start and
83 todos-get-count.
84 (todos-toggle-display-date-time): Use todos-done-string-start.
85 (todos-top-priorities): Remove autoload cookie; partially rewrite:
86 new argument list; allow combining top priorities of multiple
87 Todos files; change display to include category (and file) name as
88 part of item header; use todos-top-priorities-mode.
89 (todos-diary-items): Reimplement using only todos-top-priorities.
90 (todos-forward-category, todos-backward-category): Accommodate to
91 1-based numbering of categories; move point to top of category.
92 (todos-jump-to-category): Rewrite, adding optional arguments to
93 provide a category in non-interactive uses and to prompt for which
94 Todos file to jump to.
95 (todos-search): Reimplement; highlight each match as found, say
96 how many matches remain and prompt whether to go to next one; at
97 end of search prompt whether to remove highlighting.
98 (todos-add-category): Remove autoload cookie; assign new category
99 the highest category number; associate zero-initialized vector of
100 item counts, instead of property list, with new category; use
101 todos-validate-category-name and todos-update-categories-sexp.
102 (todos-rename-category): Use todos-validate-category-name and
103 todos-update-categories-sexp; take archive files into account.
104 (todos-delete-category): Use todos-get-count and
105 todos-update-categories-sexp, let-bind variable that were
106 mistakenly global; use delete-region instead of kill-region;
107 accommodate to 1-based numbering of categories; move point to top
108 of category.
109 (todos-raise-category): Handle item count vectors; use
110 todos-insert-category-line and todos-update-categories-sexp.
111 (todos-insert-item): Use nil time-string argument to omit time
112 string; use todos-nondiary-start and todos-nondiary-end and
113 todos-update-categories-sexp; if category named to insert into
114 does not exist, add it; take new diary items into account.
115 (todos-insert-item-ask-date, todos-insert-item-ask-date-time)
116 (todos-insert-item-ask-date-time-for-diary)
117 (todos-insert-item-ask-date-time-for-diary-here)
118 (todos-insert-item-ask-date-time-here)
119 (todos-insert-item-ask-date-maybe-notime)
120 (todos-insert-item-ask-date-maybe-notime-for-diary)
121 (todos-insert-item-ask-date-maybe-notime-for-diary-here)
122 (todos-insert-item-ask-date-maybe-notime-here)
123 (todos-insert-item-ask-date-for-diary)
124 (todos-insert-item-ask-date-for-diary-here)
125 (todos-insert-item-ask-date-here, todos-insert-item-ask-dayname)
126 (todos-insert-item-ask-dayname-time)
127 (todos-insert-item-ask-dayname-time-for-diary)
128 (todos-insert-item-ask-dayname-time-for-diary-here)
129 (todos-insert-item-ask-dayname-time-here)
130 (todos-insert-item-ask-dayname-maybe-notime)
131 (todos-insert-item-ask-dayname-maybe-notime-for-diary)
132 (todos-insert-item-ask-dayname-maybe-notime-for-diary-here)
133 (todos-insert-item-ask-dayname-maybe-notime-here)
134 (todos-insert-item-ask-dayname-for-diary)
135 (todos-insert-item-ask-dayname-for-diary-here)
136 (todos-insert-item-ask-dayname-here, todos-insert-item-ask-time)
137 (todos-insert-item-ask-time-for-diary)
138 (todos-insert-item-ask-time-for-diary-here)
139 (todos-insert-item-ask-time-here)
140 (todos-insert-item-maybe-notime)
141 (todos-insert-item-maybe-notime-for-diary)
142 (todos-insert-item-maybe-notime-for-diary-here)
143 (todos-insert-item-maybe-notime-here)
144 (todos-insert-item-for-diary, todos-insert-item-for-diary-here):
145 New insertion commands.
146 (todos-insert-item-from-calendar): Use todos-current-todos-file.
147 (todos-delete-item): Handle diary items;
148 use todos-update-categories-sexp.
149 (todos-edit-item): Check if point is with item string;
150 use read-string instead of read-from-minibuffer;
151 use todos-date-string-start; after editing put point at start of
152 item text.
153 (todos-edit-multiline): Narrow to item before invoking
154 todos-edit-mode; show key binding of todos-edit-quit in a message.
155 (todos-edit-quit): Use todos-save; kill buffer.
156 (todos-edit-item-header): Add optional argument to prompt for
157 editing only date string or only time string;
158 use todos-date-string-start.
159 (todos-edit-item-date, todos-edit-item-date-is-today)
160 (todos-raise-item-priority, todos-lower-item-priority): Rename
161 from todos-{raise, lower}-item and make them DTRT in
162 todos-top-priorities-mode.
163 (todos-set-item-priority): Make interactive; use todos-get-count
164 and todos-insert-with-overlays; interactively, just relocate the
165 item within its category.
166 (todos-move-item): Add optional argument to prompt for a category
167 in another Todos file; handle diary items; fix restoration after
168 cancelling before inserting.
169 (todos-item-done): Handle diary items; simplify handling of
170 insertion in done items section.
171 (todos-item-undo): Handle diary items.
172 (todos-archive-done-items): Accommodate to new handling of archive
173 files (in parallel with Todos files); handle diary items; use
174 todos-done-string-start.
175 (todos-toggle-item-diary-inclusion): Use todos-nondiary-start,
176 todos-nondiary-end and todos-item-counts.
177 (todos-toggle-diary-inclusion): Use todos-category-done instead of
178 todos-category-end.
179 (todos-print): Remove autoload cookie; rewrite to make overlays,
180 line wrapping and wrap prefixes printable.
181 (todos-date-pattern): Make parenthesized groups shy.
182 (todos-date-string-match): Use todos-date-string-start; make
183 todos-date-pattern an explicitly numbered group.
184 (todos-time-string-match): Use todos-date-string-start.
185 (todos-done-string-match): Use todos-done-string-start.
186 (todos-category-string-match): Rewrite to match new category and
187 category+filename patterns in todos-top-priorities-mode.
188 (todos-prefix-overlays): Use todos-done-string-start and
189 todos-category-done.
190 (todos-reset-prefix): Handle archive files; restore point after
191 changing prefix.
192 (todos-reset-separator): Handle archive files.
193 (todos-category-number): Make category number one more than its
194 list index.
195 (todos-current-category): Accommodate to 1-based numbering of
196 categories.
197 (todos-category-select): Simplify handling of done items and done
198 separator string overlay.
199 (todos-item-start): Use todos-date-string-start and
200 todos-done-string-start.
201 (todos-item-start, todos-item-end): Fix wrong parenthesizing.
202 (todos-item-string): Restore point after getting item bounds; use
203 buffer-substring-no-properties.
204 (todos-done-item-p): Use todos-done-string-start.
205 (todos-make-categories-list): Add optional argument to force
206 looping through file to get categories and their item counts,
207 otherwise set todos-categories from sexp in first line; use
208 vectors of item counts instead of plists; count diary items.
209 (todos-item-counts): Use todos-counts, todos-set-counts,
210 todos-get-counts, and todos-update-categories-sexp instead of
211 getting and setting properties; handle diary items.
212 (todos-read-category): Add argument to set prompt; don't offer
213 default category.
214 (todos-validate-category-name): Rename from
215 todos-check-category-name; take into account whether there are
216 already categories or not.
217 (todos-read-date): Accept `*' as an unspecified month, day, or year.
218 (todos-padded-string): Accommodate new structure of
219 todos-categories as alists; use todos-categories-align.
220 (todos-descending-counts-store): New variable.
221 (todos-insert-category-line): Rename from
222 todos-insert-category-name and reimplement using labels and
223 todos-get-counts instead of properties; use
224 todos-ignore-archived-categories; highlight sorted column.
225
12012-09-14 Stephen Berman <stephen.berman@gmx.net> 2262012-09-14 Stephen Berman <stephen.berman@gmx.net>
2 227
3 * calendar/todos.el Remove lots of commented out code; add various 228 * calendar/todos.el Remove lots of commented out code; add various
diff --git a/lisp/calendar/todos.el b/lisp/calendar/todos.el
index 427056e6e26..5d9c9561669 100644
--- a/lisp/calendar/todos.el
+++ b/lisp/calendar/todos.el
@@ -264,12 +264,23 @@
264;;; Customizable options 264;;; Customizable options
265 265
266(defgroup todos nil 266(defgroup todos nil
267 "Maintain lists of todo items." 267 "Maintain categorized lists of todo items."
268 :link '(emacs-commentary-link "todos") 268 :link '(emacs-commentary-link "todos")
269 :version "21.1" 269 :version "24.1"
270 :group 'calendar) 270 :group 'calendar)
271 271
272(defcustom todos-prefix "§" ; "*/*" FIXME ascii default 272;; FIXME: need this?
273(defcustom todos-initial-category "Todo"
274 "Default category name offered on initializing a new Todos file."
275 :type 'string
276 :group 'todos)
277
278(defcustom todos-display-categories-first nil
279 "Non-nil to display category list on first visit to a Todos file."
280 :type 'boolean
281 :group 'todos)
282
283(defcustom todos-prefix ""
273 "String prefixed to todo items for visual distinction." 284 "String prefixed to todo items for visual distinction."
274 :type 'string 285 :type 'string
275 :initialize 'custom-initialize-default 286 :initialize 'custom-initialize-default
@@ -277,14 +288,16 @@
277 :group 'todos) 288 :group 'todos)
278 289
279(defcustom todos-number-prefix t 290(defcustom todos-number-prefix t
280 "Non-nil to show item prefixes as consecutively increasing integers." 291 "Non-nil to show item prefixes as consecutively increasing integers.
292These reflect the priorities of the items in each category."
281 :type 'boolean 293 :type 'boolean
282 :initialize 'custom-initialize-default 294 :initialize 'custom-initialize-default
283 :set 'todos-reset-prefix 295 :set 'todos-reset-prefix
284 :group 'todos) 296 :group 'todos)
285 297
286;; FIXME: length (window-width) causes problems. Also, bad when window-width changes 298;; FIXME: Update when window-width changes (add todos-reset-separator to
287(defcustom todos-done-separator (make-string (1- (window-width)) ?-) 299;; window-configuration-change-hook in todos-mode?)
300(defcustom todos-done-separator (make-string (window-width) ?-)
288 "String used to visual separate done from not done items. 301 "String used to visual separate done from not done items.
289Displayed in a before-string overlay by `todos-toggle-view-done-items'." 302Displayed in a before-string overlay by `todos-toggle-view-done-items'."
290 :type 'string 303 :type 'string
@@ -296,7 +309,7 @@ Displayed in a before-string overlay by `todos-toggle-view-done-items'."
296 "Identifying string appended to the front of done todos items." 309 "Identifying string appended to the front of done todos items."
297 :type 'string 310 :type 'string
298 ;; :initialize 'custom-initialize-default 311 ;; :initialize 'custom-initialize-default
299 ;; :set 312 ;; :set 'todos-reset-done-string
300 :group 'todos) 313 :group 'todos)
301 314
302(defcustom todos-show-with-done nil 315(defcustom todos-show-with-done nil
@@ -304,75 +317,142 @@ Displayed in a before-string overlay by `todos-toggle-view-done-items'."
304 :type 'boolean 317 :type 'boolean
305 :group 'todos) 318 :group 'todos)
306 319
307;; FIXME: use user-emacs-directory here and below 320(defcustom todos-files-directory (locate-user-emacs-file "todos/")
308(defcustom todos-file-do (convert-standard-filename "~/.emacs.d/.todos-do") 321 "Directory where user's Todos files are saved."
309 "TODO mode list file." 322 :type 'directory
310 :type 'file
311 :group 'todos) 323 :group 'todos)
312 324
313(defcustom todos-files '((convert-standard-filename "~/.emacs.d/.todos")) 325(defun todos-files (&optional archives)
314 "List of Todos files." 326 "Default value of `todos-files-function'.
315 :type 'list 327This returns the case-insensitive alphabetically sorted list of
328files in `todos-files-directory' with the extension \".todo\".
329With non-nil ARCHIVES return the list of archive files."
330 (sort (directory-files todos-files-directory t
331 (if archives "\.toda$" "\.todo$") t)
332 (lambda (s1 s2) (let ((cis1 (upcase s1))
333 (cis2 (upcase s2)))
334 (string< cis1 cis2)))))
335
336(defcustom todos-files-function 'todos-files
337 "Function returning the value of the variable `todos-files'.
338If this function is called with an optional non-nil argument,
339then it returns the value of the variable `todos-archives'."
340 :type 'function
316 :group 'todos) 341 :group 'todos)
317 342
318(defcustom todos-archive-file (convert-standard-filename "~/.emacs.d/.todos-archive") 343(defcustom todos-merged-files nil
319 "File of finished Todos categories." 344 "List of files for `todos-merged-top-priorities'."
320 :type 'file 345 :type `(set ,@(mapcar (lambda (x) (list 'const x))
346 (funcall todos-files-function)))
321 :group 'todos) 347 :group 'todos)
322 348
323(defcustom todos-mode-hook nil 349(defcustom todos-prompt-merged-files nil
324 "TODO mode hooks." 350 "Non-nil to prompt for merging files for `todos-top-priorities'."
325 :type 'hook 351 :type 'boolean
326 :group 'todos) 352 :group 'todos)
327 353
328(defcustom todos-edit-mode-hook nil 354(defcustom todos-auto-switch-todos-file nil ;FIXME: t by default?
329 "TODO Edit mode hooks." 355 "Non-nil to make a Todos file current upon changing to it."
330 :type 'hook 356 :type 'boolean
357 :initialize 'custom-initialize-default
358 :set 'todos-toggle-switch-todos-file-noninteractively
359 :group 'todos)
360
361(defcustom todos-default-todos-file (car (funcall todos-files-function))
362 "Todos file visited by first session invocation of `todos-show'.
363Normally this should be set by invoking `todos-change-default-file'
364either directly or as a side effect of `todos-add-file'."
365 :type `(radio ,@(mapcar (lambda (x) (list 'const x))
366 (funcall todos-files-function)))
331 :group 'todos) 367 :group 'todos)
332 368
333(defcustom todos-categories-buffer "*TODOS Categories*" 369;; FIXME: make a defvar instead of a defcustom, and one for each member of todos-file
370(defcustom todos-file-top "~/todos.todt" ;FIXME
371 "TODO mode top priorities file."
372 :type 'file
373 :group 'todos)
374
375(defcustom todos-categories-buffer "*Todos Categories*"
334 "Name of buffer displayed by `todos-display-categories'." 376 "Name of buffer displayed by `todos-display-categories'."
335 :type 'string 377 :type 'string
336 :group 'todos) 378 :group 'todos)
337 379
338(defcustom todos-archived-categories-buffer "*TODOS Archived Categories*" 380(defcustom todos-categories-category-label "Category"
339 "Name of buffer displayed by `todos-display-categories'." 381 "Category button label in `todos-categories-buffer'."
340 :type 'string 382 :type 'string
341 :group 'todos) 383 :group 'todos)
342 384
343(defcustom todos-edit-buffer " *TODO Edit*" 385(defcustom todos-categories-todo-label "Todo"
344 "TODO Edit buffer name." 386 "Todo button label in `todos-categories-buffer'."
345 :type 'string 387 :type 'string
346 :group 'todos) 388 :group 'todos)
347 389
348(defcustom todos-file-top (convert-standard-filename "~/.todos-top") 390(defcustom todos-categories-diary-label "Diary"
349 "TODO mode top priorities file. 391 "Diary button label in `todos-categories-buffer'."
392 :type 'string
393 :group 'todos)
350 394
351Not in TODO format, but diary compatible. 395(defcustom todos-categories-done-label "Done"
352Automatically generated when `todos-save-top-priorities' is non-nil." 396 "Done button label in `todos-categories-buffer'."
353 :type 'string 397 :type 'string
354 :group 'todos) 398 :group 'todos)
355 399
356(defcustom todos-include-in-diary nil 400(defcustom todos-categories-archived-label "Archived"
357 "Non-nil to allow new Todo items to be included in the diary." 401 "Archived button label in `todos-categories-buffer'."
402 :type 'string
403 :group 'todos)
404
405(defcustom todos-categories-number-separator " | "
406 "String between number and category in `todos-categories-mode'.
407This separates the number from the category name in the default
408categories display according to priority."
409 :type 'string
410 :group 'todos)
411
412(defcustom todos-categories-align 'center
413 ""
414 :type '(radio (const left) (const center) (const right))
415 :group 'todos)
416
417;; FIXME: set for each Todos file?
418(defcustom todos-ignore-archived-categories nil
419 "Non-nil to ignore categories with only archived items.
420When non-nil such categories are omitted from `todos-categories'
421and hence from commands that use this variable. An exception is
422\\[todos-display-categories], which displays all categories; but
423those with only archived items are shown in `todos-archived-only'
424face and clicking them in Todos Categories mode visits the
425archived categories."
358 :type 'boolean 426 :type 'boolean
427 :initialize 'custom-initialize-default
428 :set 'todos-reset-categories
359 :group 'todos) 429 :group 'todos)
360 430
361(defcustom todos-exclusion-start "[" 431(defcustom todos-archived-categories-buffer "*Todos Archived Categories*"
362 "String prepended to item date to block diary inclusion." 432 "Name of buffer displayed by `todos-display-categories'."
363 :type 'string 433 :type 'string
364 :group 'todos 434 :group 'todos)
365 ;; :initialize 'custom-initialize-default
366 ;; :set ; change in whole Todos file
367 )
368 435
369(defcustom todos-exclusion-end "]" 436(defcustom todos-edit-buffer "*Todos Edit*"
370 "String appended to item date to match `todos-exclusion-start'." 437 "TODO Edit buffer name."
371 :type 'string 438 :type 'string
439 :group 'todos)
440
441(defcustom todos-include-in-diary nil
442 "Non-nil to allow new Todo items to be included in the diary."
443 :type 'boolean
444 :group 'todos)
445
446(defcustom todos-nondiary-marker '("[" "]")
447 "List of strings surrounding item date to block diary inclusion.
448The first string is inserted before the item date and must be a
449non-empty string that does not match a diary date in order to
450have its intended effect. The second string is inserted after
451the diary date."
452 :type '(list string string)
372 :group 'todos 453 :group 'todos
373 ;; :initialize 'custom-initialize-default 454 :initialize 'custom-initialize-default
374 ;; :set ; change in whole Todos file 455 :set 'todos-reset-nondiary-marker)
375 )
376 456
377(defcustom todos-print-function 'ps-print-buffer-with-faces 457(defcustom todos-print-function 'ps-print-buffer-with-faces
378 "Function to print the current buffer." 458 "Function to print the current buffer."
@@ -401,8 +481,12 @@ Automatically generated when `todos-save-top-priorities' is non-nil."
401 :type 'boolean 481 :type 'boolean
402 :group 'todos) 482 :group 'todos)
403 483
404(defcustom todos-always-add-time-string t 484(defcustom todos-always-add-time-string nil
405 "Add current time to date string inserted in front of new items." 485 "Non-nil adds current time to a new item's date header by default.
486When the Todos insertion commands have a non-nil \"maybe-notime\"
487argument, this reverses the effect of
488`todos-always-add-time-string': if t, these commands omit the
489current time, if nil, they include it."
406 :type 'boolean 490 :type 'boolean
407 :group 'todos) 491 :group 'todos)
408 492
@@ -424,26 +508,52 @@ Automatically generated when `todos-save-top-priorities' is non-nil."
424;; --------------------------------------------------------------------------- 508;; ---------------------------------------------------------------------------
425;;; Faces 509;;; Faces
426 510
511(defgroup todos-faces nil
512 "Faces for the Todos modes."
513 :version "24.1"
514 :group 'todos)
515
427(defface todos-prefix-string 516(defface todos-prefix-string
428 '((t 517 '((t
429 :inherit font-lock-constant-face 518 :inherit font-lock-constant-face
430 )) 519 ))
431 "Face for Todos prefix string." 520 "Face for Todos prefix string."
432 :group 'todos) 521 :group 'todos-faces)
433 522
434(defface todos-button 523(defface todos-button
435 '((t 524 '((t
436 :inherit tool-bar 525 :inherit widget-field
437 )) 526 ))
438 "Face for buttons in todos-display-categories." 527 "Face for buttons in todos-display-categories."
439 :group 'todos) 528 :group 'todos-faces)
529
530(defface todos-sorted-column
531 '((t
532 :inherit fringe
533 ))
534 "Face for buttons in todos-display-categories."
535 :group 'todos-faces)
536
537(defface todos-archived-only
538 '((t
539 (:inherit (shadow))
540 ))
541 "Face for archived-only categories in todos-display-categories."
542 :group 'todos-faces)
543
544(defface todos-search
545 '((t
546 :inherit match
547 ))
548 "Face for matches found by todos-search."
549 :group 'todos-faces)
440 550
441(defface todos-date 551(defface todos-date
442 '((t 552 '((t
443 :inherit diary 553 :inherit diary
444 )) 554 ))
445 "Face for Todos prefix string." 555 "Face for Todos prefix string."
446 :group 'todos) 556 :group 'todos-faces)
447(defvar todos-date-face 'todos-date) 557(defvar todos-date-face 'todos-date)
448 558
449(defface todos-time 559(defface todos-time
@@ -451,7 +561,7 @@ Automatically generated when `todos-save-top-priorities' is non-nil."
451 :inherit diary-time 561 :inherit diary-time
452 )) 562 ))
453 "Face for Todos prefix string." 563 "Face for Todos prefix string."
454 :group 'todos) 564 :group 'todos-faces)
455(defvar todos-time-face 'todos-time) 565(defvar todos-time-face 'todos-time)
456 566
457(defface todos-done 567(defface todos-done
@@ -459,7 +569,7 @@ Automatically generated when `todos-save-top-priorities' is non-nil."
459 :inherit font-lock-comment-face 569 :inherit font-lock-comment-face
460 )) 570 ))
461 "Face for done Todos item header string." 571 "Face for done Todos item header string."
462 :group 'todos) 572 :group 'todos-faces)
463(defvar todos-done-face 'todos-done) 573(defvar todos-done-face 'todos-done)
464 574
465(defface todos-done-sep 575(defface todos-done-sep
@@ -467,7 +577,7 @@ Automatically generated when `todos-save-top-priorities' is non-nil."
467 :inherit font-lock-type-face 577 :inherit font-lock-type-face
468 )) 578 ))
469 "Face for separator string bewteen done and not done Todos items." 579 "Face for separator string bewteen done and not done Todos items."
470 :group 'todos) 580 :group 'todos-faces)
471(defvar todos-done-sep-face 'todos-done-sep) 581(defvar todos-done-sep-face 'todos-done-sep)
472 582
473(defvar todos-font-lock-keywords 583(defvar todos-font-lock-keywords
@@ -475,63 +585,117 @@ Automatically generated when `todos-save-top-priorities' is non-nil."
475 '(todos-date-string-match 1 todos-date-face t) 585 '(todos-date-string-match 1 todos-date-face t)
476 '(todos-time-string-match 1 todos-time-face t) 586 '(todos-time-string-match 1 todos-time-face t)
477 '(todos-done-string-match 0 todos-done-face t) 587 '(todos-done-string-match 0 todos-done-face t)
478 '(todos-category-string-match 0 todos-done-sep-face t)) 588 '(todos-category-string-match 1 todos-done-sep-face t))
479 "Font-locking for Todos mode.") 589 "Font-locking for Todos mode.")
480 590
481;; --------------------------------------------------------------------------- 591;; ---------------------------------------------------------------------------
482;;; Mode setup 592;;; Modes setup
483 593
484(defvar todos-current-todos-file nil 594(defvar todos-files (funcall todos-files-function)
485 "") 595 "List of user's Todos files.")
596
597(defvar todos-archives (funcall todos-files-function t)
598 "List of user's Todos archives.")
486 599
487(defvar todos-categories nil 600(defvar todos-categories nil
488 "TODO categories.") 601 "List of categories in the current Todos file.
602The elements are lists whose car is a category name and whose cdr
603is the category's property list.")
604
605(defvar todos-insertion-map
606 (let ((map (make-keymap)))
607 (define-key map "i" 'todos-insert-item)
608 (define-key map "h" 'todos-insert-item-here)
609 (define-key map "dd" 'todos-insert-item-ask-date)
610 (define-key map "dtt" 'todos-insert-item-ask-date-time)
611 (define-key map "dtyy" 'todos-insert-item-ask-date-time-for-diary)
612 (define-key map "dtyh" 'todos-insert-item-ask-date-time-for-diary-here)
613 (define-key map "dth" 'todos-insert-item-ask-date-time-here)
614 (define-key map "dmm" 'todos-insert-item-ask-date-maybe-notime)
615 (define-key map "dmyy" 'todos-insert-item-ask-date-maybe-notime-for-diary)
616 (define-key map "dmyh" 'todos-insert-item-ask-date-maybe-notime-for-diary-here)
617 (define-key map "dmh" 'todos-insert-item-ask-date-maybe-notime-here)
618 (define-key map "dyy" 'todos-insert-item-ask-date-for-diary)
619 (define-key map "dyh" 'todos-insert-item-ask-date-for-diary-here)
620 (define-key map "dh" 'todos-insert-item-ask-date-here)
621 (define-key map "nn" 'todos-insert-item-ask-dayname)
622 (define-key map "ntt" 'todos-insert-item-ask-dayname-time)
623 (define-key map "ntyy" 'todos-insert-item-ask-dayname-time-for-diary)
624 (define-key map "ntyh" 'todos-insert-item-ask-dayname-time-for-diary-here)
625 (define-key map "nth" 'todos-insert-item-ask-dayname-time-here)
626 (define-key map "nmm" 'todos-insert-item-ask-dayname-maybe-notime)
627 (define-key map "nmyy" 'todos-insert-item-ask-dayname-maybe-notime-for-diary)
628 (define-key map "nmyh" 'todos-insert-item-ask-dayname-maybe-notime-for-diary-here)
629 (define-key map "nmh" 'todos-insert-item-ask-dayname-maybe-notime-here)
630 (define-key map "nyy" 'todos-insert-item-ask-dayname-for-diary)
631 (define-key map "nyh" 'todos-insert-item-ask-dayname-for-diary-here)
632 (define-key map "nh" 'todos-insert-item-ask-dayname-here)
633 (define-key map "tt" 'todos-insert-item-ask-time)
634 (define-key map "tyy" 'todos-insert-item-ask-time-for-diary)
635 (define-key map "tyh" 'todos-insert-item-ask-time-for-diary-here)
636 (define-key map "th" 'todos-insert-item-ask-time-here)
637 (define-key map "mm" 'todos-insert-item-maybe-notime)
638 (define-key map "myy" 'todos-insert-item-maybe-notime-for-diary)
639 (define-key map "myh" 'todos-insert-item-maybe-notime-for-diary-here)
640 (define-key map "mh" 'todos-insert-item-maybe-notime-here)
641 (define-key map "yy" 'todos-insert-item-for-diary)
642 (define-key map "yh" 'todos-insert-item-for-diary-here)
643 map)
644 "Keymap for Todos mode insertion commands.")
489 645
490(defvar todos-mode-map 646(defvar todos-mode-map
491 (let ((map (make-keymap))) 647 (let ((map (make-keymap)))
492 (suppress-keymap map t) 648 (suppress-keymap map t)
493 ;; navigation commands 649 ;; navigation commands
494 (define-key map "+" 'todos-forward-category) 650 (define-key map "f" 'todos-forward-category)
495 (define-key map "-" 'todos-backward-category) 651 (define-key map "b" 'todos-backward-category)
496 (define-key map "j" 'todos-jump-to-category) 652 (define-key map "j" 'todos-jump-to-category)
653 (define-key map "J" 'todos-jump-to-category-other-file)
497 (define-key map "n" 'todos-forward-item) 654 (define-key map "n" 'todos-forward-item)
498 (define-key map "p" 'todos-backward-item) 655 (define-key map "p" 'todos-backward-item)
499 (define-key map "S" 'todos-search) 656 (define-key map "S" 'todos-search)
657 (define-key map "X" 'todos-clear-matches)
500 ;; display commands 658 ;; display commands
501 (define-key map "C" 'todos-display-categories) 659 (define-key map "Cd" 'todos-display-categories) ;FIXME: Cs todos-show-categories?
502 ;; (define-key map "" 'todos-display-categories-alphabetically) 660 ;; (define-key map "" 'todos-display-categories-alphabetically)
503 (define-key map "h" 'todos-highlight-item) 661 (define-key map "H" 'todos-highlight-item)
504 (define-key map "N" 'todos-toggle-item-numbering) 662 (define-key map "N" 'todos-toggle-item-numbering)
505 ;; (define-key map "" 'todos-toggle-display-date-time) 663 ;; (define-key map "" 'todos-toggle-display-date-time)
506 (define-key map "P" 'todos-print) 664 (define-key map "P" 'todos-print)
507 (define-key map "q" 'todos-quit)
508 (define-key map "s" 'todos-save)
509 (define-key map "V" 'todos-view-archive)
510 (define-key map "v" 'todos-toggle-view-done-items) 665 (define-key map "v" 'todos-toggle-view-done-items)
666 (define-key map "V" 'todos-toggle-show-done-only)
667 (define-key map "Av" 'todos-view-archived-items)
668 (define-key map "As" 'todos-switch-to-archive)
669 (define-key map "Ac" 'todos-choose-archive)
511 (define-key map "Y" 'todos-diary-items) 670 (define-key map "Y" 'todos-diary-items)
512 ;; (define-key map "S" 'todos-save-top-priorities)
513 (define-key map "t" 'todos-top-priorities) 671 (define-key map "t" 'todos-top-priorities)
672 (define-key map "T" 'todos-merged-top-priorities)
673 ;; (define-key map "" 'todos-save-top-priorities)
514 ;; editing commands 674 ;; editing commands
515 (define-key map "A" 'todos-add-category) 675 (define-key map "Fa" 'todos-add-file)
676 (define-key map "Ca" 'todos-add-category)
677 (define-key map "Cr" 'todos-rename-category)
678 (define-key map "Cm" 'todos-move-category)
679 (define-key map "Ck" 'todos-delete-category)
516 (define-key map "d" 'todos-item-done) 680 (define-key map "d" 'todos-item-done)
517 ;; (define-key map "" 'todos-archive-done-items) 681 (define-key map "ee" 'todos-edit-item)
518 (define-key map "D" 'todos-delete-category) 682 (define-key map "em" 'todos-edit-multiline)
519 (define-key map "e" 'todos-edit-item) 683 (define-key map "eh" 'todos-edit-item-header)
520 (define-key map "E" 'todos-edit-multiline) 684 (define-key map "ed" 'todos-edit-item-date)
521 ;; (define-key map "" 'todos-change-date) 685 (define-key map "et" 'todos-edit-item-time)
522 (define-key map "ii" 'todos-insert-item) 686 (define-key map "i" todos-insertion-map)
523 (define-key map "ih" 'todos-insert-item-here)
524 (define-key map "ia" 'todos-insert-item-ask-date-time)
525 (define-key map "id" 'todos-insert-item-for-diary)
526 ;; (define-key map "in" 'todos-insert-item-no-time)
527 (define-key map "k" 'todos-delete-item) 687 (define-key map "k" 'todos-delete-item)
528 (define-key map "l" 'todos-lower-item)
529 (define-key map "m" 'todos-move-item) 688 (define-key map "m" 'todos-move-item)
530 (define-key map "r" 'todos-raise-item) 689 (define-key map "M" 'todos-move-item-to-file)
531 (define-key map "R" 'todos-rename-category) 690 (define-key map "-" 'todos-raise-item-priority)
691 (define-key map "+" 'todos-lower-item-priority)
692 (define-key map "#" 'todos-set-item-priority)
532 (define-key map "u" 'todos-item-undo) 693 (define-key map "u" 'todos-item-undo)
694 (define-key map "Ad" 'todos-archive-done-items)
533 (define-key map "y" 'todos-toggle-item-diary-inclusion) 695 (define-key map "y" 'todos-toggle-item-diary-inclusion)
534 ;; (define-key map "" 'todos-toggle-diary-inclusion) 696 ;; (define-key map "" 'todos-toggle-diary-inclusion)
697 (define-key map "s" 'todos-save)
698 (define-key map "q" 'todos-quit)
535 (define-key map [remap newline] 'newline-and-indent) 699 (define-key map [remap newline] 'newline-and-indent)
536 map) 700 map)
537 "Todos mode keymap.") 701 "Todos mode keymap.")
@@ -540,26 +704,28 @@ Automatically generated when `todos-save-top-priorities' is non-nil."
540 (let ((map (make-sparse-keymap))) 704 (let ((map (make-sparse-keymap)))
541 (suppress-keymap map t) 705 (suppress-keymap map t)
542 ;; navigation commands 706 ;; navigation commands
543 (define-key map "+" 'todos-forward-category) 707 (define-key map "f" 'todos-forward-category)
544 (define-key map "-" 'todos-backward-category) 708 (define-key map "b" 'todos-backward-category)
545 (define-key map "j" 'todos-jump-to-category) 709 (define-key map "j" 'todos-jump-to-category)
546 (define-key map "n" 'todos-forward-item) 710 (define-key map "n" 'todos-forward-item)
547 (define-key map "p" 'todos-backward-item) 711 (define-key map "p" 'todos-backward-item)
548 ;; display commands 712 ;; display commands
549 (define-key map "C" 'todos-display-categories) 713 (define-key map "C" 'todos-display-categories)
550 (define-key map "h" 'todos-highlight-item) 714 (define-key map "H" 'todos-highlight-item)
551 (define-key map "N" 'todos-toggle-item-numbering) 715 (define-key map "N" 'todos-toggle-item-numbering)
552 ;; (define-key map "" 'todos-toggle-display-date-time) 716 ;; (define-key map "" 'todos-toggle-display-date-time)
553 (define-key map "P" 'todos-print) 717 (define-key map "P" 'todos-print)
554 (define-key map "q" 'todos-quit) 718 (define-key map "q" 'todos-quit)
555 (define-key map "s" 'todos-save) 719 (define-key map "s" 'todos-save)
556 (define-key map "S" 'todos-search) 720 (define-key map "S" 'todos-search)
721 (define-key map "t" 'todos-show) ;FIXME: should show same category
722 (define-key map "u" 'todos-unarchive-category)
557 map) 723 map)
558 "Todos Archive mode keymap.") 724 "Todos Archive mode keymap.")
559 725
560(defvar todos-edit-mode-map 726(defvar todos-edit-mode-map
561 (let ((map (make-sparse-keymap))) 727 (let ((map (make-sparse-keymap)))
562 (define-key map "\C-c\C-q" 'todos-edit-quit) 728 (define-key map "\C-x\C-q" 'todos-edit-quit)
563 (define-key map [remap newline] 'newline-and-indent) 729 (define-key map [remap newline] 'newline-and-indent)
564 map) 730 map)
565 "Todos Edit mode keymap.") 731 "Todos Edit mode keymap.")
@@ -569,146 +735,218 @@ Automatically generated when `todos-save-top-priorities' is non-nil."
569 (suppress-keymap map t) 735 (suppress-keymap map t)
570 (define-key map "a" 'todos-display-categories-alphabetically) 736 (define-key map "a" 'todos-display-categories-alphabetically)
571 (define-key map "c" 'todos-display-categories) 737 (define-key map "c" 'todos-display-categories)
572 (define-key map "l" 'todos-lower-category) 738 (define-key map "+" 'todos-lower-category)
573 (define-key map "r" 'todos-raise-category) 739 (define-key map "-" 'todos-raise-category)
574 (define-key map "q" 'bury-buffer) ;FIXME ? 740 (define-key map "n" 'forward-button)
741 (define-key map "p" 'backward-button)
742 (define-key map [tab] 'forward-button)
743 (define-key map [backtab] 'backward-button)
744 (define-key map "q" 'todos-quit)
575 ;; (define-key map "A" 'todos-add-category) 745 ;; (define-key map "A" 'todos-add-category)
576 ;; (define-key map "D" 'todos-delete-category) 746 ;; (define-key map "D" 'todos-delete-category)
577 ;; (define-key map "R" 'todos-rename-category) 747 ;; (define-key map "R" 'todos-rename-category)
578 map) 748 map)
579 "Todos Categories mode keymap.") 749 "Todos Categories mode keymap.")
580 750
581(defvar todos-category-number 0 "TODO category number.") 751(defvar todos-top-priorities-mode-map
752 (let ((map (make-keymap)))
753 (suppress-keymap map t)
754 ;; navigation commands
755 (define-key map "j" 'todos-jump-to-category)
756 (define-key map "n" 'todos-forward-item)
757 (define-key map "p" 'todos-backward-item)
758 ;; (define-key map "S" 'todos-search)
759 ;; display commands
760 (define-key map "C" 'todos-display-categories)
761 ;; (define-key map "" 'todos-display-categories-alphabetically)
762 (define-key map "H" 'todos-highlight-item)
763 (define-key map "N" 'todos-toggle-item-numbering)
764 ;; (define-key map "" 'todos-toggle-display-date-time)
765 (define-key map "P" 'todos-print)
766 (define-key map "q" 'todos-quit)
767 (define-key map "s" 'todos-save)
768 (define-key map "V" 'todos-view-archive)
769 (define-key map "v" 'todos-toggle-view-done-items)
770 (define-key map "Y" 'todos-diary-items)
771 ;; (define-key map "S" 'todos-save-top-priorities)
772 ;; editing commands
773 (define-key map "l" 'todos-lower-item-priority)
774 (define-key map "r" 'todos-raise-item-priority)
775 (define-key map "#" 'todos-set-item-priority)
776 map)
777 "Todos Top Priorities mode keymap.")
778
779(defvar todos-current-todos-file nil
780 "Variable holding the name of the currently active Todos file.
781Automatically set by `todos-switch-todos-file'.")
782
783(defvar todos-category-number 0
784 "Number.")
582 785
583(defvar todos-tmp-buffer-name " *todo tmp*") 786(defvar todos-tmp-buffer-name " *todo tmp*")
584 787
585(defvar todos-category-beg "--==-- " 788(defvar todos-category-beg "--==-- "
586 "Category start separator to be prepended onto category name.") 789 "String marking beginning of category (inserted with its name).")
587 790
588(easy-menu-define todos-menu todos-mode-map "Todo Menu" 791(defvar todos-category-done "==--== DONE "
589 '("Todo" 792 "String marking beginning of category's done items.")
590 ["Next category" todos-forward-category t] 793
591 ["Previous category" todos-backward-category t] 794(defvar todos-nondiary-start (nth 0 todos-nondiary-marker)
592 ["Jump to category" todos-jump-to-category t] 795 "String inserted before item date to block diary inclusion.")
593 ["Show top priority items" todos-top-priorities t] 796
594 ["Print categories" todos-print t] 797(defvar todos-nondiary-end (nth 1 todos-nondiary-marker)
595 "---" 798 "String inserted after item date matching todos-nondiary-start.")
596 ["Edit item" todos-edit-item t] 799
597 ["File item" todos-file-item t] 800(defvar todos-show-done-only nil
598 ["Insert new item" todos-insert-item t] 801 "If non-nil display only done items in current category.
599 ["Insert item here" todos-insert-item-here t] 802Set by `todos-toggle-show-done-only' and used by
600 ["Kill item" todos-delete-item t] 803`todos-category-select'.")
601 "---" 804
602 ["Lower item priority" todos-lower-item t] 805(easy-menu-define
603 ["Raise item priority" todos-raise-item t] 806 todos-menu todos-mode-map "Todos Menu"
604 "---" 807 '("Todos"
605 ["Next item" todos-forward-item t] 808 ("Navigation"
606 ["Previous item" todos-backward-item t] 809 ["Next Item" todos-forward-item t]
607 "---" 810 ["Previous Item" todos-backward-item t]
608 ["Save" todos-save t] 811 "---"
609 ["Save Top Priorities" todos-save-top-priorities t] 812 ["Next Category" todos-forward-category t]
610 "---" 813 ["Previous Category" todos-backward-category t]
611 ["Quit" todos-quit t] 814 ["Jump to Category" todos-jump-to-category t]
612 )) 815 ["Jump to Category in Other File" todos-jump-to-category-other-file t]
613 816 "---"
614;; As calendar reads .todos-do before todos-mode is loaded. 817 ["Search Todos File" todos-search t]
615;;;###autoload 818 ["Clear Highlighting on Search Matches" todos-category-done t])
616(defun todos-mode () 819 ("Display"
617 "Major mode for displaying, navigating and editing Todo lists. 820 ["List Current Categories" todos-display-categories t]
821 ["List Categories Alphabetically" todos-display-categories-alphabetically t]
822 ["Turn Item Highlighting on/off" todos-highlight-item t]
823 ["Turn Item Numbering on/off" todos-toggle-item-numbering t]
824 ["Turn Item Time Stamp on/off" todos-toggle-display-date-time t]
825 ["View/Hide Done Items" todos-toggle-view-done-items t]
826 "---"
827 ["View Diary Items" todos-diary-items t]
828 ["View Top Priority Items" todos-top-priorities t]
829 ["View Merged Top Priority Items" todos-merged-top-priorities t]
830 "---"
831 ["View Archive" todos-view-archive t]
832 ["Print Category" todos-print-category t])
833 ("Editing"
834 ["Insert New Item" todos-insert-item t]
835 ["Insert Item Here" todos-insert-item-here t]
836 ("More Insertion Commands")
837 ["Edit Item" todos-edit-item t]
838 ["Edit Multiline Item" todos-edit-multiline t]
839 ["Edit Item Header" todos-edit-item-header t]
840 ["Edit Item Date" todos-edit-item-date t]
841 ["Edit Item Time" todos-edit-item-time t]
842 "---"
843 ["Lower Item Priority" todos-lower-item-priority t]
844 ["Raise Item Priority" todos-raise-item-priority t]
845 ["Set Item Priority" todos-set-item-priority t]
846 ["Move (Recategorize) Item" todos-move-item t]
847 ["Delete Item" todos-delete-item t]
848 ["Undo Done Item" todos-item-undo t]
849 ["Mark/Unmark Item for Diary" todos-toggle-item-diary-inclusion t]
850 ["Mark/Unmark Items for Diary" todos-toggle-diary-inclusion t]
851 ["Mark & Hide Done Item" todos-item-done t]
852 ["Archive Done Items" todos-archive-done-items t]
853 "---"
854 ["Add New Todos File" todos-add-file t]
855 ["Add New Category" todos-add-category t]
856 ["Delete Current Category" todos-delete-category t]
857 ["Rename Current Category" todos-rename-category t]
858 "---"
859 ["Save Todos File" todos-save t]
860 ["Save Top Priorities" todos-save-top-priorities t])
861 "---"
862 ["Quit" todos-quit t]
863 ))
618 864
619\\{todos-mode-map}" 865;; FIXME: remove when part of Emacs
620 (interactive) 866(add-to-list 'auto-mode-alist '("\\.todo\\'" . todos-mode))
621 (kill-all-local-variables) 867(add-to-list 'auto-mode-alist '("\\.toda\\'" . todos-archive-mode))
622 (setq major-mode 'todos-mode) 868
623 (setq mode-name "TODOS") 869(defun todos-modes-set-1 ()
624 (use-local-map todos-mode-map) 870 ""
625 (easy-menu-add todos-menu) 871 (set (make-local-variable 'font-lock-defaults) '(todos-font-lock-keywords t))
872 (set (make-local-variable 'indent-line-function) 'todos-indent)
626 (when todos-wrap-lines (funcall todos-line-wrapping-function)) 873 (when todos-wrap-lines (funcall todos-line-wrapping-function))
627 (make-local-variable 'indent-line-function) 874)
628 (setq indent-line-function 'todos-indent) 875
629 (make-local-variable 'font-lock-defaults) 876(defun todos-modes-set-2 ()
630 (setq font-lock-defaults '(todos-font-lock-keywords t)) 877 ""
631 (make-local-variable 'hl-line-range-function)
632 (setq hl-line-range-function
633 (lambda() (when (todos-item-end)
634 (cons (todos-item-start) (todos-item-end)))))
635 ;; (add-hook 'post-command-hook 'todos-show-paren-hack nil t)
636 (add-to-invisibility-spec 'todos) 878 (add-to-invisibility-spec 'todos)
637 (setq buffer-read-only t) 879 (setq buffer-read-only t)
638 (run-mode-hooks 'todos-mode-hook)) 880 (set (make-local-variable 'hl-line-range-function)
881 (lambda() (when (todos-item-end)
882 (cons (todos-item-start) (todos-item-end)))))
883)
884
885;; ;; As calendar reads included Todos file before todos-mode is loaded.
886;; ;;;###autoload
887(define-derived-mode todos-mode nil "Todos" ()
888 "Major mode for displaying, navigating and editing Todo lists.
639 889
640(defun todos-archive-mode () 890\\{todos-mode-map}"
891 (easy-menu-add todos-menu)
892 (todos-modes-set-1)
893 (todos-modes-set-2)
894 (set (make-local-variable 'todos-show-done-only) nil)
895 (when todos-auto-switch-todos-file
896 (add-hook 'post-command-hook
897 'todos-switch-todos-file nil t)))
898
899(define-derived-mode todos-archive-mode nil "Todos-Arch" ()
641 "Major mode for archived Todos categories. 900 "Major mode for archived Todos categories.
642 901
643\\{todos-archive-mode-map}" 902\\{todos-archive-mode-map}"
644 (interactive) 903 (todos-modes-set-1)
645 (kill-all-local-variables) 904 (todos-modes-set-2)
646 (setq major-mode 'todos-archive-mode) 905 (set (make-local-variable 'todos-show-done-only) t)
647 (setq mode-name "TODOS Archive") 906 (when todos-auto-switch-todos-file
648 (use-local-map todos-archive-mode-map) 907 (add-hook 'post-command-hook
649 ;; (easy-menu-add todos-menu) 908 'todos-switch-todos-file nil t)))
650 (when todos-wrap-lines (funcall todos-line-wrapping-function)) 909
651 (make-local-variable 'font-lock-defaults) 910(define-derived-mode todos-edit-mode nil "Todos-Ed" ()
652 (setq font-lock-defaults '(todos-font-lock-keywords t))
653 (make-local-variable 'hl-line-range-function)
654 (setq hl-line-range-function
655 (lambda() (when (todos-item-end)
656 (cons (todos-item-start) (todos-item-end)))))
657 ;; (add-hook 'post-command-hook 'todos-show-paren-hack nil t)
658 (add-to-invisibility-spec 'todos)
659 (run-mode-hooks 'todos-mode-hook))
660
661(defun todos-edit-mode ()
662 "Major mode for editing multiline Todo items. 911 "Major mode for editing multiline Todo items.
663 912
664\\{todos-edit-mode-map}" 913\\{todos-edit-mode-map}"
665 (interactive) 914 (todos-modes-set-1))
666 (setq major-mode 'todos-edit-mode)
667 (setq mode-name "TODOS Edit")
668 (use-local-map todos-edit-mode-map)
669 (make-local-variable 'font-lock-defaults)
670 (setq font-lock-defaults '(todos-font-lock-keywords t))
671 (make-local-variable 'indent-line-function)
672 (setq indent-line-function 'todos-indent)
673 (when todos-wrap-lines (funcall todos-line-wrapping-function)))
674 915
675(defun todos-categories-mode () 916(define-derived-mode todos-categories-mode nil "Todos-Cats" ()
676 "Major mode for displaying and editing Todos categories. 917 "Major mode for displaying and editing Todos categories.
677 918
678\\{todos-categories-mode-map}" 919\\{todos-categories-mode-map}"
679 (interactive)
680 (setq major-mode 'todos-categories-mode)
681 (setq mode-name "TODOS Categories")
682 (use-local-map todos-categories-mode-map)
683 (make-local-variable 'font-lock-defaults) 920 (make-local-variable 'font-lock-defaults)
684 (setq font-lock-defaults '(todos-font-lock-keywords t)) 921 (setq font-lock-defaults '(todos-font-lock-keywords t))
685 (setq buffer-read-only t) 922 (setq buffer-read-only t))
686) 923
924(define-derived-mode todos-top-priorities-mode nil "Todos-Top" ()
925 "Mode for displaying and reprioritizing top priority Todos.
926
927\\{todos-top-priorites-mode-map}"
928 (todos-modes-set-1)
929 (todos-modes-set-2))
687 930
688(defun todos-save () 931(defun todos-save ()
689 "Save the TODO list." 932 "Save the TODO list."
690 (interactive) 933 (interactive)
691 (let (buffer-read-only) 934 ;; (todos-update-categories-sexp)
692 (save-excursion 935 (save-buffer)
693 (save-restriction 936 ;; (if todos-save-top-priorities-too (todos-save-top-priorities))
694 ;; (widen) 937 )
695 ;; (goto-char (point-min))
696 ;; (unless (looking-at (concat "^" (regexp-quote todos-category-beg)))
697 ;; (kill-line))
698 ;; (prin1 todos-categories (current-buffer))
699 (save-buffer)))
700 ;; (if todos-save-top-priorities-too (todos-save-top-priorities)))
701 ))
702 938
703(defun todos-quit () 939(defun todos-quit ()
704 "Done with TODO list for now." 940 "Done with TODO list for now."
705 (interactive) 941 (interactive)
706 (widen) 942 (cond ((eq major-mode 'todos-categories-mode)
707 (todos-save) 943 (kill-buffer)
708 ;; (message "") 944 (setq todos-descending-counts-store nil)
709 (if (eq major-mode 'todos-archive-mode) 945 (setq todos-categories nil)
710 (todos-show) 946 (todos-show))
711 (bury-buffer))) 947 ((member major-mode (list 'todos-mode 'todos-archive-mode))
948 (todos-save)
949 (bury-buffer))))
712 950
713;; --------------------------------------------------------------------------- 951;; ---------------------------------------------------------------------------
714;;; Commands 952;;; Commands
@@ -716,72 +954,133 @@ Automatically generated when `todos-save-top-priorities' is non-nil."
716;;; Display 954;;; Display
717 955
718;;;###autoload 956;;;###autoload
719(defun todos-show () 957(defun todos-show (&optional solicit-file)
720 "Show TODO list." 958 "Visit the current Todos file and display one of its categories.
721 (interactive) 959
722 ;; Make this a no-op if called interactively in narrowed Todos mode, since 960With non-nil prefix argument SOLICIT-FILE ask for file to visit,
723 ;; it is in that case redundant, but in particular to work around the bug of 961otherwise the first invocation of this command in a session
724 ;; item prefix reduplication with show-paren-mode enabled. 962visits `todos-default-todos-file' (creating it if it does not yet
725 (unless (and (called-interactively-p) 963exist). Subsequent invocations from outside of Todos mode
726 (eq major-mode 'todos-mode) 964revisit this file or whichever Todos file has been made
727 (< (- ( point-max) (point-min)) (buffer-size))) 965current (e.g. by calling `todos-switch-todos-file').
728 ;; Call todos-initial-setup only if there is neither a Todo file nor 966
729 ;; a corresponding unsaved buffer. 967The category displayed is initially the first member of
730 (if (or (file-exists-p todos-file-do) 968`todos-categories' for the current Todos file, subsequently
731 (let* ((buf (get-buffer (file-name-nondirectory todos-file-do))) 969whichever category is current. If
732 (bufname (buffer-file-name buf))) 970`todos-display-categories-first' is non-nil, then the first
733 (equal (expand-file-name todos-file-do) bufname))) 971invocation of `todos-show' displays a clickable listing of the
734 (find-file todos-file-do) 972categories in the current Todos file."
735 (todos-initial-setup)) 973 (interactive "P")
736 (unless (eq major-mode 'todos-mode) (todos-mode)) 974 ;; ;; Make this a no-op if called interactively in narrowed Todos mode, since
737 (unless (string= todos-current-todos-file todos-file-do) 975 ;; ;; it is redundant in that case, but in particular to work around the bug of
738 (setq todos-current-todos-file todos-file-do) 976 ;; ;; item prefix reduplication with show-paren-mode enabled.
739 (setq todos-category-number 0) 977 ;; (unless (and (called-interactively-p)
740 (setq todos-categories nil)) 978 ;; (or (eq major-mode 'todos-mode) (eq major-mode 'todos-archive-mode))
741 (unless todos-categories 979 ;; (< (- ( point-max) (point-min)) (buffer-size)))
742 (setq todos-categories (todos-make-categories-list))) 980 (when (and (called-interactively-p)
743 (save-excursion 981 (or solicit-file
744 (todos-category-select)))) 982 (member todos-current-todos-file todos-archives)))
745 983 (setq todos-current-todos-file nil
746(defun todos-display-categories (&optional alpha) 984 todos-categories nil
747 "Display a numbered list of the Todos category names. 985 todos-category-number 0))
748The numbers give the order of the categories. 986 (let ((first-visit (or (not todos-current-todos-file) ;first call
749 987 ;; after switching to a not yet visited Todos file
750With non-nil ALPHA display a non-numbered alphabetical list. 988 (not (buffer-live-p
989 (get-file-buffer todos-current-todos-file))))))
990 (if solicit-file
991 (setq todos-current-todos-file
992 (todos-read-file-name "Select a Todos file to visit: "))
993 (or todos-current-todos-file
994 (setq todos-current-todos-file (or todos-default-todos-file
995 (todos-add-file)))))
996 (if (and first-visit todos-display-categories-first)
997 (todos-display-categories)
998 (find-file todos-current-todos-file)
999 ;; (or (eq major-mode 'todos-mode) (todos-mode))
1000 ;; initialize new Todos file
1001 (if (zerop (buffer-size))
1002 (setq todos-category-number (todos-add-category))
1003 ;; FIXME: let user choose category?
1004 (if (zerop todos-category-number) (setq todos-category-number 1)))
1005 (or todos-categories
1006 (setq todos-categories (if todos-ignore-archived-categories
1007 (todos-truncate-categories-list)
1008 (todos-make-categories-list))))
1009 (save-excursion (todos-category-select)))));)
1010
1011;; FIXME: make core of this internal?
1012(defun todos-display-categories (&optional sortkey)
1013 "Display the category names of the current Todos file.
1014The numbers indicate the current order of the categories.
1015
1016With non-nil SORTKEY display a non-numbered alphabetical list.
751The lists are in Todos Categories mode. 1017The lists are in Todos Categories mode.
752 1018
753The category names are buttonized, and pressing a button displays 1019The category names are buttonized, and pressing a button displays
754the category in Todos mode." 1020the category in Todos mode."
755 (interactive) 1021 (interactive)
756 (let ((categories (copy-sequence todos-categories)) 1022 (let* ((cats0 (if (and todos-ignore-archived-categories
757 (num 0)) 1023 (not (eq major-mode 'todos-categories-mode)))
758 (when alpha ;alphabetize the list case insensitively 1024 (todos-make-categories-list t)
759 (setq categories (sort categories (lambda (s1 s2) (let ((cis1 (upcase s1)) 1025 todos-categories))
760 (cis2 (upcase s2))) 1026 (cats (todos-sort cats0 sortkey))
761 (string< cis1 cis2)))))) 1027 ;; used by todos-insert-category-line
1028 (num 0))
762 (with-current-buffer (get-buffer-create todos-categories-buffer) 1029 (with-current-buffer (get-buffer-create todos-categories-buffer)
763 (switch-to-buffer (current-buffer)) 1030 (switch-to-buffer (current-buffer))
764 (let (buffer-read-only) 1031 (let (buffer-read-only)
765 (erase-buffer) 1032 (erase-buffer)
766 (kill-all-local-variables) 1033 (kill-all-local-variables)
767 (insert "Press a button to display the corresponding category.\n\n") 1034 (insert (format "Category counts for Todos file \"%s\"."
768 ;; FIXME: abstract format from here and todos-insert-category-name 1035 (file-name-sans-extension
769 (insert (make-string 4 32) (todos-padded-string "Category") 1036 (file-name-nondirectory todos-current-todos-file))))
770 (if (string= todos-current-todos-file todos-archive-file) 1037 (newline 2)
771 (concat (make-string 6 32) 1038 ;; FIXME: abstract format from here and todos-insert-category-line
772 (format "%s" "Archived")) 1039 (insert (make-string (+ 3 (length todos-categories-number-separator)) 32))
773 (concat (make-string 7 32)
774 (format "%-7s%-7s%s" "Todo" "Done" "Archived")))
775 "\n\n")
776 (save-excursion 1040 (save-excursion
777 (mapc '(lambda (cat) (todos-insert-category-name cat alpha)) categories))) 1041 (todos-insert-sort-button todos-categories-category-label)
778 (goto-char (next-single-char-property-change (point) 'button)) 1042 (if (member todos-current-todos-file todos-archives)
1043 (insert (concat (make-string 6 32)
1044 (format "%s" todos-categories-archived-label)))
1045 (insert (make-string 3 32))
1046 (todos-insert-sort-button todos-categories-todo-label)
1047 (insert (make-string 2 32))
1048 (todos-insert-sort-button todos-categories-diary-label)
1049 (insert (make-string 2 32))
1050 (todos-insert-sort-button todos-categories-done-label)
1051 (insert (make-string 2 32))
1052 (todos-insert-sort-button todos-categories-archived-label))
1053 (newline 2)
1054 (mapc (lambda (cat) (todos-insert-category-line cat sortkey))
1055 (mapcar 'car cats))))
779 (todos-categories-mode)))) 1056 (todos-categories-mode))))
780 1057
1058;; FIXME: make this toggle with todos-display-categories
781(defun todos-display-categories-alphabetically () 1059(defun todos-display-categories-alphabetically ()
782 "" 1060 ""
783 (interactive) 1061 (interactive)
784 (todos-display-categories t)) 1062 (todos-display-sorted 'alpha))
1063
1064;; FIXME: provide key bindings for these or delete them
1065(defun todos-display-categories-sorted-by-todo ()
1066 ""
1067 (interactive)
1068 (todos-display-sorted 'todo))
1069
1070(defun todos-display-categories-sorted-by-diary ()
1071 ""
1072 (interactive)
1073 (todos-display-sorted 'diary))
1074
1075(defun todos-display-categories-sorted-by-done ()
1076 ""
1077 (interactive)
1078 (todos-display-sorted 'done))
1079
1080(defun todos-display-categories-sorted-by-archived ()
1081 ""
1082 (interactive)
1083 (todos-display-sorted 'archived))
785 1084
786(defun todos-toggle-item-numbering () 1085(defun todos-toggle-item-numbering ()
787 "" 1086 ""
@@ -793,84 +1092,69 @@ the category in Todos mode."
793 (interactive) 1092 (interactive)
794 (save-excursion 1093 (save-excursion
795 (goto-char (point-min)) 1094 (goto-char (point-min))
796 (let* ((todos-show-with-done 1095 (let ((todos-show-with-done
797 (if (re-search-forward (concat "\n\\(\\[" 1096 (if (re-search-forward todos-done-string-start nil t)
798 (regexp-quote todos-done-string) 1097 nil
799 "\\)") nil t) 1098 t))
800 nil 1099 (cat (todos-current-category)))
801 t))
802 (cat (todos-current-category))
803 (catsym (intern-soft (concat "todos-" cat))))
804 (todos-category-select) 1100 (todos-category-select)
805 (when (zerop (get catsym 'done)) 1101 (when (zerop (todos-get-count 'done cat))
806 (message "There are no done items in this category."))))) 1102 (message "There are no done items in this category.")))))
807 1103
808(defun todos-view-archive (&optional cat) 1104(defun todos-toggle-show-done-only ()
809 "" 1105 ""
810 (interactive) 1106 (interactive)
811 (if (file-exists-p todos-archive-file) 1107 (setq todos-show-done-only (not todos-show-done-only))
812 (progn ;let ((todos-show-with-done t)) 1108 (todos-category-select))
813 (find-file todos-archive-file) 1109
1110(defun todos-view-archived-items ()
1111 "Display the archived items of the current category.
1112The buffer showing these items is in Todos Archive mode."
1113 (interactive)
1114 (let ((cat (todos-current-category)))
1115 (if (zerop (todos-get-count 'archived cat))
1116 (message "There are no archived items from this category.")
1117 (let* ((tfile-base (file-name-sans-extension todos-current-todos-file))
1118 (afile (concat tfile-base ".toda")))
1119 (find-file afile)
814 (todos-archive-mode) 1120 (todos-archive-mode)
815 (unless (string= todos-current-todos-file todos-archive-file) 1121 (unless (string= todos-current-todos-file afile)
816 (setq todos-current-todos-file todos-archive-file) 1122 (setq todos-current-todos-file afile)
817 (setq todos-categories nil)) 1123 (setq todos-categories nil))
818 (unless todos-categories 1124 (unless todos-categories
819 (setq todos-categories (todos-make-categories-list))) 1125 (setq todos-categories (todos-make-categories-list)))
820 (if cat 1126 (setq todos-category-number
821 (if (member cat (todos-categories)) 1127 (- (length todos-categories)
822 (progn 1128 (length (member cat todos-categories)))) ;FIXME
823 (setq todos-category-number 1129 (todos-jump-to-category cat)))))
824 (- (length todos-categories) 1130
825 (length (member cat todos-categories)))) 1131(defun todos-switch-to-archive (&optional ask)
826 (todos-jump-to-category-noninteractively cat)) 1132 "Visit the archive of the current Todos file, if it exists.
827 (message "No archived items from this category")) 1133The buffer showing the archive is in Todos Archive mode. The
828 (setq todos-category-number 0) 1134first visit in a session displays the first category in the
829 (todos-category-select))) 1135archive, subsequent visits return to the last category
830 (message "There is currently no Todos archive"))) 1136displayed."
831 1137 (interactive)
832;; FIXME: slow 1138 (let* ((tfile-base (file-name-sans-extension todos-current-todos-file))
833(defun todos-diary-items () 1139 (afile (if ask
834 "Display all todo items marked for diary inclusion." 1140 (todos-read-file-name "Choose a Todos archive: " t)
835 (interactive) 1141 (concat tfile-base ".toda"))))
836 (let ((bufname "*Todo diary entries*") 1142 (if (not (file-exists-p afile))
837 opoint) 1143 (message "There is currently no Todos archive for this file.")
838 (save-restriction 1144 (find-file afile)
839 (save-current-buffer 1145 (todos-archive-mode)
840 (widen) 1146 (unless (string= todos-current-todos-file afile)
841 (copy-to-buffer bufname (point-min) (point-max)))) 1147 (setq todos-current-todos-file afile)
842 (with-current-buffer bufname 1148 (setq todos-categories nil))
843 (goto-char (point-min)) 1149 (unless todos-categories
844 (while (not (eobp)) 1150 (setq todos-categories (todos-make-categories-list))
845 (setq opoint (point)) 1151 (setq todos-category-number 1))
846 (cond ((looking-at "\\[") 1152 (todos-category-select))))
847 (progn 1153
848 (todos-forward-item) 1154(defun todos-choose-archive ()
849 (if (string-match 1155 "Choose an archive and visit it."
850 (concat "^" (regexp-quote todos-category-beg) ".*$") 1156 (interactive)
851 (buffer-substring opoint (point))) 1157 (todos-switch-to-archive t))
852 (kill-region opoint (+ opoint (match-beginning 0)))
853 (kill-region opoint (point)))))
854 ((looking-at "^$")
855 (kill-line))
856 (t
857 (todos-forward-item))))
858 (goto-char (point-min))
859 (while (not (eobp))
860 (setq opoint (point))
861 (if (looking-at (regexp-quote todos-category-beg))
862 (when (progn (forward-line)
863 (or (looking-at (regexp-quote todos-category-beg))
864 ;; category has done but no unfinished items
865 (and (looking-at "^$") (forward-line))
866 (eobp)))
867 (kill-region opoint (point)))
868 (forward-line)))
869 (make-local-variable 'font-lock-defaults)
870 (setq font-lock-defaults '(todos-font-lock-keywords t))
871 (font-lock-fontify-buffer)
872 (setq buffer-read-only t))
873 (display-buffer bufname)))
874 1158
875(defun todos-highlight-item () 1159(defun todos-highlight-item ()
876 "Highlight the todo item the cursor is on." 1160 "Highlight the todo item the cursor is on."
@@ -895,7 +1179,7 @@ the category in Todos mode."
895 (setq ovs (cdr ovs)))) 1179 (setq ovs (cdr ovs))))
896 (if hidden (remove-overlays (point-min) (point-max) 'display "") 1180 (if hidden (remove-overlays (point-min) (point-max) 'display "")
897 (while (not (eobp)) 1181 (while (not (eobp))
898 (re-search-forward (concat "^\\[?" todos-date-pattern 1182 (re-search-forward (concat todos-date-string-start todos-date-pattern
899 "\\( " diary-time-regexp "\\)?\\]? ") 1183 "\\( " diary-time-regexp "\\)?\\]? ")
900 ; FIXME: this space in header? ^ 1184 ; FIXME: this space in header? ^
901 nil t) 1185 nil t)
@@ -903,107 +1187,186 @@ the category in Todos mode."
903 (setq ov (make-overlay (match-beginning 0) (match-end 0) nil t)) 1187 (setq ov (make-overlay (match-beginning 0) (match-end 0) nil t))
904 (overlay-put ov 'display "") 1188 (overlay-put ov 'display "")
905 (forward-line)))))) 1189 (forward-line))))))
906
907;;;###autoload
908(defun todos-top-priorities (&optional nof-priorities category-pr-page show-done)
909 "List top priorities for each category.
910
911Number of entries for each category is given by NOF-PRIORITIES which
912defaults to \'todos-show-priorities\'.
913
914If CATEGORY-PR-PAGE is non-nil, a page separator \'^L\' is inserted
915between each category.
916 1190
917With non-nil SHOW-DONE, include done items in the listing." 1191(defun todos-update-merged-files ()
1192 ""
1193 (interactive)
1194 (let ((files (funcall todos-files-function)))
1195 (dolist (f files)
1196 (if (member f todos-merged-files)
1197 (and (y-or-n-p
1198 (format "Remove \"%s\" from list of merged Todos files? "
1199 (file-name-sans-extension (file-name-nondirectory f))))
1200 (setq todos-merged-files (delete f todos-merged-files)))
1201 (and (y-or-n-p
1202 (format "Add \"%s\" to list of merged Todos files? "
1203 (file-name-sans-extension (file-name-nondirectory f))))
1204 (setq todos-merged-files
1205 (append todos-merged-files (list f)))))))
1206 (customize-save-variable 'todos-merged-files todos-merged-files))
1207
1208(defun todos-top-priorities (&optional num merge) ;FIXME: rename b/c of diary items
1209 "List top priorities for each category.
918 1210
919 (interactive "P") 1211Number of entries for each category is given by NUM which
920 (or nof-priorities (setq nof-priorities todos-show-priorities)) 1212defaults to \'todos-show-priorities\'. With non-nil argument
921 (if (listp nof-priorities) ;universal argument 1213MERGE list top priorities of all Todos files in
922 (setq nof-priorities (car nof-priorities))) 1214`todos-merged-files'. If `todos-prompt-merged-files' is non-nil,
1215prompt to update the list of merged files."
1216 (interactive "p")
1217 (or num (setq num todos-show-priorities))
923 (let ((todos-print-buffer-name todos-tmp-buffer-name) 1218 (let ((todos-print-buffer-name todos-tmp-buffer-name)
924 (todos-category-break (if category-pr-page " " "")) 1219 (files (list todos-current-todos-file))
925 beg end done) 1220 file bufstr cat beg end done)
926 (save-excursion 1221 (when merge
927 (todos-show)) 1222 (if (or todos-prompt-merged-files (null todos-merged-files))
928 (save-restriction 1223 (todos-update-merged-files))
929 (save-current-buffer 1224 (setq files todos-merged-files))
930 (widen) 1225 (if (buffer-live-p (get-buffer todos-print-buffer-name))
931 (if (buffer-live-p (get-buffer todos-print-buffer-name)) 1226 (kill-buffer todos-print-buffer-name))
932 (kill-buffer todos-print-buffer-name)) 1227 (save-current-buffer
933 (copy-to-buffer todos-print-buffer-name (point-min) (point-max)))) 1228 (dolist (f files)
934 (with-current-buffer todos-print-buffer-name 1229 (find-file f)
935 (goto-char (point-min)) 1230 (todos-switch-todos-file)
936 (while (re-search-forward ;Find category start 1231 (setq file (file-name-sans-extension
937 (concat "^" (regexp-quote todos-category-beg)) 1232 (file-name-nondirectory todos-current-todos-file)))
938 nil t) 1233 (with-current-buffer (get-file-buffer f)
939 (setq beg (+ (line-end-position) 1)) ;Start of first entry. 1234 (save-restriction
940 (setq end (if (re-search-forward todos-category-beg nil t) 1235 (widen)
1236 (setq bufstr (buffer-string))))
1237 (with-temp-buffer
1238 (insert bufstr)
1239 (goto-char (point-min))
1240 (unless (looking-at (concat "^" (regexp-quote todos-category-beg)))
1241 (kill-line 1))
1242 (while (re-search-forward
1243 (concat "^" (regexp-quote todos-category-beg) "\\(.+\\)\n")
1244 nil t)
1245 (setq cat (match-string 1))
1246 (delete-region (match-beginning 0) (match-end 0))
1247 (setq beg (point)) ;Start of first entry.
1248 (setq end (if (re-search-forward
1249 (concat "^" (regexp-quote todos-category-beg)) nil t)
1250 (match-beginning 0)
1251 (point-max)))
1252 (goto-char beg)
1253 (setq done
1254 (if (re-search-forward
1255 (concat "\n" (regexp-quote todos-category-done)) end t)
941 (match-beginning 0) 1256 (match-beginning 0)
942 (point-max))) 1257 end))
943 (goto-char beg) 1258 (delete-region done end)
944 (setq done 1259 (setq end done)
945 (if (re-search-forward 1260 (narrow-to-region beg end) ;In case we have too few entries.
946 (concat 1261 (goto-char (point-min))
947 (if (looking-at "^$") "" "\n") ; no unfinished items 1262 (cond ((< num 0) ; get only diary items
948 "\n\\(\\[" (regexp-quote todos-done-string) "\\)") 1263 (while (not (eobp))
949 end t) 1264 (if (looking-at (regexp-quote todos-nondiary-start))
950 (match-beginning 1) 1265 (todos-remove-item)
951 end)) 1266 (todos-forward-item))))
952 (unless show-done 1267 ((zerop num) ; keep all items
953 (delete-region done end) 1268 (goto-char end))
954 (setq end done)) 1269 (t
955 (narrow-to-region beg end) ;In case we have too few entries. 1270 (todos-forward-item num)))
956 (goto-char (point-min)) 1271 (setq beg (point))
957 (if (zerop nof-priorities) ;Traverse entries. 1272 (if (>= num 0) (delete-region beg end))
958 (goto-char end) ;All entries 1273 (goto-char (point-min))
959 (todos-forward-item nof-priorities)) 1274 (while (not (eobp))
960 (setq beg (point)) 1275 (when (re-search-forward (concat todos-date-string-start
961 (delete-region beg end) 1276 todos-date-pattern
962 (widen)) 1277 "\\( " diary-time-regexp "\\)?\\]?")
963 (and (looking-at " ") (replace-match "")) ;Remove trailing form-feed. 1278 nil t)
1279 (insert (concat " [" (if merge (concat file ":")) cat "]")))
1280 (forward-line))
1281 (widen))
1282 (append-to-buffer todos-print-buffer-name (point-min) (point-max)))))
1283 (with-current-buffer todos-print-buffer-name
1284 (todos-prefix-overlays)
1285 (todos-top-priorities-mode)
964 (goto-char (point-min)) ;Due to display buffer 1286 (goto-char (point-min)) ;Due to display buffer
965 (make-local-variable 'font-lock-defaults) 1287 ;; (make-local-variable 'font-lock-defaults)
966 (setq font-lock-defaults '(todos-font-lock-keywords t)) 1288 ;; (setq font-lock-defaults '(todos-font-lock-keywords t))
967 (font-lock-fontify-buffer) 1289 (font-lock-fontify-buffer))
968 (setq buffer-read-only t)) 1290 ;; (setq buffer-read-only t))
969 ;; Could have used switch-to-buffer as it has a norecord argument, 1291 ;; Could have used switch-to-buffer as it has a norecord argument,
970 ;; which is nice when we are called from e.g. todos-print. 1292 ;; which is nice when we are called from e.g. todos-print.
971 ;; Else we could have used pop-to-buffer. 1293 ;; Else we could have used pop-to-buffer.
972 ;; (display-buffer todos-print-buffer-name)
973 (display-buffer todos-print-buffer-name) 1294 (display-buffer todos-print-buffer-name)
974 (message "Type C-x 1 to remove %s window. M-C-v to scroll the help." 1295 (message "Type C-x 1 to remove %s window. M-C-v to scroll the help."
975 todos-print-buffer-name))) 1296 todos-print-buffer-name)))
976 1297
1298(defun todos-merged-top-priorities (&optional num)
1299 ""
1300 (interactive "p")
1301 (todos-top-priorities num t))
1302
1303(defun todos-diary-items (&optional merge)
1304 "Display todo items marked for diary inclusion.
1305The items are those in the current Todos file, or with prefix
1306argument MERGE those in all Todos files in `todos-merged-files'."
1307 (interactive "P")
1308 (todos-top-priorities -1 merge))
1309
977;;; Navigation 1310;;; Navigation
978 1311
979(defun todos-forward-category () 1312(defun todos-forward-category ()
980 "Go forward to TODO list of next category." 1313 "Go forward to TODO list of next category."
981 (interactive) 1314 (interactive)
982 (setq todos-category-number 1315 (setq todos-category-number
983 (mod (1+ todos-category-number) (length todos-categories))) 1316 (1+ (mod todos-category-number (length todos-categories))))
984 (todos-category-select)) 1317 (todos-category-select)
1318 (goto-char (point-min)))
985 1319
986(defun todos-backward-category () 1320(defun todos-backward-category ()
987 "Go back to TODO list of previous category." 1321 "Go back to TODO list of previous category."
988 (interactive) 1322 (interactive)
989 (setq todos-category-number 1323 (setq todos-category-number
990 (mod (1- todos-category-number) (length todos-categories))) 1324 (1+ (mod (- todos-category-number 2) (length todos-categories))))
991 (todos-category-select)) 1325 (todos-category-select)
1326 (goto-char (point-min)))
992 1327
993;; FIXME: Document that a non-existing name creates that category, and add 1328;; FIXME: Document that a non-existing name creates that category, and add
994;; y-or-n-p confirmation -- or eliminate this possibility? 1329;; y-or-n-p confirmation -- or eliminate this possibility?
995(defun todos-jump-to-category () 1330(defun todos-jump-to-category (&optional cat other-file)
996 "Jump to a category. Default is previous category." 1331 "Jump to a category in a Todos file.
1332When called interactively, prompt for the category.
1333Non-interactively, the argument CAT provides the category. With
1334non-nil argument OTHER-FILE, prompt for a Todos file, otherwise
1335stay with the current Todos file. See also
1336`todos-jump-to-category-other-file'."
997 (interactive) 1337 (interactive)
998 (let ((category (todos-read-category))) 1338 (when (or (and other-file
1339 (setq todos-current-todos-file
1340 (todos-read-file-name "Choose a Todos file: ")))
1341 (and cat
1342 todos-ignore-archived-categories
1343 (zerop (todos-get-count 'todo cat))
1344 (zerop (todos-get-count 'done cat))
1345 (not (zerop (todos-get-count 'archived cat)))
1346 (setq todos-current-todos-file
1347 (concat (file-name-sans-extension todos-current-todos-file)
1348 ".toda"))))
1349 (with-current-buffer (find-file-noselect todos-current-todos-file)
1350 ;; (or (eq major-mode 'todos-mode) (todos-mode))
1351 (setq todos-categories (todos-make-categories-list))))
1352 (let ((category (or (and (assoc cat todos-categories) cat)
1353 (todos-read-category "Jump to category: "))))
999 (if (string= "" category) 1354 (if (string= "" category)
1000 (setq category (todos-current-category))) 1355 (setq category (todos-current-category)))
1356 (if (string= (buffer-name) todos-categories-buffer)
1357 (kill-buffer))
1358 (if (or cat other-file)
1359 (switch-to-buffer (get-file-buffer todos-current-todos-file)))
1001 (setq todos-category-number 1360 (setq todos-category-number
1002 (if (member category todos-categories) 1361 (or (todos-category-number category)
1003 (- (length todos-categories) 1362 (todos-add-category category)))
1004 (length (member category todos-categories))) 1363 (todos-category-select)
1005 (todos-add-category category))) 1364 (goto-char (point-min))))
1006 (todos-category-select))) 1365
1366(defun todos-jump-to-category-other-file ()
1367 ""
1368 (interactive)
1369 (todos-jump-to-category nil t))
1007 1370
1008;; FIXME ? todos-{backward,forward}-item skip over empty line between done and 1371;; FIXME ? todos-{backward,forward}-item skip over empty line between done and
1009;; not done items (but todos-forward-item gets there when done items are not 1372;; not done items (but todos-forward-item gets there when done items are not
@@ -1024,126 +1387,201 @@ With non-nil SHOW-DONE, include done items in the listing."
1024 (goto-char (match-beginning 0)) 1387 (goto-char (match-beginning 0))
1025 (goto-char (point-max)))) 1388 (goto-char (point-max))))
1026 1389
1027;; FIXME: continue search with same regexp
1028(defvar todos-search-string nil
1029 ""
1030 )
1031(defun todos-search () 1390(defun todos-search ()
1032 "" 1391 "Perform a search for a regular expression, with repetition.
1392The search encompasses all todo and done items within the current Todos file; it excludes category names. Matches are highlighted
1393"
1033 (interactive) 1394 (interactive)
1034 (let ((regex (read-from-minibuffer "Enter a search string (regexp): ")) 1395 (let ((regex (read-from-minibuffer "Enter a search string (regexp): "))
1035 (start (point)) 1396 (opoint (point))
1036 found cat in-done) 1397 matches match cat in-done ov mlen msg)
1037 (widen) 1398 (widen)
1038 (goto-char (point-min)) 1399 (goto-char (point-min))
1039 (while (and (setq found (re-search-forward regex nil t)) 1400 (while (not (eobp))
1040 (save-excursion 1401 (setq match (re-search-forward regex nil t))
1041 (goto-char (line-beginning-position)) 1402 (goto-char (line-beginning-position))
1042 (looking-at (concat "^" (regexp-quote todos-category-beg))))) 1403 (unless (or (equal (point) 1)
1404 (looking-at (concat "^" (regexp-quote todos-category-beg))))
1405 (if match (push match matches)))
1043 (forward-line)) 1406 (forward-line))
1044 (if found 1407 (setq matches (reverse matches))
1045 (progn 1408 (if matches
1046 (setq found (match-beginning 0)) ;FIXME: ok if looking-at returns nil? 1409 (catch 'stop
1047 (todos-item-start) 1410 (while matches
1048 (when (looking-at (concat "^\\[" (regexp-quote todos-done-string))) 1411 (setq match (pop matches))
1049 (setq in-done t)) 1412 (goto-char match)
1050 (re-search-backward (concat "^" (regexp-quote todos-category-beg) 1413 (todos-item-start)
1051 "\\(.*\\)\n") nil t) 1414 (when (looking-at todos-done-string-start)
1052 (setq cat (match-string-no-properties 1)) 1415 (setq in-done t))
1053 (todos-category-number cat) 1416 (re-search-backward (concat "^" (regexp-quote todos-category-beg)
1054 (todos-category-select) 1417 "\\(.*\\)\n") nil t)
1055 (when in-done (unless todos-show-with-done (todos-toggle-view-done-items))) 1418 (setq cat (match-string-no-properties 1))
1056 (goto-char found)) 1419 (todos-category-number cat)
1420 (todos-category-select)
1421 (if in-done (unless todos-show-with-done (todos-toggle-view-done-items)))
1422 (goto-char match)
1423 (setq ov (make-overlay (- (point) (length regex)) (point)))
1424 (overlay-put ov 'face 'todos-search)
1425 (when matches
1426 (setq mlen (length matches))
1427 (if (y-or-n-p
1428 (if (> mlen 1)
1429 (format "There are %d more matches; go to next match? " mlen)
1430 "There is one more match; go to it? "))
1431 (widen)
1432 (throw 'stop (setq msg (if (> mlen 1)
1433 (format "There are %d more matches." mlen)
1434 "There is one more match."))))))
1435 (setq msg "There are no more matches."))
1057 (todos-category-select) 1436 (todos-category-select)
1058 (goto-char start) 1437 (goto-char opoint)
1059 (message "No match for \"%s\"" regex)))) 1438 (message "No match for \"%s\"" regex))
1439 (when msg
1440 (if (y-or-n-p (concat msg "\nUnhighlight matches? "))
1441 (todos-clear-matches)
1442 (message "You can unhighlight the matches later by typing %s"
1443 (key-description (car (where-is-internal
1444 'todos-clear-matches))))))))
1445
1446(defun todos-clear-matches ()
1447 "Removing highlighting on matches found by todos-search."
1448 (interactive)
1449 (remove-overlays 1 (1+ (buffer-size)) 'face 'todos-search))
1060 1450
1061;;; Editing 1451;;; Editing
1062 1452
1063;;;###autoload 1453(defun todos-add-file (&optional arg)
1454 ""
1455 (interactive "p")
1456 (let ((default-file (if todos-default-todos-file
1457 (file-name-sans-extension
1458 (file-name-nondirectory todos-default-todos-file))))
1459 file prompt)
1460 (while
1461 (and
1462 (cond
1463 ((or (not file) (member file todos-files))
1464 (setq prompt (concat "Enter name of new Todos file "
1465 "(TAB or SPC to see existing Todos files): ")))
1466 ((string-equal file "")
1467 (setq prompt "Enter a non-empty name: "))
1468 ((string-match "\\`\\s-+\\'" file)
1469 (setq prompt "Enter a name that is not only white space: ")))
1470 (setq file (todos-read-file-name prompt))))
1471 (if (or (not default-file)
1472 (yes-or-no-p (concat "Make %s new default Todos file "
1473 "[current default is \"%s\"]? ")
1474 file default-file))
1475 (todos-change-default-file file)
1476 (message "\"%s\" remains the default Todos file." default-file))
1477 (with-current-buffer (get-buffer-create todos-default-todos-file)
1478 (erase-buffer)
1479 (write-region (point-min) (point-max) todos-default-todos-file
1480 nil 'nomessage nil t))
1481 (if arg (todos-show) file)))
1482
1483;; FIXME: omit this and just use defcustom?
1484(defun todos-change-default-file (&optional file)
1485 ""
1486 (interactive)
1487 (let ((new-default (or file
1488 (todos-read-file-name "Choose new default Todos file: "))))
1489 (customize-save-variable 'todos-default-todos-file new-default)
1490 (message "\"%s\" is new default Todos file."
1491 (file-name-sans-extension (file-name-nondirectory new-default)))))
1492
1064(defun todos-add-category (&optional cat) 1493(defun todos-add-category (&optional cat)
1065 "Add new category CAT to the TODO list." 1494 "Add new category CAT to the TODO list."
1066 (interactive) 1495 (interactive)
1067 (let ((buffer-read-only) 1496 (let* ((buffer-read-only)
1068 (buf (find-file-noselect todos-file-do t)) 1497 (buf (find-file-noselect todos-current-todos-file t))
1069 catsym) 1498 (num (1+ (length todos-categories)))
1499 (counts (make-vector 4 0))) ; [todo diary done archived]
1500 ;; (counts (list 'todo 0 'diary 0 'done 0 'archived 0)))
1070 (unless (zerop (buffer-size buf)) 1501 (unless (zerop (buffer-size buf))
1071 (and (null todos-categories) 1502 (and (null todos-categories)
1072 (error "Error in %s: File is non-empty but contains no category" 1503 (error "Error in %s: File is non-empty but contains no category"
1073 todos-file-do))) 1504 todos-current-todos-file)))
1074 (unless cat (setq cat (read-from-minibuffer "Category: "))) 1505 (unless cat (setq cat (read-from-minibuffer "Enter new category name: ")))
1075 (with-current-buffer buf 1506 (with-current-buffer buf
1076 (setq cat (todos-check-category-name cat)) 1507 (setq cat (todos-validate-category-name cat))
1077 ;; initialize a newly created Todo buffer for Todo mode 1508 (setq todos-categories (append todos-categories (list (cons cat counts))))
1078 (unless (file-exists-p todos-file-do) (todos-mode))
1079 (setq catsym (intern (concat "todos-" cat)))
1080 (setplist catsym (list 'todo 0 'done 0 'archived 0))
1081 (nconc todos-categories (list cat)) ;FIXME: is this TRTD?
1082 (widen) 1509 (widen)
1083 ;; FIXME: make this (point-max) 1510 (goto-char (point-max))
1084 (goto-char (point-min)) 1511 (save-excursion ; for subsequent todos-category-select
1085 ;; make sure file does not begin with empty lines (shouldn't, but may be 1512 (insert todos-category-beg cat "\n\n" todos-category-done "\n"))
1086 ;; added by mistake), otherwise new categories will contain them, so 1513 (todos-update-categories-sexp)
1087 ;; won't be really empty 1514 (if (called-interactively-p 'any) ; FIXME
1088 (while (looking-at "^$") (kill-line))
1089 (insert todos-category-beg cat "\n")
1090 (if (interactive-p)
1091 ;; properly display the newly added category 1515 ;; properly display the newly added category
1092 (progn (setq todos-category-number (1- (length todos-categories))) 1516 (progn
1093 (todos-category-select)) 1517 (setq todos-category-number num)
1094 (1- (length todos-categories)))))) 1518 (todos-category-select))
1519 num))))
1095 1520
1096(defun todos-rename-category () 1521(defun todos-rename-category ()
1097 "Rename current Todos category." 1522 "Rename current Todos category."
1098 (interactive) 1523 (interactive)
1099 (let* ((buffer-read-only) 1524 (let* ((cat (todos-current-category))
1100 (cat (todos-current-category))
1101 (vec (vconcat todos-categories))
1102 (new (read-from-minibuffer (format "Rename category \"%s\" to: " cat)))) 1525 (new (read-from-minibuffer (format "Rename category \"%s\" to: " cat))))
1103 (setq new (todos-check-category-name new)) 1526 (setq new (todos-validate-category-name new))
1104 (aset vec todos-category-number new) 1527 (let* ((ofile (buffer-file-name))
1105 (setq todos-categories (append vec nil)) 1528 (archive (concat (file-name-sans-extension ofile) ".toda"))
1106 (save-excursion 1529 (buffers (append (list ofile)
1107 (widen) 1530 (unless (zerop (todos-get-count 'archived cat))
1108 (re-search-backward (concat (regexp-quote todos-category-beg) "\\(" 1531 (list archive)))))
1109 (regexp-quote cat) "\\)\n") nil t) 1532 (dolist (buf buffers)
1110 (replace-match new t t nil 1) 1533 (with-current-buffer (find-file-noselect buf)
1111 (goto-char (point-min)) 1534 (let (buffer-read-only)
1112 (setq mode-line-buffer-identification (concat "Category: " new)))) 1535 ;; (setq todos-categories (if (string= buf archive)
1113 (todos-category-select)) 1536 ;; (todos-make-categories-list t)
1537 ;; todos-categories))
1538 (todos-set-categories)
1539 (save-excursion
1540 (save-restriction
1541 (setcar (assoc cat todos-categories) new)
1542 (widen)
1543 (goto-char (point-min))
1544 (todos-update-categories-sexp)
1545 (re-search-forward (concat (regexp-quote todos-category-beg) "\\("
1546 (regexp-quote cat) "\\)\n") nil t)
1547 (replace-match new t t nil 1)))))))
1548 (setq mode-line-buffer-identification
1549 (format "Category %d: %s" todos-category-number new)))
1550 (save-excursion (todos-category-select)))
1114 1551
1552;; FIXME: what if cat has archived items?
1115(defun todos-delete-category (&optional arg) 1553(defun todos-delete-category (&optional arg)
1116 "Delete current Todos category provided it is empty. 1554 "Delete current Todos category provided it is empty.
1117With ARG non-nil delete the category unconditionally, 1555With ARG non-nil delete the category unconditionally,
1118i.e. including all existing entries." 1556i.e. including all existing entries."
1119 (interactive "P") 1557 (interactive "P")
1120 (let* ((cat (todos-current-category)) 1558 (let* ((cat (todos-current-category))
1121 (catsym (intern-soft (concat "todos-" cat))) 1559 (todo (todos-get-count 'todo cat))
1122 (todo (get catsym 'todo)) 1560 (done (todos-get-count 'done cat)))
1123 (done (get catsym 'done)) 1561 (if (and (not arg)
1124 beg end)
1125 (if (and (null arg)
1126 (or (> todo 0) (> done 0))) 1562 (or (> todo 0) (> done 0)))
1127 (message "To delete a non-empty category, type C-u D.") 1563 (message "To delete a non-empty category, type C-u D.")
1128 (when (y-or-n-p (concat "Permanently remove category \"" cat 1564 (when (y-or-n-p (concat "Permanently remove category \"" cat
1129 "\"" (and arg " and all its entries") "? ")) 1565 "\"" (and arg " and all its entries") "? "))
1130 (let ((buffer-read-only)) 1566 (widen)
1131 (widen) 1567 (let ((buffer-read-only)
1132 (setq beg (re-search-backward (concat "^" (regexp-quote todos-category-beg) 1568 (beg (re-search-backward
1133 cat "\n") nil t)) 1569 (concat "^" (regexp-quote (concat todos-category-beg cat))
1134 (setq end (if (re-search-forward (concat "\n\\(" 1570 "\n") nil t))
1135 (regexp-quote todos-category-beg) 1571 (end (if (re-search-forward
1136 ".*\n\\)") nil t) 1572 (concat "\n\\(" (regexp-quote todos-category-beg)
1137 (match-beginning 1) 1573 ".*\n\\)") nil t)
1138 (point-max))) 1574 (match-beginning 1)
1575 (point-max))))
1139 (remove-overlays beg end) 1576 (remove-overlays beg end)
1140 (kill-region beg end) 1577 (delete-region beg end)
1141 (setq todos-categories (delete cat todos-categories)) 1578 (setq todos-categories (delete (assoc cat todos-categories)
1142 (setplist catsym nil) 1579 todos-categories))
1143 (unintern catsym) 1580 (todos-update-categories-sexp)
1144 (setq todos-category-number 1581 (setq todos-category-number
1145 (mod todos-category-number (length todos-categories))) 1582 (1+ (mod todos-category-number (length todos-categories))))
1146 (todos-category-select) 1583 (todos-category-select)
1584 (goto-char (point-min))
1147 (message "Deleted category %s" cat)))))) 1585 (message "Deleted category %s" cat))))))
1148 1586
1149(defun todos-raise-category (&optional lower) 1587(defun todos-raise-category (&optional lower)
@@ -1164,19 +1602,23 @@ With non-nil argument LOWER, lower the category's priority."
1164 (num2 (1+ num1)) 1602 (num2 (1+ num1))
1165 (end (progn (forward-line 2) (point))) 1603 (end (progn (forward-line 2) (point)))
1166 (catvec (vconcat todos-categories)) 1604 (catvec (vconcat todos-categories))
1167 (cat1 (aref catvec num1)) 1605 (cat1-list (aref catvec num1))
1168 (cat2 (aref catvec num2)) 1606 (cat2-list (aref catvec num2))
1607 (cat1 (car cat1-list))
1608 (cat2 (car cat2-list))
1169 (buffer-read-only)) 1609 (buffer-read-only))
1170 (delete-region beg end) 1610 (delete-region beg end)
1171 (setq num1 (1+ num1) 1611 (setq num1 (1+ num1))
1172 num2 (1- num2)) 1612 (setq num2 (1- num2))
1173 (setq num num2) 1613 (setq num num2)
1174 (todos-insert-category-name cat2) 1614 (todos-insert-category-line cat2)
1175 (setq num num1) 1615 (setq num num1)
1176 (todos-insert-category-name cat1) 1616 (todos-insert-category-line cat1)
1177 (aset catvec num2 cat2) 1617 (aset catvec num2 (cons cat2 (cdr cat2-list)))
1178 (aset catvec num1 cat1) 1618 (aset catvec num1 (cons cat1 (cdr cat1-list)))
1179 (setq todos-categories (append catvec nil)) 1619 (setq todos-categories (append catvec nil))
1620 (with-current-buffer (get-file-buffer todos-current-todos-file)
1621 (todos-update-categories-sexp))
1180 (forward-line (if lower -1 -2)) 1622 (forward-line (if lower -1 -2))
1181 (forward-char col))))) 1623 (forward-char col)))))
1182 1624
@@ -1185,6 +1627,152 @@ With non-nil argument LOWER, lower the category's priority."
1185 (interactive) 1627 (interactive)
1186 (todos-raise-category t)) 1628 (todos-raise-category t))
1187 1629
1630;; FIXME: use save-restriction?
1631(defun todos-move-category ()
1632 "Move current category to a different Todos file.
1633If current category has archived items, also move those to the
1634archive of the file moved to, creating it if it does not exist."
1635 (interactive)
1636 ;; FIXME: warn if only category in file? If so, delete file after moving category
1637 (when (or (> (length todos-categories) 1)
1638 (y-or-n-p (concat "This is the only category in this file; "
1639 "moving it will delete the file.\n"
1640 "Do you want to proceed? ")))
1641 (let* ((ofile (buffer-file-name))
1642 (cat (todos-current-category))
1643 ;; FIXME: check if cat exists in nfile, and if so rename it
1644 (nfile (todos-read-file-name "Choose a Todos file: "))
1645 (archive (concat (file-name-sans-extension ofile) ".toda"))
1646 (buffers (append (list ofile)
1647 (unless (zerop (todos-get-count 'archived cat))
1648 (list archive)))))
1649 (dolist (buf buffers)
1650 (with-current-buffer (find-file-noselect buf)
1651 (save-excursion
1652 (save-restriction
1653 (widen)
1654 (goto-char (point-max))
1655 (let ((buffer-read-only nil)
1656 (beg (re-search-backward
1657 (concat "^"
1658 (regexp-quote (concat todos-category-beg cat)))
1659 nil t))
1660 (end (if (re-search-forward
1661 (concat "^" (regexp-quote todos-category-beg))
1662 nil t 2)
1663 (match-beginning 0)
1664 (point-max)))
1665 (content (buffer-substring-no-properties beg end)))
1666 (with-current-buffer
1667 (find-file-noselect
1668 ;; regenerate todos-archives in case there
1669 ;; is a newly created archive
1670 (if (member buf (funcall todos-files-function t))
1671 (concat (file-name-sans-extension nfile) ".toda")
1672 nfile))
1673 (let (buffer-read-only)
1674 (save-excursion
1675 (save-restriction
1676 (widen)
1677 (goto-char (point-max))
1678 (insert content)
1679 (goto-char (point-min))
1680 (if (zerop (buffer-size))
1681 (progn
1682 (set-buffer-modified-p nil) ; no questions
1683 (delete-file (buffer-file-name))
1684 (kill-buffer))
1685 (unless (looking-at
1686 (concat "^" (regexp-quote todos-category-beg)))
1687 (kill-whole-line))
1688 (save-buffer)))))
1689 (remove-overlays beg end)
1690 (delete-region beg end)
1691 (goto-char (point-min))
1692 (if (zerop (buffer-size))
1693 (progn
1694 (set-buffer-modified-p nil)
1695 (delete-file (buffer-file-name))
1696 (kill-buffer))
1697 (unless (looking-at
1698 (concat "^" (regexp-quote todos-category-beg)))
1699 (kill-whole-line))
1700 (save-buffer))))))))
1701 ;; (todos-switch-todos-file nfile))))
1702 (find-file nfile)
1703 (setq todos-current-todos-file nfile
1704 todos-categories (todos-make-categories-list t)
1705 todos-category-number (todos-category-number cat))
1706 (todos-category-select))))
1707
1708(defun todos-merge-category ()
1709 "Merge this category's items to another category in this file.
1710The todo and done items are appended to the todo and done items,
1711respectively, of the category merged to, which becomes the
1712current category, and the category merged from is deleted."
1713 (interactive)
1714 (let ((buffer-read-only nil)
1715 (cat (todos-current-category))
1716 (goal (todos-read-category "Category to merge to: ")))
1717 (widen)
1718 ;; FIXME: what if cat has archived items?
1719 (let* ((cbeg (progn
1720 (re-search-backward
1721 (concat "^" (regexp-quote todos-category-beg)) nil t)
1722 (point)))
1723 (tbeg (progn (forward-line) (point)))
1724 (dbeg (progn
1725 (re-search-forward
1726 (concat "^" (regexp-quote todos-category-done)) nil t)
1727 (match-beginning 0)))
1728 (tend (forward-line -1))
1729 (cend (progn
1730 (if (re-search-forward
1731 (concat "^" (regexp-quote todos-category-beg)) nil t)
1732 (match-beginning 0)
1733 (point-max))))
1734 (todo (buffer-substring-no-properties tbeg tend))
1735 (done (buffer-substring-no-properties dbeg cend))
1736 here)
1737 (goto-char (point-min))
1738 (re-search-forward
1739 (concat "^" (regexp-quote todos-category-beg goal)) nil t)
1740 (re-search-forward
1741 (concat "^" (regexp-quote todos-category-done)) nil t)
1742 (forward-line -1)
1743 (setq here (point))
1744 (insert todo)
1745 (goto-char (if (re-search-forward
1746 (concat "^" (regexp-quote todos-category-beg)) nil t)
1747 (match-beginning 0)
1748 (point-max)))
1749 (insert done)
1750 (remove-overlays cbeg cend)
1751 (delete-region cbeg cend)
1752 (setq todos-categories (delete (assoc cat todos-categories)
1753 todos-categories))
1754 (todos-update-categories-sexp)
1755 (setq todos-category-number (todos-category-number goal))
1756 (todos-category-select)
1757 ;; Put point at the start of the merged todo items
1758 ;; FIXME: what if there are no merged todo items but only done items?
1759 (goto-char here))))
1760
1761(defun todos-merge-categories ()
1762 ""
1763 (interactive)
1764 (let* ((cats (mapcar 'car todos-categories))
1765 (goal (todos-read-category "Category to merge to: "))
1766 (prompt (format "Merge to %s (type C-g to finish)? " goal))
1767 (source (let ((inhibit-quit t) l)
1768 (while (not (eq last-input-event 7))
1769 (dolist (c cats)
1770 (when (y-or-n-p prompt)
1771 (push c l)
1772 (setq cats (delete c cats))))))))
1773 (widen)
1774 ))
1775
1188;;;###autoload 1776;;;###autoload
1189(defun todos-insert-item (&optional arg date-type time diary here) 1777(defun todos-insert-item (&optional arg date-type time diary here)
1190 "Insert new TODO list item. 1778 "Insert new TODO list item.
@@ -1216,6 +1804,7 @@ there."
1216 (interactive "P") 1804 (interactive "P")
1217 (unless (or (todos-done-item-p) 1805 (unless (or (todos-done-item-p)
1218 (save-excursion (forward-line -1) (todos-done-item-p))) 1806 (save-excursion (forward-line -1) (todos-done-item-p)))
1807 ;; FIXME: deletable if command not autoloaded
1219 (when (not (derived-mode-p 'todos-mode)) (todos-show)) 1808 (when (not (derived-mode-p 'todos-mode)) (todos-show))
1220 (let* ((buffer-read-only) 1809 (let* ((buffer-read-only)
1221 (date-string (cond 1810 (date-string (cond
@@ -1228,41 +1817,55 @@ there."
1228 (with-current-buffer "*Calendar*" 1817 (with-current-buffer "*Calendar*"
1229 (calendar-date-string (calendar-cursor-to-date t) t t))) 1818 (calendar-date-string (calendar-cursor-to-date t) t t)))
1230 (t (calendar-date-string (calendar-current-date) t t)))) 1819 (t (calendar-date-string (calendar-current-date) t t))))
1231 (time-string (cond ((eq time 'omit) nil) ;FIXME: delete 1820 (time-string (cond ((eq time 'ask-time)
1232 ((eq time 'ask-time)
1233 (todos-read-time)) 1821 (todos-read-time))
1234 (todos-always-add-time-string 1822 (todos-always-add-time-string
1235 (substring (current-time-string) 11 16)))) 1823 (substring (current-time-string) 11 16))
1236 (new-item (concat (unless (or diary todos-include-in-diary) "[") ;FIXME 1824 (t nil)))
1825 (new-item (concat (unless (or diary todos-include-in-diary)
1826 todos-nondiary-start)
1237 date-string (when time-string (concat " " time-string)) 1827 date-string (when time-string (concat " " time-string))
1238 ;; FIXME 1828 (unless (or diary todos-include-in-diary)
1239 (unless (or diary todos-include-in-diary) "]") " " 1829 todos-nondiary-end)
1830 " "
1240 (read-from-minibuffer "New TODO entry: "))) 1831 (read-from-minibuffer "New TODO entry: ")))
1241 (cat (if arg (todos-read-category) (todos-current-category)))) 1832 (cat (if arg (todos-read-category "Insert item in category: ")
1833 (todos-current-category))))
1242 ;; indent newlines inserted by C-q C-j if nonspace char follows 1834 ;; indent newlines inserted by C-q C-j if nonspace char follows
1243 (setq new-item (replace-regexp-in-string 1835 (setq new-item (replace-regexp-in-string
1244 "\\(\n\\)[^[:blank:]]" 1836 "\\(\n\\)[^[:blank:]]"
1245 (concat "\n" (make-string todos-indent-to-here 32)) new-item 1837 (concat "\n" (make-string todos-indent-to-here 32)) new-item
1246 nil nil 1)) 1838 nil nil 1))
1247 (unless here (todos-set-item-priority new-item cat)) 1839 (unless (assoc cat todos-categories) (todos-add-category cat))
1248 (todos-insert-with-overlays new-item) 1840 ;; (unless here (todos-set-item-priority new-item cat))
1249 (todos-item-counts cat 'insert)))) 1841 ;; (todos-insert-with-overlays new-item)
1842 (if here
1843 (todos-insert-with-overlays new-item)
1844 (todos-set-item-priority new-item cat))
1845 (todos-item-counts cat 'insert)
1846 (if (or diary todos-include-in-diary) (todos-item-counts cat 'diary))
1847 (todos-update-categories-sexp))))
1250 1848
1251;; FIXME: make insertion options customizable per category 1849;; FIXME: make insertion options customizable per category
1252 1850
1253;; current date ~ current day ~ ask date ~ ask day 1851;; current date ~ current day ~ ask date ~ ask day
1254;; current time ~ ask time ~ no time 1852;; current time ~ ask time ~ maybe no time
1255;; for diary ~ not for diary 1853;; for diary ~ not for diary
1256;; here ~ ask priority 1854;; here ~ ask priority
1257 1855
1258;; date-type: d n (c) - time - diary - here 1856;; date-type: date name (calendar) - (maybe-no)time - diary - here
1259 1857
1260;; ii todos-insert-item 1858;; ii todos-insert-item + current-date/dayname + current/no-time
1859;; ih todos-insert-item-here
1261;; idd todos-insert-item-ask-date 1860;; idd todos-insert-item-ask-date
1262;; idtt todos-insert-item-ask-date-time 1861;; idtt todos-insert-item-ask-date-time
1263;; idtyy todos-insert-item-ask-date-time-for-diary 1862;; idtyy todos-insert-item-ask-date-time-for-diary
1264;; idtyh todos-insert-item-ask-date-time-for-diary-here 1863;; idtyh todos-insert-item-ask-date-time-for-diary-here
1265;; idth todos-insert-item-ask-date-time-here 1864;; idth todos-insert-item-ask-date-time-here
1865;; idmm todos-insert-item-ask-date-maybe-notime
1866;; idmyy todos-insert-item-ask-date-maybe-notime-for-diary
1867;; idmyh todos-insert-item-ask-date-maybe-notime-for-diary-here
1868;; idmh todos-insert-item-ask-date-maybe-notime-here
1266;; idyy todos-insert-item-ask-date-for-diary 1869;; idyy todos-insert-item-ask-date-for-diary
1267;; idyh todos-insert-item-ask-date-for-diary-here 1870;; idyh todos-insert-item-ask-date-for-diary-here
1268;; idh todos-insert-item-ask-date-here 1871;; idh todos-insert-item-ask-date-here
@@ -1271,28 +1874,218 @@ there."
1271;; intyy todos-insert-item-ask-dayname-time-for-diary 1874;; intyy todos-insert-item-ask-dayname-time-for-diary
1272;; intyh todos-insert-item-ask-dayname-time-for-diary-here 1875;; intyh todos-insert-item-ask-dayname-time-for-diary-here
1273;; inth todos-insert-item-ask-dayname-time-here 1876;; inth todos-insert-item-ask-dayname-time-here
1877;; inmm todos-insert-item-ask-dayname-maybe-notime
1878;; inmyy todos-insert-item-ask-dayname-maybe-notime-for-diary
1879;; inmyh todos-insert-item-ask-dayname-maybe-notime-for-diary-here
1880;; inmh todos-insert-item-ask-dayname-maybe-notime-here
1274;; inyy todos-insert-item-ask-dayname-for-diary 1881;; inyy todos-insert-item-ask-dayname-for-diary
1275;; inyh todos-insert-item-ask-dayname-for-diary-here 1882;; inyh todos-insert-item-ask-dayname-for-diary-here
1276;; inh todos-insert-item-ask-dayname-here 1883;; inh todos-insert-item-ask-dayname-here
1277;; itt todos-insert-item-time 1884;; itt todos-insert-item-ask-time
1278;; ityy todos-insert-item-time-for-diary 1885;; ityy todos-insert-item-ask-time-for-diary
1279;; ityh todos-insert-item-time-for-diary-here 1886;; ityh todos-insert-item-ask-time-for-diary-here
1280;; ith todos-insert-item-time-here 1887;; ith todos-insert-item-ask-time-here
1888;; im todos-insert-item-maybe-notime
1889;; imyy todos-insert-item-maybe-notime-for-diary
1890;; imyh todos-insert-item-maybe-notime-for-diary-here
1891;; imh todos-insert-item-maybe-notime-here
1281;; iyy todos-insert-item-for-diary 1892;; iyy todos-insert-item-for-diary
1282;; iyh todos-insert-item-for-diary-here 1893;; iyh todos-insert-item-for-diary-here
1283;; ih todos-insert-item-here
1284 1894
1285(defun todos-insert-item-here () 1895(defun todos-insert-item-ask-date (&optional arg)
1896 ""
1897 (interactive "P")
1898 (todos-insert-item arg 'ask-date))
1899
1900(defun todos-insert-item-ask-date-time (&optional arg)
1901 ""
1902 (interactive "P")
1903 (todos-insert-item arg 'ask-date 'ask-time))
1904
1905(defun todos-insert-item-ask-date-time-for-diary (&optional arg)
1906 ""
1907 (interactive "P")
1908 (todos-insert-item arg 'ask-date 'ask-time t))
1909
1910(defun todos-insert-item-ask-date-time-for-diary-here ()
1286 "" 1911 ""
1287 (interactive) 1912 (interactive)
1913 (todos-insert-item nil 'ask-date 'ask-time t t))
1914
1915(defun todos-insert-item-ask-date-time-here ()
1916 ""
1917 (interactive)
1918 (todos-insert-item nil 'ask-date 'ask-time nil t))
1919
1920(defun todos-insert-item-ask-date-maybe-notime (&optional arg)
1921 ""
1922 (interactive "P")
1923 (let ((todos-always-add-time-string (not todos-always-add-time-string)))
1924 (todos-insert-item arg 'ask-date)))
1925
1926(defun todos-insert-item-ask-date-maybe-notime-for-diary (&optional arg)
1927 ""
1928 (interactive "P")
1929 (let ((todos-always-add-time-string (not todos-always-add-time-string)))
1930 (todos-insert-item arg 'ask-date nil t)))
1931
1932(defun todos-insert-item-ask-date-maybe-notime-for-diary-here ()
1933 ""
1934 (interactive)
1935 (let ((todos-always-add-time-string (not todos-always-add-time-string)))
1936 (todos-insert-item nil 'ask-date nil t t)))
1937
1938(defun todos-insert-item-ask-date-maybe-notime-here ()
1939 ""
1940 (interactive)
1941 (let ((todos-always-add-time-string (not todos-always-add-time-string)))
1942 (todos-insert-item nil 'ask-date nil nil nil t)))
1943
1944(defun todos-insert-item-ask-date-for-diary (&optional arg)
1945 ""
1946 (interactive "P")
1947 (todos-insert-item arg 'ask-date nil t))
1948
1949(defun todos-insert-item-ask-date-for-diary-here ()
1950 ""
1951 (interactive)
1952 (todos-insert-item nil 'ask-date nil t t))
1953
1954(defun todos-insert-item-ask-date-here ()
1955 ""
1956 (interactive)
1957 (todos-insert-item nil 'ask-date nil nil t))
1958
1959(defun todos-insert-item-ask-dayname (&optional arg)
1960 ""
1961 (interactive "P")
1962 (todos-insert-item arg 'ask-dayname))
1963
1964(defun todos-insert-item-ask-dayname-time (&optional arg)
1965 ""
1966 (interactive "P")
1967 (todos-insert-item arg 'ask-dayname 'ask-time))
1968
1969(defun todos-insert-item-ask-dayname-time-for-diary (&optional arg)
1970 ""
1971 (interactive "P")
1972 (todos-insert-item arg 'ask-dayname 'ask-time t))
1973
1974(defun todos-insert-item-ask-dayname-time-for-diary-here ()
1975 ""
1976 (interactive)
1977 (todos-insert-item nil 'ask-dayname 'ask-time t t))
1978
1979(defun todos-insert-item-ask-dayname-time-here ()
1980 ""
1981 (interactive)
1982 (todos-insert-item nil 'ask-dayname 'ask-time nil t))
1983
1984(defun todos-insert-item-ask-dayname-maybe-notime (&optional arg)
1985 ""
1986 (interactive "P")
1987 (let ((todos-always-add-time-string (not todos-always-add-time-string)))
1988 (todos-insert-item arg 'ask-dayname)))
1989
1990(defun todos-insert-item-ask-dayname-maybe-notime-for-diary (&optional arg)
1991 ""
1992 (interactive "P")
1993 (let ((todos-always-add-time-string (not todos-always-add-time-string)))
1994 (todos-insert-item arg 'ask-dayname nil t)))
1995
1996(defun todos-insert-item-ask-dayname-maybe-notime-for-diary-here ()
1997 ""
1998 (interactive)
1999 (let ((todos-always-add-time-string (not todos-always-add-time-string)))
2000 (todos-insert-item nil 'ask-dayname nil t t)))
2001
2002(defun todos-insert-item-ask-dayname-maybe-notime-here ()
2003 ""
2004 (interactive)
2005 (let ((todos-always-add-time-string (not todos-always-add-time-string)))
2006 (todos-insert-item nil 'ask-dayname nil nil t)))
2007
2008(defun todos-insert-item-ask-dayname-for-diary (&optional arg)
2009 ""
2010 (interactive "P")
2011 (todos-insert-item arg 'ask-dayname nil t))
2012
2013(defun todos-insert-item-ask-dayname-for-diary-here ()
2014 ""
2015 (interactive)
2016 (todos-insert-item nil 'ask-dayname nil t t))
2017
2018(defun todos-insert-item-ask-dayname-here ()
2019 ""
2020 (interactive)
2021 (todos-insert-item nil 'ask-dayname nil nil t))
2022
2023(defun todos-insert-item-ask-time (&optional arg)
2024 ""
2025 (interactive "P")
2026 (todos-insert-item arg nil 'ask-time))
2027
2028(defun todos-insert-item-ask-time-for-diary (&optional arg)
2029 ""
2030 (interactive "P")
2031 (todos-insert-item arg nil 'ask-time t))
2032
2033(defun todos-insert-item-ask-time-for-diary-here ()
2034 ""
2035 (interactive)
2036 (todos-insert-item nil nil 'ask-time t t))
2037
2038(defun todos-insert-item-ask-time-here ()
2039 ""
2040 (interactive)
2041 (todos-insert-item nil nil 'ask-time nil t))
2042
2043(defun todos-insert-item-maybe-notime (&optional arg)
2044 ""
2045 (interactive "P")
2046 (let ((todos-always-add-time-string (not todos-always-add-time-string)))
2047 (todos-insert-item arg)))
2048
2049(defun todos-insert-item-maybe-notime-for-diary (&optional arg)
2050 ""
2051 (interactive "P")
2052 (let ((todos-always-add-time-string (not todos-always-add-time-string)))
2053 (todos-insert-item arg nil nil t)))
2054
2055(defun todos-insert-item-maybe-notime-for-diary-here ()
2056 ""
2057 (interactive)
2058 (let ((todos-always-add-time-string (not todos-always-add-time-string)))
2059 (todos-insert-item nil nil nil t t)))
2060
2061(defun todos-insert-item-maybe-notime-here ()
2062 ""
2063 (interactive)
2064 (let ((todos-always-add-time-string (not todos-always-add-time-string)))
2065 (todos-insert-item nil nil nil nil t)))
2066
2067(defun todos-insert-item-for-diary (&optional arg)
2068 ""
2069 (interactive "P")
2070 (todos-insert-item nil nil nil t))
2071
2072(defun todos-insert-item-for-diary-here ()
2073 ""
2074 (interactive)
2075 (todos-insert-item nil nil nil t t))
2076
2077(defun todos-insert-item-here ()
2078 "Insert new Todo item directly above the item at point.
2079If point is on an empty line, insert the new item there."
2080 (interactive)
1288 (todos-insert-item nil nil nil nil t)) 2081 (todos-insert-item nil nil nil nil t))
1289 2082
1290;; FIXME: autoload when key-binding is defined in calendar.el 2083;; FIXME: autoload when key-binding is defined in calendar.el
1291(defun todos-insert-item-from-calendar () 2084(defun todos-insert-item-from-calendar ()
1292 "" 2085 ""
1293 (interactive) 2086 (interactive)
1294 (pop-to-buffer (file-name-nondirectory todos-file-do)) 2087 (pop-to-buffer (file-name-nondirectory todos-current-todos-file))
1295 (todos-show) ;FIXME: todos-category-select ? 2088 (todos-show)
1296 (todos-insert-item t 'calendar)) 2089 (todos-insert-item t 'calendar))
1297 2090
1298;; FIXME: calendar is loaded before todos 2091;; FIXME: calendar is loaded before todos
@@ -1305,39 +2098,53 @@ there."
1305 (interactive) 2098 (interactive)
1306 (if (> (count-lines (point-min) (point-max)) 0) 2099 (if (> (count-lines (point-min) (point-max)) 0)
1307 (let* ((buffer-read-only) 2100 (let* ((buffer-read-only)
1308 (todos-entry (todos-item-string-start)) 2101 (item (todos-item-string-start))
1309 (todos-answer (y-or-n-p (concat "Permanently remove '" 2102 (diary-item (todos-diary-item-p))
1310 todos-entry "'? ")))) 2103 (cat (todos-current-category))
1311 (when todos-answer 2104 (answer (y-or-n-p (concat "Permanently remove '" item "'? "))))
2105 (when answer
1312 (todos-remove-item) 2106 (todos-remove-item)
1313 (when (and (bolp) (eolp) 2107 (when (and (bolp) (eolp)
1314 ;; not if last item was deleted 2108 ;; not if last item was deleted
1315 (< (point-min) (point-max))) 2109 (< (point-min) (point-max)))
1316 (todos-backward-item)) 2110 (todos-backward-item))
1317 (todos-item-counts (todos-current-category) 'delete) 2111 (todos-item-counts cat 'delete)
2112 (and diary-item (todos-item-counts cat 'nondiary))
2113 (todos-update-categories-sexp)
1318 (todos-prefix-overlays))) 2114 (todos-prefix-overlays)))
1319 (message "No TODO list entry to delete"))) ;FIXME: better message 2115 (message "No TODO list entry to delete"))) ;FIXME: better message
1320 2116
1321(defun todos-edit-item () 2117(defun todos-edit-item ()
1322 "Edit current TODO list entry." 2118 "Edit current TODO list entry."
1323 (interactive) 2119 (interactive)
1324 (let ((buffer-read-only) 2120 (when (todos-item-string)
1325 (item (todos-item-string)) 2121 (let* ((buffer-read-only)
1326 (opoint (point))) 2122 (start (todos-item-start))
1327 (if (todos-string-multiline-p item) 2123 (item-beg (progn
1328 (todos-edit-multiline) 2124 (re-search-forward
1329 (let ((new (read-from-minibuffer "Edit: " item))) 2125 (concat todos-date-string-start todos-date-pattern
1330 (while (not (string-match (concat "^\\[?" todos-date-pattern) new)) 2126 "\\( " diary-time-regexp "\\)?"
1331 (setq new (read-from-minibuffer "Item must start with a date: " new))) 2127 (regexp-quote todos-nondiary-end) "?")
1332 ;; indent newlines inserted by C-q C-j if nonspace char follows 2128 (line-end-position) t)
1333 (setq new (replace-regexp-in-string 2129 (1+ (- (point) start))))
1334 "\\(\n\\)[^[:blank:]]" 2130 (item (todos-item-string))
1335 (concat "\n" (make-string todos-indent-to-here 32)) new 2131 (opoint (point)))
1336 nil nil 1)) 2132 (if (todos-string-multiline-p item)
1337 ;; If user moved point during editing, make sure it moves back. 2133 (todos-edit-multiline)
1338 (goto-char opoint) 2134 (let ((new (read-string "Edit: " (cons item item-beg))))
1339 (todos-remove-item) 2135 (while (not (string-match (concat todos-date-string-start
1340 (todos-insert-with-overlays new))))) 2136 todos-date-pattern) new))
2137 (setq new (read-from-minibuffer "Item must start with a date: " new)))
2138 ;; indent newlines inserted by C-q C-j if nonspace char follows
2139 (setq new (replace-regexp-in-string
2140 "\\(\n\\)[^[:blank:]]"
2141 (concat "\n" (make-string todos-indent-to-here 32)) new
2142 nil nil 1))
2143 ;; If user moved point during editing, make sure it moves back.
2144 (goto-char opoint)
2145 (todos-remove-item)
2146 (todos-insert-with-overlays new)
2147 (move-to-column item-beg))))))
1341 2148
1342;; FIXME: run todos-check-format on exiting buffer (or check for date string 2149;; FIXME: run todos-check-format on exiting buffer (or check for date string
1343;; and indentation) 2150;; and indentation)
@@ -1347,30 +2154,72 @@ there."
1347 (let ((buffer-name (generate-new-buffer-name todos-edit-buffer))) 2154 (let ((buffer-name (generate-new-buffer-name todos-edit-buffer)))
1348 (switch-to-buffer 2155 (switch-to-buffer
1349 (make-indirect-buffer 2156 (make-indirect-buffer
1350 (file-name-nondirectory todos-file-do) buffer-name)) 2157 (file-name-nondirectory todos-current-todos-file) buffer-name))
1351 (message "To exit, simply kill this buffer and return to list.") 2158 (narrow-to-region (todos-item-start) (todos-item-end))
1352 (todos-edit-mode) 2159 (todos-edit-mode)
1353 (narrow-to-region (todos-item-start) (todos-item-end)))) 2160 (message "Type %s to return to Todos mode."
2161 (key-description (car (where-is-internal 'todos-edit-quit))))))
1354 2162
1355(defun todos-edit-quit () 2163(defun todos-edit-quit ()
1356 "" 2164 ""
1357 (interactive) 2165 (interactive)
2166 (todos-save)
2167 ;; (unlock-buffer)
2168 (kill-buffer)
1358 (save-excursion (todos-category-select))) 2169 (save-excursion (todos-category-select)))
1359 2170
1360;; FIXME: complete 2171(defun todos-edit-item-header (&optional part)
1361(defun todos-edit-item-header ()
1362 "" 2172 ""
1363 (interactive) 2173 (interactive)
1364 (todos-item-start) 2174 (todos-item-start)
1365 (re-search-forward (concat "^\\[?\\(?1:" todos-date-pattern 2175 (re-search-forward (concat todos-date-string-start "\\(?1:" todos-date-pattern
1366 "\\) \\(?2:" diary-time-regexp "\\)") 2176 "\\)\\(?2: " diary-time-regexp "\\)?")
1367 (line-end-position) t) 2177 (line-end-position) t)
1368 ;; ask date or dayname 2178 (let* ((odate (match-string-no-properties 1))
1369 (replace-match new-date nil nil nil 1) 2179 (otime (match-string-no-properties 2))
1370 ;; ask time 2180 (buffer-read-only)
1371 (replace-match new-date nil nil nil 2)) 2181 ndate ntime nheader)
2182 (unless (eq part 'timeonly)
2183 (setq ndate (if (save-match-data (string-match "[0-9]+" odate))
2184 (if (y-or-n-p "Change date? ")
2185 (todos-read-date)
2186 (todos-read-dayname))
2187 (if (y-or-n-p "Change day? ")
2188 (todos-read-dayname)
2189 (todos-read-date))))
2190 (replace-match ndate nil nil nil 1))
2191 (unless (eq part 'dateonly)
2192 (setq ntime (save-match-data (todos-read-time)))
2193 (when (< 0 (length ntime)) (setq ntime (concat " " ntime)))
2194 (if otime
2195 (replace-match ntime nil nil nil 2)
2196 (goto-char (match-end 1))
2197 (insert ntime)))))
2198
2199(defun todos-edit-item-date ()
2200 ""
2201 (interactive)
2202 (todos-edit-item-header 'dateonly))
2203
2204(defun todos-edit-item-date-is-today ()
2205 ""
2206 (interactive)
2207 (todos-edit-item-header 'today))
2208
2209(defun todos-edit-item-time ()
2210 ""
2211 (interactive)
2212 (todos-edit-item-header 'timeonly))
2213
2214;; (progn
2215;; (re-search-forward "\\(?1:foo\\)\\(ba\\)\\(?2:z\\)?" nil t)
2216;; (goto-char (point-max))
2217;; (concat (match-string-no-properties 1) ", " (match-string-no-properties 2)))
2218
2219;; foobaz
1372 2220
1373(defun todos-raise-item () 2221
2222(defun todos-raise-item-priority ()
1374 "Raise priority of current entry." 2223 "Raise priority of current entry."
1375 (interactive) 2224 (interactive)
1376 (unless (or (todos-done-item-p) 2225 (unless (or (todos-done-item-p)
@@ -1378,17 +2227,35 @@ there."
1378 (let (buffer-read-only) 2227 (let (buffer-read-only)
1379 (if (> (count-lines (point-min) (point)) 0) 2228 (if (> (count-lines (point-min) (point)) 0)
1380 (let ((item (todos-item-string))) 2229 (let ((item (todos-item-string)))
2230 (when (eq major-mode 'todos-top-priorities-mode)
2231 (let ((cat1 (save-excursion
2232 (re-search-forward
2233 (concat todos-date-string-start todos-date-pattern
2234 "\\( " diary-time-regexp
2235 "\\)?\\]?\\(?1: \\[\\(.+:\\)?.+\\]\\)")
2236 nil t)
2237 (match-string 1)))
2238 (cat2 (save-excursion
2239 (todos-backward-item)
2240 (re-search-forward
2241 (concat todos-date-string-start todos-date-pattern
2242 "\\( " diary-time-regexp
2243 "\\)?\\]?\\(?1: \\[\\(.+:\\)?.+\\]\\)")
2244 nil t)
2245 (match-string 1))))
2246 (if (string= cat1 cat2)
2247 (error "Cannot change item's priority in its category; do this in Todos mode"))))
1381 (todos-remove-item) 2248 (todos-remove-item)
1382 (todos-backward-item) 2249 (todos-backward-item)
1383 (todos-insert-with-overlays item)) 2250 (todos-insert-with-overlays item))
1384 (message "No TODO list entry to raise"))))) ;FIXME: better message 2251 (message "No TODO list entry to raise"))))) ;FIXME: better message
1385 2252
1386(defun todos-lower-item () 2253(defun todos-lower-item-priority ()
1387 "Lower priority of current entry." 2254 "Lower priority of current entry."
1388 (interactive) 2255 (interactive)
1389 (unless (or (todos-done-item-p) 2256 (unless (or (todos-done-item-p)
1390 (looking-at "^$")) ; between done and not done items 2257 (looking-at "^$")) ; between done and not done items
1391 (let* ((buffer-read-only)) 2258 (let (buffer-read-only)
1392 (if (save-excursion 2259 (if (save-excursion
1393 ;; can only lower non-final unfinished item 2260 ;; can only lower non-final unfinished item
1394 (todos-forward-item) 2261 (todos-forward-item)
@@ -1396,118 +2263,162 @@ there."
1396 (not (todos-done-item-p)))) 2263 (not (todos-done-item-p))))
1397 ;; Assume there is a final newline 2264 ;; Assume there is a final newline
1398 (let ((item (todos-item-string))) 2265 (let ((item (todos-item-string)))
2266 (when (eq major-mode 'todos-top-priorities-mode)
2267 (let ((cat1 (save-excursion
2268 (re-search-forward
2269 (concat todos-date-string-start todos-date-pattern
2270 "\\( " diary-time-regexp
2271 "\\)?\\]?\\(?1: \\[\\(.+:\\)?.+\\]\\)")
2272 nil t)
2273 (match-string 1)))
2274 (cat2 (save-excursion
2275 (todos-forward-item)
2276 (re-search-forward
2277 (concat todos-date-string-start todos-date-pattern
2278 "\\( " diary-time-regexp
2279 "\\)?\\]?\\(?1: \\[\\(.+:\\)?.+\\]\\)")
2280 nil t)
2281 (match-string 1))))
2282 (if (string= cat1 cat2)
2283 (error "Cannot change item's priority in its category; do this in Todos mode"))))
1399 (todos-remove-item) 2284 (todos-remove-item)
1400 (todos-forward-item) 2285 (todos-forward-item)
1401 (when (todos-done-item-p) (forward-line -1)) 2286 (when (todos-done-item-p) (forward-line -1))
1402 (todos-insert-with-overlays item)) 2287 (todos-insert-with-overlays item))
1403 (message "No TODO list entry to lower"))))) ;FIXME: better message 2288 (message "No TODO list entry to lower"))))) ;FIXME: better message
1404 2289
1405(defun todos-move-item () 2290(defun todos-set-item-priority (item cat)
2291 "Set priority of todo ITEM in category CAT and move item to suit."
2292 (interactive (list (todos-item-string) (todos-current-category)))
2293 (unless (called-interactively-p t)
2294 (todos-category-number cat)
2295 (todos-category-select))
2296 (let* ((todo (todos-get-count 'todo cat))
2297 (maxnum (1+ todo))
2298 (buffer-read-only)
2299 priority candidate prompt)
2300 (unless (zerop todo)
2301 (while (not priority)
2302 (setq candidate
2303 (string-to-number (read-from-minibuffer
2304 (concat prompt
2305 (format "Set item priority (1-%d): "
2306 maxnum)))))
2307 (setq prompt
2308 (when (or (< candidate 1) (> candidate maxnum))
2309 (format "Priority must be an integer between 1 and %d.\n" maxnum)))
2310 (unless prompt (setq priority candidate)))
2311 ;; interactively, just relocate the item within its category
2312 (when (called-interactively-p) (todos-remove-item))
2313 (goto-char (point-min))
2314 (unless (= priority 1) (todos-forward-item (1- priority))))
2315 (todos-insert-with-overlays item)))
2316
2317;; (defun todos-set-item-top-priority ()
2318;; "Set priority of item at point in the top priorities listing."
2319;; (interactive)
2320;; (let* ((item (todos-item-string))
2321;; (cat (save-excursion
2322;; (re-search-forward
2323;; (concat todos-date-string-start todos-date-pattern
2324;; "\\( " diary-time-regexp
2325;; "\\)?\\]?\\(?1: \\[\\(.+:\\)?.+\\]\\)")
2326;; nil t)
2327;; (match-string 1)))
2328;; (opoint (point))
2329;; (count 1)
2330;; (old-priority (save-excursion
2331;; (goto-char (point-min))
2332;; (while (< (point) opoint)
2333;; (todos-forward-item)
2334;; (setq count (1+ count))))))
2335;; )
2336
2337(defun todos-move-item (&optional file)
1406 "Move the current todo item to another, interactively named, category. 2338 "Move the current todo item to another, interactively named, category.
1407 2339
1408If the named category is not one of the current todo categories, then 2340If the named category is not one of the current todo categories,
1409it is created and the item becomes the first entry in that category." 2341then it is created and the item becomes the first entry in that
2342category.
2343
2344With optional non-nil argument FILE, first ask for another Todos
2345file and then solicit a category within that file to move the
2346item to."
1410 (interactive) 2347 (interactive)
1411 (unless (or (todos-done-item-p) 2348 (unless (or (todos-done-item-p)
1412 (looking-at "^$")) ; between done and not done items 2349 (looking-at "^$")) ; between done and not done items
1413 (let ((buffer-read-only) 2350 (let ((buffer-read-only)
2351 (modified (buffer-modified-p))
2352 (oldfile todos-current-todos-file)
1414 (oldnum todos-category-number) 2353 (oldnum todos-category-number)
1415 (oldcat (todos-current-category)) 2354 (oldcat (todos-current-category))
1416 (item (todos-item-string)) 2355 (item (todos-item-string))
1417 (newcat (todos-read-category)) 2356 (diary-item (todos-diary-item-p))
2357 (newfile (if file (todos-read-file-name "Choose a Todos file: ")))
1418 (opoint (point)) 2358 (opoint (point))
1419 (orig-mrk (progn (todos-item-start) (point-marker))) 2359 (orig-mrk (progn (todos-item-start) (point-marker)))
1420 moved) 2360 newcat moved)
1421 (todos-remove-item)
1422 (unwind-protect 2361 (unwind-protect
1423 (progn 2362 (progn
1424 (unless (member newcat todos-categories) (todos-add-category newcat)) 2363 (todos-remove-item)
2364 (todos-item-counts oldcat 'delete)
2365 (and diary-item (todos-item-counts oldcat 'nondiary))
2366 (when newfile
2367 (find-file-existing newfile)
2368 (setq todos-current-todos-file newfile
2369 todos-categories (todos-make-categories-list)))
2370 (setq newcat (todos-read-category "Move item to category: "))
2371 (unless (assoc newcat todos-categories) (todos-add-category newcat))
1425 (todos-set-item-priority item newcat) 2372 (todos-set-item-priority item newcat)
1426 (todos-insert-with-overlays item)
1427 (setq moved t) 2373 (setq moved t)
1428 (todos-item-counts oldcat 'delete) 2374 (todos-item-counts newcat 'insert)
1429 (todos-item-counts newcat 'insert)) 2375 (and diary-item (todos-item-counts newcat 'diary)))
1430 (unless moved 2376 (unless moved
2377 (if newfile
2378 (find-file-existing oldfile)
2379 (setq todos-current-todos-file oldfile
2380 todos-categories (todos-make-categories-list)))
1431 (widen) 2381 (widen)
1432 (goto-char orig-mrk) 2382 (goto-char orig-mrk)
1433 (todos-insert-with-overlays item) 2383 (todos-insert-with-overlays item)
1434 (setq todos-category-number oldnum) 2384 (setq todos-category-number oldnum)
2385 (todos-item-counts oldcat 'insert)
2386 (and diary-item (todos-item-counts oldcat 'diary))
1435 (todos-category-select) 2387 (todos-category-select)
1436 ;; FIXME: does this work? 2388 (set-buffer-modified-p modified)
1437 (goto-char opoint)) 2389 (goto-char opoint))
1438 (set-marker orig-mrk nil))))) 2390 (set-marker orig-mrk nil)))))
1439 2391
2392(defun todos-move-item-to-file ()
2393 ""
2394 (interactive)
2395 (todos-move-item t))
2396
1440(defun todos-item-done () 2397(defun todos-item-done ()
1441 "Mark current item as done and move it to category's done section." 2398 "Mark current item as done and move it to category's done section."
1442 (interactive) 2399 (interactive)
1443 (unless (or (todos-done-item-p) 2400 (unless (or (todos-done-item-p)
1444 (looking-at "^$")) 2401 (looking-at "^$"))
1445 (let* ((buffer-read-only) 2402 (let* ((buffer-read-only)
2403 (cat (todos-current-category))
1446 (item (todos-item-string)) 2404 (item (todos-item-string))
2405 (diary-item (todos-diary-item-p))
1447 (date-string (calendar-date-string (calendar-current-date) t t)) 2406 (date-string (calendar-date-string (calendar-current-date) t t))
1448 (time-string (if todos-always-add-time-string ;FIXME: delete condition 2407 (time-string (if todos-always-add-time-string ;FIXME: delete condition
1449 (concat " " (substring (current-time-string) 11 16)) 2408 (concat " " (substring (current-time-string) 11 16))
1450 "")) 2409 ""))
1451 (done-item (concat "[" todos-done-string date-string time-string "] " item)) 2410 ;; FIXME: todos-nondiary-*
1452 (items-end (point-max)) 2411 (done-item (concat "[" todos-done-string date-string time-string "] "
1453 next-cat) 2412 item)))
1454 (todos-remove-item) 2413 (todos-remove-item)
1455 (save-excursion 2414 (save-excursion
1456 (widen) 2415 (widen)
1457 (setq next-cat 2416 (re-search-forward (concat "^" (regexp-quote todos-category-done)) nil t)
1458 (save-excursion 2417 (forward-char)
1459 (if (re-search-forward (concat "^" (regexp-quote todos-category-beg)) 2418 (todos-insert-with-overlays done-item))
1460 nil t) 2419 (todos-item-counts cat 'done)
1461 (match-beginning 0) 2420 (and diary-item (todos-item-counts cat 'nondiary))
1462 (point-max)))) 2421 (save-excursion (todos-category-select)))))
1463 ;; insert next done item at the top of the done items list
1464 (if (re-search-forward (concat "^\\[" (regexp-quote todos-done-string))
1465 next-cat t)
1466 (goto-char (match-beginning 0))
1467 ;; need empty line between done and not done items in order not to have
1468 ;; hanging todos-prefix when done items are hidden
1469 (goto-char next-cat)
1470 (newline))
1471 (todos-insert-with-overlays done-item)))
1472 (todos-item-counts (todos-current-category) 'done)
1473 (todos-category-select)))
1474
1475(defun todos-archive-done-items ()
1476 "Archive the done items in the current category."
1477 (interactive)
1478 (let ((archive (find-file-noselect todos-archive-file t))
1479 (cat (todos-current-category))
1480 (buffer-read-only)
1481 beg end)
1482 (save-excursion
1483 (save-restriction
1484 (widen)
1485 (setq end (if (re-search-forward
1486 (concat "^" (regexp-quote todos-category-beg)) nil t)
1487 (match-beginning 0)
1488 (point-max)))
1489 (re-search-backward (concat "^" (regexp-quote todos-category-beg)
1490 (regexp-quote cat))
1491 nil t)
1492 (if (not (re-search-forward (concat "^\\[" (regexp-quote todos-done-string))
1493 nil t))
1494 (error "No done items in this category")
1495 (setq beg (match-beginning 0))
1496 (setq done (buffer-substring beg end))
1497 ;; FIXME: update archive alist
1498 (with-current-buffer archive
1499 (goto-char (point-min))
1500 (if (re-search-forward (regexp-quote (concat "^" todos-category-beg cat))
1501 nil t)
1502 (forward-char)
1503 (insert todos-category-beg cat "\n"))
1504 (insert done)
1505 (save-buffer))
1506 (delete-region beg end)
1507 (remove-overlays beg end)
1508 (kill-line -1)
1509 (todos-item-counts cat 'archive)))))
1510 (message "Done items archived."))
1511 2422
1512(defun todos-item-undo () 2423(defun todos-item-undo ()
1513 "" 2424 ""
@@ -1525,9 +2436,9 @@ it is created and the item becomes the first entry in that category."
1525 (unwind-protect 2436 (unwind-protect
1526 (progn 2437 (progn
1527 (todos-set-item-priority item cat) 2438 (todos-set-item-priority item cat)
1528 (todos-insert-with-overlays item)
1529 (setq undone t) 2439 (setq undone t)
1530 (todos-item-counts cat 'undo)) 2440 (todos-item-counts cat 'undo)
2441 (and (todos-diary-item-p) (todos-item-counts cat 'diary)))
1531 (unless undone 2442 (unless undone
1532 (widen) 2443 (widen)
1533 (goto-char orig-mrk) 2444 (goto-char orig-mrk)
@@ -1537,6 +2448,101 @@ it is created and the item becomes the first entry in that category."
1537 (goto-char opoint))) 2448 (goto-char opoint)))
1538 (set-marker orig-mrk nil))))) 2449 (set-marker orig-mrk nil)))))
1539 2450
2451(defun todos-archive-done-items ()
2452 "Archive the done items in the current category."
2453 (interactive)
2454 (let ((cat (todos-current-category)))
2455 (if (zerop (todos-get-count 'done cat))
2456 (message "No done items in this category")
2457 (when (y-or-n-p "Move all done items in this category to the archive? ")
2458 (let* ((afile (concat (file-name-sans-extension (buffer-file-name)) ".toda"))
2459 (archive (find-file-noselect afile t))
2460 beg end
2461 (buffer-read-only nil))
2462 (save-excursion
2463 (save-restriction
2464 (goto-char (point-min))
2465 (widen)
2466 (setq beg (progn
2467 (re-search-forward todos-done-string-start nil t)
2468 (match-beginning 0)))
2469 (setq end (if (re-search-forward
2470 (concat "^" (regexp-quote todos-category-beg)) nil t)
2471 (match-beginning 0)
2472 (point-max)))
2473 (setq done (buffer-substring beg end))
2474 (with-current-buffer archive
2475 (let (buffer-read-only)
2476 (widen)
2477 (goto-char (point-min))
2478 (if (progn
2479 (re-search-forward
2480 (concat "^" (regexp-quote (concat todos-category-beg cat)))
2481 nil t)
2482 (re-search-forward (regexp-quote todos-category-done) nil t))
2483 (forward-char)
2484 (insert todos-category-beg cat "\n\n" todos-category-done "\n"))
2485 (insert done)
2486 (save-buffer)))
2487 (remove-overlays beg end)
2488 (delete-region beg end)
2489 (todos-item-counts cat 'archive)))))
2490 (message "Done items archived."))))
2491
2492(defun todos-unarchive-category ()
2493 "Restore this archived category to done items in Todos file."
2494 (interactive)
2495 (when (y-or-n-p "Restore all items in this category to Todos file as done items? ")
2496 (let ((buffer-read-only nil)
2497 (tbuf (find-file-noselect
2498 (concat (file-name-sans-extension (buffer-file-name)) ".todo")
2499 t))
2500 (cat (todos-current-category))
2501 (items (buffer-substring (point-min) (point-max))))
2502 (with-current-buffer tbuf
2503 (let (buffer-read-only)
2504 (widen)
2505 (goto-char (point-min))
2506 (re-search-forward (concat "^" (regexp-quote
2507 (concat todos-category-beg cat)))
2508 nil t)
2509 (if (re-search-forward (concat "^" (regexp-quote todos-category-beg))
2510 nil t)
2511 (goto-char (match-beginning 0))
2512 (goto-char (point-max)))
2513 (insert items)))
2514 (widen)
2515 (let ((beg (re-search-backward (concat "^"
2516 (regexp-quote todos-category-beg)
2517 cat) nil t))
2518 (end (if (re-search-forward
2519 (concat "^" (regexp-quote todos-category-beg)) nil t 2)
2520 (match-beginning 0)
2521 (point-max))))
2522 (remove-overlays beg end)
2523 (delete-region beg end))
2524 (goto-char (point-min))
2525 (if (re-search-forward
2526 (concat "^" (regexp-quote todos-category-beg)) nil t)
2527 (progn
2528 ;; delete category from archive
2529 (setq todos-categories (delete (assoc cat todos-categories)
2530 todos-categories))
2531 (todos-update-categories-sexp))
2532 ;; no more categories in archive, so delete it
2533 (set-buffer-modified-p nil) ; no questions
2534 (delete-file (buffer-file-name))
2535 (kill-buffer))
2536 (let ((tfile (buffer-file-name tbuf))
2537 (todos-show-with-done t))
2538 (find-file tfile)
2539 (setq todos-current-todos-file tfile
2540 ;; also updates item counts
2541 todos-categories (todos-make-categories-list t)
2542 todos-category-number (todos-category-number cat))
2543 (todos-show)
2544 (message "Items unarchived.")))))
2545
1540(defun todos-toggle-item-diary-inclusion () 2546(defun todos-toggle-item-diary-inclusion ()
1541 "" 2547 ""
1542 (interactive) 2548 (interactive)
@@ -1546,16 +2552,19 @@ it is created and the item becomes the first entry in that category."
1546 (lim (save-excursion (todos-item-end))) 2552 (lim (save-excursion (todos-item-end)))
1547 (end (save-excursion 2553 (end (save-excursion
1548 (or (todos-time-string-match lim) 2554 (or (todos-time-string-match lim)
1549 (todos-date-string-match lim))))) 2555 (todos-date-string-match lim))))
1550 (if (looking-at "\\[") ; FIXME use todos-exclusion-start 2556 (cat (todos-current-category)))
2557 (if (looking-at (regexp-quote todos-nondiary-start))
1551 (progn 2558 (progn
1552 (replace-match "") 2559 (replace-match "")
1553 (search-forward "]" (1+ end) t) ; FIXME use todos-exclusion-end 2560 (search-forward todos-nondiary-end (1+ end) t)
1554 (replace-match "")) 2561 (replace-match "")
2562 (todos-item-counts cat 'nondiary))
1555 (when end 2563 (when end
1556 (insert "[") ; FIXME use todos-exclusion-start 2564 (insert todos-nondiary-start)
1557 (goto-char (1+ end)) 2565 (goto-char (1+ end))
1558 (insert "]")))))) ; FIXME use todos-exclusion-end 2566 (insert todos-nondiary-end)
2567 (todos-item-counts cat 'diary))))))
1559 2568
1560(defun todos-toggle-diary-inclusion (arg) 2569(defun todos-toggle-diary-inclusion (arg)
1561 "" 2570 ""
@@ -1568,11 +2577,32 @@ it is created and the item becomes the first entry in that category."
1568 (when (eq arg 2) 2577 (when (eq arg 2)
1569 (re-search-forward (concat "^" (regexp-quote todos-category-beg)) nil t) 2578 (re-search-forward (concat "^" (regexp-quote todos-category-beg)) nil t)
1570 (forward-line) 2579 (forward-line)
1571 (when (looking-at (regexp-quote todos-category-end)) (forward-line))) 2580 (when (looking-at (regexp-quote todos-category-done)) (forward-line)))
1572 (while (not (eobp)) 2581 (while (not (eobp))
1573 (todos-toggle-item-diary-inclusion) 2582 (todos-toggle-item-diary-inclusion)
1574 (todos-forward-item)))))) 2583 (todos-forward-item))))))
1575 2584
2585(defun todos-toggle-item-diary-nonmarking ()
2586 ""
2587 (interactive)
2588 (let ((buffer-read-only))
2589 (save-excursion
2590 (todos-item-start)
2591 (unless (looking-at (regexp-quote todos-nondiary-start))
2592 (if (looking-at (regexp-quote diary-nonmarking-symbol))
2593 (replace-match "")
2594 (insert diary-nonmarking-symbol))))))
2595
2596(defun todos-toggle-diary-nonmarking ()
2597 ""
2598 (interactive)
2599 (save-excursion
2600 (goto-char (point-min))
2601 (while (not (eobp))
2602 (todos-toggle-item-diary-nonmarking)
2603 (todos-forward-item))))
2604
2605;; FIXME: save to a file named according to the current todos file
1576(defun todos-save-top-priorities (&optional nof-priorities) 2606(defun todos-save-top-priorities (&optional nof-priorities)
1577 "Save top priorities for each category in `todos-file-top'. 2607 "Save top priorities for each category in `todos-file-top'.
1578 2608
@@ -1587,62 +2617,110 @@ defaults to `todos-show-priorities'."
1587 (write-file todos-file-top) 2617 (write-file todos-file-top)
1588 (kill-this-buffer))))) 2618 (kill-this-buffer)))))
1589 2619
1590;;;###autoload 2620;; ;;;###autoload
1591(defun todos-print (&optional category-pr-page) 2621;; (defun todos-print (&optional category-pr-page)
1592 "Print todo summary using `todos-print-function'. 2622;; "Print todo summary using `todos-print-function'.
1593If CATEGORY-PR-PAGE is non-nil, a page separator `^L' is inserted 2623;; If CATEGORY-PR-PAGE is non-nil, a page separator `^L' is inserted
1594between each category. 2624;; between each category.
1595 2625
1596Number of entries for each category is given by `todos-print-priorities'." 2626;; Number of entries for each category is given by `todos-print-priorities'."
1597 (interactive "P") 2627;; (interactive "P")
1598 (when (yes-or-no-p "Print Todos list? ") 2628;; (when (yes-or-no-p "Print Todos list? ")
1599 (save-window-excursion 2629;; (save-window-excursion
1600 (save-excursion 2630;; (save-excursion
1601 (save-restriction 2631;; (save-restriction
1602 (todos-top-priorities todos-print-priorities 2632;; (todos-top-priorities todos-print-priorities
1603 category-pr-page) 2633;; category-pr-page)
1604 (set-buffer todos-tmp-buffer-name) 2634;; (set-buffer todos-tmp-buffer-name)
1605 (and (funcall todos-print-function) 2635;; (and (funcall todos-print-function)
1606 (kill-this-buffer)) 2636;; (kill-this-buffer))
1607 (message "Todo printing done.")))))) 2637;; (message "Todo printing done."))))))
2638
2639(defun todos-print ()
2640 ""
2641 (interactive)
2642 (let ((buf (cond ((eq major-mode 'todos-mode)
2643 (concat "Category: " (todos-current-category) " ("
2644 (file-name-nondirectory todos-current-todos-file) ") "))
2645 ((eq major-mode 'todos-top-priorities-mode)
2646 "Todos Top Priorities")))
2647 (prefix (propertize (concat todos-prefix " ") 'face 'todos-prefix-string))
2648 (num 0)
2649 (fill-prefix (make-string todos-indent-to-here 32))
2650 (content (buffer-string)))
2651 (with-current-buffer (get-buffer-create buf)
2652 (insert content)
2653 (goto-char (point-min))
2654 (while (not (eobp))
2655 (let ((beg (point))
2656 (end (save-excursion (todos-item-end))))
2657 (when todos-number-prefix
2658 (setq num (1+ num))
2659 (setq prefix (propertize (concat (number-to-string num) " ")
2660 'face 'todos-prefix-string)))
2661 (insert prefix)
2662 (fill-region beg end))
2663 (todos-forward-item))
2664 ;; FIXME: ask user to choose between sending to printer:
2665 ;; (ps-print-buffer-with-faces)
2666 ;; and printing to a file:
2667 (ps-spool-buffer-with-faces)
2668 ;; (write-file )
2669 )
2670 (kill-buffer buf)))
1608 2671
1609;; --------------------------------------------------------------------------- 2672;; ---------------------------------------------------------------------------
1610 2673
1611;;; Internal functions 2674;;; Internals
1612 2675
1613(defvar todos-date-pattern 2676(defvar todos-date-pattern ;FIXME: start with "^" ?
1614 (let ((dayname (diary-name-pattern calendar-day-name-array nil t))) 2677 (let ((dayname (diary-name-pattern calendar-day-name-array nil t)))
1615 (concat "\\(" dayname "\\|" 2678 (concat "\\(?:" dayname "\\|"
1616 (let ((dayname) 2679 (let ((dayname)
1617 (monthname (format "\\(%s\\|\\*\\)" 2680 (monthname (format "\\(?:%s\\|\\*\\)"
1618 (diary-name-pattern calendar-month-name-array 2681 (diary-name-pattern calendar-month-name-array
1619 calendar-month-abbrev-array 2682 calendar-month-abbrev-array
1620 t))) 2683 t)))
1621 (month "\\([0-9]+\\|\\*\\)") 2684 (month "\\(?:[0-9]+\\|\\*\\)")
1622 (day "\\([0-9]+\\|\\*\\)") 2685 (day "\\(?:[0-9]+\\|\\*\\)")
1623 (year "-?\\([0-9]+\\|\\*\\)")) 2686 (year "-?\\(?:[0-9]+\\|\\*\\)"))
1624 (mapconcat 'eval calendar-date-display-form "")) 2687 (mapconcat 'eval calendar-date-display-form ""))
1625 "\\)")) 2688 "\\)"))
1626 "Regular expression matching a Todos date header.") 2689 "Regular expression matching a Todos date header.")
1627 2690
2691(defvar todos-date-string-start
2692 (concat "^\\(" (regexp-quote todos-nondiary-start) "\\|"
2693 (regexp-quote diary-nonmarking-symbol) "\\)?") ;FIXME: matches anything
2694 "Regular expression matching part of item header before the date.")
2695
2696(defvar todos-done-string-start
2697 (concat "^" (regexp-quote todos-nondiary-start) (regexp-quote todos-done-string))
2698 "Regular expression matching start of done item.")
2699
2700;; FIXME: rename these *-matcher
1628(defun todos-date-string-match (lim) 2701(defun todos-date-string-match (lim)
1629 "Find Todos date strings within LIM for font-locking." 2702 "Search for Todos date strings within LIM for font-locking."
1630 (re-search-forward (concat "^\\[?" todos-date-pattern) lim t)) 2703 (re-search-forward (concat todos-date-string-start "\\(?1:"
2704 todos-date-pattern "\\)") lim t))
1631 2705
1632(defun todos-time-string-match (lim) 2706(defun todos-time-string-match (lim)
1633 "Find Todos time strings within LIM for font-locking." 2707 "Search for Todos time strings within LIM for font-locking."
1634 (re-search-forward (concat "^\\[?" todos-date-pattern 2708 (re-search-forward (concat todos-date-string-start todos-date-pattern
1635 " \\(?1:" diary-time-regexp "\\)") lim t)) 2709 " \\(?1:" diary-time-regexp "\\)") lim t))
1636 2710
1637(defun todos-done-string-match (lim) 2711(defun todos-done-string-match (lim)
1638 "Find Todos done headers within LIM for font-locking." 2712 "Search for Todos done headers within LIM for font-locking."
1639 (re-search-forward (concat "^\\[" (regexp-quote todos-done-string) "[^][]+]") 2713 (re-search-forward (concat todos-done-string-start
1640 lim t)) 2714 "[^][]+]")
2715 lim t))
1641 2716
1642(defun todos-category-string-match (lim) 2717(defun todos-category-string-match (lim)
1643 "Find Todos category headers within LIM for font-locking." 2718 "Search for Todos category headers within LIM for font-locking."
1644 (re-search-forward (concat "^" (regexp-quote todos-category-beg) ".*$") 2719 (if (eq major-mode 'todos-top-priorities-mode)
1645 lim t)) 2720 (re-search-forward
2721 ;; (concat "^\\(?1:" (regexp-quote todos-category-beg) ".*\\)$")
2722 (concat "\\(?:^\\[?" todos-date-pattern "\\(?: " diary-time-regexp
2723 "\\)?\\]?\\) \\(?1:\\[.+\\]\\)") lim t)))
1646 2724
1647(defun todos-check-format () 2725(defun todos-check-format ()
1648 "Signal an error if the current Todos file is ill-formatted." 2726 "Signal an error if the current Todos file is ill-formatted."
@@ -1694,19 +2772,22 @@ Number of entries for each category is given by `todos-print-priorities'."
1694 ;; if last not done item is multiline, then 2772 ;; if last not done item is multiline, then
1695 ;; todos-done-string-match skips empty line, so have 2773 ;; todos-done-string-match skips empty line, so have
1696 ;; to look back. 2774 ;; to look back.
1697 (and (looking-at (concat "^\\[" (regexp-quote todos-done-string))) 2775 (and (looking-at ;; (concat "^\\[" (regexp-quote todos-done-string))
1698 (looking-back "\n\n")) 2776 todos-done-string-start)
2777 (looking-back (concat "^" (regexp-quote todos-category-done)
2778 "\n")))
1699 (setq num 1)) 2779 (setq num 1))
1700 (setq prefix (propertize (concat (number-to-string num) " ") 2780 (setq prefix (propertize (concat (number-to-string num) " ")
1701 'face 'todos-prefix-string))) 2781 'face 'todos-prefix-string)))
1702 (let* ((ovs (overlays-in (point) (point))) 2782 (let* ((ovs (overlays-in (point) (point)))
1703 (ov-pref (car ovs)) 2783 (ov-pref (car ovs))
1704 (val (when ov-pref (overlay-get ov-pref 'before-string)))) 2784 (val (when ov-pref (overlay-get ov-pref 'before-string))))
2785 ;; FIXME: is this possible?
1705 (when (and (> (length ovs) 1) 2786 (when (and (> (length ovs) 1)
1706 (not (equal val prefix))) 2787 (not (equal val prefix)))
1707 (setq ov-pref (cadr ovs))) 2788 (setq ov-pref (cadr ovs)))
1708 (when (not (equal val prefix)) 2789 (when (not (equal val prefix))
1709 ;; (delete-overlay ov-pref) ; why doesn't this work ??? 2790 ;; (when ov-pref (delete-overlay ov-pref)) ; why doesn't this work ???
1710 (remove-overlays (point) (point)); 'before-string val) ; or this ??? 2791 (remove-overlays (point) (point)); 'before-string val) ; or this ???
1711 (setq ov-pref (make-overlay (point) (point))) 2792 (setq ov-pref (make-overlay (point) (point)))
1712 (overlay-put ov-pref 'before-string prefix)))) 2793 (overlay-put ov-pref 'before-string prefix))))
@@ -1714,125 +2795,174 @@ Number of entries for each category is given by `todos-print-priorities'."
1714 2795
1715(defun todos-reset-prefix (symbol value) 2796(defun todos-reset-prefix (symbol value)
1716 "Set SYMBOL's value to VALUE, and ." ; FIXME 2797 "Set SYMBOL's value to VALUE, and ." ; FIXME
1717 (let ((oldvalue (symbol-value symbol))) 2798 (let ((oldvalue (symbol-value symbol))
2799 (files (append todos-files todos-archives)))
1718 (custom-set-default symbol value) 2800 (custom-set-default symbol value)
1719 (when (not (equal value oldvalue)) 2801 (when (not (equal value oldvalue))
1720 (save-window-excursion 2802 (dolist (f files)
1721 (todos-show) 2803 (with-current-buffer (find-file-noselect f)
1722 (save-excursion 2804 (save-window-excursion
1723 (widen) 2805 (todos-show)
1724 (goto-char (point-min)) 2806 (save-excursion
1725 (while (not (eobp)) 2807 (widen)
1726 (remove-overlays (point) (point)); 'before-string prefix) 2808 (goto-char (point-min))
1727 (forward-line))) 2809 (while (not (eobp))
1728 ;; activate the prefix setting (save-restriction does not help) 2810 (remove-overlays (point) (point)); 'before-string prefix)
1729 (todos-category-select))))) 2811 (forward-line)))
2812 ;; activate the new setting (save-restriction does not help)
2813 (save-excursion (todos-category-select))))))))
1730 2814
1731(defun todos-reset-separator (symbol value) 2815(defun todos-reset-separator (symbol value)
1732 "Set SYMBOL's value to VALUE, and ." ; FIXME 2816 "Set SYMBOL's value to VALUE, and ." ; FIXME
1733 (let ((oldvalue (symbol-value symbol))) 2817 (let ((oldvalue (symbol-value symbol))
2818 (files (append todos-files todos-archives)))
1734 (custom-set-default symbol value) 2819 (custom-set-default symbol value)
1735 (when (not (equal value oldvalue)) 2820 (when (not (equal value oldvalue))
1736 (save-window-excursion 2821 (dolist (f files)
1737 (todos-show) 2822 (with-current-buffer (find-file-noselect f)
1738 (save-excursion 2823 (save-window-excursion
1739 (goto-char (point-min)) 2824 (todos-show)
1740 (when (re-search-forward (concat "^\\[" (regexp-quote todos-done-string)) 2825 (save-excursion
1741 nil t) 2826 (goto-char (point-min))
1742 (remove-overlays (point) (point)))) 2827 (when (re-search-forward
1743 ;; activate the prefix setting (save-restriction does not help) 2828 ;; (concat "^\\[" (regexp-quote todos-done-string))
1744 (todos-category-select))))) 2829 todos-done-string-start nil t)
2830 (remove-overlays (point) (point))))
2831 ;; activate the new setting (save-restriction does not help)
2832 ;; FIXME: need to wrap in save-excursion ?
2833 (todos-category-select)))))))
2834
2835(defun todos-reset-done-string (symbol value)
2836 "Set SYMBOL's value to VALUE, and ." ; FIXME
2837 ;; (let ((oldvalue (symbol-value symbol)))
2838 ;; (custom-set-default symbol value)
2839 ;; (when (not (equal value oldvalue))
2840 ;; (save-window-excursion
2841 ;; (todos-show)
2842 ;; (save-excursion
2843 ;; (goto-char (point-min))
2844 ;; (when (re-search-forward ;; (concat "^\\[" (regexp-quote todos-done-string))
2845 ;; todos-done-string-start nil t)
2846 ;; (remove-overlays (point) (point))))
2847 ;; ;; activate the new setting (save-restriction does not help)
2848 ;; ;; FIXME: need to wrap in save-excursion ?
2849 ;; (todos-category-select))))
2850 )
2851
2852(defun todos-reset-categories (symbol value)
2853 "Set SYMBOL's value to VALUE, and ." ; FIXME
2854 (custom-set-default symbol value)
2855 (save-window-excursion
2856 (todos-show)
2857 (setq todos-categories
2858 (if value
2859 (todos-truncate-categories-list)
2860 ;; FIXME: with-current-buffer Todos
2861 ;; file and update
2862 ;; todos-categories-sexp
2863 (todos-make-categories-list t)))))
2864 ;; (save-excursion
2865 ;; ;; activate the new setting (save-restriction does not help)
2866 ;; ;; FIXME: need to wrap in save-excursion ?
2867 ;; (todos-category-select)))))
2868
2869(defun todos-toggle-switch-todos-file-noninteractively (symbol value)
2870 ""
2871 (custom-set-default symbol value)
2872 (if value
2873 (add-hook 'post-command-hook
2874 'todos-switch-todos-file nil t)
2875 (remove-hook 'post-command-hook
2876 'todos-switch-todos-file t)))
2877
2878(defun todos-switch-todos-file (&optional file) ;FIXME: need FILE?
2879 "Make another Todos file the current Todos file.
2880Called by post-command-hook if `todos-auto-switch-todos-file' is
2881non-nil (and also in `todos-top-priorities'), it makes the
2882current buffer the current Todos file if it is visiting a Todos
2883file."
2884 (let ((file (or file (buffer-file-name)))
2885 (files (if todos-show-done-only ;FIXME: should only hold for
2886 (funcall todos-files-function t) ; todos-archives
2887 (funcall todos-files-function)))
2888 cat)
2889 (when (and (member file files)
2890 (not (equal todos-current-todos-file file)))
2891 ;; (let ((catbuf (get-buffer todos-categories-buffer)))
2892 ;; (if catbuf (not (eq (other-buffer) catbuf)))))
2893 (if todos-ignore-archived-categories
2894 (progn
2895 (setq todos-categories nil)
2896 (setq todos-categories (todos-truncate-categories-list)))
2897 (setq todos-categories (todos-make-categories-list)))
2898 ;; if file is already in a buffer, redisplay the previous current category
2899 (when (< (- (point-max) (point-min)) (buffer-size))
2900 (widen)
2901 (when (re-search-backward (concat "^" (regexp-quote todos-category-beg)
2902 "\\(.+\\)\n") nil t)
2903 (setq cat (match-string-no-properties 1))
2904 (setq todos-category-number (todos-category-number cat))))
2905 (setq todos-current-todos-file file)
2906 ;; (or todos-category-number (setq todos-category-number 1))
2907 ;; (if (zerop todos-category-number) (setq todos-category-number 1))
2908 (todos-show))))
1745 2909
1746;; FIXME: should be defsubst?
1747(defun todos-category-number (cat) 2910(defun todos-category-number (cat)
1748 "Set todos-category-number to index of CAT in todos-categories." 2911 "Set todos-category-number to index of CAT in todos-categories."
1749 (setq todos-category-number (- (length todos-categories) 2912 (let ((categories (mapcar 'car todos-categories)))
1750 (length (member cat todos-categories))))) 2913 (setq todos-category-number
2914 (1+ (- (length categories)
2915 (length (member cat categories)))))))
2916
1751(defun todos-current-category () 2917(defun todos-current-category ()
1752 "Return the name of the current category." 2918 "Return the name of the current category."
1753 (nth todos-category-number todos-categories)) 2919 (car (nth (1- todos-category-number) todos-categories)))
1754 2920
2921;; FIXME: wrap in save-excursion (or else have to use todos-show in
2922;; e.g. todos-{forward, backward}-category)
1755(defun todos-category-select () 2923(defun todos-category-select ()
1756 "Make TODO mode display the current category correctly." 2924 "Display the current category correctly.
1757 (let ((name (todos-current-category))) 2925
1758 (setq mode-line-buffer-identification (concat "Category: " name)) 2926With non-nil `todos-show-with-done' display the category's done
2927\(but not archived) items below the unfinished todo items; else
2928display just the todo items."
2929 (let ((name (todos-current-category))
2930 cat-begin cat-end done-start done-sep-start done-end)
1759 (widen) 2931 (widen)
1760 (goto-char (point-min)) 2932 (goto-char (point-min))
1761 (search-forward-regexp 2933 (re-search-forward
1762 (concat "^" (regexp-quote (concat todos-category-beg name)) 2934 (concat "^" (regexp-quote (concat todos-category-beg name)) "$") nil t)
1763 "$")) 2935 (setq cat-begin (1+ (line-end-position)))
1764 (let ((begin (1+ (line-end-position))) 2936 (setq cat-end (if (re-search-forward
1765 (end (if (re-search-forward (concat "^" todos-category-beg) nil t) 2937 (concat "^" (regexp-quote todos-category-beg)) nil t)
1766 (match-beginning 0) 2938 (match-beginning 0)
1767 (point-max)))) 2939 (point-max)))
1768 (narrow-to-region begin end) 2940 (setq mode-line-buffer-identification
1769 (goto-char (point-min)))) 2941 (concat (format "Category %d: %s" todos-category-number name)))
1770 (todos-prefix-overlays) 2942 (narrow-to-region cat-begin cat-end)
1771 (unless (eq major-mode 'todos-archive-mode) 2943 (todos-prefix-overlays)
1772 ;; display or hide done items as per todos-show-with-done 2944 (goto-char (point-min))
1773 (save-excursion 2945 (if (re-search-forward (concat "\n\\(" (regexp-quote todos-category-done)
2946 "\\)") nil t)
2947 (progn
2948 (setq done-start (match-beginning 0))
2949 (setq done-sep-start (match-beginning 1))
2950 (setq done-end (match-end 0)))
2951 (error "Category %s is missing todos-category-done string" name))
2952 (if todos-show-done-only
2953 (narrow-to-region (1+ done-end) (point-max))
2954 ;; display or hide done items as per todos-show-with-done
2955 ;; FIXME: use todos-done-string-start ?
1774 (when (re-search-forward (concat "\n\\(\\[" (regexp-quote todos-done-string) 2956 (when (re-search-forward (concat "\n\\(\\[" (regexp-quote todos-done-string)
1775 "\\)") nil t) 2957 "\\)") nil t)
1776 (let (done end done-sep prefix ov-pref ov-done) 2958 (let (done-sep prefix ov-pref ov-done)
1777 (setq done (match-beginning 1) 2959 ;; FIXME: delete overlay when not viewing done items
1778 end (match-beginning 0)) 2960 (when todos-show-with-done
1779 (if todos-show-with-done 2961 (setq done-sep todos-done-separator)
1780 (progn 2962 (setq done-start cat-end)
1781 (setq done-sep todos-done-separator) 2963 (setq ov-pref (make-overlay done-sep-start done-end))
1782 (unless (string-match "^[[:space:]]*$" todos-done-separator) 2964 (overlay-put ov-pref 'display done-sep))))
1783 (setq done-sep (propertize (concat todos-done-separator "\n") 2965 (narrow-to-region (point-min) done-start))))
1784 'face 'todos-done-sep))
1785 (setq prefix (propertize (concat (if todos-number-prefix
1786 "1"
1787 todos-prefix) " ")
1788 'face 'todos-prefix-string))
1789 ;; FIXME? Just deleting done-sep overlay results in bad
1790 ;; display (except when stepping though in edebug)
1791 (remove-overlays done done)
1792 ;; must make separator overlay after making prefix overlay to get
1793 ;; the order separator before prefix
1794 (setq ov-pref (make-overlay done done)
1795 ov-done (make-overlay done done))
1796 (overlay-put ov-pref 'before-string prefix)
1797 (overlay-put ov-done 'before-string done-sep)))
1798 (narrow-to-region (point-min) end)))))))
1799
1800(defun todos-set-item-priority (item cat)
1801 "Set the priority of unfinished item ITEM in category CAT."
1802 (todos-category-number cat)
1803 (todos-category-select)
1804 (let* ((catsym (intern-soft (concat "todos-" cat)))
1805 (todo (get catsym 'todo))
1806 (maxnum (1+ todo))
1807 priority candidate prompt)
1808 (unless (zerop todo)
1809 (while (null priority)
1810 (setq candidate
1811 (string-to-number (read-from-minibuffer
1812 (concat prompt
1813 (format "Set item priority (1-%d): "
1814 maxnum)))))
1815 (setq prompt
1816 (when (or (< candidate 1) (> candidate maxnum))
1817 (format "Priority must be an integer between 1 and %d.\n" maxnum)))
1818 (unless prompt (setq priority candidate)))
1819 (goto-char (point-min))
1820 (unless (= priority 1) (todos-forward-item (1- priority))))))
1821
1822(defun todos-jump-to-category-noninteractively (cat)
1823 ""
1824 ;; (let ((bufname (buffer-name)))
1825 ;; (cond ((string= bufname todos-categories-buffer)
1826 ;; (switch-to-buffer (file-name-nondirectory todos-file-do)))
1827 ;; ((string= bufname todos-archived-categories-buffer)
1828 ;; ;; FIXME: is pop-to-buffer better for this case?
1829 ;; (switch-to-buffer (file-name-nondirectory todos-archive-file))))
1830 ;; (kill-buffer bufname))
1831 (switch-to-buffer (file-name-nondirectory todos-current-todos-file))
1832 (widen)
1833 (goto-char (point-min))
1834 (todos-category-number cat)
1835 (todos-category-select))
1836 2966
1837(defun todos-insert-with-overlays (item) 2967(defun todos-insert-with-overlays (item)
1838 "" 2968 ""
@@ -1849,8 +2979,10 @@ Number of entries for each category is given by `todos-print-priorities'."
1849 (setq item (concat (substring item 0 56) "..."))) 2979 (setq item (concat (substring item 0 56) "...")))
1850 item)) 2980 item))
1851 2981
1852(defvar todos-item-start (concat "^\\(\\[\\(" (regexp-quote todos-done-string) 2982(defvar todos-item-start ;; (concat "^\\(\\[\\(" (regexp-quote todos-done-string)
1853 "\\)?\\)?" todos-date-pattern) 2983 ;; "\\)?\\)?" todos-date-pattern)
2984 (concat "\\(" todos-date-string-start "\\|" todos-done-string-start
2985 "\\)" todos-date-pattern)
1854 "String identifying start of a Todos item.") 2986 "String identifying start of a Todos item.")
1855 2987
1856(defun todos-item-start () 2988(defun todos-item-start ()
@@ -1859,8 +2991,8 @@ Number of entries for each category is given by `todos-print-priorities'."
1859 (looking-at (regexp-quote todos-category-beg))) ; for todos-count-items 2991 (looking-at (regexp-quote todos-category-beg))) ; for todos-count-items
1860 (goto-char (line-beginning-position)) 2992 (goto-char (line-beginning-position))
1861 (while (not (looking-at todos-item-start)) 2993 (while (not (looking-at todos-item-start))
1862 (forward-line -1))) 2994 (forward-line -1))
1863 (point)) 2995 (point)))
1864 2996
1865(defun todos-item-end () 2997(defun todos-item-end ()
1866 "Move to end of current TODO list item and return its position." 2998 "Move to end of current TODO list item and return its position."
@@ -1870,8 +3002,8 @@ Number of entries for each category is given by `todos-print-priorities'."
1870 ;; adjust if item is last unfinished one before displayed done items 3002 ;; adjust if item is last unfinished one before displayed done items
1871 (when (and (not done) (todos-done-item-p)) 3003 (when (and (not done) (todos-done-item-p))
1872 (forward-line -1)) 3004 (forward-line -1))
1873 (backward-char))) 3005 (backward-char))
1874 (point)) 3006 (point)))
1875 3007
1876(defun todos-remove-item () 3008(defun todos-remove-item ()
1877 "Delete the current entry from the TODO list." 3009 "Delete the current entry from the TODO list."
@@ -1884,81 +3016,190 @@ Number of entries for each category is given by `todos-print-priorities'."
1884 3016
1885(defun todos-item-string () 3017(defun todos-item-string ()
1886 "Return current TODO list entry as a string." 3018 "Return current TODO list entry as a string."
1887 (buffer-substring (todos-item-start) (todos-item-end))) 3019 (let ((opoint (point))
3020 (start (todos-item-start))
3021 (end (todos-item-end)))
3022 (goto-char opoint)
3023 (and start end (buffer-substring-no-properties start end))))
3024
3025(defun todos-diary-item-p ()
3026 ""
3027 (save-excursion
3028 (todos-item-start)
3029 (looking-at todos-date-pattern)))
1888 3030
1889(defun todos-done-item-p () 3031(defun todos-done-item-p ()
1890 "" 3032 ""
1891 (save-excursion 3033 (save-excursion
1892 (todos-item-start) 3034 (todos-item-start)
1893 (looking-at (concat "^\\[" (regexp-quote todos-done-string))))) 3035 (looking-at todos-done-string-start)))
1894 3036
1895(defun todos-make-categories-list () 3037;; FIXME: should be defsubst?
1896 "Return a list of Todos categories and set their property lists. 3038(defun todos-counts (cat)
1897The properties are at least the category number and the numbers 3039 "Plist/Vector of item type counts in category CAT.
1898of todo items, done items and archived items in the category." 3040The counted types are all todo items, todo items for diary
1899 (let (catlist) 3041inclusion, done items and archived items."
3042 (cdr (assoc cat todos-categories)))
3043
3044(defun todos-get-count (type cat)
3045 "Return count of TYPE items in category CAT."
3046 (let (idx)
3047 (cond ((eq type 'todo)
3048 (setq idx 0))
3049 ((eq type 'diary)
3050 (setq idx 1))
3051 ((eq type 'done)
3052 (setq idx 2))
3053 ((eq type 'archived)
3054 (setq idx 3)))
3055 (aref (todos-counts cat) idx)
3056 ;; (plist-get (todos-counts cat) type)
3057 ))
3058
3059(defun todos-set-count (type counts increment)
3060 "Increment count of item TYPE in vector COUNTS by INCREMENT."
3061 (let (idx)
3062 (cond ((eq type 'todo)
3063 (setq idx 0))
3064 ((eq type 'diary)
3065 (setq idx 1))
3066 ((eq type 'done)
3067 (setq idx 2))
3068 ((eq type 'archived)
3069 (setq idx 3)))
3070 (aset counts idx (+ increment (aref counts idx)))
3071 ;; (plist-put counts type (1+ (plist-get counts type)))
3072 ))
3073
3074(defun todos-set-categories ()
3075 "Set todos-categories from the sexp at the top of the file."
3076 (save-excursion
3077 (save-restriction
3078 (widen)
3079 (goto-char (point-min))
3080 (if (looking-at "\(\(\"")
3081 (setq todos-categories (read (buffer-substring-no-properties
3082 (line-beginning-position)
3083 (line-end-position))))
3084 (error "Invalid or missing todos-categories sexp")))))
3085
3086(defun todos-make-categories-list (&optional force)
3087 "Return a list of Todos categories and their item counts.
3088The items counts are contained in a vector specifying the numbers
3089of todo items, done items and archived items in the category, in
3090that order."
3091 (setq todos-categories nil)
3092 (save-excursion
3093 (save-restriction
3094 (widen)
3095 (goto-char (point-min))
3096 (let (counts cat archive)
3097 ;; FIXME: can todos-archives be too old here?
3098 (unless (member buffer-file-name (funcall todos-files-function t))
3099 (setq archive (concat (file-name-sans-extension
3100 todos-current-todos-file) ".toda")))
3101 (while (not (eobp))
3102 (cond ((looking-at (concat (regexp-quote todos-category-beg)
3103 "\\(.*\\)\n"))
3104 (setq cat (match-string-no-properties 1))
3105 ;; counts for each category: [todo diary done archive]
3106 (setq counts (make-vector 4 0))
3107 ;; (setq counts (list 'todo 0 'diary 0 'done 0 'archived 0))
3108 (setq todos-categories
3109 (append todos-categories (list (cons cat counts))))
3110 ;; todos-archives may be too old here (e.g. during
3111 ;; todos-move-category)
3112 (when (member archive (funcall todos-files-function t))
3113 (with-current-buffer (find-file-noselect archive)
3114 (widen)
3115 (goto-char (point-min))
3116 (when (re-search-forward
3117 (concat (regexp-quote todos-category-beg) cat)
3118 (point-max) t)
3119 (forward-line)
3120 (while (not (or (looking-at
3121 (concat (regexp-quote todos-category-beg)
3122 "\\(.*\\)\n"))
3123 (eobp)))
3124 (when (looking-at todos-done-string-start)
3125 (todos-set-count 'archived counts 1))
3126 (forward-line))))))
3127 ((looking-at todos-done-string-start)
3128 (todos-set-count 'done counts 1))
3129 ((looking-at (concat "^\\(" (regexp-quote diary-nonmarking-symbol)
3130 "\\)?" todos-date-pattern))
3131 (todos-set-count 'diary counts 1)
3132 (todos-set-count 'todo counts 1))
3133 ((looking-at (concat todos-date-string-start todos-date-pattern))
3134 (todos-set-count 'todo counts 1))
3135 ;; if first line is todos-categories list, use it and end loop
3136 ;; unless forced by non-nil parameter `force' to scan whole file
3137 ((bobp)
3138 (unless force
3139 (setq todos-categories (read (buffer-substring-no-properties
3140 (line-beginning-position)
3141 (line-end-position))))
3142 (goto-char (1- (point-max))))))
3143 (forward-line)))))
3144 todos-categories)
3145
3146;; FIXME: don't let truncated list get written by todos-update-categories-sexp
3147(defun todos-truncate-categories-list ()
3148 "Return a truncated list of Todos categories plus item counts.
3149Categories containing only archived items are omitted. This list
3150is used in Todos mode when `todos-ignore-archived-categories' is
3151non-nil."
3152 (let (cats)
3153 (unless todos-categories
3154 (setq todos-categories (todos-make-categories-list)))
3155 (dolist (catcons todos-categories cats)
3156 (let ((cat (car catcons)))
3157 (setq cats
3158 (append cats
3159 (unless (and (zerop (todos-get-count 'todo cat))
3160 (zerop (todos-get-count 'done cat))
3161 (not (zerop (todos-get-count 'archived cat))))
3162 (list catcons))))))))
3163
3164(defun todos-update-categories-sexp ()
3165 ""
3166 (let (buffer-read-only)
1900 (save-excursion 3167 (save-excursion
1901 (save-restriction 3168 (save-restriction
1902 (widen) 3169 (widen)
1903 (goto-char (point-min)) 3170 (goto-char (point-min))
1904 (let ((num 0) 3171 (if (looking-at (concat "^" (regexp-quote todos-category-beg)))
1905 cat catsym archive-check) 3172 (progn (newline) (goto-char (point-min)))
1906 (while (not (eobp)) 3173 (kill-line))
1907 (cond ((looking-at (concat (regexp-quote todos-category-beg) 3174 (prin1 todos-categories (current-buffer))))))
1908 "\\(.*\\)\n")) 3175
1909 (setq cat (match-string-no-properties 1)) 3176;; FIXME: should done diary items count as diary?
1910 (setq num (1+ num)) 3177(defun todos-item-counts (cat &optional type)
1911 (setq archive-check nil) 3178 ""
1912 ;; FIXME: ok to intern in global obarray? 3179 (let ((counts (todos-counts cat)))
1913 (setq catsym (intern (concat "todos-" cat))) 3180 (cond ((eq type 'insert)
1914 (setplist catsym (list 'catnum num 'todo 0 'done 0 'archived 0)) 3181 (todos-set-count 'todo counts 1))
1915 (push cat catlist)) 3182 ((eq type 'diary)
1916 ((looking-at (concat "^\\[" (regexp-quote todos-done-string))) 3183 (todos-set-count 'diary counts 1))
1917 (put catsym 'done (1+ (get catsym 'done)))) 3184 ((eq type 'nondiary)
1918 ((looking-at (concat "^\\[?" todos-date-pattern)) 3185 (todos-set-count 'diary counts -1))
1919 (put catsym 'todo (1+ (get catsym 'todo))))) 3186 ((eq type 'delete)
1920 (unless (or archive-check 3187 ;; FIXME: ok if last done item was deleted?
1921 (string= (buffer-file-name) 3188 (if (save-excursion
1922 (expand-file-name todos-archive-file))) 3189 (re-search-backward (concat "^" (regexp-quote
1923 (let ((archive (find-file-noselect todos-archive-file))) 3190 todos-category-done)) nil t))
1924 (with-current-buffer archive 3191 (todos-set-count 'done counts -1)
1925 (goto-char (point-min)) 3192 (todos-set-count 'todo counts -1)))
1926 (when (re-search-forward 3193 ((eq type 'done)
1927 (concat (regexp-quote todos-category-beg) cat) 3194 (todos-set-count 'todo counts -1)
1928 (point-max) t) 3195 (todos-set-count 'done counts 1))
1929 (forward-line) 3196 ((eq type 'undo)
1930 (while (not (or (looking-at 3197 (todos-set-count 'todo counts 1)
1931 (concat (regexp-quote todos-category-beg) 3198 (todos-set-count 'done counts -1))
1932 "\\(.*\\)\n")) 3199 ((eq type 'archive)
1933 (eobp))) 3200 (todos-set-count 'archived counts (todos-get-count 'done cat)) ;arch+done
1934 (when (looking-at 3201 (todos-set-count 'done counts (- (todos-get-count 'done cat))))) ; 0
1935 (concat "^\\[" (regexp-quote todos-done-string))) 3202 (todos-update-categories-sexp)))
1936 (put catsym 'archived (1+ (get catsym 'archived))))
1937 (forward-line)))))
1938 (setq archive-check t))
1939 (forward-line)))))
1940 catlist))
1941
1942(defun todos-item-counts (cat &optional how)
1943 ""
1944 (let ((catsym (intern-soft (concat "todos-" cat))))
1945 ;; FIXME: need this?
1946 ;; (when catsym
1947 (cond ((eq how 'insert)
1948 (put catsym 'todo (1+ (get catsym 'todo))))
1949 ((eq how 'delete)
1950 (if (todos-done-item-p) ;FIXME: fails if last done item was deleted
1951 (put catsym 'done (1- (get catsym 'done)))
1952 (put catsym 'todo (1- (get catsym 'todo)))))
1953 ((eq how 'done)
1954 (put catsym 'todo (1- (get catsym 'todo)))
1955 (put catsym 'done (1+ (get catsym 'done))))
1956 ((eq how 'undo)
1957 (put catsym 'todo (1+ (get catsym 'todo)))
1958 (put catsym 'done (1- (get catsym 'done))))
1959 ((eq how 'archive)
1960 (put catsym 'archived (+ (get catsym 'done) (get catsym 'archived)))
1961 (put catsym 'done 0)))))
1962 3203
1963(defun todos-longest-category-name-length (categories) 3204(defun todos-longest-category-name-length (categories)
1964 "" 3205 ""
@@ -1974,8 +3215,22 @@ of todo items, done items and archived items in the category."
1974 "Return non-nil if STRING spans several lines." 3215 "Return non-nil if STRING spans several lines."
1975 (> (todos-string-count-lines string) 1)) 3216 (> (todos-string-count-lines string) 1))
1976 3217
1977(defun todos-read-category () 3218(defun todos-read-file-name (prompt &optional archive)
1978 "Return a category name (existing names with tab completion)." 3219 ""
3220 (unless (file-exists-p todos-files-directory)
3221 (make-directory todos-files-directory))
3222 (let* ((completion-ignore-case t)
3223 (files (mapcar 'file-name-sans-extension
3224 (directory-files todos-files-directory nil
3225 (if archive "\.toda$" "\.todo$"))))
3226 (file (concat todos-files-directory
3227 (completing-read prompt files nil t)
3228 (if archive ".toda" ".todo"))))
3229 (expand-file-name file)))
3230
3231(defun todos-read-category (prompt)
3232 "Return a category name from the current Todos file, with completion.
3233Prompt with PROMPT."
1979 ;; allow SPC to insert spaces, for adding new category names with 3234 ;; allow SPC to insert spaces, for adding new category names with
1980 ;; todos-move-item 3235 ;; todos-move-item
1981 (let ((map minibuffer-local-completion-map)) 3236 (let ((map minibuffer-local-completion-map))
@@ -1984,53 +3239,79 @@ of todo items, done items and archived items in the category."
1984 ;; non-nil, which makes completing-read alter todos-categories 3239 ;; non-nil, which makes completing-read alter todos-categories
1985 (let* ((categories (copy-sequence todos-categories)) 3240 (let* ((categories (copy-sequence todos-categories))
1986 (history (cons 'todos-categories (1+ todos-category-number))) 3241 (history (cons 'todos-categories (1+ todos-category-number)))
1987 (default (todos-current-category)) ;FIXME: why this default? 3242 ;; (default (todos-current-category)) ;FIXME: why this default?
1988 (completion-ignore-case todos-completion-ignore-case) 3243 (completion-ignore-case todos-completion-ignore-case)
1989 (category (completing-read 3244 (category (completing-read prompt
1990 (concat "Category [" default "]: ") 3245 ;; (concat "Category [" default "]: ")
1991 todos-categories nil nil nil history default))) 3246 todos-categories nil nil nil history))); default)))
1992 ;; restore the original value of todos-categories 3247 ;; restore the original value of todos-categories
1993 (setq todos-categories categories) 3248 (setq todos-categories categories)
1994 category))) 3249 category)))
1995 3250
1996(defun todos-check-category-name (cat) 3251(defun todos-validate-category-name (cat)
1997 "Reject names for category CAT that could yield bugs or confusion." 3252 "Check new category name CAT and when valid return it."
1998 (let (prompt) 3253 (let (prompt)
1999 (while (and (cond ((string= "" cat) 3254 (while
2000 (setq prompt "Enter a non-empty category name: ")) 3255 (and (cond ((string= "" cat)
2001 ((string-match "\\`\\s-+\\'" cat) 3256 (if todos-categories
2002 (setq prompt 3257 (setq prompt "Enter a non-empty category name: ")
2003 "Enter a category name that is not only white space: ")) 3258 ;; prompt for initial category of a new Todos file
2004 ((member cat todos-categories) 3259 (setq prompt (concat "Initial category name ["
2005 (setq prompt "Enter a non-existing category name: "))) 3260 todos-initial-category "]: "))))
2006 (setq cat (read-from-minibuffer prompt))))) 3261 ((string-match "\\`\\s-+\\'" cat)
3262 (setq prompt
3263 "Enter a category name that is not only white space: "))
3264 ((assoc cat todos-categories)
3265 (setq prompt "Enter a non-existing category name: ")))
3266 (setq cat (if todos-categories
3267 (read-from-minibuffer prompt)
3268 ;; offer default initial category name
3269 ;; FIXME: if input is just whitespace, raises "End of
3270 ;; file during parsing" error
3271 (prin1-to-string
3272 (read-from-minibuffer prompt nil nil t nil
3273 (list todos-initial-category))))))))
2007 cat) 3274 cat)
2008 3275
2009;; adapted from calendar-read-date 3276;; adapted from calendar-read-date and calendar-date-string
2010(defun todos-read-date () 3277(defun todos-read-date ()
2011 "Prompt for Gregorian date and return it in the current format." 3278 "Prompt for Gregorian date and return it in the current format.
3279Also accepts `*' as an unspecified month, day, or year."
2012 (let* ((year (calendar-read 3280 (let* ((year (calendar-read
2013 "Year (>0): " 3281 "Year (>0 or * for any year): "
2014 (lambda (x) (> x 0)) 3282 (lambda (x) (or (eq x '*) (> x 0)))
2015 (number-to-string (calendar-extract-year 3283 (number-to-string (calendar-extract-year
2016 (calendar-current-date))))) 3284 (calendar-current-date)))))
2017 (month-array calendar-month-name-array) 3285 (month-array (vconcat calendar-month-name-array (vector "*")))
3286 (abbrevs (vconcat calendar-month-abbrev-array (vector "*")))
2018 (completion-ignore-case t) 3287 (completion-ignore-case t)
3288 (monthname (completing-read
3289 "Month name (RET for current month, * for any month): "
3290 (mapcar 'list (append month-array nil))
3291 nil t nil nil
3292 (calendar-month-name (calendar-extract-month
3293 (calendar-current-date)) t)))
2019 (month (cdr (assoc-string 3294 (month (cdr (assoc-string
2020 (completing-read 3295 monthname (calendar-make-alist month-array nil nil abbrevs))))
2021 "Month name (RET for current month): " 3296 (last (if (eq month 13)
2022 (mapcar 'list (append month-array nil)) 3297 31 ; FIXME: what about shorter months?
2023 nil t nil nil 3298 (let ((yr (if (eq year '*)
2024 (calendar-month-name (calendar-extract-month 3299 1999 ; FIXME: no Feb. 29
2025 (calendar-current-date)))) 3300 year)))
2026 (calendar-make-alist month-array 1) t))) 3301 (calendar-last-day-of-month month yr))))
2027 (last (calendar-last-day-of-month month year)) 3302 day dayname)
2028 day) 3303 (while (if (numberp day) (or (< day 0) (< last day)) (not (eq day '*)))
2029 (while (or (not (numberp day)) (< day 0) (< last day))
2030 (setq day (read-from-minibuffer 3304 (setq day (read-from-minibuffer
2031 (format "Day (1-%d): " last) nil nil t nil 3305 (format "Day (1-%d or RET for today or * for any day): " last)
2032 (number-to-string (calendar-extract-day (calendar-current-date)))))) 3306 nil nil t nil
2033 (calendar-date-string (list month day year) t t))) 3307 (number-to-string
3308 (calendar-extract-day (calendar-current-date))))))
3309 (setq year (if (eq year '*) (symbol-name '*) (number-to-string year)))
3310 (setq day (if (eq day '*) (symbol-name '*) (number-to-string day)))
3311 ;; FIXME: make abbreviation customizable
3312 (setq monthname
3313 (calendar-month-name (calendar-extract-month (list month day year)) t))
3314 (mapconcat 'eval calendar-date-display-form "")))
2034 3315
2035(defun todos-read-dayname () 3316(defun todos-read-dayname ()
2036 "" 3317 ""
@@ -2050,60 +3331,155 @@ of todo items, done items and archived items in the category."
2050 (setq valid t))) 3331 (setq valid t)))
2051 answer)) 3332 answer))
2052 3333
2053;; (defun todos-categories-list (buf)
2054;; "Return a list of the Todo mode categories in buffer BUF."
2055;; (let (categories)
2056;; (with-current-buffer buf
2057;; (save-excursion
2058;; (save-restriction
2059;; (widen)
2060;; (goto-char (point-max))
2061;; (while (re-search-backward (concat "^" (regexp-quote todos-category-beg)
2062;; "\\(.*\\)\n") nil t)
2063;; (push (match-string-no-properties 1) categories)))))
2064;; categories))
2065
2066(defun todos-padded-string (str) 3334(defun todos-padded-string (str)
2067 "" 3335 ""
2068 (let* ((len (todos-longest-category-name-length todos-categories)) 3336 (let* ((categories (mapcar 'car todos-categories))
3337 (len (todos-longest-category-name-length categories))
2069 (strlen (length str)) 3338 (strlen (length str))
2070 (strlen-odd (eq (logand strlen 1) 1)) ; oddp from cl.el 3339 (strlen-odd (eq (logand strlen 1) 1)) ; oddp from cl.el
2071 (padding (/ (- len strlen) 2))) 3340 (padding (max 0 (/ (- len strlen) 2)))
2072 (concat (make-string padding 32) str 3341 (padding-left (cond ((eq todos-categories-align 'left) 0)
2073 (make-string (if strlen-odd (1+ padding) padding) 32)))) 3342 ((eq todos-categories-align 'center) padding)
2074 3343 ((eq todos-categories-align 'right)
2075(defun todos-insert-category-name (cat &optional nonum) 3344 (if strlen-odd (1+ (* padding 2)) (* padding 2)))))
3345 (padding-right (cond ((eq todos-categories-align 'left)
3346 (if strlen-odd (1+ (* padding 2)) (* padding 2)))
3347 ((eq todos-categories-align 'center)
3348 (if strlen-odd (1+ padding) padding))
3349 ((eq todos-categories-align 'right) 0))))
3350 (concat (make-string padding-left 32) str (make-string padding-right 32))))
3351
3352(defvar todos-descending-counts-store nil
3353 "Alist of current sorted category counts, keyed by sort key.")
3354
3355;; FIXME: rename to todos-insert-category-info ?
3356(defun todos-sort (list &optional key)
3357 "Return a copy of LIST, possibly sorted according to KEY." ;FIXME
3358 (let* ((l (copy-sequence list))
3359 (fn (if (eq key 'alpha)
3360 (lambda (x) (upcase x)) ;alphabetize case insensitively
3361 (lambda (x) (todos-get-count key x))))
3362 (descending (member key todos-descending-counts-store))
3363 (cmp (if (eq key 'alpha)
3364 'string<
3365 (if descending '< '>)))
3366 (pred (lambda (s1 s2) (let ((t1 (funcall fn (car s1)))
3367 (t2 (funcall fn (car s2))))
3368 (funcall cmp t1 t2)))))
3369 (when key
3370 (setq l (sort l pred))
3371 (if descending
3372 (setq todos-descending-counts-store
3373 (delete key todos-descending-counts-store))
3374 (push key todos-descending-counts-store)))
3375 l))
3376
3377(defun todos-display-sorted (type)
3378 "Keep point on the count sorting button just clicked."
3379 (let ((opoint (point)))
3380 (todos-display-categories type)
3381 (goto-char opoint)))
3382
3383(defun todos-label-to-key (label)
3384 "Return symbol for sort key associated with LABEL."
3385 (let (key)
3386 (cond ((string= label todos-categories-category-label)
3387 (setq key 'alpha))
3388 ((string= label todos-categories-todo-label)
3389 (setq key 'todo))
3390 ((string= label todos-categories-diary-label)
3391 (setq key 'diary))
3392 ((string= label todos-categories-done-label)
3393 (setq key 'done))
3394 ((string= label todos-categories-archived-label)
3395 (setq key 'archived)))
3396 key))
3397
3398(defun todos-insert-sort-button (label)
2076 "" 3399 ""
2077 (let ((catsym (intern-soft (concat "todos-" cat))) 3400 (setq str (if (string= label todos-categories-category-label)
2078 (archive (string= todos-current-todos-file todos-archive-file))) 3401 (todos-padded-string label)
3402 label))
3403 (setq beg (point))
3404 (setq end (+ beg (length str)))
3405 (insert-button str 'face nil
3406 'action
3407 `(lambda (button)
3408 (let ((key (todos-label-to-key ,label)))
3409 (if (and (member key todos-descending-counts-store)
3410 (eq key 'alpha))
3411 (progn
3412 (todos-display-categories)
3413 (setq todos-descending-counts-store
3414 (delete key todos-descending-counts-store)))
3415 (todos-display-sorted key)))))
3416 (setq ovl (make-overlay beg end))
3417 (overlay-put ovl 'face 'todos-button))
3418
3419(defun todos-insert-category-line (cat &optional nonum)
3420 ""
3421 (let ((archive (member todos-current-todos-file todos-archives))
3422 (str (todos-padded-string cat))
3423 (opoint (point)))
3424 ;; beg end ovl)
2079 ;; num is declared in caller 3425 ;; num is declared in caller
2080 (setq num (1+ num)) 3426 (setq num (1+ num))
2081 (if nonum 3427 ;; (if nonum
2082 (insert (make-string 4 32)) 3428 ;; (insert (make-string 4 32))
2083 (insert " " (format "%2d" num) " ")) 3429 ;; (insert " " (format "%2d" num) " | "))
2084 (insert-button (todos-padded-string cat) 3430 ;; (setq beg (point))
2085 'face 'todos-button 3431 ;; (setq end (+ beg (length str)))
2086 'action 3432 (insert-button
2087 `(lambda (button) 3433 ;; FIXME: use mapconcat?
2088 (todos-jump-to-category-noninteractively ,cat))) 3434 (concat (if nonum
2089 (insert (concat (make-string 8 32) 3435 (make-string (+ 3 (length todos-categories-number-separator)) 32)
2090 (unless archive 3436 (format " %2d%s" num todos-categories-number-separator))
2091 (concat 3437 str
2092 (format "%2d" (get catsym 'todo)) 3438 (make-string (+ 2 (/ (length todos-categories-todo-label) 2)) 32)
2093 (make-string 5 32))) 3439 (unless archive
2094 (format "%2d" (get catsym 'done)) 3440 (concat
2095 (unless archive 3441 (format "%2d" (todos-get-count 'todo cat))
2096 (concat 3442 (make-string (+ 2 (/ (length todos-categories-diary-label) 2)) 32)))
2097 (make-string 5 32) 3443 (unless archive
2098 (format "%2d" (get catsym 'archived)))) 3444 (concat
2099 "\n")))) 3445 (format "%2d" (todos-get-count 'diary cat))
2100 3446 (make-string (+ 3 (/ (length todos-categories-done-label) 2)) 32)))
2101(defun todos-initial-setup () 3447 (format "%2d" (todos-get-count 'done cat))
2102 "Set up things to work properly in TODO mode." 3448 (unless archive
2103 (find-file todos-file-do) 3449 (concat
2104 (erase-buffer) 3450 (make-string (+ 2 (/ (length todos-categories-archived-label) 2)) 32)
2105 (todos-mode) 3451 (format "%2d" (todos-get-count 'archived cat))
2106 (todos-add-category "Todos")) 3452 (make-string 2 32))))
3453 'face (if (and todos-ignore-archived-categories
3454 (zerop (todos-get-count 'todo cat))
3455 (zerop (todos-get-count 'done cat))
3456 (not (zerop (todos-get-count 'archived cat))))
3457 'todos-archived-only
3458 nil)
3459 'action `(lambda (button) (todos-jump-to-category ,cat)))
3460 ;; (setq ovl (make-overlay beg end))
3461 ;; (overlay-put ovl 'face 'todos-button)
3462 (let* ((beg1 (+ opoint 6 (length str)))
3463 end1 ovl1)
3464 (cond ((eq nonum 'todo)
3465 (setq beg1 (+ beg1 1 (/ (length todos-categories-todo-label) 2))))
3466 ((eq nonum 'diary)
3467 (setq beg1 (+ beg1 1 (length todos-categories-todo-label)
3468 2 (/ (length todos-categories-diary-label) 2))))
3469 ((eq nonum 'done)
3470 (setq beg1 (+ beg1 1 (length todos-categories-todo-label)
3471 2 (length todos-categories-diary-label)
3472 2 (/ (length todos-categories-done-label) 2))))
3473 ((eq nonum 'archived)
3474 (setq beg1 (+ beg1 1 (length todos-categories-todo-label)
3475 2 (length todos-categories-diary-label)
3476 2 (length todos-categories-done-label)
3477 2 (/ (length todos-categories-archived-label) 2)))))
3478 (unless (= beg1 (+ opoint 6 (length str)))
3479 (setq end1 (+ beg1 4))
3480 (setq ovl1 (make-overlay beg1 end1))
3481 (overlay-put ovl1 'face 'todos-sorted-column)))
3482 (insert (concat "\n"))))
2107 3483
2108(provide 'todos) 3484(provide 'todos)
2109 3485