* calendar/todos.el Remove lots of commented out code; add various
[bpt/emacs.git] / lisp / calendar / todos.el
CommitLineData
ee7412e4 1;;; Todos.el --- major mode for displaying and editing Todo lists
3f031767
SB
2
3;; Copyright (C) 1997, 1999, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
4;; 2008, 2009 Free Software Foundation, Inc.
5
6;; Author: Oliver Seidel <privat@os10000.net>
7;; Maintainer: Stephen Berman <stephen.berman@gmx.net>
8;; Created: 2 Aug 1997
9;; Keywords: calendar, todo
10
11;; This file is part of GNU Emacs.
12
13;; GNU Emacs is free software: you can redistribute it and/or modify
14;; it under the terms of the GNU General Public License as published by
15;; the Free Software Foundation, either version 3 of the License, or
16;; (at your option) any later version.
17
18;; GNU Emacs is distributed in the hope that it will be useful,
19;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21;; GNU General Public License for more details.
22
23;; You should have received a copy of the GNU General Public License
24;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
25
26;; ---------------------------------------------------------------------------
27
28;;; Commentary:
29
30;; Mode Description
31;;
32;; TODO is a major mode for EMACS which offers functionality to
33;; treat most lines in one buffer as a list of items one has to
34;; do. There are facilities to add new items, which are
35;; categorised, to edit or even delete items from the buffer.
36;; The buffer contents are currently compatible with the diary,
37;; so that the list of todos-items will show up in the FANCY diary
38;; mode.
39;;
40;; Notice: Besides the major mode, this file also exports the
41;; function `todos-show' which will change to the one specific
42;; TODO file that has been specified in the todos-file-do
43;; variable. If this file does not conform to the TODO mode
44;; conventions, the todos-show function will add the appropriate
45;; header and footer. I don't anticipate this to cause much
46;; grief, but be warned, in case you attempt to read a plain text
47;; file.
48;;
49;; Preface, Quickstart Installation
50;;
ee7412e4 51;; To get this to work, make Emacs execute the line
3f031767
SB
52;;
53;; (autoload 'todos "todos"
54;; "Major mode for editing TODO lists." t)
55;; (autoload 'todos-show "todos"
56;; "Show TODO items." t)
57;; (autoload 'todos-insert-item "todos"
58;; "Add TODO item." t)
59;;
60;; You may now enter new items by typing "M-x todos-insert-item",
61;; or enter your TODO list file by typing "M-x todos-show".
62;;
63;; The TODO list file has a special format and some auxiliary
64;; information, which will be added by the todos-show function if
65;; it attempts to visit an un-initialised file. Hence it is
66;; recommended to use the todos-show function for the first time,
67;; in order to initialise the file, but it is not necessary
68;; afterwards.
69;;
70;; As these commands are quite long to type, I would recommend
71;; the addition of two bindings to your to your global keymap. I
72;; personally have the following in my initialisation file:
73;;
74;; (global-set-key "\C-ct" 'todos-show) ; switch to TODO buffer
75;; (global-set-key "\C-ci" 'todos-insert-item) ; insert new item
76;;
77;; Note, however, that this recommendation has prompted some
78;; criticism, since the keys C-c LETTER are reserved for user
79;; functions. I believe my recommendation is acceptable, since
80;; the Emacs Lisp Manual *Tips* section also details that the
81;; mode itself should not bind any functions to those keys. The
82;; express aim of the above two bindings is to work outside the
83;; mode, which doesn't need the show function and offers a
84;; different binding for the insert function. They serve as
85;; shortcuts and are not even needed (since the TODO mode will be
86;; entered by visiting the TODO file, and later by switching to
87;; its buffer).
88;;
89;; If you are an advanced user of this package, please consult
90;; the whole source code for autoloads, because there are several
91;; extensions that are not explicitly listed in the above quick
92;; installation.
93;;
94;; Pre-Requisites
95;;
96;; This package will require the following packages to be
97;; available on the load-path:
98;;
99;; time-stamp
100;; easymenu
101;;
102;; Operation
103;;
104;; You will have the following facilities available:
105;;
106;; M-x todos-show will enter the todo list screen, here type
107;;
108;; + to go to next category
109;; - to go to previous category
110;; d to file the current entry, including a
111;; comment and timestamp
112;; e to edit the current entry
113;; E to edit a multi-line entry
114;; f to file the current entry, including a
115;; comment and timestamp
116;; i to insert a new entry, with prefix, omit category
117;; I to insert a new entry at current cursor position
118;; j jump to category
119;; k to kill the current entry
120;; l to lower the current entry's priority
121;; n for the next entry
122;; p for the previous entry
123;; P print
124;; q to save the list and exit the buffer
125;; r to raise the current entry's priority
126;; s to save the list
127;; S to save the list of top priorities
128;; t show top priority items for each category
129;;
130;; When you add a new entry, you are asked for the text and then
131;; for the category. I for example have categories for things
132;; that I want to do in the office (like mail my mum), that I
133;; want to do in town (like buy cornflakes) and things I want to
134;; do at home (move my suitcases). The categories can be
135;; selected with the cursor keys and if you type in the name of a
136;; category which didn't exist before, an empty category of the
137;; desired name will be added and filled with the new entry.
138;;
139;; Configuration
140;;
141;; Variable todos-prefix
142;;
143;; I would like to recommend that you use the prefix "*/*" (by
144;; leaving the variable 'todos-prefix' untouched) so that the
145;; diary displays each entry every day.
146;;
147;; To understand what I mean, please read the documentation that
148;; goes with the calendar since that will tell you how you can
149;; set up the fancy diary display and use the #include command to
150;; include your todo list file as part of your diary.
151;;
152;; If you have the diary package set up to usually display more
153;; than one day's entries at once, consider using
154;;
155;; "&%%(equal (calendar-current-date) date)"
156;;
157;; as the value of `todos-prefix'. Please note that this may slow
158;; down the processing of your diary file some.
159;;
160;; Carsten Dominik <dominik@strw.LeidenUniv.nl> suggested that
161;;
162;; "&%%(todos-cp)"
163;;
164;; might be nicer and to that effect a function has been declared
165;; further down in the code. You may wish to auto-load this.
166;;
167;; Carsten also writes that that *changing* the prefix after the
168;; todo list is already established is not as simple as changing
169;; the variable - the todo files have to be changed by hand.
170;;
171;; Variable todos-file-do
172;;
173;; This variable is fairly self-explanatory. You have to store
174;; your TODO list somewhere. This variable tells the package
175;; where to go and find this file.
176;;
177;; Variable todos-file-done
178;;
179;; Even when you're done, you may wish to retain the entries.
180;; Given that they're timestamped and you are offered to add a
181;; comment, this can make a useful diary of past events. It will
182;; even blend in with the EMACS diary package. So anyway, this
183;; variable holds the name of the file for the filed todos-items.
184;;
185;; Variable todos-file-top
186;;
187;; File storing the top priorities of your TODO list when
188;; todos-save-top-priorities is non-nil. Nice to include in your
189;; diary instead of the complete TODO list.
190;;
191;; Variable todos-mode-hook
192;;
193;; Just like other modes, too, this mode offers to call your
194;; functions before it goes about its business. This variable
195;; will be inspected for any functions you may wish to have
196;; called once the other TODO mode preparations have been
197;; completed.
198;;
199;; Variable todos-insert-threshold
200;;
201;; Another nifty feature is the insertion accuracy. If you have
202;; 8 items in your TODO list, then you may get asked 4 questions
203;; by the binary insertion algorithm. However, you may not
204;; really have a need for such accurate priorities amongst your
205;; TODO items. If you now think about the binary insertion
206;; halving the size of the window each time, then the threshold
207;; is the window size at which it will stop. If you set the
208;; threshold to zero, the upper and lower bound will coincide at
209;; the end of the loop and you will insert your item just before
210;; that point. If you set the threshold to, e.g. 8, it will stop
211;; as soon as the window size drops below that amount and will
212;; insert the item in the approximate center of that window. I
213;; got the idea for this feature after reading a very helpful
214;; e-mail reply from Trey Jackson <trey@cs.berkeley.edu> who
215;; corrected some of my awful coding and pointed me towards some
216;; good reading. Thanks Trey!
217;;
218;; Things to do
219;;
220;; These originally were my ideas, but now also include all the
221;; suggestions that I included before forgetting them:
222;;
223;; o Fancy fonts for todo/top-priority buffer
224;; o Remove todos-prefix option in todos-top-priorities
225;; o Rename category
226;; o Move entry from one category to another one
227;; o Entries which both have the generic */* prefix and a
228;; "deadline" entry which are understood by diary, indicating
229;; an event (unless marked by &)
230;; o The optional COUNT variable of todos-forward-item should be
231;; applied to the other functions performing similar tasks
232;; o Modularization could be done for repeated elements of
233;; the code, like the completing-read lines of code.
234;; o license / version function
235;; o export to diary file
236;; o todos-report-bug
237;; o GNATS support
238;; o elide multiline (as in bbdb, or, to a lesser degree, in
239;; outline mode)
ee7412e4 240;; o rewrite complete package to store data as Lisp objects
3f031767
SB
241;; and have display modes for display, for diary export,
242;; etc. (Richard Stallman pointed out this is a bad idea)
243;; o so base todos.el on generic-mode.el instead
244;;
245;; History and Gossip
246;;
247;; Many thanks to all the ones who have contributed to the
248;; evolution of this package! I hope I have listed all of you
249;; somewhere in the documentation or at least in the RCS history!
250;;
251;; Enjoy this package and express your gratitude by sending nice
252;; things to my parents' address!
253;;
254;; Oliver Seidel
255;; (Lessingstr. 8, 65760 Eschborn, Federal Republic of Germany)
256
257;;; Code:
258
b28025ed 259;; (require 'time-stamp)
2c173503 260;; (require 'calendar) ; required by diary-lib
b28025ed 261(require 'diary-lib)
3f031767 262
2c173503 263;; ---------------------------------------------------------------------------
2c173503 264;;; Customizable options
ee7412e4 265
3f031767 266(defgroup todos nil
2c173503 267 "Maintain lists of todo items."
3f031767
SB
268 :link '(emacs-commentary-link "todos")
269 :version "21.1"
270 :group 'calendar)
271
2c173503 272(defcustom todos-prefix "§" ; "*/*" FIXME ascii default
b28025ed
SB
273 "String prefixed to todo items for visual distinction."
274 :type 'string
275 :initialize 'custom-initialize-default
276 :set 'todos-reset-prefix
277 :group 'todos)
2c173503
SB
278
279(defcustom todos-number-prefix t
280 "Non-nil to show item prefixes as consecutively increasing integers."
281 :type 'boolean
282 :initialize 'custom-initialize-default
283 :set 'todos-reset-prefix
284 :group 'todos)
285
ee7412e4
SB
286;; FIXME: length (window-width) causes problems. Also, bad when window-width changes
287(defcustom todos-done-separator (make-string (1- (window-width)) ?-)
2c173503
SB
288 "String used to visual separate done from not done items.
289Displayed in a before-string overlay by `todos-toggle-view-done-items'."
290 :type 'string
291 :initialize 'custom-initialize-default
292 :set 'todos-reset-separator
293 :group 'todos)
294
295(defcustom todos-done-string "DONE "
296 "Identifying string appended to the front of done todos items."
297 :type 'string
298 ;; :initialize 'custom-initialize-default
299 ;; :set
300 :group 'todos)
301
302(defcustom todos-show-with-done nil
303 "Non-nil to display done items in all categories."
304 :type 'boolean
305 :group 'todos)
306
307;; FIXME: use user-emacs-directory here and below
308(defcustom todos-file-do (convert-standard-filename "~/.emacs.d/.todos-do")
3f031767
SB
309 "TODO mode list file."
310 :type 'file
311 :group 'todos)
2c173503
SB
312
313(defcustom todos-files '((convert-standard-filename "~/.emacs.d/.todos"))
314 "List of Todos files."
315 :type 'list
316 :group 'todos)
317
318(defcustom todos-archive-file (convert-standard-filename "~/.emacs.d/.todos-archive")
319 "File of finished Todos categories."
3f031767
SB
320 :type 'file
321 :group 'todos)
2c173503 322
2c173503 323(defcustom todos-mode-hook nil
3f031767
SB
324 "TODO mode hooks."
325 :type 'hook
326 :group 'todos)
2c173503 327
3f031767
SB
328(defcustom todos-edit-mode-hook nil
329 "TODO Edit mode hooks."
330 :type 'hook
331 :group 'todos)
2c173503 332
2c173503 333(defcustom todos-categories-buffer "*TODOS Categories*"
ee7412e4 334 "Name of buffer displayed by `todos-display-categories'."
2c173503
SB
335 :type 'string
336 :group 'todos)
337
338(defcustom todos-archived-categories-buffer "*TODOS Archived Categories*"
ee7412e4 339 "Name of buffer displayed by `todos-display-categories'."
2c173503
SB
340 :type 'string
341 :group 'todos)
342
343(defcustom todos-edit-buffer " *TODO Edit*"
344 "TODO Edit buffer name."
345 :type 'string
3f031767 346 :group 'todos)
2c173503 347
3f031767
SB
348(defcustom todos-file-top (convert-standard-filename "~/.todos-top")
349 "TODO mode top priorities file.
350
351Not in TODO format, but diary compatible.
352Automatically generated when `todos-save-top-priorities' is non-nil."
353 :type 'string
354 :group 'todos)
355
2c173503
SB
356(defcustom todos-include-in-diary nil
357 "Non-nil to allow new Todo items to be included in the diary."
358 :type 'boolean
359 :group 'todos)
360
361(defcustom todos-exclusion-start "["
362 "String prepended to item date to block diary inclusion."
363 :type 'string
364 :group 'todos
365 ;; :initialize 'custom-initialize-default
366 ;; :set ; change in whole Todos file
367 )
368
369(defcustom todos-exclusion-end "]"
ee7412e4 370 "String appended to item date to match `todos-exclusion-start'."
2c173503
SB
371 :type 'string
372 :group 'todos
373 ;; :initialize 'custom-initialize-default
374 ;; :set ; change in whole Todos file
375 )
376
3f031767
SB
377(defcustom todos-print-function 'ps-print-buffer-with-faces
378 "Function to print the current buffer."
379 :type 'symbol
380 :group 'todos)
2c173503 381
3f031767
SB
382(defcustom todos-show-priorities 1
383 "Default number of priorities to show by \\[todos-top-priorities].
3840 means show all entries."
385 :type 'integer
386 :group 'todos)
2c173503 387
3f031767
SB
388(defcustom todos-print-priorities 0
389 "Default number of priorities to print by \\[todos-print].
3900 means print all entries."
391 :type 'integer
392 :group 'todos)
2c173503 393
3f031767
SB
394(defcustom todos-save-top-priorities-too t
395 "Non-nil makes `todos-save' automatically save top-priorities in `todos-file-top'."
396 :type 'boolean
397 :group 'todos)
2c173503 398
db2c5d34 399(defcustom todos-completion-ignore-case t ;; FIXME: nil for release
ee7412e4 400 "Non-nil means don't consider case significant in `todos-read-category'."
db2c5d34
SB
401 :type 'boolean
402 :group 'todos)
3f031767 403
ee7412e4 404(defcustom todos-always-add-time-string t
b28025ed
SB
405 "Add current time to date string inserted in front of new items."
406 :type 'boolean
3f031767
SB
407 :group 'todos)
408
2c173503 409(defcustom todos-wrap-lines t
ee7412e4 410 ""
2c173503
SB
411 :group 'todos
412 :type 'boolean)
413
414(defcustom todos-line-wrapping-function 'todos-wrap-and-indent
ee7412e4 415 ""
2c173503
SB
416 :group 'todos
417 :type 'function)
418
ee7412e4
SB
419(defcustom todos-indent-to-here 6
420 ""
421 :type 'integer
422 :group 'todos)
3f031767 423
ee7412e4 424;; ---------------------------------------------------------------------------
2c173503 425;;; Faces
ee7412e4 426
db2c5d34
SB
427(defface todos-prefix-string
428 '((t
b28025ed 429 :inherit font-lock-constant-face
db2c5d34
SB
430 ))
431 "Face for Todos prefix string."
432 :group 'todos)
db2c5d34 433
ee7412e4
SB
434(defface todos-button
435 '((t
436 :inherit tool-bar
437 ))
438 "Face for buttons in todos-display-categories."
439 :group 'todos)
440
b28025ed 441(defface todos-date
db2c5d34 442 '((t
b28025ed 443 :inherit diary
db2c5d34 444 ))
b28025ed 445 "Face for Todos prefix string."
db2c5d34 446 :group 'todos)
b28025ed
SB
447(defvar todos-date-face 'todos-date)
448
449(defface todos-time
450 '((t
451 :inherit diary-time
452 ))
453 "Face for Todos prefix string."
454 :group 'todos)
455(defvar todos-time-face 'todos-time)
456
2c173503
SB
457(defface todos-done
458 '((t
459 :inherit font-lock-comment-face
460 ))
461 "Face for done Todos item header string."
462 :group 'todos)
463(defvar todos-done-face 'todos-done)
b28025ed 464
2c173503
SB
465(defface todos-done-sep
466 '((t
467 :inherit font-lock-type-face
468 ))
469 "Face for separator string bewteen done and not done Todos items."
470 :group 'todos)
471(defvar todos-done-sep-face 'todos-done-sep)
db2c5d34
SB
472
473(defvar todos-font-lock-keywords
474 (list
b28025ed 475 '(todos-date-string-match 1 todos-date-face t)
2c173503
SB
476 '(todos-time-string-match 1 todos-time-face t)
477 '(todos-done-string-match 0 todos-done-face t)
478 '(todos-category-string-match 0 todos-done-sep-face t))
db2c5d34
SB
479 "Font-locking for Todos mode.")
480
3f031767 481;; ---------------------------------------------------------------------------
ee7412e4 482;;; Mode setup
3f031767 483
f730d273
SB
484(defvar todos-current-todos-file nil
485 "")
486
3f031767
SB
487(defvar todos-categories nil
488 "TODO categories.")
489
3f031767
SB
490(defvar todos-mode-map
491 (let ((map (make-keymap)))
492 (suppress-keymap map t)
2c173503 493 ;; navigation commands
3f031767
SB
494 (define-key map "+" 'todos-forward-category)
495 (define-key map "-" 'todos-backward-category)
2c173503
SB
496 (define-key map "j" 'todos-jump-to-category)
497 (define-key map "n" 'todos-forward-item)
498 (define-key map "p" 'todos-backward-item)
499 (define-key map "S" 'todos-search)
500 ;; display commands
db2c5d34 501 (define-key map "C" 'todos-display-categories)
f730d273 502 ;; (define-key map "" 'todos-display-categories-alphabetically)
2c173503
SB
503 (define-key map "h" 'todos-highlight-item)
504 (define-key map "N" 'todos-toggle-item-numbering)
505 ;; (define-key map "" 'todos-toggle-display-date-time)
506 (define-key map "P" 'todos-print)
507 (define-key map "q" 'todos-quit)
508 (define-key map "s" 'todos-save)
f730d273 509 (define-key map "V" 'todos-view-archive)
2c173503
SB
510 (define-key map "v" 'todos-toggle-view-done-items)
511 (define-key map "Y" 'todos-diary-items)
512 ;; (define-key map "S" 'todos-save-top-priorities)
513 (define-key map "t" 'todos-top-priorities)
514 ;; editing commands
515 (define-key map "A" 'todos-add-category)
516 (define-key map "d" 'todos-item-done)
517 ;; (define-key map "" 'todos-archive-done-items)
db2c5d34 518 (define-key map "D" 'todos-delete-category)
3f031767
SB
519 (define-key map "e" 'todos-edit-item)
520 (define-key map "E" 'todos-edit-multiline)
2c173503 521 ;; (define-key map "" 'todos-change-date)
2c173503
SB
522 (define-key map "ii" 'todos-insert-item)
523 (define-key map "ih" 'todos-insert-item-here)
ee7412e4 524 (define-key map "ia" 'todos-insert-item-ask-date-time)
2c173503
SB
525 (define-key map "id" 'todos-insert-item-for-diary)
526 ;; (define-key map "in" 'todos-insert-item-no-time)
3f031767
SB
527 (define-key map "k" 'todos-delete-item)
528 (define-key map "l" 'todos-lower-item)
db2c5d34 529 (define-key map "m" 'todos-move-item)
2c173503
SB
530 (define-key map "r" 'todos-raise-item)
531 (define-key map "R" 'todos-rename-category)
532 (define-key map "u" 'todos-item-undo)
533 (define-key map "y" 'todos-toggle-item-diary-inclusion)
534 ;; (define-key map "" 'todos-toggle-diary-inclusion)
ee7412e4 535 (define-key map [remap newline] 'newline-and-indent)
2c173503
SB
536 map)
537 "Todos mode keymap.")
538
539(defvar todos-archive-mode-map
540 (let ((map (make-sparse-keymap)))
541 (suppress-keymap map t)
542 ;; navigation commands
543 (define-key map "+" 'todos-forward-category)
544 (define-key map "-" 'todos-backward-category)
545 (define-key map "j" 'todos-jump-to-category)
3f031767
SB
546 (define-key map "n" 'todos-forward-item)
547 (define-key map "p" 'todos-backward-item)
2c173503
SB
548 ;; display commands
549 (define-key map "C" 'todos-display-categories)
550 (define-key map "h" 'todos-highlight-item)
551 (define-key map "N" 'todos-toggle-item-numbering)
552 ;; (define-key map "" 'todos-toggle-display-date-time)
3f031767
SB
553 (define-key map "P" 'todos-print)
554 (define-key map "q" 'todos-quit)
3f031767 555 (define-key map "s" 'todos-save)
2c173503
SB
556 (define-key map "S" 'todos-search)
557 map)
558 "Todos Archive mode keymap.")
559
560(defvar todos-edit-mode-map
ee7412e4 561 (let ((map (make-sparse-keymap)))
2c173503 562 (define-key map "\C-c\C-q" 'todos-edit-quit)
ee7412e4 563 (define-key map [remap newline] 'newline-and-indent)
3f031767 564 map)
2c173503 565 "Todos Edit mode keymap.")
3f031767 566
ee7412e4
SB
567(defvar todos-categories-mode-map
568 (let ((map (make-sparse-keymap)))
569 (suppress-keymap map t)
570 (define-key map "a" 'todos-display-categories-alphabetically)
571 (define-key map "c" 'todos-display-categories)
572 (define-key map "l" 'todos-lower-category)
573 (define-key map "r" 'todos-raise-category)
574 (define-key map "q" 'bury-buffer) ;FIXME ?
575 ;; (define-key map "A" 'todos-add-category)
576 ;; (define-key map "D" 'todos-delete-category)
577 ;; (define-key map "R" 'todos-rename-category)
578 map)
579 "Todos Categories mode keymap.")
580
3f031767
SB
581(defvar todos-category-number 0 "TODO category number.")
582
583(defvar todos-tmp-buffer-name " *todo tmp*")
584
2c173503 585(defvar todos-category-beg "--==-- "
3f031767
SB
586 "Category start separator to be prepended onto category name.")
587
ee7412e4
SB
588(easy-menu-define todos-menu todos-mode-map "Todo Menu"
589 '("Todo"
590 ["Next category" todos-forward-category t]
591 ["Previous category" todos-backward-category t]
592 ["Jump to category" todos-jump-to-category t]
593 ["Show top priority items" todos-top-priorities t]
594 ["Print categories" todos-print t]
595 "---"
596 ["Edit item" todos-edit-item t]
597 ["File item" todos-file-item t]
598 ["Insert new item" todos-insert-item t]
599 ["Insert item here" todos-insert-item-here t]
600 ["Kill item" todos-delete-item t]
601 "---"
602 ["Lower item priority" todos-lower-item t]
603 ["Raise item priority" todos-raise-item t]
604 "---"
605 ["Next item" todos-forward-item t]
606 ["Previous item" todos-backward-item t]
607 "---"
608 ["Save" todos-save t]
609 ["Save Top Priorities" todos-save-top-priorities t]
610 "---"
611 ["Quit" todos-quit t]
612 ))
3f031767 613
ee7412e4
SB
614;; As calendar reads .todos-do before todos-mode is loaded.
615;;;###autoload
616(defun todos-mode ()
617 "Major mode for displaying, navigating and editing Todo lists.
b28025ed 618
ee7412e4
SB
619\\{todos-mode-map}"
620 (interactive)
621 (kill-all-local-variables)
622 (setq major-mode 'todos-mode)
623 (setq mode-name "TODOS")
624 (use-local-map todos-mode-map)
625 (easy-menu-add todos-menu)
626 (when todos-wrap-lines (funcall todos-line-wrapping-function))
627 (make-local-variable 'indent-line-function)
628 (setq indent-line-function 'todos-indent)
629 (make-local-variable 'font-lock-defaults)
630 (setq font-lock-defaults '(todos-font-lock-keywords t))
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)
637 (setq buffer-read-only t)
638 (run-mode-hooks 'todos-mode-hook))
3f031767 639
ee7412e4
SB
640(defun todos-archive-mode ()
641 "Major mode for archived Todos categories.
642
643\\{todos-archive-mode-map}"
3f031767 644 (interactive)
ee7412e4
SB
645 (kill-all-local-variables)
646 (setq major-mode 'todos-archive-mode)
647 (setq mode-name "TODOS Archive")
648 (use-local-map todos-archive-mode-map)
649 ;; (easy-menu-add todos-menu)
650 (when todos-wrap-lines (funcall todos-line-wrapping-function))
651 (make-local-variable 'font-lock-defaults)
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))
3f031767 660
ee7412e4
SB
661(defun todos-edit-mode ()
662 "Major mode for editing multiline Todo items.
663
664\\{todos-edit-mode-map}"
3f031767 665 (interactive)
ee7412e4
SB
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)))
3f031767 674
ee7412e4
SB
675(defun todos-categories-mode ()
676 "Major mode for displaying and editing Todos categories.
677
678\\{todos-categories-mode-map}"
2c173503 679 (interactive)
ee7412e4
SB
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)
684 (setq font-lock-defaults '(todos-font-lock-keywords t))
685 (setq buffer-read-only t)
686)
2c173503 687
ee7412e4
SB
688(defun todos-save ()
689 "Save the TODO list."
690 (interactive)
f730d273
SB
691 (let (buffer-read-only)
692 (save-excursion
693 (save-restriction
694 ;; (widen)
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 ))
3f031767 702
ee7412e4
SB
703(defun todos-quit ()
704 "Done with TODO list for now."
705 (interactive)
706 (widen)
707 (todos-save)
f730d273
SB
708 ;; (message "")
709 (if (eq major-mode 'todos-archive-mode)
710 (todos-show)
711 (bury-buffer)))
2c173503 712
ee7412e4
SB
713;; ---------------------------------------------------------------------------
714;;; Commands
2c173503 715
ee7412e4
SB
716;;; Display
717
718;;;###autoload
719(defun todos-show ()
720 "Show TODO list."
3f031767 721 (interactive)
ee7412e4
SB
722 ;; Make this a no-op if called interactively in narrowed Todos mode, since
723 ;; it is in that case redundant, but in particular to work around the bug of
724 ;; item prefix reduplication with show-paren-mode enabled.
725 (unless (and (called-interactively-p)
726 (eq major-mode 'todos-mode)
727 (< (- ( point-max) (point-min)) (buffer-size)))
728 ;; Call todos-initial-setup only if there is neither a Todo file nor
729 ;; a corresponding unsaved buffer.
730 (if (or (file-exists-p todos-file-do)
731 (let* ((buf (get-buffer (file-name-nondirectory todos-file-do)))
732 (bufname (buffer-file-name buf)))
733 (equal (expand-file-name todos-file-do) bufname)))
734 (find-file todos-file-do)
735 (todos-initial-setup))
736 (unless (eq major-mode 'todos-mode) (todos-mode))
f730d273
SB
737 (unless (string= todos-current-todos-file todos-file-do)
738 (setq todos-current-todos-file todos-file-do)
739 (setq todos-category-number 0)
740 (setq todos-categories nil))
ee7412e4 741 (unless todos-categories
f730d273 742 (setq todos-categories (todos-make-categories-list)))
ee7412e4 743 (save-excursion
f730d273 744 (todos-category-select))))
2c173503 745
ee7412e4
SB
746(defun todos-display-categories (&optional alpha)
747 "Display a numbered list of the Todos category names.
748The numbers give the order of the categories.
749
750With non-nil ALPHA display a non-numbered alphabetical list.
751The lists are in Todos Categories mode.
3f031767 752
ee7412e4
SB
753The category names are buttonized, and pressing a button displays
754the category in Todos mode."
3f031767 755 (interactive)
2c173503 756 (let ((categories (copy-sequence todos-categories))
ee7412e4
SB
757 (num 0))
758 (when alpha ;alphabetize the list case insensitively
759 (setq categories (sort categories (lambda (s1 s2) (let ((cis1 (upcase s1))
760 (cis2 (upcase s2)))
761 (string< cis1 cis2))))))
2c173503
SB
762 (with-current-buffer (get-buffer-create todos-categories-buffer)
763 (switch-to-buffer (current-buffer))
ee7412e4
SB
764 (let (buffer-read-only)
765 (erase-buffer)
766 (kill-all-local-variables)
767 (insert "Press a button to display the corresponding category.\n\n")
768 ;; FIXME: abstract format from here and todos-insert-category-name
769 (insert (make-string 4 32) (todos-padded-string "Category")
f730d273
SB
770 (if (string= todos-current-todos-file todos-archive-file)
771 (concat (make-string 6 32)
772 (format "%s" "Archived"))
773 (concat (make-string 7 32)
774 (format "%-7s%-7s%s" "Todo" "Done" "Archived")))
775 "\n\n")
ee7412e4
SB
776 (save-excursion
777 (mapc '(lambda (cat) (todos-insert-category-name cat alpha)) categories)))
f730d273 778 (goto-char (next-single-char-property-change (point) 'button))
ee7412e4
SB
779 (todos-categories-mode))))
780
781(defun todos-display-categories-alphabetically ()
782 ""
783 (interactive)
784 (todos-display-categories t))
2c173503
SB
785
786(defun todos-toggle-item-numbering ()
ee7412e4 787 ""
2c173503
SB
788 (interactive)
789 (todos-reset-prefix 'todos-number-prefix (not todos-number-prefix)))
3f031767 790
2c173503 791(defun todos-toggle-view-done-items ()
ee7412e4 792 ""
3f031767 793 (interactive)
ee7412e4
SB
794 (save-excursion
795 (goto-char (point-min))
f730d273
SB
796 (let* ((todos-show-with-done
797 (if (re-search-forward (concat "\n\\(\\["
798 (regexp-quote todos-done-string)
799 "\\)") nil t)
800 nil
801 t))
802 (cat (todos-current-category))
803 (catsym (intern-soft (concat "todos-" cat))))
804 (todos-category-select)
805 (when (zerop (get catsym 'done))
806 (message "There are no done items in this category.")))))
2c173503
SB
807
808(defun todos-view-archive (&optional cat)
809 ""
810 (interactive)
811 (if (file-exists-p todos-archive-file)
f730d273 812 (progn ;let ((todos-show-with-done t))
2c173503 813 (find-file todos-archive-file)
f730d273
SB
814 (todos-archive-mode)
815 (unless (string= todos-current-todos-file todos-archive-file)
816 (setq todos-current-todos-file todos-archive-file)
817 (setq todos-categories nil))
818 (unless todos-categories
819 (setq todos-categories (todos-make-categories-list)))
2c173503 820 (if cat
f730d273
SB
821 (if (member cat (todos-categories))
822 (progn
823 (setq todos-category-number
824 (- (length todos-categories)
825 (length (member cat todos-categories))))
826 (todos-jump-to-category-noninteractively cat))
827 (message "No archived items from this category"))
828 (setq todos-category-number 0)
2c173503 829 (todos-category-select)))
f730d273 830 (message "There is currently no Todos archive")))
2c173503 831
ee7412e4 832;; FIXME: slow
2c173503
SB
833(defun todos-diary-items ()
834 "Display all todo items marked for diary inclusion."
835 (interactive)
836 (let ((bufname "*Todo diary entries*")
837 opoint)
838 (save-restriction
839 (save-current-buffer
840 (widen)
841 (copy-to-buffer bufname (point-min) (point-max))))
842 (with-current-buffer bufname
2c173503
SB
843 (goto-char (point-min))
844 (while (not (eobp))
845 (setq opoint (point))
846 (cond ((looking-at "\\[")
847 (progn
848 (todos-forward-item)
849 (if (string-match
850 (concat "^" (regexp-quote todos-category-beg) ".*$")
851 (buffer-substring opoint (point)))
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)))
3f031767 874
2c173503
SB
875(defun todos-highlight-item ()
876 "Highlight the todo item the cursor is on."
3f031767 877 (interactive)
2c173503
SB
878 (if hl-line-mode ; todos-highlight-item
879 (hl-line-mode 0)
880 (hl-line-mode 1)))
881
882;; FIXME: make this a customizable option for whole Todos file
883(defun todos-toggle-display-date-time ()
ee7412e4 884 ""
2c173503
SB
885 (interactive)
886 (save-excursion
887 (goto-char (point-min))
888 (let ((ovs (overlays-in (point) (line-end-position)))
889 ov hidden)
890 (while ovs
891 (setq ov (car ovs))
892 (if (equal (overlay-get ov 'display) "")
893 (setq ovs nil
894 hidden t)
895 (setq ovs (cdr ovs))))
896 (if hidden (remove-overlays (point-min) (point-max) 'display "")
897 (while (not (eobp))
898 (re-search-forward (concat "^\\[?" todos-date-pattern
ee7412e4 899 "\\( " diary-time-regexp "\\)?\\]? ")
2c173503
SB
900 ; FIXME: this space in header? ^
901 nil t)
f730d273 902 ;; FIXME: wrong match data if search fails
2c173503
SB
903 (setq ov (make-overlay (match-beginning 0) (match-end 0) nil t))
904 (overlay-put ov 'display "")
f730d273 905 (forward-line))))))
2c173503
SB
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
917With non-nil SHOW-DONE, include done items in the listing."
918
919 (interactive "P")
920 (or nof-priorities (setq nof-priorities todos-show-priorities))
921 (if (listp nof-priorities) ;universal argument
922 (setq nof-priorities (car nof-priorities)))
923 (let ((todos-print-buffer-name todos-tmp-buffer-name)
924 (todos-category-break (if category-pr-page "\f" ""))
925 beg end done)
926 (save-excursion
927 (todos-show))
928 (save-restriction
929 (save-current-buffer
930 (widen)
931 (if (buffer-live-p (get-buffer todos-print-buffer-name))
932 (kill-buffer todos-print-buffer-name))
933 (copy-to-buffer todos-print-buffer-name (point-min) (point-max))))
934 (with-current-buffer todos-print-buffer-name
935 (goto-char (point-min))
936 (while (re-search-forward ;Find category start
937 (concat "^" (regexp-quote todos-category-beg))
938 nil t)
939 (setq beg (+ (line-end-position) 1)) ;Start of first entry.
940 (setq end (if (re-search-forward todos-category-beg nil t)
941 (match-beginning 0)
942 (point-max)))
943 (goto-char beg)
944 (setq done
945 (if (re-search-forward
946 (concat
947 (if (looking-at "^$") "" "\n") ; no unfinished items
948 "\n\\(\\[" (regexp-quote todos-done-string) "\\)")
949 end t)
950 (match-beginning 1)
951 end))
952 (unless show-done
953 (delete-region done end)
954 (setq end done))
955 (narrow-to-region beg end) ;In case we have too few entries.
956 (goto-char (point-min))
957 (if (zerop nof-priorities) ;Traverse entries.
958 (goto-char end) ;All entries
959 (todos-forward-item nof-priorities))
960 (setq beg (point))
961 (delete-region beg end)
962 (widen))
963 (and (looking-at "\f") (replace-match "")) ;Remove trailing form-feed.
964 (goto-char (point-min)) ;Due to display buffer
965 (make-local-variable 'font-lock-defaults)
966 (setq font-lock-defaults '(todos-font-lock-keywords t))
967 (font-lock-fontify-buffer)
968 (setq buffer-read-only t))
969 ;; 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.
971 ;; Else we could have used pop-to-buffer.
972 ;; (display-buffer todos-print-buffer-name)
973 (display-buffer todos-print-buffer-name)
974 (message "Type C-x 1 to remove %s window. M-C-v to scroll the help."
975 todos-print-buffer-name)))
976
ee7412e4
SB
977;;; Navigation
978
979(defun todos-forward-category ()
980 "Go forward to TODO list of next category."
981 (interactive)
982 (setq todos-category-number
983 (mod (1+ todos-category-number) (length todos-categories)))
984 (todos-category-select))
985
986(defun todos-backward-category ()
987 "Go back to TODO list of previous category."
988 (interactive)
989 (setq todos-category-number
990 (mod (1- todos-category-number) (length todos-categories)))
991 (todos-category-select))
992
993;; FIXME: Document that a non-existing name creates that category, and add
994;; y-or-n-p confirmation -- or eliminate this possibility?
995(defun todos-jump-to-category ()
996 "Jump to a category. Default is previous category."
997 (interactive)
998 (let ((category (todos-read-category)))
999 (if (string= "" category)
1000 (setq category (todos-current-category)))
1001 (setq todos-category-number
1002 (if (member category todos-categories)
1003 (- (length todos-categories)
1004 (length (member category todos-categories)))
1005 (todos-add-category category)))
ee7412e4
SB
1006 (todos-category-select)))
1007
1008;; 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
1010;; displayed). Also disallow prefix arg value < 1 (re-search-* allows these)
1011(defun todos-backward-item (&optional count)
1012 "Select COUNT-th previous entry of TODO list."
1013 (interactive "P")
1014 ;; FIXME ? this moves to bob if on the first item (but so does previous-line)
1015 (todos-item-start)
1016 (unless (bobp)
1017 (re-search-backward todos-item-start nil t (or count 1))))
1018
1019(defun todos-forward-item (&optional count)
1020 "Select COUNT-th next entry of TODO list."
1021 (interactive "P")
1022 (goto-char (line-end-position))
1023 (if (re-search-forward todos-item-start nil t (or count 1))
1024 (goto-char (match-beginning 0))
1025 (goto-char (point-max))))
1026
1027;; FIXME: continue search with same regexp
1028(defvar todos-search-string nil
1029 ""
1030 )
1031(defun todos-search ()
1032 ""
1033 (interactive)
1034 (let ((regex (read-from-minibuffer "Enter a search string (regexp): "))
1035 (start (point))
1036 found cat in-done)
1037 (widen)
1038 (goto-char (point-min))
1039 (while (and (setq found (re-search-forward regex nil t))
1040 (save-excursion
1041 (goto-char (line-beginning-position))
1042 (looking-at (concat "^" (regexp-quote todos-category-beg)))))
1043 (forward-line))
1044 (if found
1045 (progn
f730d273 1046 (setq found (match-beginning 0)) ;FIXME: ok if looking-at returns nil?
ee7412e4
SB
1047 (todos-item-start)
1048 (when (looking-at (concat "^\\[" (regexp-quote todos-done-string)))
1049 (setq in-done t))
1050 (re-search-backward (concat "^" (regexp-quote todos-category-beg)
1051 "\\(.*\\)\n") nil t)
1052 (setq cat (match-string-no-properties 1))
1053 (todos-category-number cat)
1054 (todos-category-select)
1055 (when in-done (unless todos-show-with-done (todos-toggle-view-done-items)))
1056 (goto-char found))
1057 (todos-category-select)
1058 (goto-char start)
1059 (message "No match for \"%s\"" regex))))
1060
2c173503 1061;;; Editing
3f031767
SB
1062
1063;;;###autoload
1064(defun todos-add-category (&optional cat)
1065 "Add new category CAT to the TODO list."
1066 (interactive)
2c173503 1067 (let ((buffer-read-only)
f730d273
SB
1068 (buf (find-file-noselect todos-file-do t))
1069 catsym)
3f031767
SB
1070 (unless (zerop (buffer-size buf))
1071 (and (null todos-categories)
ee7412e4 1072 (error "Error in %s: File is non-empty but contains no category"
3f031767 1073 todos-file-do)))
ee7412e4 1074 (unless cat (setq cat (read-from-minibuffer "Category: ")))
3f031767 1075 (with-current-buffer buf
ee7412e4 1076 (setq cat (todos-check-category-name cat))
3f031767
SB
1077 ;; initialize a newly created Todo buffer for Todo mode
1078 (unless (file-exists-p todos-file-do) (todos-mode))
f730d273
SB
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?
3f031767 1082 (widen)
f730d273 1083 ;; FIXME: make this (point-max)
3f031767 1084 (goto-char (point-min))
2c173503
SB
1085 ;; make sure file does not begin with empty lines (shouldn't, but may be
1086 ;; added by mistake), otherwise new categories will contain them, so
1087 ;; won't be really empty
1088 (while (looking-at "^$") (kill-line))
b28025ed 1089 (insert todos-category-beg cat "\n")
3f031767
SB
1090 (if (interactive-p)
1091 ;; properly display the newly added category
f730d273
SB
1092 (progn (setq todos-category-number (1- (length todos-categories)))
1093 (todos-category-select))
1094 (1- (length todos-categories))))))
3f031767 1095
2c173503 1096(defun todos-rename-category ()
db2c5d34 1097 "Rename current Todos category."
2c173503
SB
1098 (interactive)
1099 (let* ((buffer-read-only)
ee7412e4 1100 (cat (todos-current-category))
2c173503 1101 (vec (vconcat todos-categories))
ee7412e4
SB
1102 (new (read-from-minibuffer (format "Rename category \"%s\" to: " cat))))
1103 (setq new (todos-check-category-name new))
1104 (aset vec todos-category-number new)
db2c5d34
SB
1105 (setq todos-categories (append vec nil))
1106 (save-excursion
1107 (widen)
2c173503
SB
1108 (re-search-backward (concat (regexp-quote todos-category-beg) "\\("
1109 (regexp-quote cat) "\\)\n") nil t)
b28025ed 1110 (replace-match new t t nil 1)
db2c5d34 1111 (goto-char (point-min))
ee7412e4 1112 (setq mode-line-buffer-identification (concat "Category: " new))))
db2c5d34
SB
1113 (todos-category-select))
1114
b28025ed
SB
1115(defun todos-delete-category (&optional arg)
1116 "Delete current Todos category provided it is empty.
1117With ARG non-nil delete the category unconditionally,
1118i.e. including all existing entries."
1119 (interactive "P")
ee7412e4 1120 (let* ((cat (todos-current-category))
f730d273
SB
1121 (catsym (intern-soft (concat "todos-" cat)))
1122 (todo (get catsym 'todo))
1123 (done (get catsym 'done))
ee7412e4
SB
1124 beg end)
1125 (if (and (null arg)
f730d273 1126 (or (> todo 0) (> done 0)))
ee7412e4 1127 (message "To delete a non-empty category, type C-u D.")
b28025ed
SB
1128 (when (y-or-n-p (concat "Permanently remove category \"" cat
1129 "\"" (and arg " and all its entries") "? "))
2c173503
SB
1130 (let ((buffer-read-only))
1131 (widen)
1132 (setq beg (re-search-backward (concat "^" (regexp-quote todos-category-beg)
f730d273
SB
1133 cat "\n") nil t))
1134 (setq end (if (re-search-forward (concat "\n\\("
1135 (regexp-quote todos-category-beg)
1136 ".*\n\\)") nil t)
1137 (match-beginning 1)
1138 (point-max)))
2c173503
SB
1139 (remove-overlays beg end)
1140 (kill-region beg end)
1141 (setq todos-categories (delete cat todos-categories))
f730d273
SB
1142 (setplist catsym nil)
1143 (unintern catsym)
1144 (setq todos-category-number
1145 (mod todos-category-number (length todos-categories)))
2c173503
SB
1146 (todos-category-select)
1147 (message "Deleted category %s" cat))))))
db2c5d34 1148
ee7412e4
SB
1149(defun todos-raise-category (&optional lower)
1150 "Raise priority of category point is on in Categories buffer.
1151With non-nil argument LOWER, lower the category's priority."
1152 (interactive)
1153 (let (num)
1154 (save-excursion
1155 (forward-line 0)
1156 (skip-chars-forward " ")
1157 (setq num (number-at-point)))
1158 (when (and num (if lower
1159 (< num (length todos-categories))
1160 (> num 1)))
1161 (let* ((col (current-column))
1162 (beg (progn (forward-line (if lower 0 -1)) (point)))
1163 (num1 (progn (skip-chars-forward " ") (1- (number-at-point))))
1164 (num2 (1+ num1))
1165 (end (progn (forward-line 2) (point)))
1166 (catvec (vconcat todos-categories))
1167 (cat1 (aref catvec num1))
1168 (cat2 (aref catvec num2))
1169 (buffer-read-only))
1170 (delete-region beg end)
1171 (setq num1 (1+ num1)
1172 num2 (1- num2))
1173 (setq num num2)
1174 (todos-insert-category-name cat2)
1175 (setq num num1)
1176 (todos-insert-category-name cat1)
1177 (aset catvec num2 cat2)
1178 (aset catvec num1 cat1)
1179 (setq todos-categories (append catvec nil))
1180 (forward-line (if lower -1 -2))
1181 (forward-char col)))))
1182
1183(defun todos-lower-category ()
1184 "Lower priority of category point is on in Categories buffer."
1185 (interactive)
1186 (todos-raise-category t))
1187
2c173503 1188;;;###autoload
ee7412e4 1189(defun todos-insert-item (&optional arg date-type time diary here)
2c173503 1190 "Insert new TODO list item.
db2c5d34 1191
2c173503
SB
1192With prefix argument ARG solicit the category, otherwise use the
1193current category.
db2c5d34 1194
ee7412e4
SB
1195Argument DATE-TYPE sets the form of the item's mandatory date
1196string. With the value `date' this is the full date (whose
1197format is set by `calendar-date-display-form', with year, month
1198and day individually solicited (month with tab completion). With
1199the value `dayname' a weekday name is used, solicited with tab
1200completion. With the value `calendar' the full date string is
1201used and set by selecting from the Calendar. With any other
1202value (including none) the full current date is used.
1203
1204Argument TIME determines the occurrence and value of the time
1205string. With the value `omit' insert the item without a time
1206string. With the value `ask' solicit a time string; this may be
1207empty or else must match `date-time-regexp'. With any other
1208value add or omit the current time in accordance with
1209`todos-always-add-time-string'.
1210
1211With non-nil argument DIARY mark item for inclusion in user's diary. If `todos-include-in-diary' is non-nil
1212
2c173503
SB
1213With non-nil argument HERE insert the new item directly above the
1214item at point. If point is on an empty line, insert the new item
ee7412e4 1215there."
3f031767 1216 (interactive "P")
2c173503
SB
1217 (unless (or (todos-done-item-p)
1218 (save-excursion (forward-line -1) (todos-done-item-p)))
f730d273 1219 (when (not (derived-mode-p 'todos-mode)) (todos-show))
2c173503 1220 (let* ((buffer-read-only)
ee7412e4
SB
1221 (date-string (cond
1222 ((eq date-type 'ask-date)
1223 (todos-read-date))
1224 ((eq date-type 'ask-dayname)
1225 (todos-read-dayname))
1226 ((eq date-type 'calendar)
1227 ;; FIXME: should only be executed from Calendar
2c173503
SB
1228 (with-current-buffer "*Calendar*"
1229 (calendar-date-string (calendar-cursor-to-date t) t t)))
1230 (t (calendar-date-string (calendar-current-date) t t))))
f730d273 1231 (time-string (cond ((eq time 'omit) nil) ;FIXME: delete
ee7412e4
SB
1232 ((eq time 'ask-time)
1233 (todos-read-time))
1234 (todos-always-add-time-string
1235 (substring (current-time-string) 11 16))))
1236 (new-item (concat (unless (or diary todos-include-in-diary) "[") ;FIXME
1237 date-string (when time-string (concat " " time-string))
1238 ;; FIXME
1239 (unless (or diary todos-include-in-diary) "]") " "
98c97dee 1240 (read-from-minibuffer "New TODO entry: ")))
ee7412e4
SB
1241 (cat (if arg (todos-read-category) (todos-current-category))))
1242 ;; indent newlines inserted by C-q C-j if nonspace char follows
1243 (setq new-item (replace-regexp-in-string
1244 "\\(\n\\)[^[:blank:]]"
1245 (concat "\n" (make-string todos-indent-to-here 32)) new-item
1246 nil nil 1))
ee7412e4
SB
1247 (unless here (todos-set-item-priority new-item cat))
1248 (todos-insert-with-overlays new-item)
1249 (todos-item-counts cat 'insert))))
1250
1251;; FIXME: make insertion options customizable per category
ee7412e4 1252
f730d273
SB
1253;; current date ~ current day ~ ask date ~ ask day
1254;; current time ~ ask time ~ no time
1255;; for diary ~ not for diary
1256;; here ~ ask priority
ee7412e4 1257
f730d273 1258;; date-type: d n (c) - time - diary - here
ee7412e4 1259
f730d273
SB
1260;; ii todos-insert-item
1261;; idd todos-insert-item-ask-date
1262;; idtt todos-insert-item-ask-date-time
1263;; idtyy todos-insert-item-ask-date-time-for-diary
1264;; idtyh todos-insert-item-ask-date-time-for-diary-here
1265;; idth todos-insert-item-ask-date-time-here
1266;; idyy todos-insert-item-ask-date-for-diary
1267;; idyh todos-insert-item-ask-date-for-diary-here
1268;; idh todos-insert-item-ask-date-here
1269;; inn todos-insert-item-ask-dayname
1270;; intt todos-insert-item-ask-dayname-time
1271;; intyy todos-insert-item-ask-dayname-time-for-diary
1272;; intyh todos-insert-item-ask-dayname-time-for-diary-here
1273;; inth todos-insert-item-ask-dayname-time-here
1274;; inyy todos-insert-item-ask-dayname-for-diary
1275;; inyh todos-insert-item-ask-dayname-for-diary-here
1276;; inh todos-insert-item-ask-dayname-here
1277;; itt todos-insert-item-time
1278;; ityy todos-insert-item-time-for-diary
1279;; ityh todos-insert-item-time-for-diary-here
1280;; ith todos-insert-item-time-here
1281;; iyy todos-insert-item-for-diary
1282;; iyh todos-insert-item-for-diary-here
1283;; ih todos-insert-item-here
2c173503 1284
f730d273 1285(defun todos-insert-item-here ()
ee7412e4 1286 ""
2c173503 1287 (interactive)
f730d273 1288 (todos-insert-item nil nil nil nil t))
2c173503
SB
1289
1290;; FIXME: autoload when key-binding is defined in calendar.el
1291(defun todos-insert-item-from-calendar ()
ee7412e4 1292 ""
2c173503
SB
1293 (interactive)
1294 (pop-to-buffer (file-name-nondirectory todos-file-do))
f730d273 1295 (todos-show) ;FIXME: todos-category-select ?
ee7412e4 1296 (todos-insert-item t 'calendar))
2c173503
SB
1297
1298;; FIXME: calendar is loaded before todos
1299;; (add-hook 'calendar-load-hook
1300 ;; (lambda ()
1301 (define-key calendar-mode-map "it" 'todos-insert-item-from-calendar);))
3f031767
SB
1302
1303(defun todos-delete-item ()
1304 "Delete current TODO list entry."
1305 (interactive)
1306 (if (> (count-lines (point-min) (point-max)) 0)
2c173503
SB
1307 (let* ((buffer-read-only)
1308 (todos-entry (todos-item-string-start))
3f031767
SB
1309 (todos-answer (y-or-n-p (concat "Permanently remove '"
1310 todos-entry "'? "))))
1311 (when todos-answer
1312 (todos-remove-item)
2c173503
SB
1313 (when (and (bolp) (eolp)
1314 ;; not if last item was deleted
1315 (< (point-min) (point-max)))
1316 (todos-backward-item))
ee7412e4 1317 (todos-item-counts (todos-current-category) 'delete)
f730d273
SB
1318 (todos-prefix-overlays)))
1319 (message "No TODO list entry to delete"))) ;FIXME: better message
3f031767 1320
2c173503
SB
1321(defun todos-edit-item ()
1322 "Edit current TODO list entry."
1323 (interactive)
1324 (let ((buffer-read-only)
1325 (item (todos-item-string))
1326 (opoint (point)))
1327 (if (todos-string-multiline-p item)
1328 (todos-edit-multiline)
1329 (let ((new (read-from-minibuffer "Edit: " item)))
1330 (while (not (string-match (concat "^\\[?" todos-date-pattern) new))
1331 (setq new (read-from-minibuffer "Item must start with a date: " new)))
ee7412e4
SB
1332 ;; indent newlines inserted by C-q C-j if nonspace char follows
1333 (setq new (replace-regexp-in-string
1334 "\\(\n\\)[^[:blank:]]"
1335 (concat "\n" (make-string todos-indent-to-here 32)) new
1336 nil nil 1))
2c173503
SB
1337 ;; If user moved point during editing, make sure it moves back.
1338 (goto-char opoint)
1339 (todos-remove-item)
1340 (todos-insert-with-overlays new)))))
1341
1342;; FIXME: run todos-check-format on exiting buffer (or check for date string
1343;; and indentation)
1344(defun todos-edit-multiline ()
1345 "Set up a buffer for editing a multiline TODO list entry."
1346 (interactive)
1347 (let ((buffer-name (generate-new-buffer-name todos-edit-buffer)))
1348 (switch-to-buffer
1349 (make-indirect-buffer
1350 (file-name-nondirectory todos-file-do) buffer-name))
1351 (message "To exit, simply kill this buffer and return to list.")
1352 (todos-edit-mode)
1353 (narrow-to-region (todos-item-start) (todos-item-end))))
1354
1355(defun todos-edit-quit ()
ee7412e4 1356 ""
2c173503
SB
1357 (interactive)
1358 (save-excursion (todos-category-select)))
1359
ee7412e4
SB
1360;; FIXME: complete
1361(defun todos-edit-item-header ()
1362 ""
2c173503 1363 (interactive)
ee7412e4
SB
1364 (todos-item-start)
1365 (re-search-forward (concat "^\\[?\\(?1:" todos-date-pattern
1366 "\\) \\(?2:" diary-time-regexp "\\)")
1367 (line-end-position) t)
1368 ;; ask date or dayname
1369 (replace-match new-date nil nil nil 1)
1370 ;; ask time
1371 (replace-match new-date nil nil nil 2))
2c173503 1372
3f031767
SB
1373(defun todos-raise-item ()
1374 "Raise priority of current entry."
1375 (interactive)
2c173503
SB
1376 (unless (or (todos-done-item-p)
1377 (looking-at "^$")) ; between done and not done items
1378 (let (buffer-read-only)
1379 (if (> (count-lines (point-min) (point)) 0)
1380 (let ((item (todos-item-string)))
1381 (todos-remove-item)
1382 (todos-backward-item)
1383 (todos-insert-with-overlays item))
f730d273 1384 (message "No TODO list entry to raise"))))) ;FIXME: better message
3f031767
SB
1385
1386(defun todos-lower-item ()
1387 "Lower priority of current entry."
1388 (interactive)
2c173503
SB
1389 (unless (or (todos-done-item-p)
1390 (looking-at "^$")) ; between done and not done items
f730d273 1391 (let* ((buffer-read-only))
ee7412e4
SB
1392 (if (save-excursion
1393 ;; can only lower non-final unfinished item
1394 (todos-forward-item)
1395 (and (looking-at todos-item-start)
1396 (not (todos-done-item-p))))
2c173503 1397 ;; Assume there is a final newline
ee7412e4 1398 (let ((item (todos-item-string)))
2c173503
SB
1399 (todos-remove-item)
1400 (todos-forward-item)
ee7412e4 1401 (when (todos-done-item-p) (forward-line -1))
2c173503 1402 (todos-insert-with-overlays item))
f730d273 1403 (message "No TODO list entry to lower"))))) ;FIXME: better message
3f031767 1404
db2c5d34
SB
1405(defun todos-move-item ()
1406 "Move the current todo item to another, interactively named, category.
1407
1408If the named category is not one of the current todo categories, then
1409it is created and the item becomes the first entry in that category."
1410 (interactive)
2c173503
SB
1411 (unless (or (todos-done-item-p)
1412 (looking-at "^$")) ; between done and not done items
1413 (let ((buffer-read-only)
1414 (oldnum todos-category-number)
ee7412e4 1415 (oldcat (todos-current-category))
2c173503 1416 (item (todos-item-string))
ee7412e4 1417 (newcat (todos-read-category))
2c173503 1418 (opoint (point))
ee7412e4 1419 (orig-mrk (progn (todos-item-start) (point-marker)))
2c173503
SB
1420 moved)
1421 (todos-remove-item)
2c173503
SB
1422 (unwind-protect
1423 (progn
f730d273
SB
1424 (unless (member newcat todos-categories) (todos-add-category newcat))
1425 (todos-set-item-priority item newcat)
ee7412e4
SB
1426 (todos-insert-with-overlays item)
1427 (setq moved t)
1428 (todos-item-counts oldcat 'delete)
1429 (todos-item-counts newcat 'insert))
2c173503
SB
1430 (unless moved
1431 (widen)
1432 (goto-char orig-mrk)
1433 (todos-insert-with-overlays item)
1434 (setq todos-category-number oldnum)
1435 (todos-category-select)
1436 ;; FIXME: does this work?
1437 (goto-char opoint))
1438 (set-marker orig-mrk nil)))))
1439
2c173503
SB
1440(defun todos-item-done ()
1441 "Mark current item as done and move it to category's done section."
b28025ed 1442 (interactive)
2c173503
SB
1443 (unless (or (todos-done-item-p)
1444 (looking-at "^$"))
1445 (let* ((buffer-read-only)
1446 (item (todos-item-string))
1447 (date-string (calendar-date-string (calendar-current-date) t t))
ee7412e4 1448 (time-string (if todos-always-add-time-string ;FIXME: delete condition
2c173503
SB
1449 (concat " " (substring (current-time-string) 11 16))
1450 ""))
1451 (done-item (concat "[" todos-done-string date-string time-string "] " item))
1452 (items-end (point-max))
1453 next-cat)
1454 (todos-remove-item)
1455 (save-excursion
1456 (widen)
1457 (setq next-cat
1458 (save-excursion
1459 (if (re-search-forward (concat "^" (regexp-quote todos-category-beg))
1460 nil t)
1461 (match-beginning 0)
1462 (point-max))))
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)))
ee7412e4 1472 (todos-item-counts (todos-current-category) 'done)
f730d273 1473 (todos-category-select)))
3f031767 1474
2c173503
SB
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))
ee7412e4 1479 (cat (todos-current-category))
f730d273 1480 (buffer-read-only)
2c173503
SB
1481 beg end)
1482 (save-excursion
3f031767 1483 (save-restriction
2c173503 1484 (widen)
f730d273
SB
1485 (setq end (if (re-search-forward
1486 (concat "^" (regexp-quote todos-category-beg)) nil t)
1487 (match-beginning 0)
1488 (point-max)))
2c173503
SB
1489 (re-search-backward (concat "^" (regexp-quote todos-category-beg)
1490 (regexp-quote cat))
1491 nil t)
ee7412e4 1492 (if (not (re-search-forward (concat "^\\[" (regexp-quote todos-done-string))
2c173503
SB
1493 nil t))
1494 (error "No done items in this category")
1495 (setq beg (match-beginning 0))
1496 (setq done (buffer-substring beg end))
ee7412e4 1497 ;; FIXME: update archive alist
2c173503 1498 (with-current-buffer archive
b28025ed 1499 (goto-char (point-min))
2c173503
SB
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"))
f730d273
SB
1504 (insert done)
1505 (save-buffer))
2c173503
SB
1506 (delete-region beg end)
1507 (remove-overlays beg end)
ee7412e4
SB
1508 (kill-line -1)
1509 (todos-item-counts cat 'archive)))))
2c173503
SB
1510 (message "Done items archived."))
1511
2c173503 1512(defun todos-item-undo ()
ee7412e4 1513 ""
2c173503
SB
1514 (interactive)
1515 (when (todos-done-item-p)
1516 (let* ((buffer-read-only)
ee7412e4
SB
1517 (cat (todos-current-category))
1518 (done-item (todos-item-string))
1519 (opoint (point))
1520 (orig-mrk (progn (todos-item-start) (point-marker)))
1521 (start (search-forward "] ")) ; end of done date string
1522 (item (buffer-substring start (todos-item-end)))
1523 undone)
2c173503 1524 (todos-remove-item)
ee7412e4
SB
1525 (unwind-protect
1526 (progn
ee7412e4
SB
1527 (todos-set-item-priority item cat)
1528 (todos-insert-with-overlays item)
1529 (setq undone t)
1530 (todos-item-counts cat 'undo))
1531 (unless undone
1532 (widen)
1533 (goto-char orig-mrk)
1534 (todos-insert-with-overlays done-item)
ee7412e4
SB
1535 (let ((todos-show-with-done t))
1536 (todos-category-select)
1537 (goto-char opoint)))
1538 (set-marker orig-mrk nil)))))
2c173503
SB
1539
1540(defun todos-toggle-item-diary-inclusion ()
ee7412e4 1541 ""
2c173503
SB
1542 (interactive)
1543 (save-excursion
1544 (let* ((buffer-read-only)
1545 (beg (todos-item-start))
1546 (lim (save-excursion (todos-item-end)))
1547 (end (save-excursion
1548 (or (todos-time-string-match lim)
1549 (todos-date-string-match lim)))))
1550 (if (looking-at "\\[") ; FIXME use todos-exclusion-start
1551 (progn
1552 (replace-match "")
1553 (search-forward "]" (1+ end) t) ; FIXME use todos-exclusion-end
1554 (replace-match ""))
1555 (when end
1556 (insert "[") ; FIXME use todos-exclusion-start
1557 (goto-char (1+ end))
1558 (insert "]")))))) ; FIXME use todos-exclusion-end
1559
1560(defun todos-toggle-diary-inclusion (arg)
ee7412e4 1561 ""
2c173503
SB
1562 (interactive "p")
1563 (save-excursion
1564 (save-restriction
1565 (when (eq arg 2) (widen)) ;FIXME: don't toggle done items
1566 (when (or (eq arg 1) (eq arg 2))
1567 (goto-char (point-min))
1568 (when (eq arg 2)
1569 (re-search-forward (concat "^" (regexp-quote todos-category-beg)) nil t)
1570 (forward-line)
1571 (when (looking-at (regexp-quote todos-category-end)) (forward-line)))
1572 (while (not (eobp))
1573 (todos-toggle-item-diary-inclusion)
1574 (todos-forward-item))))))
3f031767
SB
1575
1576(defun todos-save-top-priorities (&optional nof-priorities)
1577 "Save top priorities for each category in `todos-file-top'.
1578
1579Number of entries for each category is given by NOF-PRIORITIES which
1580defaults to `todos-show-priorities'."
1581 (interactive "P")
1582 (save-window-excursion
1583 (save-excursion
1584 (save-restriction
1585 (todos-top-priorities nof-priorities)
1586 (set-buffer todos-tmp-buffer-name)
1587 (write-file todos-file-top)
1588 (kill-this-buffer)))))
1589
1590;;;###autoload
1591(defun todos-print (&optional category-pr-page)
1592 "Print todo summary using `todos-print-function'.
1593If CATEGORY-PR-PAGE is non-nil, a page separator `^L' is inserted
1594between each category.
1595
1596Number of entries for each category is given by `todos-print-priorities'."
1597 (interactive "P")
2c173503
SB
1598 (when (yes-or-no-p "Print Todos list? ")
1599 (save-window-excursion
1e3d87b3
SB
1600 (save-excursion
1601 (save-restriction
2c173503
SB
1602 (todos-top-priorities todos-print-priorities
1603 category-pr-page)
1604 (set-buffer todos-tmp-buffer-name)
1605 (and (funcall todos-print-function)
1606 (kill-this-buffer))
1607 (message "Todo printing done."))))))
1608
1609;; ---------------------------------------------------------------------------
1610
1611;;; Internal functions
1612
2c173503 1613(defvar todos-date-pattern
ee7412e4
SB
1614 (let ((dayname (diary-name-pattern calendar-day-name-array nil t)))
1615 (concat "\\(" dayname "\\|"
1616 (let ((dayname)
1617 (monthname (format "\\(%s\\|\\*\\)"
1618 (diary-name-pattern calendar-month-name-array
1619 calendar-month-abbrev-array
1620 t)))
1621 (month "\\([0-9]+\\|\\*\\)")
1622 (day "\\([0-9]+\\|\\*\\)")
1623 (year "-?\\([0-9]+\\|\\*\\)"))
1624 (mapconcat 'eval calendar-date-display-form ""))
1625 "\\)"))
2c173503
SB
1626 "Regular expression matching a Todos date header.")
1627
1628(defun todos-date-string-match (lim)
ee7412e4
SB
1629 "Find Todos date strings within LIM for font-locking."
1630 (re-search-forward (concat "^\\[?" todos-date-pattern) lim t))
2c173503
SB
1631
1632(defun todos-time-string-match (lim)
ee7412e4
SB
1633 "Find Todos time strings within LIM for font-locking."
1634 (re-search-forward (concat "^\\[?" todos-date-pattern
2c173503
SB
1635 " \\(?1:" diary-time-regexp "\\)") lim t))
1636
1637(defun todos-done-string-match (lim)
ee7412e4 1638 "Find Todos done headers within LIM for font-locking."
2c173503
SB
1639 (re-search-forward (concat "^\\[" (regexp-quote todos-done-string) "[^][]+]")
1640 lim t))
1641
1642(defun todos-category-string-match (lim)
ee7412e4 1643 "Find Todos category headers within LIM for font-locking."
2c173503
SB
1644 (re-search-forward (concat "^" (regexp-quote todos-category-beg) ".*$")
1645 lim t))
1646
1647(defun todos-check-format ()
1648 "Signal an error if the current Todos file is ill-formatted."
1649 (save-excursion
1650 (save-restriction
1651 (widen)
1652 (goto-char (point-min))
1653 (let ((legit (concat "^\\(" (regexp-quote todos-category-beg) "\\)"
1654 "\\|\\(\\[?" todos-date-pattern "\\)"
1655 "\\|\\([ \t]+[^ \t]*\\)"
1656 "\\|$")))
1657 (while (not (eobp))
1658 (unless (looking-at legit)
1659 (error "Illegitimate Todos file format at line %d"
1660 (line-number-at-pos (point))))
1661 (forward-line)))))
1662 (message "This Todos file is well-formatted."))
1663
1664(defun todos-wrap-and-indent ()
ee7412e4 1665 ""
2c173503
SB
1666 (make-local-variable 'word-wrap)
1667 (setq word-wrap t)
1668 (make-local-variable 'wrap-prefix)
ee7412e4 1669 (setq wrap-prefix (make-string todos-indent-to-here 32))
2c173503
SB
1670 (unless (member '(continuation) fringe-indicator-alist)
1671 (push '(continuation) fringe-indicator-alist)))
1672
ee7412e4
SB
1673(defun todos-indent ()
1674 ""
1675 (indent-to todos-indent-to-here todos-indent-to-here))
1676
2c173503 1677(defun todos-prefix-overlays ()
ee7412e4 1678 ""
2c173503
SB
1679 (when (or todos-number-prefix
1680 (not (string-match "^[[:space:]]*$" todos-prefix)))
1681 (let ((prefix (propertize (concat todos-prefix " ") 'face 'todos-prefix-string))
ee7412e4 1682 (num 0))
2c173503
SB
1683 (save-excursion
1684 (goto-char (point-min))
ee7412e4
SB
1685 (while (not (eobp))
1686 (when (or (todos-date-string-match (line-end-position))
1687 (todos-done-string-match (line-end-position)))
1688 (goto-char (match-beginning 0))
1689 (when todos-number-prefix
1690 (setq num (1+ num))
1691 ;; reset number for done items
f730d273
SB
1692 (when
1693 ;; FIXME: really need this?
ee7412e4
SB
1694 ;; if last not done item is multiline, then
1695 ;; todos-done-string-match skips empty line, so have
1696 ;; to look back.
1697 (and (looking-at (concat "^\\[" (regexp-quote todos-done-string)))
f730d273
SB
1698 (looking-back "\n\n"))
1699 (setq num 1))
ee7412e4
SB
1700 (setq prefix (propertize (concat (number-to-string num) " ")
1701 'face 'todos-prefix-string)))
ee7412e4
SB
1702 (let* ((ovs (overlays-in (point) (point)))
1703 (ov-pref (car ovs))
1704 (val (when ov-pref (overlay-get ov-pref 'before-string))))
1705 (when (and (> (length ovs) 1)
1706 (not (equal val prefix)))
1707 (setq ov-pref (cadr ovs)))
1708 (when (not (equal val prefix))
f730d273
SB
1709 ;; (delete-overlay ov-pref) ; why doesn't this work ???
1710 (remove-overlays (point) (point)); 'before-string val) ; or this ???
ee7412e4
SB
1711 (setq ov-pref (make-overlay (point) (point)))
1712 (overlay-put ov-pref 'before-string prefix))))
1713 (forward-line))))))
2c173503 1714
f730d273
SB
1715(defun todos-reset-prefix (symbol value)
1716 "Set SYMBOL's value to VALUE, and ." ; FIXME
1717 (let ((oldvalue (symbol-value symbol)))
1718 (custom-set-default symbol value)
1719 (when (not (equal value oldvalue))
1720 (save-window-excursion
1721 (todos-show)
1722 (save-excursion
1723 (widen)
1724 (goto-char (point-min))
1725 (while (not (eobp))
1726 (remove-overlays (point) (point)); 'before-string prefix)
1727 (forward-line)))
1728 ;; activate the prefix setting (save-restriction does not help)
1729 (todos-category-select)))))
1730
2c173503
SB
1731(defun todos-reset-separator (symbol value)
1732 "Set SYMBOL's value to VALUE, and ." ; FIXME
1733 (let ((oldvalue (symbol-value symbol)))
1734 (custom-set-default symbol value)
2c173503
SB
1735 (when (not (equal value oldvalue))
1736 (save-window-excursion
1737 (todos-show)
1738 (save-excursion
1739 (goto-char (point-min))
ee7412e4
SB
1740 (when (re-search-forward (concat "^\\[" (regexp-quote todos-done-string))
1741 nil t)
2c173503
SB
1742 (remove-overlays (point) (point))))
1743 ;; activate the prefix setting (save-restriction does not help)
f730d273 1744 (todos-category-select)))))
2c173503 1745
ee7412e4
SB
1746;; FIXME: should be defsubst?
1747(defun todos-category-number (cat)
1748 "Set todos-category-number to index of CAT in todos-categories."
1749 (setq todos-category-number (- (length todos-categories)
1750 (length (member cat todos-categories)))))
2c173503
SB
1751(defun todos-current-category ()
1752 "Return the name of the current category."
1753 (nth todos-category-number todos-categories))
1754
1755(defun todos-category-select ()
1756 "Make TODO mode display the current category correctly."
ee7412e4 1757 (let ((name (todos-current-category)))
2c173503
SB
1758 (setq mode-line-buffer-identification (concat "Category: " name))
1759 (widen)
1760 (goto-char (point-min))
1761 (search-forward-regexp
1762 (concat "^" (regexp-quote (concat todos-category-beg name))
1763 "$"))
1764 (let ((begin (1+ (line-end-position)))
f730d273
SB
1765 (end (if (re-search-forward (concat "^" todos-category-beg) nil t)
1766 (match-beginning 0)
1767 (point-max))))
2c173503
SB
1768 (narrow-to-region begin end)
1769 (goto-char (point-min))))
1770 (todos-prefix-overlays)
f730d273
SB
1771 (unless (eq major-mode 'todos-archive-mode)
1772 ;; display or hide done items as per todos-show-with-done
1773 (save-excursion
1774 (when (re-search-forward (concat "\n\\(\\[" (regexp-quote todos-done-string)
1775 "\\)") nil t)
1776 (let (done end done-sep prefix ov-pref ov-done)
1777 (setq done (match-beginning 1)
1778 end (match-beginning 0))
1779 (if todos-show-with-done
1780 (progn
1781 (setq done-sep todos-done-separator)
1782 (unless (string-match "^[[:space:]]*$" todos-done-separator)
1783 (setq done-sep (propertize (concat todos-done-separator "\n")
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)))))))
ee7412e4
SB
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)
f730d273
SB
1804 (let* ((catsym (intern-soft (concat "todos-" cat)))
1805 (todo (get catsym 'todo))
1806 (maxnum (1+ todo))
ee7412e4 1807 priority candidate prompt)
f730d273 1808 (unless (zerop todo)
ee7412e4
SB
1809 (while (null priority)
1810 (setq candidate
2c173503
SB
1811 (string-to-number (read-from-minibuffer
1812 (concat prompt
1813 (format "Set item priority (1-%d): "
ee7412e4
SB
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)))
2c173503 1819 (goto-char (point-min))
ee7412e4 1820 (unless (= priority 1) (todos-forward-item (1- priority))))))
2c173503
SB
1821
1822(defun todos-jump-to-category-noninteractively (cat)
ee7412e4 1823 ""
f730d273
SB
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))
2c173503
SB
1832 (widen)
1833 (goto-char (point-min))
ee7412e4 1834 (todos-category-number cat)
2c173503
SB
1835 (todos-category-select))
1836
1837(defun todos-insert-with-overlays (item)
ee7412e4
SB
1838 ""
1839 (todos-item-start)
2c173503
SB
1840 (insert item "\n")
1841 (todos-backward-item)
f730d273 1842 (todos-prefix-overlays))
3f031767
SB
1843
1844(defun todos-item-string-start ()
1845 "Return the start of this TODO list entry as a string."
1846 ;; Suitable for putting in the minibuffer when asking the user
1847 (let ((item (todos-item-string)))
1848 (if (> (length item) 60)
1849 (setq item (concat (substring item 0 56) "...")))
1850 item))
1851
ee7412e4
SB
1852(defvar todos-item-start (concat "^\\(\\[\\(" (regexp-quote todos-done-string)
1853 "\\)?\\)?" todos-date-pattern)
1854 "String identifying start of a Todos item.")
1855
3f031767 1856(defun todos-item-start ()
2c173503
SB
1857 "Move to start of current TODO list item and return its position."
1858 (unless (or (looking-at "^$") ; last item or between done and not done
1859 (looking-at (regexp-quote todos-category-beg))) ; for todos-count-items
1860 (goto-char (line-beginning-position))
ee7412e4 1861 (while (not (looking-at todos-item-start))
2c173503
SB
1862 (forward-line -1)))
1863 (point))
3f031767
SB
1864
1865(defun todos-item-end ()
2c173503 1866 "Move to end of current TODO list item and return its position."
ee7412e4
SB
1867 (unless (looking-at "^$") ; FIXME:
1868 (let ((done (todos-done-item-p)))
1869 (todos-forward-item)
1870 ;; adjust if item is last unfinished one before displayed done items
1871 (when (and (not done) (todos-done-item-p))
1872 (forward-line -1))
1873 (backward-char)))
2c173503 1874 (point))
3f031767
SB
1875
1876(defun todos-remove-item ()
1877 "Delete the current entry from the TODO list."
ee7412e4
SB
1878 (let* ((beg (todos-item-start))
1879 (end (progn (todos-item-end) (1+ (point))))
2c173503
SB
1880 (ov-start (car (overlays-in beg beg))))
1881 (when ov-start
2c173503
SB
1882 (delete-overlay ov-start))
1883 (delete-region beg end)))
3f031767
SB
1884
1885(defun todos-item-string ()
1886 "Return current TODO list entry as a string."
1887 (buffer-substring (todos-item-start) (todos-item-end)))
1888
2c173503 1889(defun todos-done-item-p ()
ee7412e4 1890 ""
2c173503
SB
1891 (save-excursion
1892 (todos-item-start)
1893 (looking-at (concat "^\\[" (regexp-quote todos-done-string)))))
1894
f730d273
SB
1895(defun todos-make-categories-list ()
1896 "Return a list of Todos categories and set their property lists.
1897The properties are at least the category number and the numbers
1898of todo items, done items and archived items in the category."
1899 (let (catlist)
2c173503
SB
1900 (save-excursion
1901 (save-restriction
1902 (widen)
1903 (goto-char (point-min))
f730d273
SB
1904 (let ((num 0)
1905 cat catsym archive-check)
2c173503
SB
1906 (while (not (eobp))
1907 (cond ((looking-at (concat (regexp-quote todos-category-beg)
1908 "\\(.*\\)\n"))
f730d273
SB
1909 (setq cat (match-string-no-properties 1))
1910 (setq num (1+ num))
1911 (setq archive-check nil)
1912 ;; FIXME: ok to intern in global obarray?
1913 (setq catsym (intern (concat "todos-" cat)))
1914 (setplist catsym (list 'catnum num 'todo 0 'done 0 'archived 0))
1915 (push cat catlist))
2c173503 1916 ((looking-at (concat "^\\[" (regexp-quote todos-done-string)))
f730d273 1917 (put catsym 'done (1+ (get catsym 'done))))
2c173503 1918 ((looking-at (concat "^\\[?" todos-date-pattern))
f730d273
SB
1919 (put catsym 'todo (1+ (get catsym 'todo)))))
1920 (unless (or archive-check
1921 (string= (buffer-file-name)
1922 (expand-file-name todos-archive-file)))
1923 (let ((archive (find-file-noselect todos-archive-file)))
1924 (with-current-buffer archive
1925 (goto-char (point-min))
1926 (when (re-search-forward
1927 (concat (regexp-quote todos-category-beg) cat)
1928 (point-max) t)
1929 (forward-line)
1930 (while (not (or (looking-at
1931 (concat (regexp-quote todos-category-beg)
1932 "\\(.*\\)\n"))
1933 (eobp)))
1934 (when (looking-at
1935 (concat "^\\[" (regexp-quote todos-done-string)))
1936 (put catsym 'archived (1+ (get catsym 'archived))))
1937 (forward-line)))))
1938 (setq archive-check t))
2c173503 1939 (forward-line)))))
f730d273 1940 catlist))
2c173503 1941
ee7412e4 1942(defun todos-item-counts (cat &optional how)
2c173503 1943 ""
f730d273
SB
1944 (let ((catsym (intern-soft (concat "todos-" cat))))
1945 ;; FIXME: need this?
1946 ;; (when catsym
ee7412e4 1947 (cond ((eq how 'insert)
f730d273 1948 (put catsym 'todo (1+ (get catsym 'todo))))
ee7412e4
SB
1949 ((eq how 'delete)
1950 (if (todos-done-item-p) ;FIXME: fails if last done item was deleted
f730d273
SB
1951 (put catsym 'done (1- (get catsym 'done)))
1952 (put catsym 'todo (1- (get catsym 'todo)))))
ee7412e4 1953 ((eq how 'done)
f730d273
SB
1954 (put catsym 'todo (1- (get catsym 'todo)))
1955 (put catsym 'done (1+ (get catsym 'done))))
ee7412e4 1956 ((eq how 'undo)
f730d273
SB
1957 (put catsym 'todo (1+ (get catsym 'todo)))
1958 (put catsym 'done (1- (get catsym 'done))))
ee7412e4 1959 ((eq how 'archive)
f730d273
SB
1960 (put catsym 'archived (+ (get catsym 'done) (get catsym 'archived)))
1961 (put catsym 'done 0)))))
ee7412e4
SB
1962
1963(defun todos-longest-category-name-length (categories)
2c173503
SB
1964 ""
1965 (let ((longest 0))
ee7412e4 1966 (dolist (c categories longest)
f730d273 1967 (setq longest (max longest (length c))))))
2c173503 1968
3f031767
SB
1969(defun todos-string-count-lines (string)
1970 "Return the number of lines STRING spans."
1971 (length (split-string string "\n")))
1972
1973(defun todos-string-multiline-p (string)
1974 "Return non-nil if STRING spans several lines."
1975 (> (todos-string-count-lines string) 1))
1976
ee7412e4 1977(defun todos-read-category ()
f730d273 1978 "Return a category name (existing names with tab completion)."
db2c5d34
SB
1979 ;; allow SPC to insert spaces, for adding new category names with
1980 ;; todos-move-item
1981 (let ((map minibuffer-local-completion-map))
1982 (define-key map " " nil)
1983 ;; make a copy of todos-categories in case history-delete-duplicates is
1984 ;; non-nil, which makes completing-read alter todos-categories
1985 (let* ((categories (copy-sequence todos-categories))
1986 (history (cons 'todos-categories (1+ todos-category-number)))
ee7412e4 1987 (default (todos-current-category)) ;FIXME: why this default?
db2c5d34
SB
1988 (completion-ignore-case todos-completion-ignore-case)
1989 (category (completing-read
1990 (concat "Category [" default "]: ")
1991 todos-categories nil nil nil history default)))
1992 ;; restore the original value of todos-categories
1993 (setq todos-categories categories)
1994 category)))
3f031767 1995
ee7412e4
SB
1996(defun todos-check-category-name (cat)
1997 "Reject names for category CAT that could yield bugs or confusion."
1998 (let (prompt)
1999 (while (and (cond ((string= "" cat)
2000 (setq prompt "Enter a non-empty category name: "))
2001 ((string-match "\\`\\s-+\\'" cat)
f730d273
SB
2002 (setq prompt
2003 "Enter a category name that is not only white space: "))
ee7412e4
SB
2004 ((member cat todos-categories)
2005 (setq prompt "Enter a non-existing category name: ")))
2006 (setq cat (read-from-minibuffer prompt)))))
2007 cat)
2008
2009;; adapted from calendar-read-date
2010(defun todos-read-date ()
2011 "Prompt for Gregorian date and return it in the current format."
2012 (let* ((year (calendar-read
2013 "Year (>0): "
2014 (lambda (x) (> x 0))
2015 (number-to-string (calendar-extract-year
2016 (calendar-current-date)))))
2017 (month-array calendar-month-name-array)
2018 (completion-ignore-case t)
2019 (month (cdr (assoc-string
2020 (completing-read
2021 "Month name (RET for current month): "
2022 (mapcar 'list (append month-array nil))
2023 nil t nil nil
2024 (calendar-month-name (calendar-extract-month
2025 (calendar-current-date))))
2026 (calendar-make-alist month-array 1) t)))
2027 (last (calendar-last-day-of-month month year))
2028 day)
2029 (while (or (not (numberp day)) (< day 0) (< last day))
2030 (setq day (read-from-minibuffer
2031 (format "Day (1-%d): " last) nil nil t nil
2032 (number-to-string (calendar-extract-day (calendar-current-date))))))
2033 (calendar-date-string (list month day year) t t)))
2034
2035(defun todos-read-dayname ()
2036 ""
2037 (let ((completion-ignore-case t))
2038 (completing-read "Enter a day name: "
2039 (append calendar-day-name-array nil)
2040 nil t)))
2041
2042(defun todos-read-time ()
2043 ""
2044 (let (valid answer)
2045 (while (not valid)
2046 (setq answer (read-from-minibuffer
f730d273 2047 "Enter a clock time (or return for none): "))
ee7412e4
SB
2048 (when (or (string= "" answer)
2049 (string-match diary-time-regexp answer))
2050 (setq valid t)))
2051 answer))
2052
f730d273
SB
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))
2c173503 2065
ee7412e4
SB
2066(defun todos-padded-string (str)
2067 ""
f730d273 2068 (let* ((len (todos-longest-category-name-length todos-categories))
ee7412e4
SB
2069 (strlen (length str))
2070 (strlen-odd (eq (logand strlen 1) 1)) ; oddp from cl.el
2071 (padding (/ (- len strlen) 2)))
2072 (concat (make-string padding 32) str
2073 (make-string (if strlen-odd (1+ padding) padding) 32))))
2074
2075(defun todos-insert-category-name (cat &optional nonum)
2076 ""
f730d273
SB
2077 (let ((catsym (intern-soft (concat "todos-" cat)))
2078 (archive (string= todos-current-todos-file todos-archive-file)))
ee7412e4
SB
2079 ;; num is declared in caller
2080 (setq num (1+ num))
2081 (if nonum
2082 (insert (make-string 4 32))
2083 (insert " " (format "%2d" num) " "))
2084 (insert-button (todos-padded-string cat)
2085 'face 'todos-button
2086 'action
2087 `(lambda (button)
2088 (todos-jump-to-category-noninteractively ,cat)))
f730d273
SB
2089 (insert (concat (make-string 8 32)
2090 (unless archive
2091 (concat
2092 (format "%2d" (get catsym 'todo))
2093 (make-string 5 32)))
2094 (format "%2d" (get catsym 'done))
2095 (unless archive
2096 (concat
2097 (make-string 5 32)
2098 (format "%2d" (get catsym 'archived))))
2099 "\n"))))
3f031767
SB
2100
2101(defun todos-initial-setup ()
2102 "Set up things to work properly in TODO mode."
2103 (find-file todos-file-do)
2104 (erase-buffer)
2105 (todos-mode)
2106 (todos-add-category "Todos"))
2107
2108(provide 'todos)
2109
f730d273
SB
2110;;; UI
2111;; - display
2112;; - show todos in cat
2113;; - show done in cat
2114;; - show catlist
2115;; - show top priorities in all cats
2116;; - show archived
2117;; - navigation
2118;; -
2119;; - editing
2120;;
2121;;; Internals
2122;; - cat props: name, number, todos, done, archived
2123;; - item props: priority, date-time, status?
2124;; - file format
2125;; - cat begin
2126;; - todo items 0...n
2127;; - empty line
2128;; - done-separator
2129;; - done item 0...n
2130
3f031767 2131;;; todos.el ends here