Remove non-free old and crusty clearcase pkg
[packages] / xemacs-packages / calendar / todo-mode.el
1 ;;; todo-mode.el --- major mode for editing TODO list files
2
3 ;; Copyright (C) 1997, 1999, 2001, 2002, 2003, 2004, 2005, 2006, 2007
4 ;;   Free Software Foundation, Inc.
5
6 ;; Author: Oliver Seidel <os10000@seidel-space.de>
7 ;;   [Not clear the above works, July 2000]
8 ;; Created: 2 Aug 1997
9 ;; Keywords: calendar, todo
10
11 ;; This file is part of XEmacs.
12
13 ;; XEmacs 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 2, or (at your option)
16 ;; any later version.
17
18 ;; XEmacs 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 XEmacs; see the file COPYING.  If not, write to the
25 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
26 ;; Boston, MA 02110-1301, USA.
27
28 ;; ---------------------------------------------------------------------------
29
30 ;;; Commentary:
31
32 ;;  Mode Description
33 ;;
34 ;;      TODO is a major mode for EMACS which offers functionality to
35 ;;      treat most lines in one buffer as a list of items one has to
36 ;;      do.  There are facilities to add new items, which are
37 ;;      categorised, to edit or even delete items from the buffer.
38 ;;      The buffer contents are currently compatible with the diary,
39 ;;      so that the list of todo-items will show up in the FANCY diary
40 ;;      mode.
41 ;;
42 ;;      Notice: Besides the major mode, this file also exports the
43 ;;      function `todo-show' which will change to the one specific
44 ;;      TODO file that has been specified in the todo-file-do
45 ;;      variable.  If this file does not conform to the TODO mode
46 ;;      conventions, the todo-show function will add the appropriate
47 ;;      header and footer.  I don't anticipate this to cause much
48 ;;      grief, but be warned, in case you attempt to read a plain text
49 ;;      file.
50 ;;
51 ;;  Preface, Quickstart Installation
52 ;;
53 ;;      To get this to work, make emacs execute the line
54 ;;
55 ;;          (autoload 'todo-mode "todo-mode"
56 ;;                    "Major mode for editing TODO lists." t)
57 ;;          (autoload 'todo-show "todo-mode"
58 ;;                    "Show TODO items." t)
59 ;;          (autoload 'todo-insert-item "todo-mode"
60 ;;                    "Add TODO item." t)
61 ;;
62 ;;      You may now enter new items by typing "M-x todo-insert-item",
63 ;;      or enter your TODO list file by typing "M-x todo-show".
64 ;;
65 ;;      The TODO list file has a special format and some auxiliary
66 ;;      information, which will be added by the todo-show function if
67 ;;      it attempts to visit an un-initialised file.  Hence it is
68 ;;      recommended to use the todo-show function for the first time,
69 ;;      in order to initialise the file, but it is not necessary
70 ;;      afterwards.
71 ;;
72 ;;      As these commands are quite long to type, I would recommend
73 ;;      the addition of two bindings to your to your global keymap.  I
74 ;;      personally have the following in my initialisation file:
75 ;;
76 ;;          (global-set-key "\C-ct" 'todo-show) ;; switch to TODO buffer
77 ;;          (global-set-key "\C-ci" 'todo-insert-item) ;; insert new item
78 ;;
79 ;;      Note, however, that this recommendation has prompted some
80 ;;      criticism, since the keys C-c LETTER are reserved for user
81 ;;      functions.  I believe my recommendation is acceptable, since
82 ;;      the Emacs Lisp Manual *Tips* section also details that the
83 ;;      mode itself should not bind any functions to those keys.  The
84 ;;      express aim of the above two bindings is to work outside the
85 ;;      mode, which doesn't need the show function and offers a
86 ;;      different binding for the insert function.  They serve as
87 ;;      shortcuts and are not even needed (since the TODO mode will be
88 ;;      entered by visiting the TODO file, and later by switching to
89 ;;      its buffer).
90 ;;
91 ;;      If you are an advanced user of this package, please consult
92 ;;      the whole source code for autoloads, because there are several
93 ;;      extensions that are not explicitly listed in the above quick
94 ;;      installation.
95 ;;
96 ;;  Pre-Requisites
97 ;;
98 ;;      This package will require the following packages to be
99 ;;      available on the load-path:
100 ;;
101 ;;          time-stamp
102 ;;          easymenu
103 ;;
104 ;;  Operation
105 ;;
106 ;;      You will have the following facilities available:
107 ;;
108 ;;          M-x todo-show   will enter the todo list screen, here type
109 ;;
110 ;;          +  to go to next category
111 ;;          -  to go to previous category
112 ;;          d  to file the current entry, including a
113 ;;                                  comment and timestamp
114 ;;          e  to edit the current entry
115 ;;          E  to edit a multi-line entry
116 ;;          f  to file the current entry, including a
117 ;;                                  comment and timestamp
118 ;;          i  to insert a new entry, with prefix, omit category
119 ;;          I  to insert a new entry at current cursor position
120 ;;          j  jump to category
121 ;;          k  to kill the current entry
122 ;;          l  to lower the current entry's priority
123 ;;          n  for the next entry
124 ;;          p  for the previous entry
125 ;;          P  print
126 ;;          q  to save the list and exit the buffer
127 ;;          r  to raise the current entry's priority
128 ;;          s  to save the list
129 ;;          S  to save the list of top priorities
130 ;;          t  show top priority items for each category
131 ;;
132 ;;      When you add a new entry, you are asked for the text and then
133 ;;      for the category.  I for example have categories for things
134 ;;      that I want to do in the office (like mail my mum), that I
135 ;;      want to do in town (like buy cornflakes) and things I want to
136 ;;      do at home (move my suitcases).  The categories can be
137 ;;      selected with the cursor keys and if you type in the name of a
138 ;;      category which didn't exist before, an empty category of the
139 ;;      desired name will be added and filled with the new entry.
140 ;;
141 ;;  Configuration
142 ;;
143 ;;  Variable todo-prefix
144 ;;
145 ;;      I would like to recommend that you use the prefix "*/*" (by
146 ;;      leaving the variable 'todo-prefix' untouched) so that the
147 ;;      diary displays each entry every day.
148 ;;
149 ;;      To understand what I mean, please read the documentation that
150 ;;      goes with the calendar since that will tell you how you can
151 ;;      set up the fancy diary display and use the #include command to
152 ;;      include your todo list file as part of your diary.
153 ;;
154 ;;      If you have the diary package set up to usually display more
155 ;;      than one day's entries at once, consider using
156 ;;
157 ;;          "&%%(equal (calendar-current-date) date)"
158 ;;
159 ;;      as the value of `todo-prefix'.  Please note that this may slow
160 ;;      down the processing of your diary file some.
161 ;;
162 ;;      Carsten Dominik <dominik@strw.LeidenUniv.nl> suggested that
163 ;;
164 ;;          "&%%(todo-cp)"
165 ;;
166 ;;      might be nicer and to that effect a function has been declared
167 ;;      further down in the code.  You may wish to auto-load this.
168 ;;
169 ;;      Carsten also writes that that *changing* the prefix after the
170 ;;      todo list is already established is not as simple as changing
171 ;;      the variable - the todo files have to be changed by hand.
172 ;;
173 ;;  Variable todo-file-do
174 ;;
175 ;;      This variable is fairly self-explanatory.  You have to store
176 ;;      your TODO list somewhere.  This variable tells the package
177 ;;      where to go and find this file.
178 ;;
179 ;;  Variable todo-file-done
180 ;;
181 ;;      Even when you're done, you may wish to retain the entries.
182 ;;      Given that they're timestamped and you are offered to add a
183 ;;      comment, this can make a useful diary of past events.  It will
184 ;;      even blend in with the EMACS diary package.  So anyway, this
185 ;;      variable holds the name of the file for the filed todo-items.
186 ;;
187 ;;  Variable todo-file-top
188 ;;
189 ;;      File storing the top priorities of your TODO list when
190 ;;      todo-save-top-priorities is non-nil.  Nice to include in your
191 ;;      diary instead of the complete TODO list.
192 ;;
193 ;;  Variable todo-mode-hook
194 ;;
195 ;;      Just like other modes, too, this mode offers to call your
196 ;;      functions before it goes about its business.  This variable
197 ;;      will be inspected for any functions you may wish to have
198 ;;      called once the other TODO mode preparations have been
199 ;;      completed.
200 ;;
201 ;;  Variable todo-insert-threshold
202 ;;
203 ;;      Another nifty feature is the insertion accuracy.  If you have
204 ;;      8 items in your TODO list, then you may get asked 4 questions
205 ;;      by the binary insertion algorithm.  However, you may not
206 ;;      really have a need for such accurate priorities amongst your
207 ;;      TODO items.  If you now think about the binary insertion
208 ;;      halfing the size of the window each time, then the threshhold
209 ;;      is the window size at which it will stop.  If you set the
210 ;;      threshhold to zero, the upper and lower bound will coincide at
211 ;;      the end of the loop and you will insert your item just before
212 ;;      that point.  If you set the threshhold to, e.g. 8, it will stop
213 ;;      as soon as the window size drops below that amount and will
214 ;;      insert the item in the approximate centre of that window.  I
215 ;;      got the idea for this feature after reading a very helpful
216 ;;      e-mail reply from Trey Jackson <trey@cs.berkeley.edu> who
217 ;;      corrected some of my awful coding and pointed me towards some
218 ;;      good reading.  Thanks Trey!
219 ;;
220 ;;  Things to do
221 ;;
222 ;;      These originally were my ideas, but now also include all the
223 ;;      suggestions that I included before forgetting them:
224 ;;
225 ;;      o   Fancy fonts for todo/top-priority buffer
226 ;;      o   Remove todo-prefix option in todo-top-priorities
227 ;;      o   Rename category
228 ;;      o   Move entry from one category to another one
229 ;;      o   Entries which both have the generic */* prefix and a
230 ;;          "deadline" entry which are understood by diary, indicating
231 ;;          an event (unless marked by &)
232 ;;      o   The optional COUNT variable of todo-forward-item should be
233 ;;          applied to the other functions performing similar tasks
234 ;;      o   Modularization could be done for repeaded elements of
235 ;;          the code, like the completing-read lines of code.
236 ;;      o   license / version function
237 ;;      o   export to diary file
238 ;;      o   todo-report-bug
239 ;;      o   GNATS support
240 ;;      o   elide multiline (as in bbdb, or, to a lesser degree, in
241 ;;          outline mode)
242 ;;      o   rewrite complete package to store data as lisp objects
243 ;;          and have display modes for display, for diary export,
244 ;;          etc. (Richard Stallman pointed out this is a bad idea)
245 ;;      o   so base todo-mode.el on generic-mode.el instead
246 ;;
247 ;;  History and Gossip
248 ;;
249 ;;      Many thanks to all the ones who have contributed to the
250 ;;      evolution of this package!  I hope I have listed all of you
251 ;;      somewhere in the documentation or at least in the RCS history!
252 ;;
253 ;;      Enjoy this package and express your gratitude by sending nice
254 ;;      things to my parents' address!
255 ;;
256 ;;      Oliver Seidel
257 ;;      (Lessingstr. 8, 65760 Eschborn, Federal Republic of Germany)
258
259 ;;; Synched up with: FSF Emacs 22 CVS 2007-03-30
260
261 ;;; Code:
262
263 ;; XEmacs change
264 (eval-and-compile
265   (unless (fboundp 'line-beginning-position)
266     (defalias 'line-beginning-position 'point-at-bol))
267   (unless (fboundp 'line-end-position)
268     (defalias 'line-end-position 'point-at-eol)))
269
270
271 ;; User-configurable variables:
272
273 (defgroup todo nil
274   "Maintain a list of todo items."
275   :link '(emacs-commentary-link "todo-mode")
276   :version "21.1"
277   :group 'calendar)
278
279 (defcustom todo-prefix     "*/*"
280   "*TODO mode prefix for entries.
281
282 This is useful in conjunction with `calendar' and `diary' if you use
283
284 #include \"~/.todo-do\"
285
286 in your diary file to include your todo list file as part of your
287 diary.  With the default value \"*/*\" the diary displays each entry
288 every day and it may also be marked on every day of the calendar.
289 Using \"&%%(equal (calendar-current-date) date)\" instead will only
290 show and mark todo entreis for today, but may slow down processing of
291 the diary file somewhat."
292   :type 'string
293   :group 'todo)
294 (defcustom todo-file-do    "~/.todo-do"
295   "*TODO mode list file."
296   :type 'file
297   :group 'todo)
298 (defcustom todo-file-done  "~/.todo-done"
299   "*TODO mode archive file."
300   :type 'file
301   :group 'todo)
302 (defcustom todo-mode-hook  nil
303   "*TODO mode hooks."
304   :type 'hook
305   :group 'todo)
306 (defcustom todo-edit-mode-hook nil
307   "*TODO Edit mode hooks."
308   :type 'hook
309   :group 'todo)
310 (defcustom todo-insert-threshold 0
311   "*TODO mode insertion accuracy.
312
313 If you have 8 items in your TODO list, then you may get asked 4
314 questions by the binary insertion algorithm.  However, you may not
315 really have a need for such accurate priorities amongst your TODO
316 items.  If you now think about the binary insertion halfing the size
317 of the window each time, then the threshhold is the window size at
318 which it will stop.  If you set the threshhold to zero, the upper and
319 lower bound will coincide at the end of the loop and you will insert
320 your item just before that point.  If you set the threshhold to,
321 e.g. 8, it will stop as soon as the window size drops below that
322 amount and will insert the item in the approximate center of that
323 window."
324   :type 'integer
325   :group 'todo)
326 (defvar todo-edit-buffer " *TODO Edit*"
327   "TODO Edit buffer name.")
328 (defcustom todo-file-top "~/.todo-top"
329   "*TODO mode top priorities file.
330
331 Not in TODO format, but diary compatible.
332 Automatically generated when `todo-save-top-priorities' is non-nil."
333   :type 'string
334   :group 'todo)
335
336 (defcustom todo-print-function 'ps-print-buffer-with-faces
337   "*Function to print the current buffer."
338   :type 'symbol
339   :group 'todo)
340 (defcustom todo-show-priorities 1
341   "*Default number of priorities to show by \\[todo-top-priorities].
342 0 means show all entries."
343   :type 'integer
344   :group 'todo)
345 (defcustom todo-print-priorities 0
346   "*Default number of priorities to print by \\[todo-print].
347 0 means print all entries."
348   :type 'integer
349   :group 'todo)
350 (defcustom todo-remove-separator t
351   "*Non-nil to remove category separators in\
352 \\[todo-top-priorities] and \\[todo-print]."
353   :type 'boolean
354   :group 'todo)
355 (defcustom todo-save-top-priorities-too t
356   "*Non-nil makes `todo-save' automatically save top-priorities in `todo-file-top'."
357   :type 'boolean
358   :group 'todo)
359
360 ;; Thanks for the ISO time stamp format go to Karl Eichwalder <ke@suse.de>
361 ;; My format string for the appt.el package is "%3b %2d, %y, %02I:%02M%p".
362 ;;
363 (defcustom todo-time-string-format
364   "%:y-%02m-%02d %02H:%02M"
365   "*TODO mode time string format for done entries.
366 For details see the variable `time-stamp-format'."
367   :type 'string
368   :group 'todo)
369
370 (defcustom todo-entry-prefix-function 'todo-entry-timestamp-initials
371   "*Function producing text to insert at start of todo entry."
372   :type 'symbol
373   :group 'todo)
374 (defcustom todo-initials (or (getenv "INITIALS") (user-login-name))
375   "*Initials of todo item author."
376   :type 'string
377   :group 'todo)
378
379 (autoload 'time-stamp-string "time-stamp")
380
381 (defun todo-entry-timestamp-initials ()
382   "Prepend timestamp and your initials to the head of a TODO entry."
383   (let ((time-stamp-format todo-time-string-format))
384     (concat (time-stamp-string) " " todo-initials ": ")))
385
386 ;; ---------------------------------------------------------------------------
387
388 ;; Set up some helpful context ...
389
390 (defvar todo-categories nil
391   "TODO categories.")
392
393 (defvar todo-cats nil
394   "Old variable for holding the TODO categories.
395 Use `todo-categories' instead.")
396
397 (defvar todo-previous-line 0
398   "Previous line asked about.")
399
400 (defvar todo-previous-answer 0
401   "Previous answer got.")
402
403 (defvar todo-mode-map
404   (let ((map (make-keymap)))
405     (suppress-keymap map t)
406     (define-key map "+" 'todo-forward-category)
407     (define-key map "-" 'todo-backward-category)
408     (define-key map "d" 'todo-file-item) ;done/delete
409     (define-key map "e" 'todo-edit-item)
410     (define-key map "E" 'todo-edit-multiline)
411     (define-key map "f" 'todo-file-item)
412     (define-key map "i" 'todo-insert-item)
413     (define-key map "I" 'todo-insert-item-here)
414     (define-key map "j" 'todo-jump-to-category)
415     (define-key map "k" 'todo-delete-item)
416     (define-key map "l" 'todo-lower-item)
417     (define-key map "n" 'todo-forward-item)
418     (define-key map "p" 'todo-backward-item)
419     (define-key map "P" 'todo-print)
420     (define-key map "q" 'todo-quit)
421     (define-key map "r" 'todo-raise-item)
422     (define-key map "s" 'todo-save)
423     (define-key map "S" 'todo-save-top-priorities)
424     (define-key map "t" 'todo-top-priorities)
425     map)
426   "TODO mode keymap.")
427
428 (defvar todo-category-number 0 "TODO category number.")
429
430 (defvar todo-tmp-buffer-name " *todo tmp*")
431
432 (defvar todo-category-sep (make-string 75 ?-)
433   "Category separator.")
434
435 (defvar todo-category-beg " --- "
436   "Category start separator to be prepended onto category name.")
437
438 (defvar todo-category-end "--- End"
439   "Separator after a category.")
440
441 (defvar todo-header "-*- mode: todo; "
442   "Header of todo files.")
443
444 ;; ---------------------------------------------------------------------------
445
446 (defun todo-category-select ()
447   "Make TODO mode display the current category correctly."
448   (let ((name (nth todo-category-number todo-categories)))
449     (setq mode-line-buffer-identification
450 ;;          (concat "Category: " name))
451           (concat "Category: " (format "%18s" name)))
452     (widen)
453     (goto-char (point-min))
454     (search-forward-regexp
455      (concat "^"
456              (regexp-quote (concat todo-prefix todo-category-beg name))
457              "$"))
458     (let ((begin (1+ (line-end-position))))
459       (search-forward-regexp (concat "^" todo-category-end))
460       (narrow-to-region begin (line-beginning-position))
461       (goto-char (point-min)))))
462 (defalias 'todo-cat-slct 'todo-category-select)
463
464 (defun todo-forward-category ()
465   "Go forward to TODO list of next category."
466   (interactive)
467   (setq todo-category-number
468         (mod (1+ todo-category-number) (length todo-categories)))
469   (todo-category-select))
470 (defalias 'todo-cmd-forw 'todo-forward-category)
471
472 (defun todo-backward-category ()
473   "Go back to TODO list of previous category."
474   (interactive)
475   (setq todo-category-number
476         (mod (1- todo-category-number) (length todo-categories)))
477   (todo-category-select))
478 (defalias 'todo-cmd-back 'todo-backward-category)
479
480 (defun todo-backward-item ()
481   "Select previous entry of TODO list."
482   (interactive)
483   (search-backward-regexp (concat "^" (regexp-quote todo-prefix)) nil t)
484   (message ""))
485 (defalias 'todo-cmd-prev 'todo-backward-item)
486
487 (defun todo-forward-item (&optional count)
488   "Select COUNT-th next entry of TODO list."
489   (interactive "P")
490   (if (listp count) (setq count (car count)))
491   (end-of-line)
492   (search-forward-regexp (concat "^" (regexp-quote todo-prefix))
493                          nil 'goto-end count)
494   (beginning-of-line)
495   (message ""))
496 (defalias 'todo-cmd-next 'todo-forward-item)
497
498 (defun todo-save ()
499   "Save the TODO list."
500   (interactive)
501   (save-excursion
502     (save-restriction
503       (save-buffer)))
504   (if todo-save-top-priorities-too (todo-save-top-priorities)))
505 (defalias 'todo-cmd-save 'todo-save)
506
507 (defun todo-quit ()
508   "Done with TODO list for now."
509   (interactive)
510   (widen)
511   (todo-save)
512   (message "")
513   (bury-buffer))
514 (defalias 'todo-cmd-done 'todo-quit)
515
516 (defun todo-edit-item ()
517   "Edit current TODO list entry."
518   (interactive)
519   (let ((item (todo-item-string)))
520     (if (todo-string-multiline-p item)
521         (todo-edit-multiline)
522       (let ((new (read-from-minibuffer "Edit: " item)))
523         (todo-remove-item)
524         (insert new "\n")
525         (todo-backward-item)
526         (message "")))))
527 (defalias 'todo-cmd-edit 'todo-edit-item)
528
529 (defun todo-edit-multiline ()
530   "Set up a buffer for editing a multiline TODO list entry."
531   (interactive)
532   (let ((buffer-name (generate-new-buffer-name todo-edit-buffer)))
533     (switch-to-buffer
534      (make-indirect-buffer
535       (file-name-nondirectory todo-file-do) buffer-name))
536     (message "To exit, simply kill this buffer and return to list.")
537     (todo-edit-mode)
538     (narrow-to-region (todo-item-start) (todo-item-end))))
539
540 ;;;###autoload
541 (defun todo-add-category (cat)
542   "Add new category CAT to the TODO list."
543   (interactive "sCategory: ")
544   (save-window-excursion
545     (setq todo-categories (cons cat todo-categories))
546     (find-file todo-file-do)
547     (widen)
548     (goto-char (point-min))
549     (let ((posn (search-forward "-*- mode: todo; " 17 t)))
550       (if (not (null posn)) (goto-char posn))
551       (if (equal posn nil)
552           (progn
553             (insert "-*- mode: todo; \n")
554             (forward-char -1))
555         (kill-line)))
556     (insert (format "todo-categories: %S; -*-" todo-categories))
557     (forward-char 1)
558     (insert (format "%s%s%s\n%s\n%s %s\n"
559                     todo-prefix todo-category-beg cat
560                     todo-category-end
561                     todo-prefix todo-category-sep)))
562   0)
563
564 ;;;###autoload
565 (defun todo-add-item-non-interactively (new-item category)
566   "Insert NEW-ITEM in TODO list as a new entry in CATEGORY."
567   (save-excursion
568     (todo-show))
569   (save-excursion
570     (if (string= "" category)
571         (setq category (nth todo-category-number todo-categories)))
572     (let ((cat-exists (member category todo-categories)))
573       (setq todo-category-number
574             (if cat-exists
575                 (- (length todo-categories) (length cat-exists))
576               (todo-add-category category))))
577     (todo-show)
578     (setq todo-previous-line 0)
579     (let ((top 1)
580           (bottom (1+ (count-lines (point-min) (point-max)))))
581       (while (> (- bottom top) todo-insert-threshold)
582         (let* ((current (/ (+ top bottom) 2))
583                (answer (if (< current bottom)
584                            (todo-more-important-p current) nil)))
585           (if answer
586               (setq bottom current)
587             (setq top (1+ current)))))
588       (setq top (/ (+ top bottom) 2))
589       ;; goto-line doesn't have the desired behavior in a narrowed buffer
590       (goto-char (point-min))
591       (forward-line (1- top)))
592     (insert new-item "\n")
593     (todo-backward-item)
594     (todo-save)
595     (message "")))
596
597 ;;;###autoload
598 (defun todo-insert-item (arg)
599   "Insert new TODO list entry.
600 With a prefix argument solicit the category, otherwise use the current
601 category."
602   (interactive "P")
603   (save-excursion
604     (if (not (string-equal mode-name "TODO")) (todo-show))
605     (let* ((new-item (concat todo-prefix " "
606                              (read-from-minibuffer
607                               "New TODO entry: "
608                               (if todo-entry-prefix-function
609                                   (funcall todo-entry-prefix-function)))))
610            (categories todo-categories)
611            (history (cons 'categories (1+ todo-category-number)))
612            (current-category (nth todo-category-number todo-categories))
613            (category
614             (if arg
615                 current-category
616               (completing-read (concat "Category [" current-category "]: ")
617                                (todo-category-alist) nil nil nil
618                                history current-category))))
619       (todo-add-item-non-interactively new-item category))))
620
621 (defalias 'todo-cmd-inst 'todo-insert-item)
622
623 (defun todo-insert-item-here ()
624   "Insert new TODO list entry under the cursor."
625   (interactive "")
626   (save-excursion
627     (if (not (string-equal mode-name "TODO")) (todo-show))
628     (let* ((new-item (concat todo-prefix " "
629                              (read-from-minibuffer
630                               "New TODO entry: "
631                               (if todo-entry-prefix-function
632                                   (funcall todo-entry-prefix-function))))))
633       (insert (concat new-item "\n")))))
634
635 (defun todo-more-important-p (line)
636   "Ask whether entry is more important than the one at LINE."
637   (if (not (equal todo-previous-line line))
638       (progn
639         (setq todo-previous-line line)
640         (goto-char (point-min))
641         (forward-line (1- todo-previous-line))
642         (let ((item (todo-item-string-start)))
643           (setq todo-previous-answer
644                 (y-or-n-p (concat "More important than '" item "'? "))))))
645   todo-previous-answer)
646 (defalias 'todo-ask-p 'todo-more-important-p)
647
648 (defun todo-delete-item ()
649   "Delete current TODO list entry."
650   (interactive)
651   (if (> (count-lines (point-min) (point-max)) 0)
652       (let* ((todo-entry (todo-item-string-start))
653              (todo-answer (y-or-n-p (concat "Permanently remove '"
654                                             todo-entry "'? "))))
655         (if todo-answer
656             (progn
657               (todo-remove-item)
658               (todo-backward-item)))
659         (message ""))
660     (error "No TODO list entry to delete")))
661 (defalias 'todo-cmd-kill 'todo-delete-item)
662
663 (defun todo-raise-item ()
664   "Raise priority of current entry."
665   (interactive)
666   (if (> (count-lines (point-min) (point)) 0)
667       (let ((item (todo-item-string)))
668         (todo-remove-item)
669         (todo-backward-item)
670         (save-excursion
671           (insert item "\n"))
672         (message ""))
673     (error "No TODO list entry to raise")))
674 (defalias 'todo-cmd-rais 'todo-raise-item)
675
676 (defun todo-lower-item ()
677   "Lower priority of current entry."
678   (interactive)
679   (if (> (count-lines (point) (point-max)) 1)
680       ;; Assume there is a final newline
681       (let ((item (todo-item-string)))
682         (todo-remove-item)
683         (todo-forward-item)
684         (save-excursion
685           (insert item "\n"))
686         (message ""))
687     (error "No TODO list entry to lower")))
688 (defalias 'todo-cmd-lowr 'todo-lower-item)
689
690 (defun todo-file-item (&optional comment)
691   "File the current TODO list entry away, annotated with an optional COMMENT."
692   (interactive "sComment: ")
693   (or (> (count-lines (point-min) (point-max)) 0)
694       (error "No TODO list entry to file away"))
695   (let ((time-stamp-format todo-time-string-format))
696     (if (and comment (> (length comment) 0))
697         (progn
698           (goto-char (todo-item-end))
699           (insert
700            (if (save-excursion (beginning-of-line)
701                                (looking-at (regexp-quote todo-prefix)))
702                " "
703              "\n\t")
704            "(" comment ")")))
705     (goto-char (todo-item-end))
706     (insert " [" (nth todo-category-number todo-categories) "]")
707     (goto-char (todo-item-start))
708     (let ((temp-point (point)))
709       (if (looking-at (regexp-quote todo-prefix))
710           (replace-match (time-stamp-string))
711         ;; Standard prefix -> timestamp
712         ;; Else prefix non-standard item start with timestamp
713         (insert (time-stamp-string)))
714       (append-to-file temp-point (1+ (todo-item-end)) todo-file-done)
715       (delete-region temp-point (1+ (todo-item-end))))
716     (todo-backward-item)
717     (message "")))
718
719 ;; ---------------------------------------------------------------------------
720
721 ;; Utility functions:
722
723
724 ;;;###autoload
725 (defun todo-top-priorities (&optional nof-priorities category-pr-page)
726   "List top priorities for each category.
727
728 Number of entries for each category is given by NOF-PRIORITIES which
729 defaults to \'todo-show-priorities\'.
730
731 If CATEGORY-PR-PAGE is non-nil, a page separator \'^L\' is inserted
732 between each category."
733
734   (interactive "P")
735   (or nof-priorities (setq nof-priorities todo-show-priorities))
736   (if (listp nof-priorities)            ;universal argument
737       (setq nof-priorities (car nof-priorities)))
738   (let ((todo-print-buffer-name todo-tmp-buffer-name)
739         ;;(todo-print-category-number 0)
740         (todo-category-break (if category-pr-page "\f" ""))
741         (cat-end
742          (concat
743           (if todo-remove-separator
744               (concat todo-category-end "\n"
745                       (regexp-quote todo-prefix) " " todo-category-sep "\n")
746             (concat todo-category-end "\n"))))
747         beg end)
748     (todo-show)
749     (save-excursion
750       (save-restriction
751         (widen)
752         (copy-to-buffer todo-print-buffer-name (point-min) (point-max))
753         (set-buffer todo-print-buffer-name)
754         (goto-char (point-min))
755         (when (re-search-forward (regexp-quote todo-header) nil t)
756           (beginning-of-line 1)
757           (delete-region (point) (line-end-position)))
758         (while (re-search-forward       ;Find category start
759                 (regexp-quote (concat todo-prefix todo-category-beg))
760                 nil t)
761           (setq beg (+ (line-end-position) 1)) ;Start of first entry.
762           (re-search-forward cat-end nil t)
763           (setq end (match-beginning 0))
764           (replace-match todo-category-break)
765           (narrow-to-region beg end)    ;In case we have too few entries.
766           (goto-char (point-min))
767           (if (= 0 nof-priorities)      ;Traverse entries.
768               (goto-char end)            ;All entries
769             (todo-forward-item nof-priorities))
770           (setq beg (point))
771           (delete-region beg end)
772           (widen))
773         (and (looking-at "\f") (replace-match "")) ;Remove trailing form-feed.
774         (goto-char (point-min))         ;Due to display buffer
775         ))
776     ;; Could have used switch-to-buffer as it has a norecord argument,
777     ;; which is nice when we are called from e.g. todo-print.
778     ;; Else we could have used pop-to-buffer.
779     (display-buffer todo-print-buffer-name)
780     (message "Type C-x 1 to remove %s window.  M-C-v to scroll the help."
781              todo-print-buffer-name)))
782
783 (defun todo-save-top-priorities (&optional nof-priorities)
784   "Save top priorities for each category in `todo-file-top'.
785
786 Number of entries for each category is given by NOF-PRIORITIES which
787 defaults to `todo-show-priorities'."
788   (interactive "P")
789   (save-window-excursion
790     (save-excursion
791       (save-restriction
792         (todo-top-priorities nof-priorities)
793         (set-buffer todo-tmp-buffer-name)
794         (write-file todo-file-top)
795         (kill-this-buffer)))))
796
797 ;;;###autoload
798 (defun todo-print (&optional category-pr-page)
799   "Print todo summary using `todo-print-function'.
800 If CATEGORY-PR-PAGE is non-nil, a page separator `^L' is inserted
801 between each category.
802
803 Number of entries for each category is given by `todo-print-priorities'."
804   (interactive "P")
805   (save-window-excursion
806     (save-excursion
807       (save-restriction
808         (todo-top-priorities todo-print-priorities
809                              category-pr-page)
810         (set-buffer todo-tmp-buffer-name)
811         (and (funcall todo-print-function)
812              (kill-this-buffer))
813         (message "Todo printing done.")))))
814
815 (defun todo-jump-to-category ()
816   "Jump to a category.  Default is previous category."
817   (interactive)
818   (let* ((categories todo-categories)
819          (history (cons 'categories (1+ todo-category-number)))
820          (default (nth todo-category-number todo-categories))
821          (category (completing-read
822                     (concat "Category [" default "]: ")
823                     (todo-category-alist) nil nil nil history default)))
824     (if (string= "" category)
825         (setq category (nth todo-category-number todo-categories)))
826     (setq todo-category-number
827           (if (member category todo-categories)
828               (- (length todo-categories)
829                  (length (member category todo-categories)))
830             (todo-add-category category)))
831     (todo-show)))
832
833 (defun todo-line-string ()
834   "Return current line in buffer as a string."
835   (buffer-substring (line-beginning-position) (line-end-position)))
836
837 (defun todo-item-string-start ()
838   "Return the start of this TODO list entry as a string."
839   ;; Suitable for putting in the minibuffer when asking the user
840   (let ((item (todo-item-string)))
841     (if (> (length item) 60)
842         (setq item (concat (substring item 0 56) "...")))
843     item))
844
845 (defun todo-item-start ()
846   "Return point at start of current TODO list item."
847   (save-excursion
848     (beginning-of-line)
849     (if (not (looking-at (regexp-quote todo-prefix)))
850         (search-backward-regexp
851          (concat "^" (regexp-quote todo-prefix)) nil t))
852     (point)))
853
854 (defun todo-item-end ()
855   "Return point at end of current TODO list item."
856   (save-excursion
857     (end-of-line)
858     (search-forward-regexp
859      (concat "^" (regexp-quote todo-prefix)) nil 'goto-end)
860     (1- (line-beginning-position))))
861
862 (defun todo-remove-item ()
863   "Delete the current entry from the TODO list."
864   (delete-region (todo-item-start) (1+ (todo-item-end))))
865
866 (defun todo-item-string ()
867   "Return current TODO list entry as a string."
868   (buffer-substring (todo-item-start) (todo-item-end)))
869
870 (defun todo-string-count-lines (string)
871   "Return the number of lines STRING spans."
872   (length (split-string string "\n")))
873
874 (defun todo-string-multiline-p (string)
875   "Return non-nil if STRING spans several lines."
876   (> (todo-string-count-lines string) 1))
877
878 (defun todo-category-alist ()
879   "Generate an alist for use in `completing-read' from `todo-categories'."
880   (mapcar #'list todo-categories))
881
882 ;; ---------------------------------------------------------------------------
883
884 (easy-menu-define todo-menu todo-mode-map "Todo Menu"
885                   '("Todo"
886                     ["Next category"        todo-forward-category t]
887                     ["Previous category"    todo-backward-category t]
888                     ["Jump to category"     todo-jump-to-category t]
889                     ["Show top priority items" todo-top-priorities t]
890                     ["Print categories"     todo-print t]
891                     "---"
892                     ["Edit item"            todo-edit-item t]
893                     ["File item"            todo-file-item t]
894                     ["Insert new item"      todo-insert-item t]
895                     ["Insert item here"     todo-insert-item-here t]
896                     ["Kill item"            todo-delete-item t]
897                     "---"
898                     ["Lower item priority"  todo-lower-item t]
899                     ["Raise item priority"  todo-raise-item t]
900                     "---"
901                     ["Next item"            todo-forward-item t]
902                     ["Previous item"        todo-backward-item t]
903                     "---"
904                     ["Save"                 todo-save t]
905                     ["Save Top Priorities"  todo-save-top-priorities t]
906                     "---"
907                     ["Quit"                 todo-quit t]
908                     ))
909
910 ;; As calendar reads .todo-do before todo-mode is loaded.
911 ;;;###autoload
912 (defun todo-mode ()
913   "Major mode for editing TODO lists.
914
915 \\{todo-mode-map}"
916   (interactive)
917   (kill-all-local-variables)
918   (setq major-mode 'todo-mode)
919   (setq mode-name "TODO")
920   (use-local-map todo-mode-map)
921   (easy-menu-add todo-menu)
922   (run-mode-hooks 'todo-mode-hook))
923
924 (eval-when-compile
925   (defvar date)
926   (defvar entry))
927
928 ;; Read about this function in the setup instructions above!
929 ;;;###autoload
930 (defun todo-cp ()
931   "Make a diary entry appear only in the current date's diary."
932   (if (equal (calendar-current-date) date)
933       entry))
934
935 (define-derived-mode todo-edit-mode text-mode "TODO Edit"
936   "Major mode for editing items in the TODO list.
937
938 \\{todo-edit-mode-map}")
939
940 ;;;###autoload
941 (defun todo-show ()
942   "Show TODO list."
943   (interactive)
944   (if (file-exists-p todo-file-do)
945       (find-file todo-file-do)
946     (todo-initial-setup))
947   (if (null todo-categories)
948       (if (null todo-cats)
949           (error "Error in %s: No categories in list `todo-categories'"
950                  todo-file-do)
951         (goto-char (point-min))
952         (and (search-forward "todo-cats:" nil t)
953              (replace-match "todo-categories:"))
954         (make-local-variable 'todo-categories)
955         (setq todo-categories todo-cats)))
956   (beginning-of-line)
957   (todo-category-select))
958
959 (defun todo-initial-setup ()
960   "Set up things to work properly in TODO mode."
961   (find-file todo-file-do)
962   (erase-buffer)
963   (todo-mode)
964   (todo-add-category "Todo"))
965
966 (provide 'todo-mode)
967
968 ;;; arch-tag: 6fd91be5-776e-4464-a109-da4ea0e4e497
969 ;;; todo-mode.el ends here