(require 'time-stamp)
(defgroup todo nil
"Maintain a list of todo items."
:link '(emacs-commentary-link "todo-mode")
:version "21.1"
:group 'calendar)
(defcustom todo-prefix "*/*"
"*TODO mode prefix for entries.
This is useful in conjunction with `calendar' and `diary' if you use
#include \"~/.todo-do\"
in your diary file to include your todo list file as part of your
diary. With the default value \"*/*\" the diary displays each entry
every day and it may also be marked on every day of the calendar.
Using \"&%%(equal (calendar-current-date) date)\" instead will only
show and mark todo entries for today, but may slow down processing of
the diary file somewhat."
:type 'string
:group 'todo)
(defcustom todo-file-do "~/.todo-do"
"*TODO mode list file."
:type 'file
:group 'todo)
(defcustom todo-file-done "~/.todo-done"
"*TODO mode archive file."
:type 'file
:group 'todo)
(defcustom todo-mode-hook nil
"*TODO mode hooks."
:type 'hook
:group 'todo)
(defcustom todo-edit-mode-hook nil
"*TODO Edit mode hooks."
:type 'hook
:group 'todo)
(defcustom todo-insert-threshold 0
"*TODO mode insertion accuracy.
If you have 8 items in your TODO list, then you may get asked 4
questions by the binary insertion algorithm. However, you may not
really have a need for such accurate priorities amongst your TODO
items. If you now think about the binary insertion halving the size
of the window each time, then the threshold is the window size at
which it will stop. If you set the threshold to zero, the upper and
lower bound will coincide at the end of the loop and you will insert
your item just before that point. If you set the threshold to,
e.g. 8, it will stop as soon as the window size drops below that
amount and will insert the item in the approximate center of that
window."
:type 'integer
:group 'todo)
(defvar todo-edit-buffer " *TODO Edit*"
"TODO Edit buffer name.")
(defcustom todo-file-top "~/.todo-top"
"*TODO mode top priorities file.
Not in TODO format, but diary compatible.
Automatically generated when `todo-save-top-priorities' is non-nil."
:type 'string
:group 'todo)
(defcustom todo-print-function 'ps-print-buffer-with-faces
"*Function to print the current buffer."
:type 'symbol
:group 'todo)
(defcustom todo-show-priorities 1
"*Default number of priorities to show by \\[todo-top-priorities].
0 means show all entries."
:type 'integer
:group 'todo)
(defcustom todo-print-priorities 0
"*Default number of priorities to print by \\[todo-print].
0 means print all entries."
:type 'integer
:group 'todo)
(defcustom todo-remove-separator t
"*Non-nil to remove category separators in\
\\[todo-top-priorities] and \\[todo-print]."
:type 'boolean
:group 'todo)
(defcustom todo-save-top-priorities-too t
"*Non-nil makes `todo-save' automatically save top-priorities in `todo-file-top'."
:type 'boolean
:group 'todo)
(defcustom todo-time-string-format
"%:y-%02m-%02d %02H:%02M"
"*TODO mode time string format for done entries.
For details see the variable `time-stamp-format'."
:type 'string
:group 'todo)
(defcustom todo-entry-prefix-function 'todo-entry-timestamp-initials
"*Function producing text to insert at start of todo entry."
:type 'symbol
:group 'todo)
(defcustom todo-initials (or (getenv "INITIALS") (user-login-name))
"*Initials of todo item author."
:type 'string
:group 'todo)
(defun todo-entry-timestamp-initials ()
"Prepend timestamp and your initials to the head of a TODO entry."
(let ((time-stamp-format todo-time-string-format))
(concat (time-stamp-string) " " todo-initials ": ")))
(defvar todo-categories nil
"TODO categories.")
(defvar todo-cats nil
"Old variable for holding the TODO categories.
Use `todo-categories' instead.")
(defvar todo-previous-line 0
"Previous line asked about.")
(defvar todo-previous-answer 0
"Previous answer got.")
(defvar todo-mode-map
(let ((map (make-keymap)))
(suppress-keymap map t)
(define-key map "+" 'todo-forward-category)
(define-key map "-" 'todo-backward-category)
(define-key map "d" 'todo-file-item) (define-key map "e" 'todo-edit-item)
(define-key map "E" 'todo-edit-multiline)
(define-key map "f" 'todo-file-item)
(define-key map "i" 'todo-insert-item)
(define-key map "I" 'todo-insert-item-here)
(define-key map "j" 'todo-jump-to-category)
(define-key map "k" 'todo-delete-item)
(define-key map "l" 'todo-lower-item)
(define-key map "n" 'todo-forward-item)
(define-key map "p" 'todo-backward-item)
(define-key map "P" 'todo-print)
(define-key map "q" 'todo-quit)
(define-key map "r" 'todo-raise-item)
(define-key map "s" 'todo-save)
(define-key map "S" 'todo-save-top-priorities)
(define-key map "t" 'todo-top-priorities)
map)
"TODO mode keymap.")
(defvar todo-category-number 0 "TODO category number.")
(defvar todo-tmp-buffer-name " *todo tmp*")
(defvar todo-category-sep (make-string 75 ?-)
"Category separator.")
(defvar todo-category-beg " --- "
"Category start separator to be prepended onto category name.")
(defvar todo-category-end "--- End"
"Separator after a category.")
(defvar todo-header "-*- mode: todo; "
"Header of todo files.")
(defun todo-category-select ()
"Make TODO mode display the current category correctly."
(let ((name (nth todo-category-number todo-categories)))
(setq mode-line-buffer-identification
(concat "Category: " (format "%18s" name)))
(widen)
(goto-char (point-min))
(search-forward-regexp
(concat "^"
(regexp-quote (concat todo-prefix todo-category-beg name))
"$"))
(let ((begin (1+ (line-end-position))))
(search-forward-regexp (concat "^" todo-category-end))
(narrow-to-region begin (line-beginning-position))
(goto-char (point-min)))))
(defalias 'todo-cat-slct 'todo-category-select)
(defun todo-forward-category ()
"Go forward to TODO list of next category."
(interactive)
(setq todo-category-number
(mod (1+ todo-category-number) (length todo-categories)))
(todo-category-select))
(defalias 'todo-cmd-forw 'todo-forward-category)
(defun todo-backward-category ()
"Go back to TODO list of previous category."
(interactive)
(setq todo-category-number
(mod (1- todo-category-number) (length todo-categories)))
(todo-category-select))
(defalias 'todo-cmd-back 'todo-backward-category)
(defun todo-backward-item ()
"Select previous entry of TODO list."
(interactive)
(search-backward-regexp (concat "^" (regexp-quote todo-prefix)) nil t)
(message ""))
(defalias 'todo-cmd-prev 'todo-backward-item)
(defun todo-forward-item (&optional count)
"Select COUNT-th next entry of TODO list."
(interactive "P")
(if (listp count) (setq count (car count)))
(end-of-line)
(search-forward-regexp (concat "^" (regexp-quote todo-prefix))
nil 'goto-end count)
(beginning-of-line)
(message ""))
(defalias 'todo-cmd-next 'todo-forward-item)
(defun todo-save ()
"Save the TODO list."
(interactive)
(save-excursion
(save-restriction
(save-buffer)))
(if todo-save-top-priorities-too (todo-save-top-priorities)))
(defalias 'todo-cmd-save 'todo-save)
(defun todo-quit ()
"Done with TODO list for now."
(interactive)
(widen)
(todo-save)
(message "")
(bury-buffer))
(defalias 'todo-cmd-done 'todo-quit)
(defun todo-edit-item ()
"Edit current TODO list entry."
(interactive)
(let ((item (todo-item-string)))
(if (todo-string-multiline-p item)
(todo-edit-multiline)
(let ((new (read-from-minibuffer "Edit: " item)))
(todo-remove-item)
(insert new "\n")
(todo-backward-item)
(message "")))))
(defalias 'todo-cmd-edit 'todo-edit-item)
(defun todo-edit-multiline ()
"Set up a buffer for editing a multiline TODO list entry."
(interactive)
(let ((buffer-name (generate-new-buffer-name todo-edit-buffer)))
(switch-to-buffer
(make-indirect-buffer
(file-name-nondirectory todo-file-do) buffer-name))
(message "To exit, simply kill this buffer and return to list.")
(todo-edit-mode)
(narrow-to-region (todo-item-start) (todo-item-end))))
(defun todo-add-category (cat)
"Add new category CAT to the TODO list."
(interactive "sCategory: ")
(save-window-excursion
(setq todo-categories (cons cat todo-categories))
(find-file todo-file-do)
(widen)
(goto-char (point-min))
(let ((posn (search-forward "-*- mode: todo; " 17 t)))
(if (not (null posn)) (goto-char posn))
(if (equal posn nil)
(progn
(insert "-*- mode: todo; \n")
(forward-char -1))
(kill-line)))
(insert (format "todo-categories: %S; -*-" todo-categories))
(forward-char 1)
(insert (format "%s%s%s\n%s\n%s %s\n"
todo-prefix todo-category-beg cat
todo-category-end
todo-prefix todo-category-sep)))
0)
(defun todo-add-item-non-interactively (new-item category)
"Insert NEW-ITEM in TODO list as a new entry in CATEGORY."
(save-excursion
(todo-show))
(save-excursion
(if (string= "" category)
(setq category (nth todo-category-number todo-categories)))
(let ((cat-exists (member category todo-categories)))
(setq todo-category-number
(if cat-exists
(- (length todo-categories) (length cat-exists))
(todo-add-category category))))
(todo-show)
(setq todo-previous-line 0)
(let ((top 1)
(bottom (1+ (count-lines (point-min) (point-max)))))
(while (> (- bottom top) todo-insert-threshold)
(let* ((current (/ (+ top bottom) 2))
(answer (if (< current bottom)
(todo-more-important-p current) nil)))
(if answer
(setq bottom current)
(setq top (1+ current)))))
(setq top (/ (+ top bottom) 2))
(goto-char (point-min))
(forward-line (1- top)))
(insert new-item "\n")
(todo-backward-item)
(todo-save)
(message "")))
(defun todo-insert-item (arg)
"Insert new TODO list entry.
With a prefix argument solicit the category, otherwise use the current
category."
(interactive "P")
(save-excursion
(if (not (string-equal mode-name "TODO")) (todo-show))
(let* ((new-item (concat todo-prefix " "
(read-from-minibuffer
"New TODO entry: "
(if todo-entry-prefix-function
(funcall todo-entry-prefix-function)))))
(categories todo-categories)
(history (cons 'categories (1+ todo-category-number)))
(current-category (nth todo-category-number todo-categories))
(category
(if arg
current-category
(completing-read (concat "Category [" current-category "]: ")
(todo-category-alist) nil nil nil
history current-category))))
(todo-add-item-non-interactively new-item category))))
(defalias 'todo-cmd-inst 'todo-insert-item)
(defun todo-insert-item-here ()
"Insert new TODO list entry under the cursor."
(interactive "")
(save-excursion
(if (not (string-equal mode-name "TODO")) (todo-show))
(let* ((new-item (concat todo-prefix " "
(read-from-minibuffer
"New TODO entry: "
(if todo-entry-prefix-function
(funcall todo-entry-prefix-function))))))
(insert (concat new-item "\n")))))
(defun todo-more-important-p (line)
"Ask whether entry is more important than the one at LINE."
(if (not (equal todo-previous-line line))
(progn
(setq todo-previous-line line)
(goto-char (point-min))
(forward-line (1- todo-previous-line))
(let ((item (todo-item-string-start)))
(setq todo-previous-answer
(y-or-n-p (concat "More important than '" item "'? "))))))
todo-previous-answer)
(defalias 'todo-ask-p 'todo-more-important-p)
(defun todo-delete-item ()
"Delete current TODO list entry."
(interactive)
(if (> (count-lines (point-min) (point-max)) 0)
(let* ((todo-entry (todo-item-string-start))
(todo-answer (y-or-n-p (concat "Permanently remove '"
todo-entry "'? "))))
(if todo-answer
(progn
(todo-remove-item)
(todo-backward-item)))
(message ""))
(error "No TODO list entry to delete")))
(defalias 'todo-cmd-kill 'todo-delete-item)
(defun todo-raise-item ()
"Raise priority of current entry."
(interactive)
(if (> (count-lines (point-min) (point)) 0)
(let ((item (todo-item-string)))
(todo-remove-item)
(todo-backward-item)
(save-excursion
(insert item "\n"))
(message ""))
(error "No TODO list entry to raise")))
(defalias 'todo-cmd-rais 'todo-raise-item)
(defun todo-lower-item ()
"Lower priority of current entry."
(interactive)
(if (> (count-lines (point) (point-max)) 1)
(let ((item (todo-item-string)))
(todo-remove-item)
(todo-forward-item)
(save-excursion
(insert item "\n"))
(message ""))
(error "No TODO list entry to lower")))
(defalias 'todo-cmd-lowr 'todo-lower-item)
(defun todo-file-item (&optional comment)
"File the current TODO list entry away, annotated with an optional COMMENT."
(interactive "sComment: ")
(or (> (count-lines (point-min) (point-max)) 0)
(error "No TODO list entry to file away"))
(let ((time-stamp-format todo-time-string-format))
(if (and comment (> (length comment) 0))
(progn
(goto-char (todo-item-end))
(insert
(if (save-excursion (beginning-of-line)
(looking-at (regexp-quote todo-prefix)))
" "
"\n\t")
"(" comment ")")))
(goto-char (todo-item-end))
(insert " [" (nth todo-category-number todo-categories) "]")
(goto-char (todo-item-start))
(let ((temp-point (point)))
(if (looking-at (regexp-quote todo-prefix))
(replace-match (time-stamp-string))
(insert (time-stamp-string)))
(append-to-file temp-point (1+ (todo-item-end)) todo-file-done)
(delete-region temp-point (1+ (todo-item-end))))
(todo-backward-item)
(message "")))
(defun todo-top-priorities (&optional nof-priorities category-pr-page)
"List top priorities for each category.
Number of entries for each category is given by NOF-PRIORITIES which
defaults to \'todo-show-priorities\'.
If CATEGORY-PR-PAGE is non-nil, a page separator \'^L\' is inserted
between each category."
(interactive "P")
(or nof-priorities (setq nof-priorities todo-show-priorities))
(if (listp nof-priorities) (setq nof-priorities (car nof-priorities)))
(let ((todo-print-buffer-name todo-tmp-buffer-name)
(todo-category-break (if category-pr-page "" ""))
(cat-end
(concat
(if todo-remove-separator
(concat todo-category-end "\n"
(regexp-quote todo-prefix) " " todo-category-sep "\n")
(concat todo-category-end "\n"))))
beg end)
(todo-show)
(save-excursion
(save-restriction
(widen)
(copy-to-buffer todo-print-buffer-name (point-min) (point-max))
(set-buffer todo-print-buffer-name)
(goto-char (point-min))
(when (re-search-forward (regexp-quote todo-header) nil t)
(beginning-of-line 1)
(delete-region (point) (line-end-position)))
(while (re-search-forward (regexp-quote (concat todo-prefix todo-category-beg))
nil t)
(setq beg (+ (line-end-position) 1)) (re-search-forward cat-end nil t)
(setq end (match-beginning 0))
(replace-match todo-category-break)
(narrow-to-region beg end) (goto-char (point-min))
(if (= 0 nof-priorities) (goto-char end) (todo-forward-item nof-priorities))
(setq beg (point))
(delete-region beg end)
(widen))
(and (looking-at "") (replace-match "")) (goto-char (point-min)) ))
(display-buffer todo-print-buffer-name)
(message "Type C-x 1 to remove %s window. M-C-v to scroll the help."
todo-print-buffer-name)))
(defun todo-save-top-priorities (&optional nof-priorities)
"Save top priorities for each category in `todo-file-top'.
Number of entries for each category is given by NOF-PRIORITIES which
defaults to `todo-show-priorities'."
(interactive "P")
(save-window-excursion
(save-excursion
(save-restriction
(todo-top-priorities nof-priorities)
(set-buffer todo-tmp-buffer-name)
(write-file todo-file-top)
(kill-this-buffer)))))
(defun todo-print (&optional category-pr-page)
"Print todo summary using `todo-print-function'.
If CATEGORY-PR-PAGE is non-nil, a page separator `^L' is inserted
between each category.
Number of entries for each category is given by `todo-print-priorities'."
(interactive "P")
(save-window-excursion
(save-excursion
(save-restriction
(todo-top-priorities todo-print-priorities
category-pr-page)
(set-buffer todo-tmp-buffer-name)
(and (funcall todo-print-function)
(kill-this-buffer))
(message "Todo printing done.")))))
(defun todo-jump-to-category ()
"Jump to a category. Default is previous category."
(interactive)
(let* ((categories todo-categories)
(history (cons 'categories (1+ todo-category-number)))
(default (nth todo-category-number todo-categories))
(category (completing-read
(concat "Category [" default "]: ")
(todo-category-alist) nil nil nil history default)))
(if (string= "" category)
(setq category (nth todo-category-number todo-categories)))
(setq todo-category-number
(if (member category todo-categories)
(- (length todo-categories)
(length (member category todo-categories)))
(todo-add-category category)))
(todo-show)))
(defun todo-line-string ()
"Return current line in buffer as a string."
(buffer-substring (line-beginning-position) (line-end-position)))
(defun todo-item-string-start ()
"Return the start of this TODO list entry as a string."
(let ((item (todo-item-string)))
(if (> (length item) 60)
(setq item (concat (substring item 0 56) "...")))
item))
(defun todo-item-start ()
"Return point at start of current TODO list item."
(save-excursion
(beginning-of-line)
(if (not (looking-at (regexp-quote todo-prefix)))
(search-backward-regexp
(concat "^" (regexp-quote todo-prefix)) nil t))
(point)))
(defun todo-item-end ()
"Return point at end of current TODO list item."
(save-excursion
(end-of-line)
(search-forward-regexp
(concat "^" (regexp-quote todo-prefix)) nil 'goto-end)
(1- (line-beginning-position))))
(defun todo-remove-item ()
"Delete the current entry from the TODO list."
(delete-region (todo-item-start) (1+ (todo-item-end))))
(defun todo-item-string ()
"Return current TODO list entry as a string."
(buffer-substring (todo-item-start) (todo-item-end)))
(defun todo-string-count-lines (string)
"Return the number of lines STRING spans."
(length (split-string string "\n")))
(defun todo-string-multiline-p (string)
"Return non-nil if STRING spans several lines."
(> (todo-string-count-lines string) 1))
(defun todo-category-alist ()
"Generate an alist for use in `completing-read' from `todo-categories'."
(mapcar #'list todo-categories))
(easy-menu-define todo-menu todo-mode-map "Todo Menu"
'("Todo"
["Next category" todo-forward-category t]
["Previous category" todo-backward-category t]
["Jump to category" todo-jump-to-category t]
["Show top priority items" todo-top-priorities t]
["Print categories" todo-print t]
"---"
["Edit item" todo-edit-item t]
["File item" todo-file-item t]
["Insert new item" todo-insert-item t]
["Insert item here" todo-insert-item-here t]
["Kill item" todo-delete-item t]
"---"
["Lower item priority" todo-lower-item t]
["Raise item priority" todo-raise-item t]
"---"
["Next item" todo-forward-item t]
["Previous item" todo-backward-item t]
"---"
["Save" todo-save t]
["Save Top Priorities" todo-save-top-priorities t]
"---"
["Quit" todo-quit t]
))
(defun todo-mode ()
"Major mode for editing TODO lists.
\\{todo-mode-map}"
(interactive)
(kill-all-local-variables)
(setq major-mode 'todo-mode)
(setq mode-name "TODO")
(use-local-map todo-mode-map)
(easy-menu-add todo-menu)
(run-mode-hooks 'todo-mode-hook))
(eval-when-compile
(defvar date)
(defvar entry))
(defun todo-cp ()
"Make a diary entry appear only in the current date's diary."
(if (equal (calendar-current-date) date)
entry))
(define-derived-mode todo-edit-mode text-mode "TODO Edit"
"Major mode for editing items in the TODO list.
\\{todo-edit-mode-map}")
(defun todo-show ()
"Show TODO list."
(interactive)
(if (file-exists-p todo-file-do)
(find-file todo-file-do)
(todo-initial-setup))
(if (null todo-categories)
(if (null todo-cats)
(error "Error in %s: No categories in list `todo-categories'"
todo-file-do)
(goto-char (point-min))
(and (search-forward "todo-cats:" nil t)
(replace-match "todo-categories:"))
(make-local-variable 'todo-categories)
(setq todo-categories todo-cats)))
(beginning-of-line)
(todo-category-select))
(defun todo-initial-setup ()
"Set up things to work properly in TODO mode."
(find-file todo-file-do)
(erase-buffer)
(todo-mode)
(todo-add-category "Todo"))
(provide 'todo-mode)