1 ;;; Todos.el --- facilities for making and maintaining Todo lists
3 ;; Copyright (C) 1997, 1999, 2001-2011 Free Software Foundation, Inc.
5 ;; Author: Oliver Seidel <privat@os10000.net>
6 ;; Stephen Berman <stephen.berman@gmx.net>
7 ;; Maintainer: Stephen Berman <stephen.berman@gmx.net>
9 ;; Keywords: calendar, todo
11 ;; This file is part of GNU Emacs.
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.
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.
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/>.
30 ;; - show todos in cat
33 ;; - show top priorities in all cats
40 ;; - cat props: name, number, todos, done, archived
41 ;; - item props: priority, date-time, status?
53 ;; ---------------------------------------------------------------------------
57 "Create and maintain categorized lists of todo items."
58 :link
'(emacs-commentary-link "todos")
62 (defcustom todos-initial-category
"Todo"
63 "Default category name offered on initializing a new Todos file."
67 (defcustom todos-display-categories-first nil
68 "Non-nil to display category list on first visit to a Todos file."
72 (defcustom todos-prefix
""
73 "String prefixed to todo items for visual distinction."
75 :initialize
'custom-initialize-default
76 :set
'todos-reset-prefix
79 (defcustom todos-number-prefix t
80 "Non-nil to prefix items with consecutively increasing integers.
81 These reflect the priorities of the items in each category."
83 :initialize
'custom-initialize-default
84 :set
'todos-reset-prefix
87 ;; FIXME: Update when window-width changes. Add todos-reset-separator to
88 ;; window-configuration-change-hook in todos-mode? But this depends on the
89 ;; value being window-width instead of a constant length.
90 (defcustom todos-done-separator
(make-string (window-width) ?-
)
91 "String used to visual separate done from not done items.
92 Displayed in a before-string overlay by `todos-toggle-view-done-items'."
94 :initialize
'custom-initialize-default
95 :set
'todos-reset-prefix
98 (defcustom todos-done-string
"DONE "
99 "Identifying string appended to the front of done todos items."
101 :initialize
'custom-initialize-default
102 :set
'todos-reset-done-string
105 (defcustom todos-comment-string
"COMMENT"
106 "String inserted before optional comment appended to done item."
108 :initialize
'custom-initialize-default
109 :set
'todos-reset-comment-string
112 (defcustom todos-show-with-done nil
113 "Non-nil to display done items in all categories."
117 (defun todos-mode-line-control (cat)
118 "Return a mode line control for Todos buffers.
119 Argument CAT is the name of the current Todos category.
120 This function is the value of the user variable
121 `todos-mode-line-function'."
122 (let ((file (file-name-sans-extension
123 (file-name-nondirectory todos-current-todos-file
))))
124 (format "%s category %d: %s" file todos-category-number cat
)))
126 (defcustom todos-mode-line-function
'todos-mode-line-control
127 "Function that returns a mode line control for Todos buffers.
128 The function is expected to take one argument that holds the name
129 of the current Todos category. The resulting control becomes the
130 local value of `mode-line-buffer-identification' in each Todos
135 (defcustom todos-files-directory
(locate-user-emacs-file "todos/")
136 "Directory where user's Todos files are saved."
140 (defun todos-files (&optional archives
)
141 "Default value of `todos-files-function'.
142 This returns the case-insensitive alphabetically sorted list of
143 file truenames in `todos-files-directory' with the extension
144 \".todo\". With non-nil ARCHIVES return the list of archive file
145 truenames (those with the extension \".toda\")."
146 (let ((files (mapcar 'file-truename
147 (directory-files todos-files-directory t
148 (if archives
"\.toda$" "\.todo$") t
))))
149 (sort files
(lambda (s1 s2
) (let ((cis1 (upcase s1
))
151 (string< cis1 cis2
))))))
153 (defcustom todos-files-function
'todos-files
154 "Function returning the value of the variable `todos-files'.
155 This function should take an optional argument that, if non-nil,
156 makes it return the value of the variable `todos-archives'."
160 (defcustom todos-filter-function nil
165 (defcustom todos-priorities-rules
(list)
166 "List of rules for choosing top priorities of each Todos file.
167 The rules should be set interactively by invoking
168 `todos-set-top-priorities'.
170 Each rule is a list whose first element is a member of
171 `todos-files', whose second element is a number specifying the
172 default number of top priority items for the categories in that
173 file, and whose third element is an alist whose elements are
174 conses of a category name in that file and the number of top
175 priority items in that category that `todos-top-priorities' shows
176 by default, which overrides the number for the file."
180 (defcustom todos-merged-files nil
181 "List of files for `todos-merged-top-priorities'."
182 :type
`(set ,@(mapcar (lambda (x) (list 'const x
))
183 (funcall todos-files-function
)))
186 (defcustom todos-prompt-merged-files nil
187 "Non-nil to prompt for merging files for `todos-filter-items'."
191 (defcustom todos-show-current-file t
192 "Non-nil to make `todos-show' visit the current Todos file.
193 Otherwise, `todos-show' always visits `todos-default-todos-file'."
195 :initialize
'custom-initialize-default
196 :set
'todos-toggle-show-current-file
199 ;; FIXME: omit second sentence from doc string?
200 (defcustom todos-default-todos-file
(car (funcall todos-files-function
))
201 "Todos file visited by first session invocation of `todos-show'.
202 Normally this should be set by invoking `todos-change-default-file'
203 either directly or as a side effect of `todos-add-file'."
204 :type
`(radio ,@(mapcar (lambda (x) (list 'const x
))
205 (funcall todos-files-function
)))
208 (defcustom todos-visit-files-commands
(list 'find-file
'dired-find-file
)
209 "List of commands to visit files for `todos-after-find-file'.
210 Invoking these commands to visit a Todos or Todos Archive file
211 calls `todos-show' or `todos-show-archive', so that the file is
212 displayed correctly."
213 :type
'(repeat function
)
216 (defcustom todos-categories-buffer
"*Todos Categories*"
217 "Name of buffer displayed by `todos-display-categories'."
221 (defcustom todos-categories-category-label
"Category"
222 "Category button label in `todos-categories-buffer'."
226 (defcustom todos-categories-todo-label
"Todo"
227 "Todo button label in `todos-categories-buffer'."
231 (defcustom todos-categories-diary-label
"Diary"
232 "Diary button label in `todos-categories-buffer'."
236 (defcustom todos-categories-done-label
"Done"
237 "Done button label in `todos-categories-buffer'."
241 (defcustom todos-categories-archived-label
"Archived"
242 "Archived button label in `todos-categories-buffer'."
246 (defcustom todos-categories-totals-label
"Totals"
247 "String to label total item counts in `todos-categories-buffer'."
251 (defcustom todos-categories-number-separator
" | "
252 "String between number and category in `todos-categories-buffer'.
253 This separates the number from the category name in the default
254 categories display according to priority."
258 (defcustom todos-categories-align
'center
259 "Alignment of category names in `todos-categories-buffer'."
260 :type
'(radio (const left
) (const center
) (const right
))
263 (defcustom todos-ignore-archived-categories nil
264 "Non-nil to ignore categories with only archived items.
265 When non-nil such categories are omitted from `todos-categories'
266 and hence from commands that use this variable. An exception is
267 \\[todos-display-categories], which displays all categories; but
268 those with only archived items are shown in `todos-archived-only'
269 face and clicking them in Todos Categories mode visits the
270 archived categories."
272 :initialize
'custom-initialize-default
273 :set
'todos-reset-categories
277 (defcustom todos-edit-buffer
"*Todos Edit*"
278 "Name of current buffer in Todos Edit mode."
282 ;; (defcustom todos-edit-buffer "*Todos Top Priorities*"
283 ;; "TODO Edit buffer name."
287 ;; (defcustom todos-edit-buffer "*Todos Diary Entries*"
288 ;; "TODO Edit buffer name."
292 (defcustom todos-use-only-highlighted-region t
293 "Non-nil to enable inserting only highlighted region as new item."
297 (defcustom todos-include-in-diary nil
298 "Non-nil to allow new Todo items to be included in the diary."
302 (defcustom todos-diary-nonmarking nil
303 "Non-nil to insert new Todo diary items as nonmarking by default.
304 This appends `diary-nonmarking-symbol' to the front of an item on
305 insertion provided it doesn't begin with `todos-nondiary-marker'."
309 (defcustom todos-nondiary-marker
'("[" "]")
310 "List of strings surrounding item date to block diary inclusion.
311 The first string is inserted before the item date and must be a
312 non-empty string that does not match a diary date in order to
313 have its intended effect. The second string is inserted after
315 :type
'(list string string
)
317 :initialize
'custom-initialize-default
318 :set
'todos-reset-nondiary-marker
)
320 (defcustom todos-print-function
'ps-print-buffer-with-faces
321 "Function called to print buffer content; see `todos-print'."
325 ;; FIXME: rename, change meaning of zero, refer to todos-priorities-rules
326 (defcustom todos-show-priorities
1
327 "Default number of priorities to show by `todos-top-priorities'.
328 0 means show all entries."
332 (defcustom todos-print-priorities
0
333 "Default number of priorities to print by `todos-print'.
334 0 means print all entries."
338 (defcustom todos-completion-ignore-case t
;; FIXME: nil for release?
339 "Non-nil means don't consider case significant in `todos-read-category'."
343 (defcustom todos-always-add-time-string nil
344 "Non-nil adds current time to a new item's date header by default.
345 When the Todos insertion commands have a non-nil \"maybe-notime\"
346 argument, this reverses the effect of
347 `todos-always-add-time-string': if t, these commands omit the
348 current time, if nil, they include it."
352 (defcustom todos-wrap-lines t
353 "Non-nil to wrap long lines by `todos-line-wrapping-function'." ;FIXME
357 (defcustom todos-line-wrapping-function
'todos-wrap-and-indent
358 "Function called when `todos-wrap-lines' is non-nil." ;FIXME
362 (defcustom todos-indent-to-here
6
363 "Number of spaces `todos-line-wrapping-function' indents to."
367 ;; ---------------------------------------------------------------------------
370 (defgroup todos-faces nil
371 "Faces for the Todos modes."
375 (defface todos-prefix-string
376 '((t :inherit font-lock-constant-face
))
377 "Face for Todos prefix string."
381 '((t :inherit font-lock-warning-face
))
382 "Face for marks on Todos items."
385 (defface todos-button
386 '((t :inherit widget-field
))
387 "Face for buttons in todos-display-categories."
390 (defface todos-sorted-column
391 '((t :inherit fringe
))
392 "Face for buttons in todos-display-categories."
395 (defface todos-archived-only
396 '((t (:inherit
(shadow))))
397 "Face for archived-only categories in todos-display-categories."
400 (defface todos-search
401 '((t :inherit match
))
402 "Face for matches found by todos-search."
406 '((t :inherit diary
))
407 "Face for Todos prefix string."
409 (defvar todos-date-face
'todos-date
)
412 '((t :inherit diary-time
))
413 "Face for Todos prefix string."
415 (defvar todos-time-face
'todos-time
)
418 '((t :inherit font-lock-comment-face
))
419 "Face for done Todos item header string."
421 (defvar todos-done-face
'todos-done
)
423 (defface todos-comment
424 '((t :inherit font-lock-comment-face
))
425 "Face for comments appended to done Todos items."
427 (defvar todos-comment-face
'todos-comment
)
429 (defface todos-done-sep
430 '((t :inherit font-lock-type-face
))
431 "Face for separator string bewteen done and not done Todos items."
433 (defvar todos-done-sep-face
'todos-done-sep
)
435 (defvar todos-font-lock-keywords
437 '(todos-date-string-matcher 1 todos-date-face t
)
438 '(todos-time-string-matcher 1 todos-time-face t
)
439 '(todos-done-string-matcher 0 todos-done-face t
)
440 '(todos-comment-string-matcher 1 todos-done-face t
)
441 '(todos-category-string-matcher 1 todos-done-sep-face t
))
442 "Font-locking for Todos mode.")
444 ;; ---------------------------------------------------------------------------
447 (defvar todos-files
(funcall todos-files-function
)
448 "List of truenames of user's Todos files.")
450 (defvar todos-archives
(funcall todos-files-function t
)
451 "List of truenames of user's Todos archives.")
453 (defvar todos-categories nil
454 "Alist of categories in the current Todos file.
455 The elements are cons cells whose car is a category name and
456 whose cdr is a vector of the category's item counts. These are,
457 in order, the numbers of todo items, todo items included in the
458 Diary, done items and archived items.")
460 (defvar todos-categories-full nil
461 "Variable holding non-truncated copy of `todos-categories'.
462 Set when `todos-ignore-archived-categories' is set to non-nil, to
463 restore full `todos-categories' list when
464 `todos-ignore-archived-categories' is reset to nil.")
466 (defvar todos-current-todos-file nil
467 "Variable holding the name of the currently active Todos file.")
468 ;; Automatically set by `todos-switch-todos-file'.")
470 ;; FIXME: Add function to kill-buffer-hook that sets this to the latest
471 ;; existing Todos file or else todos-default-todos-file on killing the buffer
473 (defvar todos-global-current-todos-file nil
474 "Variable holding name of current Todos file.
475 Used by functions called from outside of Todos mode to visit the
476 current Todos file rather than the default Todos file (i.e. when
477 users option `todos-show-current-file' is non-nil).")
479 (defun todos-reset-global-current-todos-file ()
481 (let ((buflist (copy-sequence (buffer-list)))
482 (cur todos-global-current-todos-file
))
485 (let* ((buf (pop buflist
))
486 (bufname (buffer-file-name buf
)))
487 (when bufname
(setq bufname
(file-truename bufname
)))
488 (when (and (member bufname todos-files
)
489 (not (eq buf
(current-buffer))))
490 (setq todos-global-current-todos-file bufname
)
491 (throw 'done nil
)))))
492 (if (equal cur todos-global-current-todos-file
)
493 (setq todos-global-current-todos-file todos-default-todos-file
))))
495 (defvar todos-category-number
1
496 "Variable holding the number of the current Todos category.
497 This number is one more than the index of the category in
498 `todos-categories'.")
500 (defvar todos-first-visit t
501 "Non-nil if first display of this file in the current session.
502 See `todos-display-categories-first'.")
505 (defvar todos-tmp-buffer-name
" *todo tmp*")
507 (defvar todos-category-beg
"--==-- "
508 "String marking beginning of category (inserted with its name).")
510 (defvar todos-category-done
"==--== DONE "
511 "String marking beginning of category's done items.")
513 (defvar todos-nondiary-start
(nth 0 todos-nondiary-marker
)
514 "String inserted before item date to block diary inclusion.")
516 (defvar todos-nondiary-end
(nth 1 todos-nondiary-marker
)
517 "String inserted after item date matching `todos-nondiary-start'.")
519 (defvar todos-show-done-only nil
520 "If non-nil display only done items in current category.
521 Set by `todos-toggle-show-done-only' and used by
522 `todos-category-select'.")
524 ;;; Todos insertion commands, key bindings and keymap
526 ;; http://rosettacode.org/wiki/Power_set#Common_Lisp (GFDL)
530 (let ((prev (powerset (cdr l
))))
531 (append (mapcar #'(lambda (elt) (cons (car l
) elt
)) prev
)
534 ;; Return list of lists of non-nil atoms produced from ARGLIST. The elements
535 ;; of ARGLIST may be atoms or lists.
536 (defun todos-gen-arglists (arglist)
539 (let ((arg (pop arglist
)))
541 (setq arglists
(if arglists
542 (mapcar (lambda (l) (push arg l
)) arglists
)
543 (list (push arg arglists
)))))
547 (if (= 1 (length arglists
))
548 (apply (lambda (l) (push a l
)) arglists
)
549 (mapcar (lambda (l) (push a l
)) arglists
)))
551 (setq arglists
(mapcar 'reverse
(apply 'append
(mapc 'car arglists
))))))
553 (defvar todos-insertion-commands-args-genlist
554 '(diary nonmarking
(calendar date dayname
) time
(here region
))
555 "Generator list for argument lists of Todos insertion commands.")
557 (eval-when-compile (require 'cl
)) ; remove-duplicates
559 (defvar todos-insertion-commands-args
560 (let ((argslist (todos-gen-arglists todos-insertion-commands-args-genlist
))
562 (setq res
(remove-duplicates
563 (apply 'append
(mapcar 'powerset argslist
)) :test
'equal
))
565 (unless (= 5 (length l
))
566 (let ((v (make-vector 5 nil
)) elt
)
569 (cond ((eq elt
'diary
)
571 ((eq elt
'nonmarking
)
573 ((or (eq elt
'calendar
)
582 (setq l
(append v nil
))))
583 (setq new
(append new
(list l
))))
585 "List of all argument lists for Todos insertion commands.")
587 (defun todos-insertion-command-name (arglist)
588 "Generate Todos insertion command name from ARGLIST."
589 (replace-regexp-in-string
591 (replace-regexp-in-string
593 (concat "todos-item-insert-"
594 (mapconcat (lambda (e) (if e
(symbol-name e
))) arglist
"-")))))
596 (defvar todos-insertion-commands-names
598 (todos-insertion-command-name l
))
599 todos-insertion-commands-args
)
600 "List of names of Todos insertion commands.")
602 (defmacro todos-define-insertion-command
(&rest args
)
603 (let ((name (intern (todos-insertion-command-name args
)))
609 `(defun ,name
(&optional arg
)
610 "Todos item insertion command."
612 (todos-insert-item arg
',arg0
',arg1
',arg2
',arg3
',arg4
))))
614 (defvar todos-insertion-commands
616 (eval `(todos-define-insertion-command ,@c
)))
617 todos-insertion-commands-args
)
618 "List of Todos insertion commands.")
620 (defvar todos-insertion-commands-arg-key-list
622 ("nonmarking" "k" "kk")
623 ("calendar" "c" "cc")
631 (defun todos-insertion-key-bindings (map)
633 (dolist (c todos-insertion-commands
)
635 (cname (symbol-name c
)))
636 ;; (if (string-match "diary\\_>" cname) (setq key (concat key "yy")))
637 ;; (if (string-match "diary.+" cname) (setq key (concat key "y")))
638 ;; (if (string-match "nonmarking\\_>" cname) (setq key (concat key "kk")))
639 ;; (if (string-match "nonmarking.+" cname) (setq key (concat key "k")))
640 ;; (if (string-match "calendar\\_>" cname) (setq key (concat key "cc")))
641 ;; (if (string-match "calendar.+" cname) (setq key (concat key "c")))
642 ;; (if (string-match "date\\_>" cname) (setq key (concat key "dd")))
643 ;; (if (string-match "date.+" cname) (setq key (concat key "d")))
644 ;; (if (string-match "dayname\\_>" cname) (setq key (concat key "nn")))
645 ;; (if (string-match "dayname.+" cname) (setq key (concat key "n")))
646 ;; (if (string-match "time\\_>" cname) (setq key (concat key "tt")))
647 ;; (if (string-match "time.+" cname) (setq key (concat key "t")))
648 ;; (if (string-match "here" cname) (setq key (concat key "h")))
649 ;; (if (string-match "region" cname) (setq key (concat key "r")))
651 (let ((arg (nth 0 l
))
654 (if (string-match (concat (regexp-quote arg
) "\\_>") cname
)
655 (setq key
(concat key key2
)))
656 (if (string-match (concat (regexp-quote arg
) ".+") cname
)
657 (setq key
(concat key key1
)))))
658 todos-insertion-commands-arg-key-list
)
659 (if (string-match (concat (regexp-quote "todos-item-insert") "\\_>") cname
)
660 (setq key
(concat key
"i")))
661 (define-key map key c
))))
663 (defvar todos-insertion-map
664 (let ((map (make-keymap)))
665 (todos-insertion-key-bindings map
)
667 "Keymap for Todos mode insertion commands.")
669 (defvar todos-mode-map
670 (let ((map (make-keymap)))
671 ;; Don't suppress digit keys, so they can supply prefix arguments.
672 (suppress-keymap map
)
674 (define-key map
"Cd" 'todos-display-categories
) ;FIXME: Cs todos-show-categories?
675 ;; (define-key map "" 'todos-display-categories-alphabetically)
676 (define-key map
"H" 'todos-highlight-item
)
677 (define-key map
"N" 'todos-toggle-item-numbering
)
678 (define-key map
"D" 'todos-toggle-display-date-time
)
679 (define-key map
"*" 'todos-toggle-mark-item
)
680 (define-key map
"C*" 'todos-mark-category
)
681 (define-key map
"Cu" 'todos-unmark-category
)
682 (define-key map
"P" 'todos-print
)
683 ;; (define-key map "" 'todos-print-to-file)
684 (define-key map
"v" 'todos-toggle-view-done-items
)
685 (define-key map
"V" 'todos-toggle-show-done-only
)
686 (define-key map
"Av" 'todos-view-archived-items
)
687 (define-key map
"As" 'todos-show-archive
)
688 (define-key map
"Ac" 'todos-choose-archive
)
689 (define-key map
"Y" 'todos-diary-items
)
690 ;; (define-key map "" 'todos-update-merged-files)
691 ;; (define-key map "" 'todos-set-top-priorities)
692 (define-key map
"Ftt" 'todos-top-priorities
)
693 (define-key map
"Ftm" 'todos-merged-top-priorities
)
694 (define-key map
"Fdd" 'todos-diary-items
)
695 (define-key map
"Fdm" 'todos-merged-diary-items
)
696 (define-key map
"Frr" 'todos-regexp-items
)
697 (define-key map
"Frm" 'todos-merged-regexp-items
)
698 (define-key map
"Fcc" 'todos-custom-items
)
699 (define-key map
"Fcm" 'todos-merged-custom-items
)
700 ;; (define-key map "" 'todos-save-top-priorities)
701 ;; navigation commands
702 (define-key map
"f" 'todos-forward-category
)
703 (define-key map
"b" 'todos-backward-category
)
704 (define-key map
"j" 'todos-jump-to-category
)
705 (define-key map
"J" 'todos-jump-to-category-other-file
)
706 (define-key map
"n" 'todos-forward-item
)
707 (define-key map
"p" 'todos-backward-item
)
708 (define-key map
"S" 'todos-search
)
709 (define-key map
"X" 'todos-clear-matches
)
711 (define-key map
"Fa" 'todos-add-file
)
712 ;; (define-key map "" 'todos-change-default-file)
713 (define-key map
"Ca" 'todos-add-category
)
714 (define-key map
"Cr" 'todos-rename-category
)
715 (define-key map
"Cg" 'todos-merge-category
)
716 ;; (define-key map "" 'todos-merge-categories)
717 (define-key map
"Cm" 'todos-move-category
)
718 (define-key map
"Ck" 'todos-delete-category
)
719 (define-key map
"d" 'todos-item-done
)
720 (define-key map
"ee" 'todos-edit-item
)
721 (define-key map
"em" 'todos-edit-multiline
)
722 (define-key map
"eh" 'todos-edit-item-header
)
723 (define-key map
"ed" 'todos-edit-item-date
)
724 (define-key map
"ey" 'todos-edit-item-date-is-today
)
725 (define-key map
"et" 'todos-edit-item-time
)
726 (define-key map
"ec" 'todos-comment-done-item
) ;FIXME: or just "c"?
727 (define-key map
"i" todos-insertion-map
)
728 (define-key map
"k" 'todos-delete-item
)
729 (define-key map
"m" 'todos-move-item
)
730 (define-key map
"M" 'todos-move-item-to-file
)
731 ;; FIXME: This prevents `-' from being used in a numerical prefix argument
732 ;; without typing C-u
733 (define-key map
"-" 'todos-raise-item-priority
)
734 (define-key map
"r" 'todos-raise-item-priority
)
735 (define-key map
"+" 'todos-lower-item-priority
)
736 (define-key map
"l" 'todos-lower-item-priority
)
737 (define-key map
"#" 'todos-set-item-priority
)
738 (define-key map
"u" 'todos-item-undo
)
739 (define-key map
"Ad" 'todos-archive-done-item-or-items
) ;FIXME
740 (define-key map
"AD" 'todos-archive-category-done-items
) ;FIXME
741 ;; (define-key map "" 'todos-unarchive-items)
742 ;; (define-key map "" 'todos-unarchive-category)
743 (define-key map
"y" 'todos-toggle-diary-inclusion
)
744 ;; (define-key map "" 'todos-toggle-diary-inclusion)
745 ;; (define-key map "" 'todos-toggle-item-diary-nonmarking)
746 ;; (define-key map "" 'todos-toggle-diary-nonmarking)
747 (define-key map
"s" 'todos-save
)
748 (define-key map
"q" 'todos-quit
)
749 (define-key map
[remap newline
] 'newline-and-indent
)
751 "Todos mode keymap.")
754 todos-menu todos-mode-map
"Todos Menu"
757 ["Next Item" todos-forward-item t
]
758 ["Previous Item" todos-backward-item t
]
760 ["Next Category" todos-forward-category t
]
761 ["Previous Category" todos-backward-category t
]
762 ["Jump to Category" todos-jump-to-category t
]
763 ["Jump to Category in Other File" todos-jump-to-category-other-file t
]
765 ["Search Todos File" todos-search t
]
766 ["Clear Highlighting on Search Matches" todos-category-done t
])
768 ["List Current Categories" todos-display-categories t
]
769 ;; ["List Categories Alphabetically" todos-display-categories-alphabetically t]
770 ["Turn Item Highlighting on/off" todos-highlight-item t
]
771 ["Turn Item Numbering on/off" todos-toggle-item-numbering t
]
772 ["Turn Item Time Stamp on/off" todos-toggle-display-date-time t
]
773 ["View/Hide Done Items" todos-toggle-view-done-items t
]
775 ["View Diary Items" todos-diary-items t
]
776 ["View Top Priority Items" todos-top-priorities t
]
777 ["View Merged Top Priority Items" todos-merged-top-priorities t
]
779 ["View Archive" todos-view-archive t
]
780 ["Print Category" todos-print t
]) ;FIXME
782 ["Insert New Item" todos-insert-item t
]
783 ["Insert Item Here" todos-insert-item-here t
]
784 ("More Insertion Commands")
785 ["Edit Item" todos-edit-item t
]
786 ["Edit Multiline Item" todos-edit-multiline t
]
787 ["Edit Item Header" todos-edit-item-header t
]
788 ["Edit Item Date" todos-edit-item-date t
]
789 ["Edit Item Time" todos-edit-item-time t
]
791 ["Lower Item Priority" todos-lower-item-priority t
]
792 ["Raise Item Priority" todos-raise-item-priority t
]
793 ["Set Item Priority" todos-set-item-priority t
]
794 ["Move (Recategorize) Item" todos-move-item t
]
795 ["Delete Item" todos-delete-item t
]
796 ["Undo Done Item" todos-item-undo t
]
797 ["Mark/Unmark Item for Diary" todos-toggle-item-diary-inclusion t
]
798 ["Mark/Unmark Items for Diary" todos-toggle-diary-inclusion t
]
799 ["Mark & Hide Done Item" todos-item-done t
]
800 ["Archive Done Items" todos-archive-category-done-items t
] ;FIXME
802 ["Add New Todos File" todos-add-file t
]
803 ["Add New Category" todos-add-category t
]
804 ["Delete Current Category" todos-delete-category t
]
805 ["Rename Current Category" todos-rename-category t
]
807 ["Save Todos File" todos-save t
]
808 ["Save Top Priorities" todos-save-top-priorities t
])
810 ["Quit" todos-quit t
]
813 (defvar todos-archive-mode-map
814 (let ((map (make-sparse-keymap)))
815 (suppress-keymap map t
)
816 ;; navigation commands
817 (define-key map
"f" 'todos-forward-category
)
818 (define-key map
"b" 'todos-backward-category
)
819 (define-key map
"j" 'todos-jump-to-category
)
820 (define-key map
"n" 'todos-forward-item
)
821 (define-key map
"p" 'todos-backward-item
)
823 (define-key map
"C" 'todos-display-categories
)
824 (define-key map
"H" 'todos-highlight-item
)
825 (define-key map
"N" 'todos-toggle-item-numbering
)
826 ;; (define-key map "" 'todos-toggle-display-date-time)
827 (define-key map
"P" 'todos-print
)
828 (define-key map
"q" 'todos-quit
)
829 (define-key map
"s" 'todos-save
)
830 (define-key map
"S" 'todos-search
)
831 (define-key map
"t" 'todos-show
) ;FIXME: should show same category
832 ;; (define-key map "u" 'todos-unarchive-item)
833 (define-key map
"U" 'todos-unarchive-category
)
835 "Todos Archive mode keymap.")
837 (defvar todos-edit-mode-map
838 (let ((map (make-sparse-keymap)))
839 (define-key map
"\C-x\C-q" 'todos-edit-quit
)
840 (define-key map
[remap newline
] 'newline-and-indent
)
842 "Todos Edit mode keymap.")
844 (defvar todos-categories-mode-map
845 (let ((map (make-sparse-keymap)))
846 (suppress-keymap map t
)
847 ;; (define-key map "a" 'todos-display-categories-alphabetically)
848 (define-key map
"c" 'todos-display-categories
)
849 (define-key map
"+" 'todos-lower-category
)
850 (define-key map
"-" 'todos-raise-category
)
851 (define-key map
"n" 'forward-button
)
852 (define-key map
"p" 'backward-button
)
853 (define-key map
[tab] 'forward-button)
854 (define-key map [backtab] 'backward-button)
855 (define-key map "q" 'todos-quit)
856 ;; (define-key map "A" 'todos-add-category)
857 ;; (define-key map "D" 'todos-delete-category)
858 ;; (define-key map "R" 'todos-rename-category)
860 "Todos Categories mode keymap.")
862 (defvar todos-filter-items-mode-map
863 (let ((map (make-keymap)))
864 (suppress-keymap map t)
865 ;; navigation commands
866 (define-key map "j" 'todos-jump-to-category)
867 (define-key map "n" 'todos-forward-item)
868 (define-key map "p" 'todos-backward-item)
869 ;; (define-key map "S" 'todos-search)
871 (define-key map "C" 'todos-display-categories)
872 ;; (define-key map "" 'todos-display-categories-alphabetically)
873 (define-key map "H" 'todos-highlight-item)
874 (define-key map "N" 'todos-toggle-item-numbering)
875 ;; (define-key map "" 'todos-toggle-display-date-time)
876 (define-key map "P" 'todos-print)
877 (define-key map "q" 'todos-quit)
878 (define-key map "s" 'todos-save)
879 (define-key map "V" 'todos-view-archive)
880 (define-key map "v" 'todos-toggle-view-done-items)
881 (define-key map "Y" 'todos-diary-items)
882 ;; (define-key map "S" 'todos-save-top-priorities)
884 (define-key map "l" 'todos-lower-item-priority)
885 (define-key map "r" 'todos-raise-item-priority)
886 (define-key map "#" 'todos-set-item-priority)
888 "Todos Top Priorities mode keymap.")
890 ;; FIXME: remove when part of Emacs
891 (add-to-list 'auto-mode-alist '("\\.todo\\'" . todos-mode))
892 (add-to-list 'auto-mode-alist '("\\.toda\\'" . todos-archive-mode))
894 (defun todos-modes-set-1 ()
896 (set (make-local-variable 'font-lock-defaults) '(todos-font-lock-keywords t))
897 (set (make-local-variable 'indent-line-function) 'todos-indent)
898 (when todos-wrap-lines (funcall todos-line-wrapping-function))
901 (defun todos-modes-set-2 ()
903 (add-to-invisibility-spec 'todos)
904 (setq buffer-read-only t)
905 (set (make-local-variable 'hl-line-range-function)
906 (lambda() (when (todos-item-end)
907 (cons (todos-item-start) (todos-item-end)))))
910 ;; Autoloading isn't needed if files are identified by auto-mode-alist
911 ;; ;; As calendar reads included Todos file before todos-mode is loaded.
913 (define-derived-mode todos-mode nil "Todos" () ;FIXME: derive from special-mode?
914 "Major mode for displaying, navigating and editing Todo lists.
917 (easy-menu-add todos-menu)
920 (when (member (file-truename (buffer-file-name))
921 (funcall todos-files-function))
922 (set (make-local-variable 'todos-current-todos-file)
923 (file-truename (buffer-file-name))))
924 (set (make-local-variable 'todos-categories-full) nil)
925 ;; todos-set-categories sets todos-categories-full.
926 (set (make-local-variable 'todos-categories) (todos-set-categories))
927 (set (make-local-variable 'todos-first-visit) t)
928 (set (make-local-variable 'todos-category-number) 1) ;0)
929 (set (make-local-variable 'todos-show-done-only) nil)
930 (set (make-local-variable 'todos-categories-with-marks) nil)
931 (when todos-show-current-file
932 (add-hook 'pre-command-hook 'todos-show-current-file nil t))
933 (add-hook 'post-command-hook 'todos-after-find-file nil t)
934 (add-hook 'kill-buffer-hook 'todos-reset-global-current-todos-file nil t))
937 (defun todos-unload-hook ()
939 (remove-hook 'pre-command-hook 'todos-show-current-file t)
940 (remove-hook 'post-command-hook 'todos-after-find-file t)
941 (remove-hook 'kill-buffer-hook 'todos-reset-global-current-todos-file t))
943 (define-derived-mode todos-archive-mode nil "Todos-Arch" ()
944 "Major mode for archived Todos categories.
946 \\{todos-archive-mode-map}"
949 (set (make-local-variable 'todos-show-done-only) t)
950 (set (make-local-variable 'todos-current-todos-file)
951 (file-truename (buffer-file-name)))
952 (set (make-local-variable 'todos-categories) (todos-set-categories))
953 (set (make-local-variable 'todos-category-number) 1) ; 0)
954 (add-hook 'post-command-hook 'todos-after-find-file nil t))
956 ;; FIXME: return to Todos or Archive mode
957 (define-derived-mode todos-raw-mode nil "Todos Raw" ()
958 "Emergency repair mode for Todos files."
959 (when (member major-mode '(todos-mode todos-archive-mode))
960 (setq buffer-read-only nil)
961 (set (make-local-variable 'font-lock-defaults) '(todos-font-lock-keywords t))
963 ;; FIXME: doesn't DTRT here
964 (todos-prefix-overlays)))
966 (define-derived-mode todos-edit-mode nil "Todos-Ed" ()
967 "Major mode for editing multiline Todo items.
969 \\{todos-edit-mode-map}"
972 (define-derived-mode todos-categories-mode nil "Todos-Cats" ()
973 "Major mode for displaying and editing Todos categories.
975 \\{todos-categories-mode-map}"
976 (set (make-local-variable 'todos-current-todos-file)
977 todos-global-current-todos-file)
978 (let ((cats (with-current-buffer (get-file-buffer todos-current-todos-file)
979 (if todos-ignore-archived-categories
980 todos-categories-full
981 (todos-set-categories)))))
982 (set (make-local-variable 'todos-categories) cats)))
984 (define-derived-mode todos-filter-items-mode nil "Todos-Top" ()
985 "Mode for displaying and reprioritizing top priority Todos.
987 \\{todos-filter-items-mode-map}"
993 "Save the current Todos file."
995 ;; (todos-update-categories-sexp)
997 ;; (if todos-save-top-priorities-too (todos-save-top-priorities))
1000 (defun todos-quit ()
1001 "Exit the current Todos-related buffer.
1002 Depending on the specific mode, this either kills and the buffer
1005 (cond ((eq major-mode 'todos-categories-mode)
1007 (setq todos-descending-counts nil)
1009 ((eq major-mode 'todos-filter-items-mode)
1012 ((member major-mode (list 'todos-mode 'todos-archive-mode))
1016 ;; ---------------------------------------------------------------------------
1022 (defun todos-show (&optional solicit-file)
1023 "Visit the current Todos file and display one of its categories.
1025 With non-nil prefix argument SOLICIT-FILE ask for file to visit.
1026 Otherwise, the first invocation of this command in a session
1027 visits `todos-default-todos-file' (creating it if it does not yet
1028 exist); subsequent invocations from outside of Todos mode revisit
1029 this file or, if user option `todos-show-current-file' is
1030 non-nil, whichever Todos file was visited last.
1032 The category displayed on initial invocation is the first member
1033 of `todos-categories' for the current Todos file, on subsequent
1034 invocations whichever category was displayed last. If
1035 `todos-display-categories-first' is non-nil, then the first
1036 invocation of `todos-show' displays a clickable listing of the
1037 categories in the current Todos file."
1039 (let ((file (cond (solicit-file
1040 (if (funcall todos-files-function)
1041 (todos-read-file-name "Select a Todos file to visit: "
1043 (error "There are no Todos files")))
1044 ((eq major-mode 'todos-archive-mode)
1045 ;; FIXME: should it visit same category?
1046 (concat (file-name-sans-extension todos-current-todos-file)
1049 (or todos-current-todos-file
1050 (and todos-show-current-file
1051 todos-global-current-todos-file)
1052 todos-default-todos-file
1053 (todos-add-file))))))
1054 (if (and todos-first-visit todos-display-categories-first)
1055 (todos-display-categories)
1056 (set-window-buffer (selected-window)
1057 (set-buffer (find-file-noselect file)))
1058 ;; If no Todos file exists, initialize one.
1059 (if (zerop (buffer-size))
1060 ;; Call with empty category name to get initial prompt.
1061 (setq todos-category-number (todos-add-category "")))
1062 (save-excursion (todos-category-select)))
1063 (setq todos-first-visit nil)))
1065 (defun todos-toggle-item-numbering ()
1068 (todos-reset-prefix 'todos-number-prefix (not todos-number-prefix)))
1070 (defun todos-toggle-view-done-items ()
1071 "Show hidden or hide visible done items in current category."
1074 (goto-char (point-min))
1075 (let ((todos-show-with-done
1076 (if (re-search-forward todos-done-string-start nil t)
1079 (cat (todos-current-category)))
1080 (todos-category-select)
1081 (when (zerop (todos-get-count 'done cat))
1082 (message "There are no done items in this category.")))))
1084 ;; FIXME: should there be `todos-toggle-view-todo-items'?
1085 (defun todos-toggle-show-done-only ()
1086 "Make category display done or back to todo items." ;FIXME
1088 (setq todos-show-done-only (not todos-show-done-only))
1089 (todos-category-select))
1091 (defun todos-view-archived-items ()
1092 "Display the archived items of the current category.
1093 The buffer showing these items is in Todos Archive mode."
1095 (let ((cat (todos-current-category)))
1096 (if (zerop (todos-get-count 'archived cat))
1097 (message "There are no archived items from this category.")
1098 (let* ((tfile-base (file-name-sans-extension todos-current-todos-file))
1099 (afile (concat tfile-base ".toda")))
1100 (set-window-buffer (selected-window) (set-buffer
1101 (find-file-noselect afile)))
1102 (todos-category-number cat)
1103 (todos-jump-to-category cat)))))
1105 (defun todos-show-archive (&optional ask)
1106 "Visit the archive of the current Todos file, if it exists.
1107 With non-nil argument ASK prompt to choose an archive to visit;
1108 see `todos-choose-archive'. The buffer showing the archive is in
1109 Todos Archive mode. The first visit in a session displays the
1110 first category in the archive, subsequent visits return to the
1111 last category displayed."
1113 (let* ((tfile-base (file-name-sans-extension todos-current-todos-file))
1115 (todos-read-file-name "Choose a Todos archive: " t t)
1116 (concat tfile-base ".toda"))))
1117 (if (not (file-exists-p afile))
1118 (message "There is currently no Todos archive for this file.")
1119 (set-window-buffer (selected-window) (set-buffer
1120 (find-file-noselect afile)))
1121 (todos-category-select))))
1123 (defun todos-choose-archive ()
1124 "Choose an archive and visit it."
1126 (todos-show-archive t))
1128 (defun todos-highlight-item ()
1129 "Highlight the todo item the cursor is on."
1131 (if hl-line-mode ; todos-highlight-item
1135 (defun todos-toggle-display-date-time (&optional all)
1136 "Hide or show date/time of todo items in current category.
1137 With non-nil prefix argument ALL do this in the whole file."
1141 (goto-char (point-min))
1142 (let ((ovs (overlays-in (point) (1+ (point))))
1146 (if (equal (overlay-get ov 'display) "")
1147 (setq ovs nil hidden t)))
1148 (when all (widen) (goto-char (point-min)))
1150 (remove-overlays (point-min) (point-max) 'display "")
1152 (when (re-search-forward
1153 (concat todos-date-string-start todos-date-pattern
1154 "\\( " diary-time-regexp "\\)?"
1155 (regexp-quote todos-nondiary-end) "? ")
1157 (unless (save-match-data (todos-done-item-p))
1158 (setq ov (make-overlay (match-beginning 0) (match-end 0) nil t))
1159 (overlay-put ov 'display "")))
1160 (todos-forward-item)))))))
1162 (defun todos-toggle-mark-item (&optional n all)
1163 "Mark item at point if unmarked, or unmark it if marked.
1165 With a positive numerical prefix argument N, change the
1166 markedness of the next N items. With non-nil argument ALL, mark
1167 all visible items in the category (depending on visibility, all
1168 todo and done items, or just todo or just done items).
1170 The mark is the character \"*\" inserted in front of the item's
1171 priority number or the `todos-prefix' string; if `todos-prefix'
1172 is \"*\", then the mark is \"@\"."
1174 (if all (goto-char (point-min)))
1175 (unless (> n 0) (setq n 1))
1177 (while (or (and all (not (eobp)))
1179 (let* ((cat (todos-current-category))
1180 (ov (todos-item-marked-p))
1181 (marked (assoc cat todos-categories-with-marks)))
1182 (if (and ov (not all))
1185 (if (= (cdr marked) 1) ; Deleted last mark in this category.
1186 (setq todos-categories-with-marks
1187 (assq-delete-all cat todos-categories-with-marks))
1188 (setcdr marked (1- (cdr marked)))))
1189 (when (todos-item-start)
1190 (unless (and all (todos-item-marked-p))
1191 (setq ov (make-overlay (point) (point)))
1192 (overlay-put ov 'before-string todos-item-mark)
1194 (setcdr marked (1+ (cdr marked)))
1195 (push (cons cat 1) todos-categories-with-marks))))))
1196 (todos-forward-item)
1199 (defun todos-mark-category ()
1200 "Put the \"*\" mark on all items in this category.
1201 \(If `todos-prefix' is \"*\", then the mark is \"@\".)"
1203 (todos-toggle-mark-item 0 t))
1205 (defun todos-unmark-category ()
1206 "Remove the \"*\" mark from all items in this category.
1207 \(If `todos-prefix' is \"*\", then the mark is \"@\".)"
1209 (remove-overlays (point-min) (point-max) 'before-string todos-item-mark)
1210 (setq todos-categories-with-marks
1211 (delq (assoc (todos-current-category) todos-categories-with-marks)
1212 todos-categories-with-marks)))
1214 (defun todos-update-merged-files ()
1215 "Interactively add files to or remove from `todos-merged-files'.
1216 You can also customize `todos-merged-files' directly."
1217 (interactive) ;FIXME
1218 (let ((files (funcall todos-files-function)))
1220 (if (member f todos-merged-files)
1222 (format "Remove \"%s\" from list of merged Todos files? "
1223 (file-name-sans-extension (file-name-nondirectory f))))
1224 (setq todos-merged-files (delete f todos-merged-files)))
1226 (format "Add \"%s\" to list of merged Todos files? "
1227 (file-name-sans-extension (file-name-nondirectory f))))
1228 (setq todos-merged-files
1229 (append todos-merged-files (list f)))))))
1230 (customize-save-variable 'todos-merged-files todos-merged-files))
1232 (defvar todos-top-priorities-widgets nil
1233 "Widget placeholder used by `todos-set-top-priorities'.
1234 This variable temporarily holds user changed values which are
1235 saved to `todos-priorities-rules'.")
1237 (defun todos-set-top-priorities ()
1240 (let ((buf (get-buffer-create "*Todos Top Priorities*"))
1241 (files (funcall todos-files-function))
1242 file frules cats fwidget cwidgets rules)
1243 (with-current-buffer buf
1244 (let ((inhibit-read-only t))
1247 (kill-all-local-variables)
1248 (setq todos-top-priorities-widgets nil)
1251 (insert-file-contents f)
1252 (setq file (file-name-sans-extension (file-name-nondirectory f))
1253 frules (assoc file todos-priorities-rules)
1254 cats (mapcar 'car (todos-set-categories))))
1256 (widget-create 'editable-field
1258 :value (or (and frules (cadr frules))
1261 :format " %v : %t\n"))
1263 (let ((tp-num (cdr (assoc c cats)))
1266 (setq cwidget (widget-create 'editable-field
1268 :value (or tp-num "")
1270 :format " %v : %t\n"))
1271 (push cwidget cwidgets)))
1272 (push (cons fwidget cwidgets) todos-top-priorities-widgets))
1273 (widget-insert "\n\n")
1274 (widget-create 'push-button
1275 :notify (lambda (widget &rest ignore)
1279 (widget-create 'push-button
1280 :notify (lambda (&rest ignore)
1281 (let ((widgets todos-top-priorities-widgets)
1282 (rules todos-priorities-rules)
1286 (let* ((fwid (car w))
1288 (fname (widget-get fwid :tag))
1289 (fval (widget-value fwid)))
1291 (let ((cat (widget-get c :tag))
1292 (cval (widget-value c)))
1293 (push (cons cat cval) tp-cats)))
1294 (push (list fname fval tp-cats) rules)))
1295 (setq todos-priorities-rules rules)
1296 (customize-save-variable 'todos-priorities-rules
1297 todos-priorities-rules)))
1299 (use-local-map widget-keymap)
1301 (set-window-buffer (selected-window) (set-buffer buf))))
1303 (defun todos-filter-items (&optional filter merge)
1304 "Display a filtered list of items from different categories.
1306 The special items are either the first NUM items (the top priority items) or the items marked as diary entries in each category of the current Todos file.
1308 Number of entries for each category is given by NUM, which
1309 defaults to `todos-show-priorities'. With non-nil argument
1310 MERGE list top priorities of all Todos files in
1311 `todos-merged-files'. If `todos-prompt-merged-files' is non-nil,
1312 prompt to update the list of merged files."
1313 (let ((num (if (consp filter) (cdr filter) todos-show-priorities))
1314 (buf (get-buffer-create todos-tmp-buffer-name))
1315 (files (list todos-current-todos-file))
1316 regexp fname bufstr cat beg end done)
1318 ;; FIXME: same or different treatment for top priorities and other
1319 ;; filters? And what about todos-prompt-merged-files?
1320 (setq files (if (member filter '(diary regexp custom))
1321 (or (and todos-prompt-merged-files
1322 (todos-update-merged-files))
1324 (todos-update-merged-files))
1325 ;; Set merged files for top priorities.
1326 (or (mapcar (lambda (f)
1327 (let ((file (car f))
1329 (and val (not (zerop val))
1330 (push file files))))
1331 todos-priorities-rules)
1332 (if (y-or-n-p "Choose files for merging top priorities? ")
1333 (progn (todos-set-top-priorities) (error ""))
1334 (error "No files are set for merging top priorities"))))))
1335 (with-current-buffer buf
1337 (kill-all-local-variables)
1338 (todos-filter-items-mode))
1339 (when (eq filter 'regexp)
1340 (setq regexp (read-string "Enter a regular expression: ")))
1341 (save-current-buffer
1343 (setq fname (file-name-sans-extension (file-name-nondirectory f)))
1345 (insert-file-contents f)
1346 (goto-char (point-min))
1347 ;; Unless the number of items to show was supplied by prefix
1348 ;; argument of caller, override `todos-show-priorities' with the
1349 ;; nonzero file-wide value from `todos-priorities-rules'.
1350 (unless (consp filter)
1351 (let ((tp-val (nth 1 (assoc fname todos-priorities-rules))))
1352 (unless (zerop (length tp-val))
1353 (setq num (string-to-number tp-val)))))
1354 (unless (looking-at (concat "^" (regexp-quote todos-category-beg)))
1356 (while (re-search-forward
1357 (concat "^" (regexp-quote todos-category-beg) "\\(.+\\)\n")
1359 (setq cat (match-string 1))
1360 ;; Unless the number of items to show was supplied by prefix
1361 ;; argument of caller, override `todos-show-priorities' with the
1362 ;; nonzero category-wide value from `todos-priorities-rules'.
1363 (unless (consp filter)
1364 (let* ((cats (nth 2 (assoc fname todos-priorities-rules)))
1365 (tp-val (cdr (assoc cat cats))))
1366 (unless (zerop (length tp-val))
1367 (setq num (string-to-number tp-val)))))
1368 (delete-region (match-beginning 0) (match-end 0))
1369 (setq beg (point)) ; Start of first entry.
1370 (setq end (if (re-search-forward
1371 (concat "^" (regexp-quote todos-category-beg)) nil t)
1376 (if (re-search-forward
1377 (concat "\n" (regexp-quote todos-category-done)) end t)
1380 (delete-region done end)
1382 (narrow-to-region beg end) ; Process current category.
1383 (goto-char (point-min))
1384 ;; Apply the filter.
1385 (cond ((eq filter 'diary)
1387 (if (looking-at (regexp-quote todos-nondiary-start))
1389 (todos-forward-item))))
1390 ((eq filter 'regexp)
1392 (if (string-match regexp (todos-item-string))
1393 (todos-forward-item)
1394 (todos-remove-item))))
1395 ((eq filter 'custom)
1396 (if todos-filter-function
1397 (funcall todos-filter-function)
1398 (error "No custom filter function has been defined")))
1399 (t ; Filter top priority items.
1400 (todos-forward-item num)))
1402 (unless (member filter '(diary regexp custom))
1403 (delete-region beg end))
1404 (goto-char (point-min))
1405 ;; Add file (if using merged files) and category tags to item.
1407 (when (re-search-forward
1408 (concat todos-date-string-start todos-date-pattern
1409 "\\( " diary-time-regexp "\\)?"
1410 (regexp-quote todos-nondiary-end) "?")
1412 (insert (concat " [" (if merge (concat fname ":")) cat "]")))
1415 (setq bufstr (buffer-string))
1416 (with-current-buffer buf
1417 (let (buffer-read-only)
1418 (insert bufstr))))))
1419 (set-window-buffer (selected-window) (set-buffer buf))
1420 (todos-prefix-overlays)
1421 (goto-char (point-min))
1422 ;; FIXME: this is necessary -- why?
1423 (font-lock-fontify-buffer)))
1425 (defun todos-top-priorities (&optional num)
1426 "List top priorities of each category in `todos-merged-files'.
1427 Number of entries for each category is given by NUM, which
1428 defaults to `todos-show-priorities'."
1430 (let ((arg (if num (cons 'top num) 'top)))
1431 (todos-filter-items arg)))
1433 (defun todos-merged-top-priorities (&optional num)
1434 "List top priorities of each category in `todos-merged-files'.
1435 Number of entries for each category is given by NUM, which
1436 defaults to `todos-show-priorities'."
1438 (let ((arg (if num (cons 'top num) 'top)))
1439 (todos-filter-items arg t)))
1441 (defun todos-diary-items ()
1442 "Display todo items for diary inclusion in this Todos file."
1444 (todos-filter-items 'diary))
1446 (defun todos-merged-diary-items ()
1447 "Display todo items for diary inclusion in one or more Todos file.
1448 The files are those listed in `todos-merged-files'."
1450 (todos-filter-items 'diary t))
1452 (defun todos-regexp-items ()
1453 "Display todo items matching a user-entered regular expression.
1454 The items are those in the current Todos file."
1456 (todos-filter-items 'regexp))
1458 (defun todos-merged-regexp-items ()
1459 "Display todo items matching a user-entered regular expression.
1460 The items are those in the files listed in `todos-merged-files'."
1462 (todos-filter-items 'regexp t))
1464 (defun todos-custom-items ()
1465 "Display todo items filtered by `todos-filter-function'.
1466 The items are those in the current Todos file."
1468 (todos-filter-items 'custom))
1470 (defun todos-merged-custom-items ()
1471 "Display todo items filtered by `todos-filter-function'.
1472 The items are those in the files listed in `todos-merged-files'."
1474 (todos-filter-items 'custom t))
1478 (defun todos-forward-category (&optional back)
1479 "Visit the numerically next category in this Todos file.
1480 With non-nil argument BACK, visit the numerically previous
1483 (setq todos-category-number
1484 (1+ (mod (- todos-category-number (if back 2 0))
1485 (length todos-categories))))
1486 (todos-category-select)
1487 (goto-char (point-min)))
1489 (defun todos-backward-category ()
1490 "Visit the numerically previous category in this Todos file."
1492 (todos-forward-category t))
1495 (defun todos-jump-to-category (&optional cat other-file)
1496 "Jump to a category in this or another Todos file.
1497 Optional argument CAT provides the category name. Otherwise,
1498 prompt for the category, with TAB completion on existing
1499 categories. If a non-existing category name is entered, ask
1500 whether to add a new category with this name, if affirmed, do so,
1501 then jump to that category. With non-nil argument OTHER-FILE,
1502 prompt for a Todos file, otherwise jump within the current Todos
1505 (let ((file (or (and other-file
1506 (todos-read-file-name "Choose a Todos file: " nil t))
1507 ;; Jump to archived-only Categories from Todos Categories mode.
1509 todos-ignore-archived-categories
1510 (zerop (todos-get-count 'todo cat))
1511 (zerop (todos-get-count 'done cat))
1512 (not (zerop (todos-get-count 'archived cat)))
1513 (concat (file-name-sans-extension
1514 todos-current-todos-file) ".toda"))
1515 todos-current-todos-file
1516 ;; If invoked from outside of Todos mode before todos-show...
1517 todos-default-todos-file)))
1518 (with-current-buffer (find-file-noselect file)
1519 (and other-file (setq todos-current-todos-file file))
1520 (let ((category (or (and (assoc cat todos-categories) cat)
1521 (todos-read-category "Jump to category: "))))
1522 ;; ;; FIXME: why is this needed?
1523 ;; (if (string= "" category)
1524 ;; (setq category (todos-current-category)))
1525 ;; Clean up after selecting category in Todos Categories mode.
1526 (if (string= (buffer-name) todos-categories-buffer)
1528 (if (or cat other-file)
1529 (set-window-buffer (selected-window)
1530 (set-buffer (get-file-buffer file))))
1531 (unless todos-global-current-todos-file
1532 (setq todos-global-current-todos-file todos-current-todos-file))
1533 (todos-category-number category)
1534 (if (> todos-category-number (length todos-categories))
1535 (setq todos-category-number (todos-add-category category)))
1536 (todos-category-select)
1537 (goto-char (point-min))))))
1539 (defun todos-jump-to-category-other-file ()
1540 "Jump to a category in another Todos file.
1541 The category is chosen by prompt, with TAB completion."
1543 (todos-jump-to-category nil t))
1545 ;; FIXME ? disallow prefix arg value < 1 (re-search-* allows these)
1546 (defun todos-forward-item (&optional count)
1547 "Move point down to start of item with next lower priority.
1548 With numerical prefix COUNT, move point COUNT items downward,"
1550 (let* ((not-done (not (or (todos-done-item-p) (looking-at "^$"))))
1551 (start (line-end-position)))
1553 (if (re-search-forward todos-item-start nil t (or count 1))
1554 (goto-char (match-beginning 0))
1555 (goto-char (point-max)))
1556 ;; If points advances by one from a todo to a done item, go back to the
1557 ;; space above todos-done-separator, since that is a legitimate place to
1558 ;; insert an item. But skip this space if count > 1, since that should
1559 ;; only stop on an item (FIXME: or not?)
1560 (when (and not-done (todos-done-item-p))
1561 (if (or (not count) (= count 1))
1562 (re-search-backward "^$" start t)))))
1564 (defun todos-backward-item (&optional count)
1565 "Move point up to start of item with next higher priority.
1566 With numerical prefix COUNT, move point COUNT items upward,"
1568 (let* ((done (todos-done-item-p)))
1569 ;; FIXME ? this moves to bob if on the first item (but so does previous-line)
1572 (re-search-backward todos-item-start nil t (or count 1)))
1573 ;; If points advances by one from a done to a todo item, go back to the
1574 ;; space above todos-done-separator, since that is a legitimate place to
1575 ;; insert an item. But skip this space if count > 1, since that should
1576 ;; only stop on an item (FIXME: or not?)
1577 (when (and done (not (todos-done-item-p))
1578 (or (not count) (= count 1)))
1579 (re-search-forward (concat "^" (regexp-quote todos-category-done)) nil t)
1580 (forward-line -1))))
1582 (defun todos-search ()
1583 "Search for a regular expression in this Todos file.
1584 The search runs through the whole file and encompasses all and
1585 only todo and done items; it excludes category names. Multiple
1586 matches are shown sequentially, highlighted in `todos-search'
1589 (let ((regex (read-from-minibuffer "Enter a search string (regexp): "))
1591 matches match cat in-done ov mlen msg)
1593 (goto-char (point-min))
1595 (setq match (re-search-forward regex nil t))
1596 (goto-char (line-beginning-position))
1597 (unless (or (equal (point) 1)
1598 (looking-at (concat "^" (regexp-quote todos-category-beg))))
1599 (if match (push match matches)))
1601 (setq matches (reverse matches))
1605 (setq match (pop matches))
1608 (when (looking-at todos-done-string-start)
1610 (re-search-backward (concat "^" (regexp-quote todos-category-beg)
1611 "\\(.*\\)\n") nil t)
1612 (setq cat (match-string-no-properties 1))
1613 (todos-category-number cat)
1614 (todos-category-select)
1616 (unless todos-show-with-done (todos-toggle-view-done-items)))
1618 (setq ov (make-overlay (- (point) (length regex)) (point)))
1619 (overlay-put ov 'face 'todos-search)
1621 (setq mlen (length matches))
1624 (format "There are %d more matches; go to next match? "
1626 "There is one more match; go to it? "))
1628 (throw 'stop (setq msg (if (> mlen 1)
1629 (format "There are %d more matches."
1631 "There is one more match."))))))
1632 (setq msg "There are no more matches."))
1633 (todos-category-select)
1635 (message "No match for \"%s\"" regex))
1637 (if (y-or-n-p (concat msg "\nUnhighlight matches? "))
1638 (todos-clear-matches)
1639 (message "You can unhighlight the matches later by typing %s"
1640 (key-description (car (where-is-internal
1641 'todos-clear-matches))))))))
1643 (defun todos-clear-matches ()
1644 "Remove highlighting on matches found by todos-search."
1646 (remove-overlays 1 (1+ (buffer-size)) 'face 'todos-search))
1650 (defun todos-add-file ()
1651 "Name and add a new Todos file.
1652 Interactively, prompt for a category and display it.
1653 Noninteractively, return the name of the new file."
1655 (let ((default-file (if todos-default-todos-file
1656 (file-name-sans-extension
1657 (file-name-nondirectory todos-default-todos-file))))
1658 file prompt shortname)
1662 ((or (not file) (member file todos-files))
1663 (setq prompt (concat "Enter name of new Todos file "
1664 "(TAB or SPC to see existing Todos files): ")))
1665 ((string-equal file "")
1666 (setq prompt "Enter a non-empty name: "))
1667 ((string-match "\\`\\s-+\\'" file)
1668 (setq prompt "Enter a name that is not only white space: ")))
1669 (setq file (todos-read-file-name prompt))))
1670 (setq shortname (file-name-sans-extension (file-name-nondirectory file)))
1671 (with-current-buffer (get-buffer-create file)
1673 (write-region (point-min) (point-max) file nil 'nomessage nil t)
1675 ;; FIXME: todos-change-default-file yields a Custom mismatch
1676 ;; (if (or (not default-file)
1677 ;; (yes-or-no-p (concat (format "Make \"%s\" new default Todos file "
1679 ;; (format "[current default is \"%s\"]? "
1681 ;; (todos-change-default-file file)
1682 ;; (message "\"%s\" remains the default Todos file." default-file))
1683 (if (called-interactively-p)
1685 (setq todos-current-todos-file file)
1689 ;; FIXME: omit this and just use defcustom? Says "changed outside of Custom
1691 (defun todos-change-default-file (&optional file)
1694 (let ((new-default (or file
1695 (todos-read-file-name "Choose new default Todos file: "
1697 (customize-save-variable 'todos-default-todos-file new-default)
1698 (message "\"%s\" is new default Todos file."
1699 (file-name-sans-extension (file-name-nondirectory new-default)))))
1701 (defun todos-add-category (&optional cat)
1702 "Add a new category to the current Todos file.
1703 Called interactively, prompt for category name, then visit the
1704 category in Todos mode. Non-interactively, argument CAT provides
1705 the category name, which is also the return value."
1707 (let* ((buffer-read-only)
1708 ;; FIXME: check against todos-archive-done-item-or-items with empty file
1709 (buf (find-file-noselect todos-current-todos-file t))
1710 ;; (buf (get-file-buffer todos-current-todos-file))
1711 (num (1+ (length todos-categories)))
1712 (counts (make-vector 4 0))) ; [todo diary done archived]
1713 (unless (zerop (buffer-size buf))
1714 (and (null todos-categories)
1715 (error "Error in %s: File is non-empty but contains no category"
1716 todos-current-todos-file)))
1717 (unless cat (setq cat (read-from-minibuffer "Enter new category name: ")))
1718 (with-current-buffer buf
1719 (setq cat (todos-validate-category-name cat))
1720 (setq todos-categories (append todos-categories (list (cons cat counts))))
1722 (goto-char (point-max))
1723 (save-excursion ; Save point for todos-category-select.
1724 (insert todos-category-beg cat "\n\n" todos-category-done "\n"))
1725 (todos-update-categories-sexp)
1726 ;; If called by command, display the newly added category, else return
1727 ;; the category number to the caller.
1728 (if (called-interactively-p 'any) ; FIXME?
1730 (setq todos-category-number num)
1731 (todos-category-select))
1734 (defun todos-rename-category ()
1735 "Rename current Todos category.
1736 If this file has an archive containing this category, rename the
1737 category there as well."
1739 (let* ((cat (todos-current-category))
1740 (new (read-from-minibuffer (format "Rename category \"%s\" to: " cat))))
1741 (setq new (todos-validate-category-name new))
1742 (let* ((ofile todos-current-todos-file)
1743 (archive (concat (file-name-sans-extension ofile) ".toda"))
1744 (buffers (append (list ofile)
1745 (unless (zerop (todos-get-count 'archived cat))
1747 (dolist (buf buffers)
1748 (with-current-buffer (find-file-noselect buf)
1749 (let (buffer-read-only)
1750 (setq todos-categories (todos-set-categories))
1753 (setcar (assoc cat todos-categories) new)
1755 (goto-char (point-min))
1756 (todos-update-categories-sexp)
1757 (re-search-forward (concat (regexp-quote todos-category-beg)
1758 "\\(" (regexp-quote cat) "\\)\n")
1760 (replace-match new t t nil 1)))))))
1761 (setq mode-line-buffer-identification
1762 (funcall todos-mode-line-function new)))
1763 (save-excursion (todos-category-select)))
1765 (defun todos-delete-category (&optional arg)
1766 "Delete current Todos category provided it is empty.
1767 With ARG non-nil delete the category unconditionally,
1768 i.e. including all existing todo and done items."
1770 (let* ((cat (todos-current-category))
1771 (todo (todos-get-count 'todo cat))
1772 (done (todos-get-count 'done cat))
1773 (archived (todos-get-count 'archived cat)))
1775 (or (> todo 0) (> done 0)))
1776 (message "To delete a non-empty category, type C-u D.")
1777 (when (yes-or-no-p (concat "Permanently remove category \"" cat
1778 "\"" (and arg " and all its entries") "? "))
1779 ;; FIXME ? optionally delete archived category as well?
1781 (y-or-n-p (concat "This category has archived items; "
1782 "the archived category will remain\n"
1783 "after deleting the todo category. "
1784 "Do you still want to delete it\n"
1785 "(see 'todos-ignore-archived-categories' "
1786 "for another option)? ")))
1788 (let ((buffer-read-only)
1789 (beg (re-search-backward
1790 (concat "^" (regexp-quote (concat todos-category-beg cat))
1792 (end (if (re-search-forward
1793 (concat "\n\\(" (regexp-quote todos-category-beg)
1797 (remove-overlays beg end)
1798 (delete-region beg end)
1799 (setq todos-categories (delete (assoc cat todos-categories)
1801 (todos-update-categories-sexp)
1802 (setq todos-category-number
1803 (1+ (mod todos-category-number (length todos-categories))))
1804 (todos-category-select)
1805 (goto-char (point-min))
1806 (message "Deleted category %s" cat)))))))
1808 (defun todos-raise-category (&optional lower)
1809 "Raise priority of category point is on in Categories buffer.
1810 With non-nil argument LOWER, lower the category's priority."
1815 (skip-chars-forward " ")
1816 (setq num (number-at-point)))
1817 (when (and num (if lower
1818 (< num (length todos-categories))
1820 (let* ((col (current-column))
1821 (beg (progn (forward-line (if lower 0 -1)) (point)))
1822 (num1 (progn (skip-chars-forward " ") (1- (number-at-point))))
1824 (end (progn (forward-line 2) (point)))
1825 (catvec (vconcat todos-categories))
1826 (cat1-list (aref catvec num1))
1827 (cat2-list (aref catvec num2))
1828 (cat1 (car cat1-list))
1829 (cat2 (car cat2-list))
1830 buffer-read-only newcats)
1831 (delete-region beg end)
1832 (setq num1 (1+ num1))
1833 (setq num2 (1- num2))
1835 (todos-insert-category-line cat2)
1837 (todos-insert-category-line cat1)
1838 (aset catvec num2 (cons cat2 (cdr cat2-list)))
1839 (aset catvec num1 (cons cat1 (cdr cat1-list)))
1840 (setq todos-categories (append catvec nil))
1841 (setq newcats todos-categories)
1842 (with-current-buffer (get-file-buffer todos-current-todos-file)
1843 (setq todos-categories newcats)
1844 (todos-update-categories-sexp))
1845 (forward-line (if lower -1 -2))
1846 (forward-char col)))))
1848 (defun todos-lower-category ()
1849 "Lower priority of category point is on in Categories buffer."
1851 (todos-raise-category t))
1853 (defun todos-move-category ()
1854 "Move current category to a different Todos file.
1855 If current category has archived items, also move those to the
1856 archive of the file moved to, creating it if it does not exist."
1858 (when (or (> (length todos-categories) 1)
1859 (y-or-n-p (concat "This is the only category in this file; "
1860 "moving it will also delete the file.\n"
1861 "Do you want to proceed? ")))
1862 (let* ((ofile todos-current-todos-file)
1863 (cat (todos-current-category))
1864 (nfile (todos-read-file-name "Choose a Todos file: " nil t))
1865 (archive (concat (file-name-sans-extension ofile) ".toda"))
1866 (buffers (append (list ofile)
1867 (unless (zerop (todos-get-count 'archived cat))
1870 (dolist (buf buffers)
1871 (with-current-buffer (find-file-noselect buf)
1873 (goto-char (point-max))
1874 (let* ((beg (re-search-backward
1876 (regexp-quote (concat todos-category-beg cat)))
1878 (end (if (re-search-forward
1879 (concat "^" (regexp-quote todos-category-beg))
1883 (content (buffer-substring-no-properties beg end))
1884 (counts (cdr (assoc cat todos-categories)))
1886 ;; Move the category to the new file. Also update or create
1887 ;; archive file if necessary.
1888 (with-current-buffer
1890 ;; Regenerate todos-archives in case there
1891 ;; is a newly created archive.
1892 (if (member buf (funcall todos-files-function t))
1893 (concat (file-name-sans-extension nfile) ".toda")
1895 (let* ((nfile-short (file-name-sans-extension
1896 (file-name-nondirectory nfile)))
1898 (format "Todos file \"%s\" already has "
1900 (format "the category \"%s\";\n" cat)
1901 "enter a new category name: "))
1904 (goto-char (point-max))
1906 ;; If the file moved to has a category with the same
1907 ;; name, rename the moved category.
1908 (when (assoc cat todos-categories)
1909 (unless (member (file-truename (buffer-file-name))
1910 (funcall todos-files-function t))
1911 (setq new (read-from-minibuffer prompt))
1912 (setq new (todos-validate-category-name new))))
1913 ;; Replace old with new name in Todos and archive files.
1915 (goto-char (point-max))
1917 (concat "^" (regexp-quote todos-category-beg)
1918 "\\(" (regexp-quote cat) "\\)") nil t)
1919 (replace-match new nil nil nil 1)))
1920 (setq todos-categories
1921 (append todos-categories (list (cons new counts))))
1922 (todos-update-categories-sexp)
1923 ;; If archive was just created, save it to avoid "File <xyz> no
1924 ;; longer exists!" message on invoking
1925 ;; `todos-view-archived-items'. FIXME: maybe better to save
1927 (unless (file-exists-p (buffer-file-name))
1929 (todos-category-number (or new cat))
1930 (todos-category-select))
1931 ;; Delete the category from the old file, and if that was the
1932 ;; last category, delete the file. Also handle archive file
1934 (remove-overlays beg end)
1935 (delete-region beg end)
1936 (goto-char (point-min))
1937 ;; Put point after todos-categories sexp.
1939 (if (eobp) ; Aside from sexp, file is empty.
1941 ;; Skip confirming killing the archive buffer.
1942 (set-buffer-modified-p nil)
1943 (delete-file todos-current-todos-file)
1945 (setq todos-categories (delete (assoc cat todos-categories)
1947 (todos-update-categories-sexp)
1948 (todos-category-select)))))
1949 (set-window-buffer (selected-window)
1950 (set-buffer (find-file-noselect nfile)))
1951 (todos-category-number (or new cat))
1952 (todos-category-select))))
1954 (defun todos-merge-category ()
1955 "Merge this category with chosen category in this file. The
1956 current category's todo and done items are appended to the chosen
1957 category's todo and done items, respectively, which becomes the
1958 current category, and the category moved from is deleted."
1960 (let ((buffer-read-only nil)
1961 (cat (todos-current-category))
1962 (goal (todos-read-category "Category to merge to: " t)))
1964 ;; FIXME: check if cat has archived items and merge those too
1967 (concat "^" (regexp-quote todos-category-beg)) nil t)
1969 (tbeg (progn (forward-line) (point)))
1972 (concat "^" (regexp-quote todos-category-done)) nil t)
1973 (forward-line) (point)))
1974 (tend (progn (forward-line -2) (point)))
1976 (if (re-search-forward
1977 (concat "^" (regexp-quote todos-category-beg)) nil t)
1980 (todo (buffer-substring-no-properties tbeg tend))
1981 (done (buffer-substring-no-properties dbeg cend))
1983 (goto-char (point-min))
1985 (concat "^" (regexp-quote (concat todos-category-beg goal))) nil t)
1987 (concat "^" (regexp-quote todos-category-done)) nil t)
1991 (goto-char (if (re-search-forward
1992 (concat "^" (regexp-quote todos-category-beg)) nil t)
1996 (remove-overlays cbeg cend)
1997 (delete-region cbeg cend)
1998 (todos-set-count 'todo (todos-get-count 'todo cat) goal)
1999 (todos-set-count 'done (todos-get-count 'done cat) goal)
2000 (setq todos-categories (delete (assoc cat todos-categories)
2002 (todos-update-categories-sexp)
2003 (todos-category-number goal)
2004 (todos-category-select)
2005 ;; Put point at the start of the merged todo items.
2006 ;; FIXME: what if there are no merged todo items but only done items?
2010 (defun todos-merge-categories ()
2013 (let* ((cats (mapcar 'car todos-categories))
2014 (goal (todos-read-category "Category to merge to: " t))
2015 (prompt (format "Merge to %s (type C-g to finish)? " goal))
2016 (source (let ((inhibit-quit t) l)
2017 (while (not (eq last-input-event 7))
2019 (when (y-or-n-p prompt)
2021 (setq cats (delete c cats))))))))
2025 ;; FIXME: make insertion options customizable per category
2027 ;; (defun todos-insert-item (&optional arg use-point date-type time
2028 ;; diary nonmarking)
2029 (defun todos-insert-item (&optional arg diary nonmarking date-type time
2031 "Add a new Todo item to a category.
2032 See the note at the end of this document string about key
2033 bindings and convenience commands derived from this command.
2035 With no (or nil) prefix argument ARG, add the item to the current
2036 category; with one prefix argument (C-u), prompt for a category
2037 from the current Todos file; with two prefix arguments (C-u C-u),
2038 first prompt for a Todos file, then a category in that file. If
2039 a non-existing category is entered, ask whether to add it to the
2040 Todos file; if answered affirmatively, add the category and
2041 insert the item there.
2043 When argument DIARY is non-nil, this overrides the intent of the
2044 user option `todos-include-in-diary' for this item: if
2045 `todos-include-in-diary' is nil, include the item in the Fancy
2046 Diary display, and if it is non-nil, exclude the item from the
2047 Fancy Diary display. When DIARY is nil, `todos-include-in-diary'
2048 has its intended effect.
2050 When the item is included in the Fancy Diary display and the
2051 argument NONMARKING is non-nil, this overrides the intent of the
2052 user option `todos-diary-nonmarking' for this item: if
2053 `todos-diary-nonmarking' is nil, append `diary-nonmarking-symbol'
2054 to the item, and if it is non-nil, omit `diary-nonmarking-symbol'.
2056 The argument DATE-TYPE determines the content of the item's
2057 mandatory date header string and how it is added:
2058 - If DATE-TYPE is the symbol `calendar', the Calendar pops up and
2059 when the user puts the cursor on a date and hits RET, that
2060 date, in the format set by `calendar-date-display-form',
2061 becomes the date in the header.
2062 - If DATE-TYPE is the symbol `date', the header contains the date
2063 in the format set by `calendar-date-display-form', with year,
2064 month and day individually prompted for (month with tab
2066 - If DATE-TYPE is the symbol `dayname' the header contains a
2067 weekday name instead of a date, prompted for with tab
2069 - If DATE-TYPE has any other value (including nil or none) the
2070 header contains the current date (in the format set by
2071 `calendar-date-display-form').
2073 With non-nil argument TIME prompt for a time string; this must
2074 either be empty or else match `diary-time-regexp'. If TIME is
2075 nil, add or omit the current time according to value of the user
2076 option `todos-always-add-time-string'.
2078 The argument REGION-OR-HERE determines the source and location of
2080 - If the REGION-OR-HERE is the symbol `here', prompt for the text
2081 of the new item and insert it directly above the todo item at
2082 point, or if point is on the empty line below the last todo
2083 item, insert the new item there. An error is signalled if
2084 `todos-insert-item' is invoked with `here' outside of the
2086 - If REGION-OR-HERE is the symbol `region', use the region of the
2087 current buffer as the text of the new item, depending on the
2088 value of user option `todos-use-only-highlighted-region': if
2089 this is non-nil, then use the region only when it is
2090 highlighted; otherwise, use the region regardless of
2091 highlighting. An error is signalled if there is no region in
2092 the current buffer. Prompt for the item's priority in the
2093 category (an integer between 1 and one more than the number of
2094 items in the category), and insert the item accordingly.
2095 - If REGION-OR-HERE has any other value (in particular, nil or
2096 none), prompt for the text and the item's priority, and insert
2097 the item accordingly.
2099 To facilitate using these arguments when inserting a new todo
2100 item, convenience commands have been defined for all admissible
2101 combinations (96 in all!) together with mnenomic key bindings
2102 based on on the name of the arguments and their order: _h_ere or
2103 _r_egion - _c_alendar or _d_ate or day_n_ame - _t_ime - diar_y_ -
2104 nonmar_k_ing. An alternative interface for customizing key
2105 binding is also provided with the function
2106 `todos-insertion-bindings'." ;FIXME
2108 (let ((region (eq region-or-here 'region))
2109 (here (eq region-or-here 'here)))
2111 ;; FIXME: better to use use-region-p or region-active-p?
2112 (unless (and (if todos-use-only-highlighted-region
2116 (error "The mark is not set now, so there is no region")))
2117 (let* ((buf (current-buffer))
2118 (new-item (if region
2119 ;; FIXME: or keep properties?
2120 (buffer-substring-no-properties
2121 (region-beginning) (region-end))
2122 (read-from-minibuffer "Todo item: ")))
2124 ((eq date-type 'date)
2126 ((eq date-type 'dayname)
2127 (todos-read-dayname))
2128 ((eq date-type 'calendar)
2129 (setq todos-date-from-calendar t)
2130 (let (calendar-view-diary-initially-flag)
2132 (with-current-buffer "*Calendar*"
2133 (todos-set-date-from-calendar))
2134 todos-date-from-calendar)
2135 (t (calendar-date-string (calendar-current-date) t t))))
2136 ;; FIXME: should TIME override `todos-always-add-time-string'? But
2137 ;; then add another option to use current time or prompt for time
2139 (time-string (or (and time (todos-read-time))
2140 (and todos-always-add-time-string
2141 (substring (current-time-string) 11 16)))))
2142 (setq todos-date-from-calendar nil)
2143 (cond ((equal arg '(16)) ; FIXME: cf. set-mark-command
2144 (todos-jump-to-category nil t)
2147 (set-buffer (get-file-buffer todos-global-current-todos-file))))
2148 ((equal arg '(4)) ; FIXME: just arg?
2149 (todos-jump-to-category)
2152 (set-buffer (get-file-buffer todos-global-current-todos-file))))
2154 (when (not (derived-mode-p 'todos-mode)) (todos-show))))
2155 (let (buffer-read-only)
2157 ;; Add date, time and diary marking as required.
2158 (concat (if (not (and diary (not todos-include-in-diary)))
2159 todos-nondiary-start
2160 (when (and nonmarking (not todos-diary-nonmarking))
2161 diary-nonmarking-symbol))
2162 date-string (when time-string
2163 (concat " " time-string))
2164 (when (not (and diary (not todos-include-in-diary)))
2167 ;; Indent newlines inserted by C-q C-j if nonspace char follows.
2168 (setq new-item (replace-regexp-in-string
2169 "\\(\n\\)[^[:blank:]]"
2170 (concat "\n" (make-string todos-indent-to-here 32))
2171 new-item nil nil 1))
2173 (cond ((not (eq major-mode 'todos-mode))
2174 (error "Cannot insert a todo item here outside of Todos mode"))
2175 ((not (eq buf (current-buffer)))
2176 (error "Cannot insert an item here after changing buffer"))
2177 ((or (todos-done-item-p)
2178 ;; Point on last blank line.
2179 (save-excursion (forward-line -1) (todos-done-item-p)))
2180 (error "Cannot insert a new item in the done item section"))
2182 (todos-insert-with-overlays new-item)))
2183 (todos-set-item-priority new-item (todos-current-category) t))
2184 (todos-set-count 'todo 1)
2185 (if (or diary todos-include-in-diary) (todos-set-count 'diary 1))
2186 (todos-update-categories-sexp)))))
2188 ;; FIXME: autoload when key-binding is defined in calendar.el
2189 (defun todos-insert-item-from-calendar ()
2192 ;; FIXME: todos-current-todos-file is nil here, better to solicit Todos file?
2193 ;; FIXME: t-g-c-t-f is nil if no Todos file has been visited
2194 (pop-to-buffer (file-name-nondirectory todos-global-current-todos-file))
2196 ;; FIXME: this now calls todos-set-date-from-calendar
2197 (todos-insert-item t 'calendar))
2199 ;; FIXME: calendar is loaded before todos
2200 ;; (add-hook 'calendar-load-hook
2202 (define-key calendar-mode-map "it" 'todos-insert-item-from-calendar);))
2204 (defvar todos-date-from-calendar nil)
2205 (defun todos-set-date-from-calendar ()
2207 (when todos-date-from-calendar
2208 (local-set-key (kbd "RET") 'exit-recursive-edit)
2209 (message "Put cursor on a date and type <return> to set it.")
2210 ;; FIXME: is there a better way than recursive-edit?
2211 ;; FIXME: use unwind-protect? Check recursive-depth?
2213 (setq todos-date-from-calendar
2214 (calendar-date-string (calendar-cursor-to-date t) t t))
2217 (defun todos-delete-item ()
2218 "Delete at least one item in this category.
2220 If there are marked items, delete all of these; otherwise, delete
2223 (let* ((cat (todos-current-category))
2224 (marked (assoc cat todos-categories-with-marks))
2225 (item (unless marked (todos-item-string)))
2226 (ov (make-overlay (save-excursion (todos-item-start))
2227 (save-excursion (todos-item-end))))
2228 ;; FIXME: make confirmation an option
2230 (y-or-n-p "Permanently delete all marked items? ")
2232 (overlay-put ov 'face 'todos-search)
2233 (y-or-n-p (concat "Permanently delete this item? ")))))
2237 (and marked (goto-char (point-min)))
2240 (if (or (and marked (todos-item-marked-p)) item)
2242 (if (todos-done-item-p)
2243 (todos-set-count 'done -1)
2244 (todos-set-count 'todo -1 cat)
2245 (and (todos-diary-item-p) (todos-set-count 'diary -1)))
2248 ;; Don't leave point below last item.
2249 (and item (bolp) (eolp) (< (point-min) (point-max))
2250 (todos-backward-item))
2252 (throw 'done (setq item nil))))
2253 (todos-forward-item))))
2255 (remove-overlays (point-min) (point-max) 'before-string todos-item-mark)
2256 (setq todos-categories-with-marks
2257 (assq-delete-all cat todos-categories-with-marks))
2259 (todos-update-categories-sexp)
2260 (todos-prefix-overlays))
2261 (if ov (delete-overlay ov))))
2263 (defun todos-edit-item ()
2264 "Edit current Todo item in the minibuffer."
2266 (when (todos-item-string)
2267 (let* ((buffer-read-only)
2268 (start (todos-item-start))
2271 (concat todos-date-string-start todos-date-pattern
2272 "\\( " diary-time-regexp "\\)?"
2273 (regexp-quote todos-nondiary-end) "?")
2274 (line-end-position) t)
2275 (1+ (- (point) start))))
2276 (item (todos-item-string))
2277 (multiline (> (length (split-string item "\n")) 1))
2280 (todos-edit-multiline)
2281 (let ((new (read-string "Edit: " (cons item item-beg))))
2282 (while (not (string-match
2283 (concat todos-date-string-start todos-date-pattern) new))
2284 (setq new (read-from-minibuffer
2285 "Item must start with a date: " new)))
2286 ;; Indent newlines inserted by C-q C-j if nonspace char follows.
2287 (setq new (replace-regexp-in-string
2288 "\\(\n\\)[^[:blank:]]"
2289 (concat "\n" (make-string todos-indent-to-here 32)) new
2291 ;; If user moved point during editing, make sure it moves back.
2294 (todos-insert-with-overlays new)
2295 (move-to-column item-beg))))))
2297 ;; FIXME: run todos-check-format on exiting buffer (or check for date string
2299 (defun todos-edit-multiline ()
2300 "Edit current Todo item in Todos Edit mode.
2301 Use of newlines invokes `todos-indent' to insure compliance with
2302 the format of Diary entries."
2304 (let ((buffer-name (generate-new-buffer-name todos-edit-buffer)))
2307 (set-buffer (make-indirect-buffer
2308 (file-name-nondirectory todos-current-todos-file)
2310 (narrow-to-region (todos-item-start) (todos-item-end))
2312 (message "Type %s to return to Todos mode."
2313 (key-description (car (where-is-internal 'todos-edit-quit))))))
2315 (defun todos-edit-quit ()
2316 "Return from Todos Edit mode to Todos mode."
2321 (defun todos-edit-item-header (&optional what)
2322 "Edit date/time header of at least one item.
2324 Interactively, ask whether to edit year, month and day or day of
2325 the week, as well as time. If there are marked items, apply the
2326 changes to all of these; otherwise, edit just the item at point.
2328 Non-interactively, argument WHAT specifies whether to edit only
2329 the date or only the time, or to set the date to today."
2331 (let* ((cat (todos-current-category))
2332 (marked (assoc cat todos-categories-with-marks))
2334 ndate ntime nheader)
2336 (or (and marked (goto-char (point-min))) (todos-item-start))
2340 (while (not (todos-item-marked-p))
2341 (todos-forward-item)
2342 (and (eobp) (throw 'stop nil))))
2343 (re-search-forward (concat todos-date-string-start "\\(?1:"
2345 "\\)\\(?2: " diary-time-regexp "\\)?")
2346 (line-end-position) t)
2347 (let* ((odate (match-string-no-properties 1))
2348 (otime (match-string-no-properties 2))
2350 (if (eq what 'today)
2352 (setq ndate (calendar-date-string (calendar-current-date) t t))
2353 (replace-match ndate nil nil nil 1))
2354 (unless (eq what 'timeonly)
2356 (setq ndate (if (save-match-data (string-match "[0-9]+" odate))
2357 (if (y-or-n-p "Change date? ")
2359 (todos-read-dayname))
2360 (if (y-or-n-p "Change day? ")
2361 (todos-read-dayname)
2362 (todos-read-date)))))
2363 (replace-match ndate nil nil nil 1))
2364 (unless (eq what 'dateonly)
2366 (setq ntime (save-match-data (todos-read-time)))
2367 (when (< 0 (length ntime)) (setq ntime (concat " " ntime))))
2369 (replace-match ntime nil nil nil 2)
2370 (goto-char (match-end 1))
2374 (todos-forward-item)
2375 (goto-char (point-max))))))))
2377 (defun todos-edit-item-date ()
2378 "Prompt For and apply changes to current item's date."
2380 (todos-edit-item-header 'dateonly))
2382 (defun todos-edit-item-date-is-today ()
2383 "Set item date to today's date."
2385 (todos-edit-item-header 'today))
2387 (defun todos-edit-item-time ()
2388 "Prompt For and apply changes to current item's time."
2390 (todos-edit-item-header 'timeonly))
2392 (defun todos-raise-item-priority (&optional lower)
2393 "Raise priority of current item by moving it up by one item.
2394 With non-nil argument LOWER lower item's priority."
2396 (unless (or (todos-done-item-p)
2397 (looking-at "^$")) ; We're between todo and done items.
2398 (let (buffer-read-only)
2401 ;; Can't lower final todo item.
2402 (todos-forward-item)
2403 (and (looking-at todos-item-start)
2404 (not (todos-done-item-p)))))
2405 ;; Can't raise or lower only todo item.
2406 (> (count-lines (point-min) (point)) 0))
2407 (let ((item (todos-item-string))
2408 (marked (todos-item-marked-p)))
2409 ;; In Todos Top Priorities mode, an item's priority can be changed
2410 ;; wrt items in another category, but not wrt items in the same
2412 (when (eq major-mode 'todos-filter-items-mode)
2413 (let* ((regexp (concat todos-date-string-start todos-date-pattern
2414 "\\( " diary-time-regexp "\\)?"
2415 (regexp-quote todos-nondiary-end)
2416 "?\\(?1: \\[\\(.+:\\)?.+\\]\\)"))
2417 (cat1 (save-excursion
2418 (re-search-forward regexp nil t)
2420 (cat2 (save-excursion
2422 (todos-forward-item)
2423 (todos-backward-item))
2424 (re-search-forward regexp nil t)
2426 (if (string= cat1 cat2)
2427 ;; FIXME: better message
2428 (error (concat "Cannot change item's priority in its "
2429 "category; do this in Todos mode")))))
2431 (if lower (todos-forward-item) (todos-backward-item))
2432 (todos-insert-with-overlays item)
2433 ;; If item was marked, retore the mark.
2434 (and marked (overlay-put (make-overlay (point) (point))
2435 'before-string todos-item-mark)))
2436 (message ""))))) ;FIXME: no message ?
2438 (defun todos-lower-item-priority ()
2439 "Lower priority of current item by moving it down by one item."
2441 (todos-raise-item-priority t))
2443 ;; FIXME: incorporate todos-(raise|lower)-item-priority ?
2444 (defun todos-set-item-priority (item cat &optional new)
2445 "Set todo ITEM's priority in category CAT, moving item as needed.
2446 Interactively, the item and the category are the current ones,
2447 and the priority is a number between 1 and the number of items in
2448 the category. Non-interactively with argument NEW, the lowest
2449 priority is one more than the number of items in CAT."
2450 (interactive (list (todos-item-string) (todos-current-category)))
2451 (unless (called-interactively-p t)
2452 (todos-category-number cat)
2453 (todos-category-select))
2454 (let* ((todo (todos-get-count 'todo cat))
2455 (maxnum (if new (1+ todo) todo))
2457 priority candidate prompt)
2458 (unless (zerop todo)
2459 (while (not priority)
2461 (string-to-number (read-from-minibuffer
2463 (format "Set item priority (1-%d): "
2466 (when (or (< candidate 1) (> candidate maxnum))
2467 (format "Priority must be an integer between 1 and %d.\n"
2469 (unless prompt (setq priority candidate)))
2470 ;; Interactively, just relocate the item within its category.
2471 (when (called-interactively-p) (todos-remove-item))
2472 (goto-char (point-min))
2473 (unless (= priority 1) (todos-forward-item (1- priority))))
2474 (todos-insert-with-overlays item)))
2476 ;; FIXME: apply to marked items?
2477 (defun todos-move-item (&optional file)
2478 "Move at least one todo item to another category.
2480 If there are marked items, move all of these; otherwise, move
2483 With non-nil argument FILE, first prompt for another Todos file and
2484 then a category in that file to move the item or items to.
2486 If the chosen category is not one of the existing categories,
2487 then it is created and the item(s) become(s) the first
2488 entry/entries in that category."
2490 (unless (or (todos-done-item-p)
2491 (looking-at "^$")) ; We're between todo and done items.
2492 (let* ((buffer-read-only)
2493 (file1 todos-current-todos-file)
2494 (cat1 (todos-current-category))
2495 (marked (assoc cat1 todos-categories-with-marks))
2496 (num todos-category-number)
2497 (item (todos-item-string))
2498 (diary-item (todos-diary-item-p))
2499 (omark (save-excursion (todos-item-start) (point-marker)))
2501 (todos-read-file-name "Choose a Todos file: " nil t)
2506 (set-buffer (find-file-noselect file2))
2507 (setq cat2 (let* ((pl (if (and marked (> (cdr marked) 1)) "s" ""))
2508 (name (todos-read-category
2509 (concat "Move item" pl " to category: ")))
2510 (prompt (concat "Choose a different category than "
2511 "the current one\n(type `"
2513 (car (where-is-internal
2514 'todos-set-item-priority)))
2515 "' to reprioritize item "
2516 "within the same category): ")))
2517 (while (equal name cat1)
2518 (setq name (todos-read-category prompt)))
2520 (set-buffer (get-file-buffer file1))
2524 (goto-char (point-min))
2526 (when (todos-item-marked-p)
2527 (setq item (concat item (todos-item-string) "\n"))
2528 (setq count (1+ count))
2529 (when (todos-diary-item-p)
2530 (setq count-diary (1+ count-diary))))
2531 (todos-forward-item))
2532 ;; Chop off last newline.
2533 (setq item (substring item 0 -1)))
2535 (when (todos-diary-item-p) (setq count-diary 1)))
2536 (set-window-buffer (selected-window)
2537 (set-buffer (find-file-noselect file2)))
2538 (unless (assoc cat2 todos-categories) (todos-add-category cat2))
2539 (todos-set-item-priority item cat2 t)
2540 (setq nmark (point-marker))
2541 (todos-set-count 'todo count)
2542 (todos-set-count 'diary count-diary)
2543 (todos-update-categories-sexp)
2544 (with-current-buffer (get-file-buffer file1)
2553 (concat "^" (regexp-quote todos-category-beg)) nil t)
2557 (concat "^" (regexp-quote todos-category-done)) nil t)
2558 (setq end (match-beginning 0))
2560 (while (< (point) end)
2561 (if (todos-item-marked-p)
2563 (todos-forward-item))))
2564 (todos-remove-item))))
2565 (todos-set-count 'todo (- count) cat1)
2566 (todos-set-count 'diary (- count-diary) cat1)
2567 (todos-update-categories-sexp))
2568 (set-window-buffer (selected-window)
2569 (set-buffer (find-file-noselect file2)))
2570 (setq todos-category-number (todos-category-number cat2))
2571 (todos-category-select)
2572 (goto-char nmark))))
2574 (defun todos-move-item-to-file ()
2575 "Move the current todo item to a category in another Todos file."
2577 (todos-move-item t))
2579 ;; FIXME: apply to marked items?
2580 (defun todos-item-done (&optional arg)
2581 "Tag this item as done and move it to category's done section.
2582 With prefix argument ARG prompt for a comment and append it to the
2585 (unless (or (todos-done-item-p)
2587 (let* ((buffer-read-only)
2588 (item (todos-item-string))
2589 (diary-item (todos-diary-item-p))
2590 (date-string (calendar-date-string (calendar-current-date) t t))
2591 (time-string (if todos-always-add-time-string ;FIXME: delete condition
2592 (concat " " (substring (current-time-string) 11 16))
2594 ;; FIXME: todos-nondiary-* ?
2595 (done-item (concat "[" todos-done-string date-string time-string "] "
2597 (comment (and arg (read-string "Enter a comment: "))))
2599 (unless (zerop (length comment))
2600 (setq done-item (concat done-item " [" todos-comment-string ": "
2604 (re-search-forward (concat "^" (regexp-quote todos-category-done)) nil t)
2606 (todos-insert-with-overlays done-item))
2607 (todos-set-count 'todo -1)
2608 (todos-set-count 'done 1)
2609 (and diary-item (todos-set-count 'diary -1))
2610 (todos-update-categories-sexp)
2611 (save-excursion (todos-category-select)))))
2613 (defun todos-comment-done-item ()
2614 "Add a comment to this done item."
2616 (when (todos-done-item-p)
2617 (let ((comment (read-string "Enter a comment: "))
2620 (insert " [" todos-comment-string ": " comment "]"))))
2622 ;; FIXME: implement this or done item editing?
2623 (defun todos-uncomment-done-item ()
2627 ;; FIXME: delete comment from restored item or just leave it up to user?
2628 (defun todos-item-undo ()
2629 "Restore this done item to the todo section of this category."
2631 (when (todos-done-item-p)
2632 (let* ((buffer-read-only)
2633 (done-item (todos-item-string))
2635 (orig-mrk (progn (todos-item-start) (point-marker)))
2636 ;; Find the end of the date string added upon making item done.
2637 (start (search-forward "] "))
2638 (item (buffer-substring start (todos-item-end)))
2641 ;; If user cancels before setting new priority, then restore everything.
2644 (todos-set-item-priority item (todos-current-category) t)
2646 (todos-set-count 'todo 1)
2647 (todos-set-count 'done -1)
2648 (and (todos-diary-item-p) (todos-set-count 'diary 1))
2649 (todos-update-categories-sexp))
2652 (goto-char orig-mrk)
2653 (todos-insert-with-overlays done-item)
2654 (let ((todos-show-with-done t))
2655 (todos-category-select)
2656 (goto-char opoint)))
2657 (set-marker orig-mrk nil)))))
2659 (defun todos-archive-done-item-or-items (&optional all)
2660 "Archive at least one done item in this category.
2662 If there are marked done items (and no marked todo items),
2663 archive all of these; otherwise, with non-nil argument ALL,
2664 archive all done items in this category; otherwise, archive the
2667 If the archive of this file does not exist, it is created. If
2668 this category does not exist in the archive, it is created."
2670 (when (not (member (buffer-file-name) (funcall todos-files-function t)))
2671 (if (and all (zerop (todos-get-count 'done cat)))
2672 (message "No done items in this category")
2674 (let* ((cat (todos-current-category))
2675 (tbuf (current-buffer))
2676 (marked (assoc cat todos-categories-with-marks))
2677 (afile (concat (file-name-sans-extension
2678 todos-current-todos-file) ".toda"))
2679 (archive (if (file-exists-p afile)
2680 (find-file-noselect afile t)
2682 ;; todos-add-category requires an exisiting file...
2683 (with-current-buffer (get-buffer-create afile)
2685 (write-region (point-min) (point-max) afile
2686 nil 'nomessage nil t)))
2687 ;; ...but the file still lacks a categories sexp, so
2688 ;; visiting the file would barf on todos-set-categories,
2689 ;; hence we just return the buffer.
2690 (get-buffer afile)))
2691 (item (and (todos-done-item-p) (concat (todos-item-string) "\n")))
2693 marked-items beg end all-done
2698 (goto-char (point-min))
2700 (if (todos-item-marked-p)
2701 (if (not (todos-done-item-p))
2702 (throw 'end (message "Only done items can be archived"))
2703 (concat marked-items (todos-item-string) "\n")
2704 (setq count (1+ count)))
2705 (todos-forward-item)))))
2707 (if (y-or-n-p "Archive all done items in this category? ")
2710 (goto-char (point-min))
2713 (re-search-forward todos-done-string-start nil t)
2714 (match-beginning 0))
2715 end (if (re-search-forward
2716 (concat "^" (regexp-quote todos-category-beg))
2720 all-done (buffer-substring beg end)
2721 count (todos-get-count 'done))))
2723 (when (or marked all item)
2724 (with-current-buffer archive
2725 (let ((current todos-global-current-todos-file)
2728 (goto-char (point-min))
2731 (concat "^" (regexp-quote (concat todos-category-beg cat)))
2733 (re-search-forward (regexp-quote todos-category-done) nil t))
2735 ;; todos-add-category uses t-c-t-f, so temporarily set it.
2736 (setq todos-current-todos-file afile)
2737 (todos-add-category cat)
2738 (goto-char (point-max)))
2739 (insert (cond (marked marked-items)
2742 (todos-set-count 'done (if (or marked all) count 1))
2743 (todos-update-categories-sexp)
2744 ;; Save to file now (using write-region in order not to visit
2745 ;; afile) so we can visit it later with todos-view-archived-items
2746 ;; or todos-show-archive.
2747 (write-region nil nil afile)
2748 (setq todos-current-todos-file current)))
2749 (with-current-buffer tbuf
2750 (cond ((or marked item)
2751 (and marked (goto-char (point-min)))
2754 (if (or (and marked (todos-item-marked-p)) item)
2757 (todos-set-count 'done -1)
2758 (todos-set-count 'archived 1)
2759 ;; Don't leave point below last item.
2760 (and item (bolp) (eolp) (< (point-min) (point-max))
2761 (todos-backward-item))
2763 (throw 'done (setq item nil))))
2764 (todos-forward-item)))))
2766 (remove-overlays beg end)
2767 (delete-region beg end)
2768 (todos-set-count 'done (- count))
2769 (todos-set-count 'archived count)))
2771 (remove-overlays (point-min) (point-max)
2772 'before-string todos-item-mark)
2773 (setq todos-categories-with-marks
2774 (assq-delete-all cat todos-categories-with-marks))
2776 (todos-update-categories-sexp)
2777 (todos-prefix-overlays)
2778 ;; FIXME: Heisenbug: item displays mark -- but not when edebugging
2779 (remove-overlays (point-min) (point-max)
2780 'before-string todos-item-mark)))
2781 (display-buffer (find-file-noselect afile) t)
2782 ;; FIXME: how to avoid switch-to-buffer and still get tbuf above
2783 ;; afile? What about pop-to-buffer-same-window in recent trunk?
2784 (switch-to-buffer tbuf))))))
2786 (defun todos-archive-category-done-items ()
2787 "Move all done items in this category to its archive."
2789 (todos-archive-done-item-or-items t))
2791 (defun todos-unarchive-items (&optional all)
2792 "Unarchive at least one item in this archive category.
2794 If there are marked items, unarchive all of these; otherwise,
2795 with non-nil argument ALL, unarchive all items in this category;
2796 otherwise, unarchive the item at point.
2798 Unarchived items are restored as done items to the corresponding
2799 category in the Todos file, inserted at the end of done section.
2800 If all items in the archive category were restored, the category
2801 is deleted from the archive. If this was the only category in the
2802 archive, the archive file is deleted."
2804 (when (member (buffer-file-name) (funcall todos-files-function t))
2806 (let* ((buffer-read-only nil)
2807 (tbuf (find-file-noselect
2808 (concat (file-name-sans-extension todos-current-todos-file)
2810 (cat (todos-current-category))
2811 (marked (assoc cat todos-categories-with-marks))
2812 (item (concat (todos-item-string) "\n"))
2813 (all-items (buffer-substring (point-min) (point-max)))
2814 (all-count (todos-get-count 'done))
2815 marked-items marked-count)
2817 (goto-char (point-min))
2819 (when (todos-item-marked-p)
2820 (concat marked-items (todos-item-string) "\n")
2821 (setq marked-count (1+ marked-count)))
2822 (todos-forward-item)))
2823 ;; Restore items to end of category's done section and update counts.
2824 (with-current-buffer tbuf
2825 (let (buffer-read-only)
2827 (goto-char (point-min))
2828 (re-search-forward (concat "^" (regexp-quote
2829 (concat todos-category-beg cat)))
2831 (if (re-search-forward (concat "^" (regexp-quote todos-category-beg))
2833 (goto-char (match-beginning 0))
2834 (goto-char (point-max)))
2836 (insert marked-items)
2837 (todos-set-count 'done marked-count)
2838 (todos-set-count 'archived (- marked-count)))
2840 (if (y-or-n-p (concat "Restore this category's items "
2841 "to Todos file as done items "
2842 "and delete this category? "))
2843 (progn (insert all-items)
2844 (todos-set-count 'done all-count)
2845 (todos-set-count 'archived (- all-count)))
2849 (todos-set-count 'done 1)
2850 (todos-set-count 'archived -1)))
2851 (todos-update-categories-sexp)))
2852 ;; Delete restored items from archive.
2853 (cond ((or marked item)
2854 (and marked (goto-char (point-min)))
2857 (if (or (and marked (todos-item-marked-p)) item)
2860 (todos-set-count 'done -1)
2861 ;; Don't leave point below last item.
2862 (and item (bolp) (eolp) (< (point-min) (point-max))
2863 (todos-backward-item))
2865 (throw 'done (setq item nil))))
2866 (todos-forward-item)))))
2868 (remove-overlays (point-min) (point-max))
2869 (delete-region (point-min) (point-max))
2870 (todos-set-count 'done (- all-count))))
2871 ;; If that was the last category in the archive, delete the whole file.
2872 (if (= (length todos-categories) 1)
2874 (delete-file todos-current-todos-file)
2875 ;; Don't bother confirming killing the archive buffer.
2876 (set-buffer-modified-p nil)
2878 ;; Otherwise, if the archive category is now empty, delete it.
2879 (when (eq (point-min) (point-max))
2881 (let ((beg (re-search-backward
2882 (concat "^" (regexp-quote todos-category-beg) cat)
2884 (end (if (re-search-forward
2885 (concat "^" (regexp-quote todos-category-beg))
2889 (remove-overlays beg end)
2890 (delete-region beg end)
2891 (setq todos-categories (delete (assoc cat todos-categories)
2893 (todos-update-categories-sexp))))
2894 ;; Visit category in Todos file and show restored done items.
2895 (let ((tfile (buffer-file-name tbuf))
2896 (todos-show-with-done t))
2897 (set-window-buffer (selected-window)
2898 (set-buffer (find-file-noselect tfile)))
2899 (todos-category-number cat)
2901 (message "Items unarchived."))))))
2903 (defun todos-unarchive-category ()
2904 "Unarchive all items in this category. See `todos-unarchive-items'."
2906 (todos-unarchive-items t))
2908 (defun todos-toggle-diary-inclusion (&optional all)
2909 "Toggle diary status of one or more todo items in this category.
2911 If a candidate item is marked with `todos-nondiary-marker',
2912 remove this marker; otherwise, insert it.
2914 With non-nil argument ALL toggle the diary status of all todo
2915 items in this category; otherwise, if there are marked todo
2916 items, toggle the diary status of all and only these, otherwise
2917 toggle the diary status of the item at point. "
2919 (let ((marked (assoc (todos-current-category)
2920 todos-categories-with-marks)))
2924 (when (or marked all) (goto-char (point-min)))
2926 (if (todos-done-item-p)
2927 (throw 'stop (message "Done items cannot be changed"))
2928 (unless (and marked (not (todos-item-marked-p)))
2930 (let* ((buffer-read-only)
2931 (beg (todos-item-start))
2932 (lim (save-excursion (todos-item-end)))
2933 (end (save-excursion
2934 (or (todos-time-string-matcher lim)
2935 (todos-date-string-matcher lim)))))
2936 (if (looking-at (regexp-quote todos-nondiary-start))
2939 (search-forward todos-nondiary-end (1+ end) t)
2941 (todos-set-count 'diary 1))
2943 (insert todos-nondiary-start)
2944 (goto-char (1+ end))
2945 (insert todos-nondiary-end)
2946 (todos-set-count 'diary -1))))))
2947 (unless (or marked all) (throw 'stop nil))
2948 (todos-forward-item))))))
2949 (todos-update-categories-sexp)))
2951 (defun todos-toggle-item-diary-nonmarking ()
2952 "Mark or unmark this todos diary item for calendar display.
2953 See `diary-nonmarking-symbol'."
2955 (let ((buffer-read-only))
2958 (unless (looking-at (regexp-quote todos-nondiary-start))
2959 (if (looking-at (regexp-quote diary-nonmarking-symbol))
2961 (insert diary-nonmarking-symbol))))))
2963 (defun todos-toggle-diary-nonmarking ()
2964 "Mark or unmark this category's todos diary items for calendar.
2965 See `diary-nonmarking-symbol'."
2968 (goto-char (point-min))
2970 (todos-toggle-item-diary-nonmarking)
2971 (todos-forward-item))))
2973 (defun todos-print (&optional to-file)
2974 "Produce a printable version of the current Todos buffer.
2975 This includes overlays, indentation, and, depending on the value
2976 of `todos-print-function', faces. With non-nil argument TO-FILE
2977 write the printable version to a file; otherwise, send it to the
2980 (let ((buf todos-tmp-buffer-name) ;FIXME
2982 ((eq major-mode 'todos-mode)
2983 (concat "Todos File: "
2984 (file-name-sans-extension
2985 (file-name-nondirectory todos-current-todos-file))
2986 "\nCategory: " (todos-current-category)))
2987 ((eq major-mode 'todos-filter-items-mode)
2988 "Todos Top Priorities")))
2989 (prefix (propertize (concat todos-prefix " ")
2990 'face 'todos-prefix-string))
2992 (fill-prefix (make-string todos-indent-to-here 32))
2993 (content (buffer-string))
2995 (with-current-buffer (get-buffer-create buf)
2997 (goto-char (point-min))
3000 (end (save-excursion (todos-item-end))))
3001 (when todos-number-prefix
3003 (setq prefix (propertize (concat (number-to-string num) " ")
3004 'face 'todos-prefix-string)))
3006 (fill-region beg end))
3007 ;; Calling todos-forward-item infloops at todos-item-start due to
3008 ;; non-overlay prefix, so search for item start instead.
3009 (if (re-search-forward todos-item-start nil t)
3011 (goto-char (point-max))))
3012 (if (re-search-backward (concat "^" (regexp-quote todos-category-done))
3014 (replace-match todos-done-separator))
3015 (goto-char (point-min))
3019 (let ((file (read-file-name "Print to file: ")))
3020 (funcall todos-print-function file))
3021 (funcall todos-print-function)))
3024 (defun todos-print-to-file ()
3025 "Save printable version of this Todos buffer to a file."
3029 ;; ---------------------------------------------------------------------------
3033 (defvar todos-date-pattern ;FIXME: start with "^" ?
3034 (let ((dayname (diary-name-pattern calendar-day-name-array nil t)))
3035 (concat "\\(?:" dayname "\\|"
3037 (monthname (format "\\(?:%s\\|\\*\\)"
3039 calendar-month-name-array
3040 calendar-month-abbrev-array t)))
3041 (month "\\(?:[0-9]+\\|\\*\\)")
3042 (day "\\(?:[0-9]+\\|\\*\\)")
3043 (year "-?\\(?:[0-9]+\\|\\*\\)"))
3044 (mapconcat 'eval calendar-date-display-form ""))
3046 "Regular expression matching a Todos date header.")
3048 (defvar todos-date-string-start
3049 ;; FIXME: with ? matches anything
3050 (concat "^\\(" (regexp-quote todos-nondiary-start) "\\|"
3051 (regexp-quote diary-nonmarking-symbol) "\\)?")
3052 "Regular expression matching part of item header before the date.")
3054 (defvar todos-done-string-start
3055 (concat "^\\[" (regexp-quote todos-done-string))
3056 "Regular expression matching start of done item.")
3058 (defun todos-date-string-matcher (lim)
3059 "Search for Todos date strings within LIM for font-locking."
3061 (concat todos-date-string-start "\\(?1:" todos-date-pattern "\\)") lim t))
3063 (defun todos-time-string-matcher (lim)
3064 "Search for Todos time strings within LIM for font-locking."
3065 (re-search-forward (concat todos-date-string-start todos-date-pattern
3066 " \\(?1:" diary-time-regexp "\\)") lim t))
3068 (defun todos-done-string-matcher (lim)
3069 "Search for Todos done headers within LIM for font-locking."
3070 (re-search-forward (concat todos-done-string-start
3074 (defun todos-comment-string-matcher (lim)
3075 "Search for Todos done comment within LIM for font-locking."
3076 (re-search-forward (concat "\\[\\(?1:" todos-comment-string "\\):")
3079 (defun todos-category-string-matcher (lim)
3080 "Search for Todos category headers within LIM for font-locking."
3081 (if (eq major-mode 'todos-filter-items-mode)
3083 ;; (concat "^\\(?1:" (regexp-quote todos-category-beg) ".*\\)$")
3084 (concat "\\(?:^\\[?" todos-date-pattern "\\(?: " diary-time-regexp
3085 "\\)?\\]?\\) \\(?1:\\[.+\\]\\)") lim t)))
3087 (defun todos-check-format ()
3088 "Signal an error if the current Todos file is ill-formatted."
3092 (goto-char (point-min))
3093 (let ((legit (concat "^\\(" (regexp-quote todos-category-beg) "\\)"
3094 "\\|\\(\\[?" todos-date-pattern "\\)"
3095 "\\|\\([ \t]+[^ \t]*\\)"
3098 (unless (looking-at legit)
3099 (error "Illegitimate Todos file format at line %d"
3100 (line-number-at-pos (point))))
3102 (message "This Todos file is well-formatted."))
3104 (defun todos-after-find-file ()
3105 "Show Todos files correctly when visited from outside of Todos mode."
3106 (and (member this-command todos-visit-files-commands)
3107 (= (- (point-max) (point-min)) (buffer-size))
3108 (member major-mode '(todos-mode todos-archive-mode))
3109 (todos-category-select)))
3111 (defun todos-wrap-and-indent ()
3112 "Use word wrapping on long lines and indent with a wrap prefix.
3113 The amount of indentation is given by user option
3114 `todos-indent-to-here'."
3115 (set (make-local-variable 'word-wrap) t)
3116 (set (make-local-variable 'wrap-prefix) (make-string todos-indent-to-here 32))
3117 (unless (member '(continuation) fringe-indicator-alist)
3118 (push '(continuation) fringe-indicator-alist)))
3120 (defun todos-indent ()
3121 "Indent from point to `todos-indent-to-here'."
3122 (indent-to todos-indent-to-here todos-indent-to-here))
3124 (defun todos-prefix-overlays ()
3125 "Put before-string overlay in front of this category's items.
3126 The overlay's value is the string `todos-prefix' or with non-nil
3127 `todos-number-prefix' an integer in the sequence from 1 to the
3128 number of todo or done items in the category indicating the
3129 item's priority. Todo and done items are numbered independently
3131 (when (or todos-number-prefix
3132 (not (string-match "^[[:space:]]*$" todos-prefix)))
3133 (let ((prefix (propertize (concat todos-prefix " ")
3134 'face 'todos-prefix-string))
3137 (goto-char (point-min))
3139 (when (or (todos-date-string-matcher (line-end-position))
3140 (todos-done-string-matcher (line-end-position)))
3141 (goto-char (match-beginning 0))
3142 (when todos-number-prefix
3144 ;; Reset number for done items.
3146 ;; FIXME: really need this?
3147 ;; If last not done item is multiline, then
3148 ;; todos-done-string-matcher skips empty line, so have
3150 (and (looking-at todos-done-string-start)
3151 (looking-back (concat "^"
3152 (regexp-quote todos-category-done)
3155 (setq prefix (propertize (concat (number-to-string num) " ")
3156 'face 'todos-prefix-string)))
3157 (let ((ovs (overlays-in (point) (point)))
3161 (let ((val (overlay-get ov 'before-string)))
3164 (setq ov-pref val)))))
3165 (unless (equal ov-pref prefix)
3166 (remove-overlays (point) (point)) ; 'before-string) doesn't work
3167 (overlay-put (make-overlay (point) (point))
3168 'before-string prefix)
3169 (and marked (overlay-put (make-overlay (point) (point))
3170 'before-string todos-item-mark)))))
3173 (defun todos-reset-prefix (symbol value)
3174 "The :set function for `todos-prefix' and `todos-number-prefix'."
3175 (let ((oldvalue (symbol-value symbol))
3176 (files (append todos-files todos-archives)))
3177 (custom-set-default symbol value)
3178 (when (not (equal value oldvalue))
3180 (with-current-buffer (find-file-noselect f)
3181 (save-window-excursion
3185 (goto-char (point-min))
3187 (remove-overlays (point) (point)); 'before-string prefix)
3189 ;; Activate the new setting (save-restriction does not help).
3190 (save-excursion (todos-category-select))))))))
3192 (defun todos-reset-nondiary-marker (symbol value)
3193 "The :set function for user option `todos-nondiary-marker'."
3194 (let ((oldvalue (symbol-value symbol))
3195 (files (append todos-files todos-archives)))
3196 (custom-set-default symbol value)
3197 ;; Need to reset these to get font-locking right.
3198 (setq todos-nondiary-start (nth 0 todos-nondiary-marker)
3199 todos-nondiary-end (nth 1 todos-nondiary-marker)
3200 todos-date-string-start
3201 ;; FIXME: with ? matches anything
3202 (concat "^\\(" (regexp-quote todos-nondiary-start) "\\|"
3203 (regexp-quote diary-nonmarking-symbol) "\\)?"))
3204 (when (not (equal value oldvalue))
3206 (with-current-buffer (find-file-noselect f)
3207 (let (buffer-read-only)
3209 (goto-char (point-min))
3211 (if (re-search-forward
3212 (concat "^\\(" todos-done-string-start "[^][]+] \\)?"
3213 "\\(?1:" (regexp-quote (car oldvalue))
3214 "\\)" todos-date-pattern "\\( "
3215 diary-time-regexp "\\)?\\(?2:"
3216 (regexp-quote (cadr oldvalue)) "\\)")
3219 (replace-match (nth 0 value) t t nil 1)
3220 (replace-match (nth 1 value) t t nil 2))
3222 (todos-category-select)))))))
3224 (defun todos-reset-done-string (symbol value)
3225 "The :set function for user option `todos-done-string'."
3226 (let ((oldvalue (symbol-value symbol))
3227 (files (append todos-files todos-archives)))
3228 (custom-set-default symbol value)
3229 ;; Need to reset this to get font-locking right.
3230 (setq todos-done-string-start
3231 (concat "^\\[" (regexp-quote todos-done-string)))
3232 (when (not (equal value oldvalue))
3234 (with-current-buffer (find-file-noselect f)
3235 (let (buffer-read-only)
3237 (goto-char (point-min))
3239 (if (re-search-forward
3240 (concat "^" (regexp-quote todos-nondiary-start)
3241 "\\(" (regexp-quote oldvalue) "\\)")
3243 (replace-match value t t nil 1)
3245 (todos-category-select)))))))
3247 (defun todos-reset-comment-string (symbol value)
3248 "The :set function for user option `todos-comment-string'."
3249 (let ((oldvalue (symbol-value symbol))
3250 (files (append todos-files todos-archives)))
3251 (custom-set-default symbol value)
3252 (when (not (equal value oldvalue))
3254 (with-current-buffer (find-file-noselect f)
3255 (let (buffer-read-only)
3258 (goto-char (point-min))
3260 (if (re-search-forward
3262 "\\[\\(" (regexp-quote oldvalue) "\\): [^]]*\\]")
3264 (replace-match value t t nil 1)
3266 (todos-category-select))))))))
3268 (defun todos-reset-categories (symbol value)
3269 "The :set function for `todos-ignore-archived-categories'."
3270 (custom-set-default symbol value)
3271 (dolist (f (funcall todos-files-function))
3272 (with-current-buffer (find-file-noselect f)
3274 (setq todos-categories-full todos-categories
3275 todos-categories (todos-truncate-categories-list))
3276 (setq todos-categories todos-categories-full
3277 todos-categories-full nil))
3278 (todos-category-select))))
3280 (defun todos-toggle-show-current-file (symbol value)
3281 "The :set function for user option `todos-show-current-file'."
3282 (custom-set-default symbol value)
3284 (add-hook 'pre-command-hook 'todos-show-current-file nil t)
3285 (remove-hook 'pre-command-hook 'todos-show-current-file t)))
3287 (defun todos-show-current-file ()
3288 "Visit current instead of default Todos file with `todos-show'.
3289 This function is added to `pre-command-hook' when user option
3290 `todos-show-current-file' is set to non-nil."
3291 (setq todos-global-current-todos-file todos-current-todos-file))
3292 ;; (and (eq major-mode 'todos-mode)
3293 ;; (setq todos-global-current-todos-file (buffer-file-name))))
3295 ;; FIXME: rename to todos-set-category-number ?
3296 (defun todos-category-number (cat)
3297 "Set and return buffer-local value of `todos-category-number'.
3298 This value is one more than the index of category CAT, starting
3299 with one instead of zero, so that the highest priority
3300 category (see `todos-display-categories') has the number one."
3301 (let ((categories (mapcar 'car todos-categories)))
3302 (setq todos-category-number
3303 (1+ (- (length categories)
3304 (length (member cat categories)))))))
3306 (defun todos-current-category ()
3307 "Return the name of the current category."
3308 (car (nth (1- todos-category-number) todos-categories)))
3310 (defun todos-category-select ()
3311 "Display the current category correctly.
3313 With non-nil user option `todos-show-done-only' display only the
3314 category's done (but not archived) items; else (the default)
3315 display just the todo items, or with non-nil user option
3316 `todos-show-with-done' also display the category's done items
3317 below the todo items."
3318 (let ((name (todos-current-category))
3319 cat-begin cat-end done-start done-sep-start done-end)
3321 (goto-char (point-min))
3323 (concat "^" (regexp-quote (concat todos-category-beg name)) "$") nil t)
3324 (setq cat-begin (1+ (line-end-position)))
3325 (setq cat-end (if (re-search-forward
3326 (concat "^" (regexp-quote todos-category-beg)) nil t)
3329 (setq mode-line-buffer-identification
3330 (funcall todos-mode-line-function name))
3331 (narrow-to-region cat-begin cat-end)
3332 (todos-prefix-overlays)
3333 (goto-char (point-min))
3334 (if (re-search-forward (concat "\n\\(" (regexp-quote todos-category-done)
3337 (setq done-start (match-beginning 0))
3338 (setq done-sep-start (match-beginning 1))
3339 (setq done-end (match-end 0)))
3340 (error "Category %s is missing todos-category-done string" name))
3341 (if todos-show-done-only
3342 (narrow-to-region (1+ done-end) (point-max))
3343 ;; Display or hide done items as per todos-show-with-done.
3344 ;; FIXME: use todos-done-string-start ?
3345 (when (re-search-forward (concat "\n\\(\\["
3346 (regexp-quote todos-done-string)
3348 (let (done-sep prefix ov-pref ov-done)
3349 ;; FIXME: delete overlay when not viewing done items?
3350 (when todos-show-with-done
3351 (setq done-sep todos-done-separator)
3352 (setq done-start cat-end)
3353 (setq ov-pref (make-overlay done-sep-start done-end))
3354 (overlay-put ov-pref 'display done-sep))))
3355 (narrow-to-region (point-min) done-start))))
3357 (defun todos-insert-with-overlays (item)
3358 "Insert ITEM and update prefix/priority number overlays."
3361 (todos-backward-item)
3362 (todos-prefix-overlays))
3364 (defvar todos-item-start ;; (concat "^\\(\\[\\(" (regexp-quote todos-done-string)
3365 ;; "\\)?\\)?" todos-date-pattern)
3366 (concat "\\(" todos-date-string-start "\\|" todos-done-string-start
3367 "\\)" todos-date-pattern)
3368 "String identifying start of a Todos item.")
3370 (defun todos-item-start ()
3371 "Move to start of current Todos item and return its position."
3372 (unless (looking-at "^$")
3373 ;; (or (looking-at "^$") ; last item or between done and not done
3374 ;; ;; FIXME: need this? (was needed by abandoned todos-count-items)
3375 ;; (looking-at (regexp-quote todos-category-beg)))
3376 (goto-char (line-beginning-position))
3377 (while (not (looking-at todos-item-start))
3381 (defun todos-item-end ()
3382 "Move to end of current Todos item and return its position."
3383 ;; Items cannot end with a blank line.
3384 (unless (looking-at "^$")
3385 (let ((done (todos-done-item-p)))
3386 (todos-forward-item)
3387 ;; Adjust if item is last unfinished one before displayed done items.
3388 (when (and (not done) (todos-done-item-p))
3393 (defun todos-remove-item ()
3394 "Internal function called in editing, deleting or moving items."
3395 (let* ((beg (todos-item-start))
3396 (end (progn (todos-item-end) (1+ (point))))
3397 (ovs (overlays-in beg beg)))
3398 ;; There can be both prefix/number and mark overlays.
3399 (while ovs (delete-overlay (car ovs)) (pop ovs))
3400 (delete-region beg end)))
3402 (defun todos-item-string ()
3403 "Return bare text of current item as a string."
3404 (let ((opoint (point))
3405 (start (todos-item-start))
3406 (end (todos-item-end)))
3408 (and start end (buffer-substring-no-properties start end))))
3410 (defun todos-diary-item-p ()
3411 "Return non-nil if item at point is marked for diary inclusion."
3414 (looking-at todos-date-pattern)))
3416 (defun todos-done-item-p ()
3417 "Return non-nil if item at point is a done item."
3420 (looking-at todos-done-string-start)))
3422 (defvar todos-item-mark (propertize (if (equal todos-prefix "*") "@" "*")
3424 "String used to mark items.")
3426 (defun todos-item-marked-p ()
3427 "If this item is marked, return mark overlay."
3428 (let ((ovs (overlays-in (line-beginning-position) (line-beginning-position)))
3429 (mark todos-item-mark)
3434 (and (equal (overlay-get ov 'before-string) mark)
3435 (throw 'stop (setq marked t)))))
3438 (defvar todos-categories-with-marks nil
3439 "Alist of categories and number of marked items they contain.")
3441 (defun todos-get-count (type &optional category)
3442 "Return count of TYPE items in CATEGORY.
3443 If CATEGORY is nil, default to the current category."
3444 (let* ((cat (or category (todos-current-category)))
3445 (counts (cdr (assoc cat todos-categories)))
3446 (idx (cond ((eq type 'todo) 0)
3447 ((eq type 'diary) 1)
3449 ((eq type 'archived) 3))))
3452 (defun todos-set-count (type increment &optional category)
3453 "Increment count of TYPE items in CATEGORY by INCREMENT.
3454 If CATEGORY is nil, default to the current category."
3455 (let* ((cat (or category (todos-current-category)))
3456 (counts (cdr (assoc cat todos-categories)))
3457 (idx (cond ((eq type 'todo) 0)
3458 ((eq type 'diary) 1)
3460 ((eq type 'archived) 3))))
3461 (aset counts idx (+ increment (aref counts idx)))))
3463 ;; (defun todos-item-counts (operation &optional cat1 cat2)
3464 ;; "Update item counts in category CAT1 changed by OPERATION.
3465 ;; If CAT1 is nil, update counts from the current category. With
3466 ;; non-nil CAT2 include specified counts from that category in the
3467 ;; calculation for CAT1.
3468 ;; After updating the item counts, update the `todos-categories' sexp."
3469 ;; (let* ((cat (or cat1 (todos-current-category))))
3470 ;; (cond ((eq type 'insert)
3471 ;; (todos-set-count 'todo 1 cat))
3472 ;; ((eq type 'diary)
3473 ;; (todos-set-count 'diary 1 cat))
3474 ;; ((eq type 'nondiary)
3475 ;; (todos-set-count 'diary -1 cat))
3476 ;; ((eq type 'delete)
3477 ;; ;; FIXME: ok if last done item was deleted?
3478 ;; (if (save-excursion
3479 ;; (re-search-backward (concat "^" (regexp-quote
3480 ;; todos-category-done)) nil t))
3481 ;; (todos-set-count 'done -1 cat)
3482 ;; (todos-set-count 'todo -1 cat)))
3484 ;; (unless (member (buffer-file-name) (funcall todos-files-function t))
3485 ;; (todos-set-count 'todo -1 cat))
3486 ;; (todos-set-count 'done 1 cat))
3488 ;; (todos-set-count 'todo 1 cat)
3489 ;; (todos-set-count 'done -1 cat))
3490 ;; ((eq type 'archive1)
3491 ;; (todos-set-count 'archived 1 cat)
3492 ;; (todos-set-count 'done -1 cat))
3493 ;; ((eq type 'archive)
3494 ;; (if (member (buffer-file-name) (funcall todos-files-function t))
3495 ;; ;; In Archive file augment done count with cat's previous
3497 ;; (todos-set-count 'done (todos-get-count 'done cat) cat)
3498 ;; ;; In Todos file augment archive count with cat's previous
3499 ;; ;; done count, and make the latter zero.
3500 ;; (todos-set-count 'archived (todos-get-count 'done cat) cat)
3501 ;; (todos-set-count 'done (- (todos-get-count 'done cat)) cat)))
3502 ;; ((eq type 'merge)
3503 ;; ;; Augment todo and done counts of cat by those of cat2.
3504 ;; (todos-set-count 'todo (todos-get-count 'todo cat2) cat)
3505 ;; (todos-set-count 'done (todos-get-count 'done cat2) cat)))
3506 ;; (todos-update-categories-sexp)))
3508 (defun todos-set-categories ()
3509 "Set `todos-categories' from the sexp at the top of the file."
3510 ;; New archive files created by `todos-move-category' are empty, which would
3511 ;; make the sexp test fail and raise an error, so in this case we skip it.
3512 (unless (zerop (buffer-size))
3516 (goto-char (point-min))
3517 ;; todos-truncate-categories-list needs non-nil todos-categories.
3518 (setq todos-categories-full
3519 (if (looking-at "\(\(\"")
3520 (read (buffer-substring-no-properties
3521 (line-beginning-position)
3522 (line-end-position)))
3523 (error "Invalid or missing todos-categories sexp"))
3524 todos-categories todos-categories-full)))
3525 (if (and todos-ignore-archived-categories
3526 (eq major-mode 'todos-mode))
3527 (todos-truncate-categories-list)
3528 todos-categories-full)))
3530 ;; FIXME: currently unused -- make this a command to rebuild a corrupted
3531 ;; todos-cats sexp ?
3532 (defun todos-make-categories-list (&optional force)
3533 "Return an alist of Todos categories and their item counts.
3534 With non-nil argument FORCE parse the entire file to build the
3535 list; otherwise, get the value by reading the sexp at the top of
3537 (setq todos-categories nil)
3541 (goto-char (point-min))
3542 (let (counts cat archive)
3543 ;; FIXME: can todos-archives be too old here?
3544 (unless (member buffer-file-name (funcall todos-files-function t))
3545 (setq archive (concat (file-name-sans-extension
3546 todos-current-todos-file) ".toda")))
3548 (cond ((looking-at (concat (regexp-quote todos-category-beg)
3550 (setq cat (match-string-no-properties 1))
3551 ;; Counts for each category: [todo diary done archive]
3552 (setq counts (make-vector 4 0))
3553 (setq todos-categories
3554 (append todos-categories (list (cons cat counts))))
3555 ;; todos-archives may be too old here (e.g. during
3556 ;; todos-move-category).
3557 (when (member archive (funcall todos-files-function t))
3558 (with-current-buffer (find-file-noselect archive)
3560 (goto-char (point-min))
3561 (when (re-search-forward
3562 (concat (regexp-quote todos-category-beg) cat)
3565 (while (not (or (looking-at
3567 (regexp-quote todos-category-beg)
3570 (when (looking-at todos-done-string-start)
3571 (todos-set-count 'archived 1 cat))
3573 ((looking-at todos-done-string-start)
3574 (todos-set-count 'done 1 cat))
3575 ((looking-at (concat "^\\("
3576 (regexp-quote diary-nonmarking-symbol)
3577 "\\)?" todos-date-pattern))
3578 (todos-set-count 'diary 1 cat)
3579 (todos-set-count 'todo 1 cat))
3580 ((looking-at (concat todos-date-string-start todos-date-pattern))
3581 (todos-set-count 'todo 1 cat))
3582 ;; If first line is todos-categories list, use it and end loop
3583 ;; unless forced by non-nil parameter `force' to scan whole file.
3586 (setq todos-categories (read (buffer-substring-no-properties
3587 (line-beginning-position)
3588 (line-end-position))))
3589 (goto-char (1- (point-max))))))
3593 (defun todos-truncate-categories-list ()
3594 "Return a truncated alist of Todos categories plus item counts.
3595 Categories containing only archived items are omitted. This list
3596 is used in Todos mode when `todos-ignore-archived-categories' is
3599 (dolist (catcons todos-categories-full cats)
3600 (let ((cat (car catcons)))
3603 (unless (and (zerop (todos-get-count 'todo cat))
3604 (zerop (todos-get-count 'done cat))
3605 (not (zerop (todos-get-count 'archived cat))))
3606 (list catcons))))))))
3608 (defun todos-update-categories-sexp ()
3609 "Update the `todos-categories' sexp at the top of the file."
3610 (let (buffer-read-only)
3614 (goto-char (point-min))
3615 (if (looking-at (concat "^" (regexp-quote todos-category-beg)))
3616 (progn (newline) (goto-char (point-min)))
3617 ;; With empty buffer (e.g. with new archive in
3618 ;; `todos-move-category') `kill-line' signals end of buffer.
3619 (kill-region (line-beginning-position) (line-end-position)))
3621 ;; (prin1 todos-categories (current-buffer))))))
3622 (prin1 todos-categories-full (current-buffer))))))
3624 (defun todos-read-file-name (prompt &optional archive mustmatch)
3625 "Choose and return the name of a Todos file, prompting with PROMPT.
3626 Show completions with TAB or SPC; the names are shown in short
3627 form but the absolute truename is returned. With non-nil ARCHIVE
3628 return the absolute truename of a Todos archive file. With non-nil
3629 MUSTMATCH the name of an existing file must be chosen;
3630 otherwise, a new file name is allowed." ;FIXME: is this possible?
3631 (unless (file-exists-p todos-files-directory)
3632 (make-directory todos-files-directory))
3633 (let* ((completion-ignore-case t)
3634 (files (mapcar 'file-name-sans-extension
3635 (directory-files todos-files-directory nil
3636 (if archive "\.toda$" "\.todo$"))))
3637 (file (concat todos-files-directory
3638 (completing-read prompt files nil mustmatch)
3639 (if archive ".toda" ".todo"))))
3640 (file-truename file)))
3642 (defun todos-read-category (prompt &optional mustmatch)
3643 "Choose and return a category name, prompting with PROMPT.
3644 Show completions with TAB or SPC. With non-nil MUSTMATCH the
3645 name must be that of an existing category; otherwise, a new
3646 category name is allowed, after checking its validity."
3647 ;; Allow SPC to insert spaces, for adding new category names.
3648 (let ((map minibuffer-local-completion-map))
3649 (define-key map " " nil)
3650 ;; Make a copy of todos-categories in case history-delete-duplicates is
3651 ;; non-nil, which makes completing-read alter todos-categories.
3652 (let* ((categories (copy-sequence todos-categories))
3653 (history (cons 'todos-categories (1+ todos-category-number)))
3654 (completion-ignore-case todos-completion-ignore-case)
3655 (category (completing-read prompt todos-categories nil
3656 mustmatch nil history
3657 (if todos-categories
3658 (todos-current-category)
3659 ;; Trigger prompt for initial category
3661 ;; FIXME: let "" return todos-current-category
3663 (when (and (not (assoc category categories))
3664 (y-or-n-p (format (concat "There is no category \"%s\" in "
3665 "this file; add it? ") category)))
3666 (todos-validate-category-name category)
3667 (todos-add-category category)))
3668 ;; Restore the original value of todos-categories.
3669 (setq todos-categories categories)
3672 (defun todos-validate-category-name (cat)
3673 "Check new category name CAT and when valid return it."
3676 (and (cond ((string= "" cat)
3677 ;; (if todos-categories
3678 ;; (setq prompt "Enter a non-empty category name: ")
3679 ;; Prompt for initial category of a new Todos file.
3680 (setq prompt (concat "Initial category name ["
3681 todos-initial-category "]: ")));)
3682 ((string-match "\\`\\s-+\\'" cat)
3684 "Enter a category name that is not only white space: "))
3685 ;; FIXME: add completion
3686 ((assoc cat todos-categories)
3687 (setq prompt "Enter a non-existing category name: ")))
3688 (setq cat (if todos-categories
3689 (read-from-minibuffer prompt)
3690 ;; Offer default initial category name.
3692 (read-from-minibuffer prompt nil nil t nil
3693 (list todos-initial-category))))))))
3696 ;; (defun todos-read-category (prompt)
3697 ;; "Prompt with PROMPT for an existing category name and return it.
3698 ;; Show completions with TAB or SPC."
3699 ;; ;; Make a copy of todos-categories in case history-delete-duplicates is
3700 ;; ;; non-nil, which makes completing-read alter todos-categories.
3701 ;; (let* ((categories (copy-sequence todos-categories))
3702 ;; (history (cons 'todos-categories (1+ todos-category-number)))
3703 ;; (completion-ignore-case todos-completion-ignore-case)
3704 ;; (category (completing-read prompt todos-categories nil
3705 ;; mustmatch nil history)))
3706 ;; (setq category (completing-read prompt todos-categories nil t))
3707 ;; ;; Restore the original value of todos-categories.
3708 ;; (setq todos-categories categories)
3711 ;; (defun todos-new-category-name (prompt)
3712 ;; "Prompt with PROMPT for a new category name and return it."
3713 ;; (let ((map minibuffer-local-completion-map)
3715 ;; ;; Allow SPC to insert spaces, for adding new category names.
3716 ;; (define-key map " " nil)
3718 ;; ;; Validate entered category name.
3719 ;; (and (cond ((string= "" cat)
3721 ;; (if todos-categories
3722 ;; "Enter a non-empty category name: "
3723 ;; ;; Prompt for initial category of a new Todos file.
3724 ;; (concat "Initial category name ["
3725 ;; todos-initial-category "]: "))))
3726 ;; ((string-match "\\`\\s-+\\'" cat)
3728 ;; "Enter a category name that is not only white space: "))
3729 ;; ((assoc cat todos-categories)
3730 ;; (setq prompt-n "Enter a non-existing category name: ")))
3731 ;; (setq cat (if todos-categories
3732 ;; (read-from-minibuffer prompt)
3733 ;; ;; Offer default initial category name.
3735 ;; (read-from-minibuffer
3736 ;; (or prompt prompt-n) nil nil t nil
3737 ;; (list todos-initial-category))))))
3738 ;; (setq prompt nil)))
3741 ;; ;; Adapted from calendar-read-date and calendar-date-string.
3742 (defun todos-read-date ()
3743 "Prompt for Gregorian date and return it in the current format.
3744 Also accepts `*' as an unspecified month, day, or year."
3745 (let* ((year (calendar-read
3746 ;; FIXME: maybe better like monthname with RET for current month
3747 "Year (>0 or * for any year): "
3748 (lambda (x) (or (eq x '*) (> x 0)))
3749 (number-to-string (calendar-extract-year
3750 (calendar-current-date)))))
3751 (month-array (vconcat calendar-month-name-array (vector "*")))
3752 (abbrevs (vconcat calendar-month-abbrev-array (vector "*")))
3753 (completion-ignore-case t)
3754 (monthname (completing-read
3755 "Month name (RET for current month, * for any month): "
3756 (mapcar 'list (append month-array nil))
3758 (calendar-month-name (calendar-extract-month
3759 (calendar-current-date)) t)))
3760 (month (cdr (assoc-string
3761 monthname (calendar-make-alist month-array nil nil
3763 (last (if (= month 13)
3764 31 ; FIXME: what about shorter months?
3765 (let ((yr (if (eq year '*)
3766 1999 ; FIXME: no Feb. 29
3768 (calendar-last-day-of-month month yr))))
3770 (while (if (numberp day) (or (< day 0) (< last day)) (not (eq day '*)))
3771 (setq day (read-from-minibuffer
3772 (format "Day (1-%d or RET for today or * for any day): " last)
3775 (calendar-extract-day (calendar-current-date))))))
3776 (setq year (if (eq year '*) (symbol-name '*) (number-to-string year)))
3777 (setq day (if (eq day '*) (symbol-name '*) (number-to-string day)))
3778 ;; FIXME: make abbreviation customizable
3780 (or (and (= month 13) "*")
3781 (calendar-month-name (calendar-extract-month (list month day year))
3783 (mapconcat 'eval calendar-date-display-form "")))
3785 (defun todos-read-dayname ()
3786 "Choose name of a day of the week with completion and return it."
3787 (let ((completion-ignore-case t))
3788 (completing-read "Enter a day name: "
3789 (append calendar-day-name-array nil)
3792 (defun todos-read-time ()
3793 "Prompt for and return a valid clock time as a string.
3794 Valid time strings are those matching `diary-time-regexp'."
3797 (setq answer (read-from-minibuffer
3798 "Enter a clock time (or return for none): "))
3799 (when (or (string= "" answer)
3800 (string-match diary-time-regexp answer))
3804 ;;; Sorting and display routines for todos-categories-mode.
3806 (defun todos-display-categories (&optional sortkey)
3807 "Display a table of the current file's categories and item counts.
3809 In the initial display the categories are numbered, indicating
3810 their current order for navigating by \\[todos-forward-category]
3811 and \\[todos-backward-category]. You can persistantly change the
3812 order of the category at point by typing \\[todos-raise-category]
3813 or \\[todos-lower-category].
3815 The labels above the category names and item counts are buttons,
3816 and clicking these changes the display: sorted by category name
3817 or by the respective item counts (alternately descending or
3818 ascending). In these displays the categories are not numbered
3819 and \\[todos-raise-category] and \\[todos-lower-category] are
3820 disabled. (Programmatically, the sorting is triggered by passing
3821 a non-nil SORTKEY argument.)
3823 In addition, the lines with the category names and item counts
3824 are buttonized, and pressing one of these button jumps to the
3825 category in Todos mode (or Todos Archive mode, for categories
3826 containing only archived items, provided user option
3827 `todos-ignore-archived-categories' is non-nil. These categories
3828 are shown in `todos-archived-only' face."
3830 (unless (eq major-mode 'todos-categories-mode)
3831 (setq todos-global-current-todos-file (or todos-current-todos-file
3832 todos-default-todos-file)))
3833 (let* ((cats0 (if (and todos-ignore-archived-categories
3834 (not (eq major-mode 'todos-categories-mode)))
3835 todos-categories-full
3837 (cats (todos-sort cats0 sortkey))
3838 (archive (member todos-current-todos-file todos-archives))
3839 ;; `num' is used by todos-insert-category-line.
3841 (set-window-buffer (selected-window)
3842 (set-buffer (get-buffer-create todos-categories-buffer)))
3843 (let (buffer-read-only)
3845 (kill-all-local-variables)
3846 (todos-categories-mode)
3847 ;; FIXME: add usage tips?
3848 (insert (format "Category counts for Todos file \"%s\"."
3849 (file-name-sans-extension
3850 (file-name-nondirectory todos-current-todos-file))))
3852 ;; Make space for the column of category numbers.
3853 (insert (make-string (+ 4 (length todos-categories-number-separator)) 32))
3854 ;; Add the category and item count buttons (if this is the list of
3855 ;; categories in an archive, show only done item counts).
3857 (todos-insert-sort-button todos-categories-category-label)
3858 (if (member todos-current-todos-file todos-archives)
3859 (insert (concat (make-string 6 32)
3860 (format "%s" todos-categories-archived-label)))
3861 (insert (make-string 3 32))
3862 (todos-insert-sort-button todos-categories-todo-label)
3863 (insert (make-string 2 32))
3864 (todos-insert-sort-button todos-categories-diary-label)
3865 (insert (make-string 2 32))
3866 (todos-insert-sort-button todos-categories-done-label)
3867 (insert (make-string 2 32))
3868 (todos-insert-sort-button todos-categories-archived-label))
3870 ;; Fill in the table with buttonized lines, each showing a category and
3872 (mapc (lambda (cat) (todos-insert-category-line cat sortkey))
3875 ;; Add a line showing item count totals.
3876 (insert (make-string (+ 4 (length todos-categories-number-separator)) 32)
3877 (todos-padded-string todos-categories-totals-label)
3881 (make-string (1+ (/ (length (car elt)) 2)) 32)
3882 (format "%3d" (nth (cdr elt) (todos-total-item-counts)))
3883 ;; Add an extra space if label length is odd (using
3884 ;; definition of oddp from cl.el).
3885 (if (eq (logand (length (car elt)) 1) 1) " ")))
3887 (list (cons todos-categories-done-label 2))
3888 (list (cons todos-categories-todo-label 0)
3889 (cons todos-categories-diary-label 1)
3890 (cons todos-categories-done-label 2)
3891 (cons todos-categories-archived-label 3)))
3893 (setq buffer-read-only t)))
3895 ;; ;; FIXME: make this toggle with todos-display-categories
3896 ;; (defun todos-display-categories-alphabetically ()
3899 ;; (todos-display-sorted 'alpha))
3901 ;; ;; FIXME: provide key bindings for these or delete them
3902 ;; (defun todos-display-categories-sorted-by-todo ()
3905 ;; (todos-display-sorted 'todo))
3907 ;; (defun todos-display-categories-sorted-by-diary ()
3910 ;; (todos-display-sorted 'diary))
3912 ;; (defun todos-display-categories-sorted-by-done ()
3915 ;; (todos-display-sorted 'done))
3917 ;; (defun todos-display-categories-sorted-by-archived ()
3920 ;; (todos-display-sorted 'archived))
3922 (defun todos-longest-category-name-length (categories)
3923 "Return the length of the longest name in list CATEGORIES."
3925 (dolist (c categories longest)
3926 (setq longest (max longest (length c))))))
3928 (defun todos-padded-string (str)
3929 "Return string STR padded with spaces.
3930 The placement of the padding is determined by the value of user
3931 option `todos-categories-align'."
3932 (let* ((categories (mapcar 'car todos-categories))
3933 (len (max (todos-longest-category-name-length categories)
3934 (length todos-categories-category-label)))
3935 (strlen (length str))
3936 (strlen-odd (eq (logand strlen 1) 1)) ; oddp from cl.el
3937 (padding (max 0 (/ (- len strlen) 2)))
3938 (padding-left (cond ((eq todos-categories-align 'left) 0)
3939 ((eq todos-categories-align 'center) padding)
3940 ((eq todos-categories-align 'right)
3941 (if strlen-odd (1+ (* padding 2)) (* padding 2)))))
3942 (padding-right (cond ((eq todos-categories-align 'left)
3943 (if strlen-odd (1+ (* padding 2)) (* padding 2)))
3944 ((eq todos-categories-align 'center)
3945 (if strlen-odd (1+ padding) padding))
3946 ((eq todos-categories-align 'right) 0))))
3947 (concat (make-string padding-left 32) str (make-string padding-right 32))))
3949 (defvar todos-descending-counts nil
3950 "List of keys for category counts sorted in descending order.")
3952 (defun todos-sort (list &optional key)
3953 "Return a copy of LIST, possibly sorted according to KEY."
3954 (let* ((l (copy-sequence list))
3955 (fn (if (eq key 'alpha)
3956 (lambda (x) (upcase x)) ; Alphabetize case insensitively.
3957 (lambda (x) (todos-get-count key x))))
3958 (descending (member key todos-descending-counts))
3959 (cmp (if (eq key 'alpha)
3961 (if descending '< '>)))
3962 (pred (lambda (s1 s2) (let ((t1 (funcall fn (car s1)))
3963 (t2 (funcall fn (car s2))))
3964 (funcall cmp t1 t2)))))
3966 (setq l (sort l pred))
3968 (setq todos-descending-counts
3969 (delete key todos-descending-counts))
3970 (push key todos-descending-counts)))
3973 (defun todos-display-sorted (type)
3974 "Keep point on the TYPE count sorting button just clicked."
3975 (let ((opoint (point)))
3976 (todos-display-categories type)
3977 (goto-char opoint)))
3979 (defun todos-label-to-key (label)
3980 "Return symbol for sort key associated with LABEL."
3982 (cond ((string= label todos-categories-category-label)
3984 ((string= label todos-categories-todo-label)
3986 ((string= label todos-categories-diary-label)
3988 ((string= label todos-categories-done-label)
3990 ((string= label todos-categories-archived-label)
3991 (setq key 'archived)))
3994 (defun todos-insert-sort-button (label)
3995 "Insert button for displaying categories sorted by item counts.
3996 LABEL determines which type of count is sorted."
3997 (setq str (if (string= label todos-categories-category-label)
3998 (todos-padded-string label)
4001 (setq end (+ beg (length str)))
4002 (insert-button str 'face nil
4005 (let ((key (todos-label-to-key ,label)))
4006 (if (and (member key todos-descending-counts)
4009 (todos-display-categories)
4010 (setq todos-descending-counts
4011 (delete key todos-descending-counts)))
4012 (todos-display-sorted key)))))
4013 (setq ovl (make-overlay beg end))
4014 (overlay-put ovl 'face 'todos-button))
4016 (defun todos-total-item-counts ()
4017 "Return a list of total item counts for the current file."
4018 (mapcar (lambda (i) (apply '+ (mapcar (lambda (l) (aref l i))
4019 (mapcar 'cdr todos-categories))))
4022 (defun todos-insert-category-line (cat &optional nonum)
4023 "Insert button displaying category CAT's name and item counts.
4024 With non-nil argument NONUM show only these; otherwise, insert a
4025 number in front of the button indicating the category's priority.
4026 The number and the category name are separated by the string
4027 which is the value of the user option
4028 `todos-categories-number-separator'."
4029 (let* ((archive (member todos-current-todos-file todos-archives))
4030 (str (todos-padded-string cat))
4032 ;; num is declared in caller.
4036 (make-string (+ 4 (length todos-categories-number-separator))
4038 (format " %3d%s" num todos-categories-number-separator))
4040 (mapconcat (lambda (elt)
4042 (make-string (1+ (/ (length (car elt)) 2)) 32) ; label
4043 (format "%3d" (todos-get-count (cdr elt) cat)) ; count
4044 ;; Add an extra space if label length is odd
4045 ;; (using def of oddp from cl.el).
4046 (if (eq (logand (length (car elt)) 1) 1) " ")))
4048 (list (cons todos-categories-done-label 'done))
4049 (list (cons todos-categories-todo-label 'todo)
4050 (cons todos-categories-diary-label 'diary)
4051 (cons todos-categories-done-label 'done)
4052 (cons todos-categories-archived-label
4055 'face (if (and todos-ignore-archived-categories
4056 (zerop (todos-get-count 'todo cat))
4057 (zerop (todos-get-count 'done cat))
4058 (not (zerop (todos-get-count 'archived cat))))
4059 'todos-archived-only
4061 'action `(lambda (button) (let ((buf (current-buffer)))
4062 (todos-jump-to-category ,cat)
4063 (kill-buffer buf))))
4064 ;; Highlight the sorted count column.
4065 (let* ((beg (+ opoint 6 (length str)))
4067 (cond ((eq nonum 'todo)
4068 (setq beg (+ beg 1 (/ (length todos-categories-todo-label) 2))))
4070 (setq beg (+ beg 1 (length todos-categories-todo-label)
4071 2 (/ (length todos-categories-diary-label) 2))))
4073 (setq beg (+ beg 1 (length todos-categories-todo-label)
4074 2 (length todos-categories-diary-label)
4075 2 (/ (length todos-categories-done-label) 2))))
4076 ((eq nonum 'archived)
4077 (setq beg (+ beg 1 (length todos-categories-todo-label)
4078 2 (length todos-categories-diary-label)
4079 2 (length todos-categories-done-label)
4080 2 (/ (length todos-categories-archived-label) 2)))))
4081 (unless (= beg (+ opoint 6 (length str)))
4082 (setq end (+ beg 4))
4083 (setq ovl (make-overlay beg end))
4084 (overlay-put ovl 'face 'todos-sorted-column)))
4089 ;;; todos.el ends here
4091 ;;; necessitated adaptations to diary-lib.el
4093 ;; (defun diary-goto-entry (button)
4094 ;; "Jump to the diary entry for the BUTTON at point."
4095 ;; (let* ((locator (button-get button 'locator))
4096 ;; (marker (car locator))
4097 ;; markbuf file opoint)
4098 ;; ;; If marker pointing to diary location is valid, use that.
4099 ;; (if (and marker (setq markbuf (marker-buffer marker)))
4101 ;; (pop-to-buffer markbuf)
4102 ;; (goto-char (marker-position marker)))
4103 ;; ;; Marker is invalid (eg buffer has been killed, as is the case with
4104 ;; ;; included diary files).
4105 ;; (or (and (setq file (cadr locator))
4106 ;; (file-exists-p file)
4107 ;; (find-file-other-window file)
4109 ;; (when (eq major-mode (default-value 'major-mode)) (diary-mode))
4110 ;; (when (eq major-mode 'todos-mode) (widen))
4111 ;; (goto-char (point-min))
4112 ;; (when (re-search-forward (format "%s.*\\(%s\\)"
4113 ;; (regexp-quote (nth 2 locator))
4114 ;; (regexp-quote (nth 3 locator)))
4116 ;; (goto-char (match-beginning 1))
4117 ;; (when (eq major-mode 'todos-mode)
4118 ;; (setq opoint (point))
4119 ;; (re-search-backward (concat "^"
4120 ;; (regexp-quote todos-category-beg)
4123 ;; (todos-category-number (match-string 1))
4124 ;; (todos-category-select)
4125 ;; (goto-char opoint)))))
4126 ;; (message "Unable to locate this diary entry")))))
HCoop / bpt / emacs.git / blob