;;; todo-mode.el --- major mode for editing TODO list files
-;; Copyright (C) 1997, 1999, 2001, 2002, 2003, 2004, 2005, 2006, 2007
-;; Free Software Foundation, Inc.
+;; Copyright (C) 1997, 1999, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
+;; 2008, 2009, 2010 Free Software Foundation, Inc.
-;; Author: Oliver Seidel <os10000@seidel-space.de>
-;; [Not clear the above works, July 2000]
+;; Author: Oliver Seidel <privat@os10000.net>
+;; Maintainer: Stephen Berman <stephen.berman@gmx.net>
;; Created: 2 Aug 1997
;; Keywords: calendar, todo
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;; ---------------------------------------------------------------------------
;;
;; Preface, Quickstart Installation
;;
-;; To get this to work, make emacs execute the line
+;; To get this to work, make Emacs execute the line
;;
;; (autoload 'todo-mode "todo-mode"
;; "Major mode for editing TODO lists." t)
;; the addition of two bindings to your to your global keymap. I
;; personally have the following in my initialisation file:
;;
-;; (global-set-key "\C-ct" 'todo-show) ;; switch to TODO buffer
-;; (global-set-key "\C-ci" 'todo-insert-item) ;; insert new item
+;; (global-set-key "\C-ct" 'todo-show) ; switch to TODO buffer
+;; (global-set-key "\C-ci" 'todo-insert-item) ; insert new item
;;
;; Note, however, that this recommendation has prompted some
;; criticism, since the keys C-c LETTER are reserved for user
;; 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 centre of that window. I
+;; insert the item in the approximate center of that window. I
;; got the idea for this feature after reading a very helpful
;; e-mail reply from Trey Jackson <trey@cs.berkeley.edu> who
;; corrected some of my awful coding and pointed me towards some
;; o GNATS support
;; o elide multiline (as in bbdb, or, to a lesser degree, in
;; outline mode)
-;; o rewrite complete package to store data as lisp objects
+;; o rewrite complete package to store data as Lisp objects
;; and have display modes for display, for diary export,
;; etc. (Richard Stallman pointed out this is a bad idea)
;; o so base todo-mode.el on generic-mode.el instead
:group 'calendar)
(defcustom todo-prefix "*/*"
- "*TODO mode prefix for entries.
+ "TODO mode prefix for entries.
This is useful in conjunction with `calendar' and `diary' if you use
the diary file somewhat."
:type 'string
:group 'todo)
-(defcustom todo-file-do "~/.todo-do"
- "*TODO mode list file."
+(defcustom todo-file-do (convert-standard-filename "~/.todo-do")
+ "TODO mode list file."
:type 'file
:group 'todo)
-(defcustom todo-file-done "~/.todo-done"
- "*TODO mode archive file."
+(defcustom todo-file-done (convert-standard-filename "~/.todo-done")
+ "TODO mode archive file."
:type 'file
:group 'todo)
(defcustom todo-mode-hook nil
- "*TODO mode hooks."
+ "TODO mode hooks."
:type 'hook
:group 'todo)
(defcustom todo-edit-mode-hook nil
- "*TODO Edit mode hooks."
+ "TODO Edit mode hooks."
:type 'hook
:group 'todo)
(defcustom todo-insert-threshold 0
- "*TODO mode insertion accuracy.
+ "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
:group 'todo)
(defvar todo-edit-buffer " *TODO Edit*"
"TODO Edit buffer name.")
-(defcustom todo-file-top "~/.todo-top"
- "*TODO mode top priorities file.
+(defcustom todo-file-top (convert-standard-filename "~/.todo-top")
+ "TODO mode top priorities file.
Not in TODO format, but diary compatible.
Automatically generated when `todo-save-top-priorities' is non-nil."
:group 'todo)
(defcustom todo-print-function 'ps-print-buffer-with-faces
- "*Function to print the current buffer."
+ "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].
+ "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].
+ "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\
+ "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'."
+ "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.
+ "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."
+ "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."
+ "Initials of todo item author."
:type 'string
:group 'todo)
(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 "")))))
+ (if (< (point-min) (point-max))
+ (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 ""))))
+ (error "No TODO list entry to edit")))
(defalias 'todo-cmd-edit 'todo-edit-item)
(defun todo-edit-multiline ()
(narrow-to-region (todo-item-start) (todo-item-end))))
;;;###autoload
-(defun todo-add-category (cat)
+(defun todo-add-category (&optional 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)
+ (interactive)
+ (let ((buf (find-file-noselect todo-file-do t))
+ (prompt "Category: "))
+ (unless (zerop (buffer-size buf))
+ (and (null todo-categories)
+ (null todo-cats)
+ (error "Error in %s: File is non-empty but contains no category"
+ todo-file-do)))
+ (unless cat (setq cat (read-from-minibuffer prompt)))
+ (with-current-buffer buf
+ ;; reject names that could induce bugs and confusion
+ (while (and (cond ((string= "" cat)
+ (setq prompt "Enter a non-empty category name: "))
+ ((string-match "\\`\\s-+\\'" cat)
+ (setq prompt "Enter a category name that is not only white space: "))
+ ((member cat todo-categories)
+ (setq prompt "Enter a non-existing category name: ")))
+ (setq cat (read-from-minibuffer prompt))))
+ ;; initialize a newly created Todo buffer for Todo mode
+ (unless (file-exists-p todo-file-do) (todo-mode))
+ (setq todo-categories (cons cat todo-categories))
+ (widen)
+ (goto-char (point-min))
+ (if (search-forward "-*- mode: todo; " (+ (point-min) 16) t)
+ (kill-line)
+ (insert "-*- mode: todo; \n")
+ (forward-char -1))
+ (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))
+ (if (called-interactively-p 'interactive)
+ ;; properly display the newly added category
+ (progn (setq todo-category-number 0) (todo-show))
+ 0))))
;;;###autoload
(defun todo-add-item-non-interactively (new-item category)
(setq bottom current)
(setq top (1+ current)))))
(setq top (/ (+ top bottom) 2))
- ;; goto-line doesn't have the desired behavior in a narrowed buffer
+ ;; goto-line doesn't have the desired behavior in a narrowed buffer.
(goto-char (point-min))
(forward-line (1- top)))
(insert new-item "\n")
;;;###autoload
(defun todo-insert-item (arg)
"Insert new TODO list entry.
-With a prefix argument solicit the category, otherwise use the current
+With a prefix argument ARG solicit the category, otherwise use the current
category."
(interactive "P")
(save-excursion
- (if (not (string-equal mode-name "TODO")) (todo-show))
+ (if (not (derived-mode-p 'todo-mode)) (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))))
+ (category (if arg (todo-completing-read) 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")))))
+ "Insert a new TODO list entry directly above the entry at point.
+If point is on an empty line, insert the entry there."
+ (interactive)
+ (if (not (derived-mode-p 'todo-mode)) (todo-show))
+ (let ((new-item (concat todo-prefix " "
+ (read-from-minibuffer
+ "New TODO entry: "
+ (if todo-entry-prefix-function
+ (funcall todo-entry-prefix-function))))))
+ (unless (and (bolp) (eolp)) (todo-item-start))
+ (insert (concat new-item "\n"))
+ (backward-char)
+ ;; put point at start of new entry
+ (todo-item-start)))
(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 "'? "))))))
+ (unless (equal todo-previous-line line)
+ (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)
(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)))
+ (when todo-answer
+ (todo-remove-item)
+ (todo-backward-item))
(message ""))
(error "No TODO list entry to delete")))
(defalias 'todo-cmd-kill 'todo-delete-item)
(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 ")")))
+ (when (and comment (> (length comment) 0))
+ (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))
+ (todo-item-start)
(let ((temp-point (point)))
(if (looking-at (regexp-quote todo-prefix))
(replace-match (time-stamp-string))
;; Standard prefix -> timestamp
;; Else prefix non-standard item start with timestamp
(insert (time-stamp-string)))
- (append-to-file temp-point (1+ (todo-item-end)) todo-file-done)
- (delete-region temp-point (1+ (todo-item-end))))
+ (append-to-file temp-point (todo-item-end 'include-sep) todo-file-done)
+ (delete-region temp-point (todo-item-end 'include-sep)))
(todo-backward-item)
(message "")))
;;;###autoload
-(defun todo-top-priorities (&optional nof-priorities category-pr-page)
+(defun todo-top-priorities (&optional nof-priorities category-pr-page
+ interactive)
"List top priorities for each category.
Number of entries for each category is given by NOF-PRIORITIES which
-defaults to \'todo-show-priorities\'.
+defaults to `todo-show-priorities'.
If CATEGORY-PR-PAGE is non-nil, a page separator \'^L\' is inserted
-between each category."
+between each category.
+INTERACTIVE should be non-nil if this function is called interactively."
- (interactive "P")
+ (interactive "P\ni\nP")
(or nof-priorities (setq nof-priorities todo-show-priorities))
(if (listp nof-priorities) ;universal argument
(setq nof-priorities (car nof-priorities)))
(regexp-quote todo-prefix) " " todo-category-sep "\n")
(concat todo-category-end "\n"))))
beg end)
- (todo-show)
(save-excursion
+ (todo-show)
(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 ;Find category start
- (regexp-quote (concat todo-prefix todo-category-beg))
- nil t)
- (setq beg (+ (line-end-position) 1)) ;Start of first entry.
- (re-search-forward cat-end nil t)
- (setq end (match-beginning 0))
- (replace-match todo-category-break)
- (narrow-to-region beg end) ;In case we have too few entries.
- (goto-char (point-min))
- (if (= 0 nof-priorities) ;Traverse entries.
- (goto-char end) ;All entries
- (todo-forward-item nof-priorities))
- (setq beg (point))
- (delete-region beg end)
- (widen))
- (and (looking-at "\f") (replace-match "")) ;Remove trailing form-feed.
- (goto-char (point-min)) ;Due to display buffer
- ))
- ;; Could have used switch-to-buffer as it has a norecord argument,
- ;; which is nice when we are called from e.g. todo-print.
- ;; Else we could have used pop-to-buffer.
- (display-buffer todo-print-buffer-name)
+ (save-current-buffer
+ (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 ;Find category start
+ (regexp-quote (concat todo-prefix todo-category-beg))
+ nil t)
+ (setq beg (+ (line-end-position) 1)) ;Start of first entry.
+ (re-search-forward cat-end nil t)
+ (setq end (match-beginning 0))
+ (replace-match todo-category-break)
+ (narrow-to-region beg end) ;In case we have too few entries.
+ (goto-char (point-min))
+ (if (zerop nof-priorities) ;Traverse entries.
+ (goto-char end) ;All entries
+ (todo-forward-item nof-priorities))
+ (setq beg (point))
+ (delete-region beg end)
+ (widen))
+ (and (looking-at "\f") (replace-match "")) ;Remove trailing form-feed.
+ (goto-char (point-min)) ;Due to display buffer
+ )))
+ (when interactive (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-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)))
+ (let ((category (todo-completing-read)))
(if (string= "" category)
(setq category (nth todo-category-number todo-categories)))
(setq todo-category-number
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."
+ "Go to start of current TODO list item and return point."
+ (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 (&optional include-sep)
+ "Return point at end of current TODO list item.
+If INCLUDE-SEP is non-nil, return point after the separator."
(save-excursion
(end-of-line)
- (search-forward-regexp
- (concat "^" (regexp-quote todo-prefix)) nil 'goto-end)
- (1- (line-beginning-position))))
+ (if (search-forward-regexp
+ (concat "^" (regexp-quote todo-prefix)) nil 'goto-end)
+ (goto-char (match-beginning 0)))
+ (unless include-sep (skip-chars-backward "\n"))
+ (point)))
(defun todo-remove-item ()
"Delete the current entry from the TODO list."
- (delete-region (todo-item-start) (1+ (todo-item-end))))
+ (delete-region (todo-item-start) (todo-item-end 'include-sep)))
(defun todo-item-string ()
"Return current TODO list entry as a 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))
+(defun todo-completing-read ()
+ "Return a category name, with completion, for use in Todo mode."
+ ;; make a copy of todo-categories in case history-delete-duplicates is
+ ;; non-nil, which makes completing-read alter todo-categories
+ (let* ((categories (copy-sequence todo-categories))
+ (history (cons 'todo-categories (1+ todo-category-number)))
+ (default (nth todo-category-number todo-categories))
+ (category (completing-read
+ (concat "Category [" default "]: ")
+ todo-categories nil nil nil history default)))
+ ;; restore the original value of todo-categories
+ (setq todo-categories categories)
+ category))
;; ---------------------------------------------------------------------------
(easy-menu-add todo-menu)
(run-mode-hooks 'todo-mode-hook))
-(eval-when-compile
- (defvar date)
- (defvar entry))
+(defvar date)
+(defvar entry)
;; t-c should be used from diary code, which requires calendar.
-(declare-function calendar-current-date "calendar" nil)
+(declare-function calendar-current-date "calendar" (&optional offset))
;; Read about this function in the setup instructions above!
;;;###autoload
(defun todo-show ()
"Show TODO list."
(interactive)
- (if (file-exists-p todo-file-do)
+ ;; Call todo-initial-setup only if there is neither a Todo file nor
+ ;; a corresponding unsaved buffer.
+ (if (or (file-exists-p todo-file-do)
+ (let* ((buf (get-buffer (file-name-nondirectory todo-file-do)))
+ (bufname (buffer-file-name buf)))
+ (equal (expand-file-name todo-file-do) bufname)))
(find-file todo-file-do)
(todo-initial-setup))
(if (null todo-categories)
(provide 'todo-mode)
-;;; arch-tag: 6fd91be5-776e-4464-a109-da4ea0e4e497
+;; arch-tag: 6fd91be5-776e-4464-a109-da4ea0e4e497
;;; todo-mode.el ends here
HCoop / bpt / emacs.git / blobdiff