;;; Todos.el --- facilities for making and maintaining Todo lists
-;; Copyright (C) 1997, 1999, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 1999, 2001-2012 Free Software Foundation, Inc.
;; Author: Oliver Seidel <privat@os10000.net>
;; Stephen Berman <stephen.berman@gmx.net>
;; Created: 2 Aug 1997
;; Keywords: calendar, todo
-;; This file is part of GNU Emacs.
+;; This file is [not yet] part of GNU Emacs.
;; 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
;;; Commentary:
-;; UI
-;; - display
-;; - show todos in cat
-;; - show done in cat
-;; - show catlist
-;; - show top priorities in all cats
-;; - show archived
-;; - navigation
-;; -
-;; - editing
-;;
-;; Internals
-;; - cat props: name, number, todos, done, archived
-;; - item props: priority, date-time, status?
-;; - file format
-;; - cat begin
-;; - todo items 0...n
-;; - empty line
-;; - done-separator
-;; - done item 0...n
-
;;; Code:
(require 'diary-lib)
+;; For remove-duplicates in todos-insertion-commands-args.
+(eval-when-compile (require 'cl))
;; ---------------------------------------------------------------------------
;;; User options
(defgroup todos nil
"Create and maintain categorized lists of todo items."
:link '(emacs-commentary-link "todos")
- :version "24.1"
+ :version "24.2"
:group 'calendar)
+(defcustom todos-files-directory (locate-user-emacs-file "todos/")
+ "Directory where user's Todos files are saved."
+ :type 'directory
+ :group 'todos)
+
+(defun todos-files (&optional archives)
+ "Default value of `todos-files-function'.
+This returns the case-insensitive alphabetically sorted list of
+file truenames in `todos-files-directory' with the extension
+\".todo\". With non-nil ARCHIVES return the list of archive file
+truenames (those with the extension \".toda\")."
+ (let ((files (if (file-exists-p todos-files-directory)
+ (mapcar 'file-truename
+ (directory-files todos-files-directory t
+ (if archives "\.toda$" "\.todo$") t)))))
+ (sort files (lambda (s1 s2) (let ((cis1 (upcase s1))
+ (cis2 (upcase s2)))
+ (string< cis1 cis2))))))
+
+(defcustom todos-files-function 'todos-files
+ "Function returning the value of the variable `todos-files'.
+This function should take an optional argument that, if non-nil,
+makes it return the value of the variable `todos-archives'."
+ :type 'function
+ :group 'todos)
+
+(defun todos-short-file-name (file)
+ "Return short form of Todos FILE.
+This lacks the extension and directory components."
+ (file-name-sans-extension (file-name-nondirectory file)))
+
+(defcustom todos-default-todos-file (car (funcall todos-files-function))
+ "Todos file visited by first session invocation of `todos-show'."
+ :type `(radio ,@(mapcar (lambda (f) (list 'const f))
+ (mapcar 'todos-short-file-name
+ (funcall todos-files-function))))
+ :group 'todos)
+
+;; FIXME: is there a better alternative to this?
+(defun todos-reevaluate-default-file-defcustom ()
+ "Reevaluate defcustom of `todos-default-todos-file'.
+Called after adding or deleting a Todos file."
+ (eval (defcustom todos-default-todos-file (car (funcall todos-files-function))
+ "Todos file visited by first session invocation of `todos-show'."
+ :type `(radio ,@(mapcar (lambda (f) (list 'const f))
+ (mapcar 'todos-short-file-name
+ (funcall todos-files-function))))
+ :group 'todos)))
+
+(defcustom todos-show-current-file t
+ "Non-nil to make `todos-show' visit the current Todos file.
+Otherwise, `todos-show' always visits `todos-default-todos-file'."
+ :type 'boolean
+ :initialize 'custom-initialize-default
+ :set 'todos-toggle-show-current-file
+ :group 'todos)
+
+(defun todos-toggle-show-current-file (symbol value)
+ "The :set function for user option `todos-show-current-file'."
+ (custom-set-default symbol value)
+ (if value
+ (add-hook 'pre-command-hook 'todos-show-current-file nil t)
+ (remove-hook 'pre-command-hook 'todos-show-current-file t)))
+
+(defcustom todos-visit-files-commands (list 'find-file 'dired-find-file)
+ "List of commands to visit files for `todos-after-find-file'.
+Invoking these commands to visit a Todos or Todos Archive file
+calls `todos-show' or `todos-show-archive', so that the file is
+displayed correctly."
+ :type '(repeat function)
+ :group 'todos)
+
+(defcustom todos-initial-file "Todo"
+ "Default file name offered on adding first Todos file."
+ :type 'string
+ :group 'todos)
+
(defcustom todos-initial-category "Todo"
"Default category name offered on initializing a new Todos file."
:type 'string
:set 'todos-reset-prefix
:group 'todos)
+(defun todos-reset-prefix (symbol value)
+ "The :set function for `todos-prefix' and `todos-number-prefix'."
+ (let ((oldvalue (symbol-value symbol))
+ (files (append todos-files todos-archives)))
+ (custom-set-default symbol value)
+ (when (not (equal value oldvalue))
+ (dolist (f files)
+ (with-current-buffer (find-file-noselect f)
+ (save-window-excursion
+ (todos-show)
+ (save-excursion
+ (widen)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (remove-overlays (point) (point)); 'before-string prefix)
+ (forward-line)))
+ ;; Activate the new setting (save-restriction does not help).
+ (save-excursion (todos-category-select))))))))
+
;; FIXME: Update when window-width changes. Add todos-reset-separator to
;; window-configuration-change-hook in todos-mode? But this depends on the
;; value being window-width instead of a constant length.
-(defcustom todos-done-separator (make-string (window-width) ?-)
+(defcustom todos-done-separator (make-string (window-width) ?_)
"String used to visual separate done from not done items.
Displayed in a before-string overlay by `todos-toggle-view-done-items'."
:type 'string
:initialize 'custom-initialize-default
- :set 'todos-reset-prefix
+ :set 'todos-reset-separator
:group 'todos)
+;; (defun todos-reset-separator (symbol value)
+;; "The :set function for `todos-done-separator'
+;; Also added to `window-configuration-change-hook' in Todos mode."
+;; (let ((oldvalue (symbol-value symbol)))
+;; (custom-set-default symbol value)
+;; (when (not (equal value oldvalue))
+;; (make-string (window-width) ?_)
+;; ;; (save-excursion (todos-category-select))
+;; )))
+
(defcustom todos-done-string "DONE "
"Identifying string appended to the front of done todos items."
:type 'string
:set 'todos-reset-done-string
:group 'todos)
+(defun todos-reset-done-string (symbol value)
+ "The :set function for user option `todos-done-string'."
+ (let ((oldvalue (symbol-value symbol))
+ (files (append todos-files todos-archives)))
+ (custom-set-default symbol value)
+ ;; Need to reset this to get font-locking right.
+ (setq todos-done-string-start
+ (concat "^\\[" (regexp-quote todos-done-string)))
+ (when (not (equal value oldvalue))
+ (dolist (f files)
+ (with-current-buffer (find-file-noselect f)
+ (let (buffer-read-only)
+ (widen)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (if (re-search-forward
+ (concat "^" (regexp-quote todos-nondiary-start)
+ "\\(" (regexp-quote oldvalue) "\\)")
+ nil t)
+ (replace-match value t t nil 1)
+ (forward-line)))
+ (todos-category-select)))))))
+
(defcustom todos-comment-string "COMMENT"
"String inserted before optional comment appended to done item."
:type 'string
:set 'todos-reset-comment-string
:group 'todos)
+(defun todos-reset-comment-string (symbol value)
+ "The :set function for user option `todos-comment-string'."
+ (let ((oldvalue (symbol-value symbol))
+ (files (append todos-files todos-archives)))
+ (custom-set-default symbol value)
+ (when (not (equal value oldvalue))
+ (dolist (f files)
+ (with-current-buffer (find-file-noselect f)
+ (let (buffer-read-only)
+ (save-excursion
+ (widen)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (if (re-search-forward
+ (concat
+ "\\[\\(" (regexp-quote oldvalue) "\\): [^]]*\\]")
+ nil t)
+ (replace-match value t t nil 1)
+ (forward-line)))
+ (todos-category-select))))))))
+
(defcustom todos-show-with-done nil
"Non-nil to display done items in all categories."
:type 'boolean
Argument CAT is the name of the current Todos category.
This function is the value of the user variable
`todos-mode-line-function'."
- (let ((file (file-name-sans-extension
- (file-name-nondirectory todos-current-todos-file))))
- (format "%s category %d: %s" file todos-category-number cat)))
+ (let ((file (todos-short-file-name todos-current-todos-file)))
+ (format "%s category %d: %s" file todos-category-number cat)))
(defcustom todos-mode-line-function 'todos-mode-line-control
"Function that returns a mode line control for Todos buffers.
-The function is expected to take one argument that holds the name
-of the current Todos category. The resulting control becomes the
-local value of `mode-line-buffer-identification' in each Todos
-buffer."
- :type 'function
- :group 'todos)
-
-(defcustom todos-files-directory (locate-user-emacs-file "todos/")
- "Directory where user's Todos files are saved."
- :type 'directory
- :group 'todos)
-
-(defun todos-files (&optional archives)
- "Default value of `todos-files-function'.
-This returns the case-insensitive alphabetically sorted list of
-file truenames in `todos-files-directory' with the extension
-\".todo\". With non-nil ARCHIVES return the list of archive file
-truenames (those with the extension \".toda\")."
- (let ((files (mapcar 'file-truename
- (directory-files todos-files-directory t
- (if archives "\.toda$" "\.todo$") t))))
- (sort files (lambda (s1 s2) (let ((cis1 (upcase s1))
- (cis2 (upcase s2)))
- (string< cis1 cis2))))))
-
-(defcustom todos-files-function 'todos-files
- "Function returning the value of the variable `todos-files'.
-This function should take an optional argument that, if non-nil,
-makes it return the value of the variable `todos-archives'."
- :type 'function
- :group 'todos)
-
-(defcustom todos-filter-function nil
- ""
+The function expects one argument holding the name of the current
+Todos category. The resulting control becomes the local value of
+`mode-line-buffer-identification' in each Todos buffer."
:type 'function
:group 'todos)
-(defcustom todos-priorities-rules (list)
- "List of rules for choosing top priorities of each Todos file.
-The rules should be set interactively by invoking
-`todos-set-top-priorities'.
-
-Each rule is a list whose first element is a member of
-`todos-files', whose second element is a number specifying the
-default number of top priority items for the categories in that
-file, and whose third element is an alist whose elements are
-conses of a category name in that file and the number of top
-priority items in that category that `todos-top-priorities' shows
-by default, which overrides the number for the file."
- :type 'list
- :group 'todos)
-
-(defcustom todos-merged-files nil
- "List of files for `todos-merged-top-priorities'."
- :type `(set ,@(mapcar (lambda (x) (list 'const x))
- (funcall todos-files-function)))
- :group 'todos)
-
-(defcustom todos-prompt-merged-files nil
- "Non-nil to prompt for merging files for `todos-filter-items'."
- :type 'boolean
- :group 'todos)
-
-(defcustom todos-show-current-file t
- "Non-nil to make `todos-show' visit the current Todos file.
-Otherwise, `todos-show' always visits `todos-default-todos-file'."
- :type 'boolean
- :initialize 'custom-initialize-default
- :set 'todos-toggle-show-current-file
- :group 'todos)
-
-;; FIXME: omit second sentence from doc string?
-(defcustom todos-default-todos-file (car (funcall todos-files-function))
- "Todos file visited by first session invocation of `todos-show'.
-Normally this should be set by invoking `todos-change-default-file'
-either directly or as a side effect of `todos-add-file'."
- :type `(radio ,@(mapcar (lambda (x) (list 'const x))
- (funcall todos-files-function)))
- :group 'todos)
-
-(defcustom todos-visit-files-commands (list 'find-file 'dired-find-file)
- "List of commands to visit files for `todos-after-find-file'.
-Invoking these commands to visit a Todos or Todos Archive file
-calls `todos-show' or `todos-show-archive', so that the file is
-displayed correctly."
- :type '(repeat function)
- :group 'todos)
-
-(defcustom todos-categories-buffer "*Todos Categories*"
- "Name of buffer displayed by `todos-display-categories'."
+(defun todos-special-buffer-name (buffer-type file-list)
+ "Rename Todos special buffer.
+The new name is concatenated from the string BUFFER-TYPE and the
+names of the files in FILE-LIST. Used in the mode-list of
+buffers displaying top priorities, diary items, regexp items
+etc. for single and multiple files."
+ (let* ((flist (if (listp file-list) file-list (list file-list)))
+ (multi (> (length flist) 1))
+ (fnames (mapconcat (lambda (f) (todos-short-file-name f))
+ flist ", ")))
+ (rename-buffer (format (concat "%s for file" (if multi "s" "")
+ " \"%s\"") buffer-type fnames))))
+
+(defcustom todos-filter-buffer "Todos filtered items"
+ "Initial name of buffer in Todos Filter mode."
:type 'string
:group 'todos)
-(defcustom todos-categories-category-label "Category"
- "Category button label in `todos-categories-buffer'."
+(defcustom todos-top-priorities-buffer "Todos top priorities"
+ "Name of buffer displaying top priorities in Todos Filter mode."
:type 'string
:group 'todos)
-(defcustom todos-categories-todo-label "Todo"
- "Todo button label in `todos-categories-buffer'."
+(defcustom todos-diary-items-buffer "Todos diary items"
+ "Name of buffer displaying diary items in Todos Filter mode."
:type 'string
:group 'todos)
-(defcustom todos-categories-diary-label "Diary"
- "Diary button label in `todos-categories-buffer'."
+(defcustom todos-regexp-items-buffer "Todos regexp items"
+ "Name of buffer displaying regexp items in Todos Filter mode."
:type 'string
:group 'todos)
-(defcustom todos-categories-done-label "Done"
- "Done button label in `todos-categories-buffer'."
+(defcustom todos-custom-items-buffer "Todos custom items"
+ "Name of buffer displaying custom items in Todos Filter mode."
:type 'string
:group 'todos)
-(defcustom todos-categories-archived-label "Archived"
- "Archived button label in `todos-categories-buffer'."
- :type 'string
+(defcustom todos-priorities-rules nil
+ "List of rules giving how many items `todos-top-priorities' shows.
+This variable should be set interactively by
+`\\[todos-set-top-priorities-in-file]' or
+`\\[todos-set-top-priorities-in-category]'.
+
+Each rule is a list of the form (FILE NUM ALIST), where FILE is a
+member of `todos-files', NUM is a number specifying the default
+number of top priority items for each category in that file, and
+ALIST, when non-nil, consists of conses of a category name in
+FILE and a number specifying the default number of top priority
+items in that category, which overrides NUM."
+ :type 'list
:group 'todos)
-(defcustom todos-categories-totals-label "Totals"
- "String to label total item counts in `todos-categories-buffer'."
- :type 'string
+(defcustom todos-show-priorities 1
+ "Default number of top priorities shown by `todos-top-priorities'."
+ :type 'integer
:group 'todos)
-(defcustom todos-categories-number-separator " | "
- "String between number and category in `todos-categories-buffer'.
-This separates the number from the category name in the default
-categories display according to priority."
- :type 'string
+(defcustom todos-filter-function nil
+ ""
+ :type 'function
:group 'todos)
-(defcustom todos-categories-align 'center
- "Alignment of category names in `todos-categories-buffer'."
- :type '(radio (const left) (const center) (const right))
+(defcustom todos-filter-files nil
+ "List of default files for multifile item filtering."
+ :type `(set ,@(mapcar (lambda (f) (list 'const f))
+ (mapcar 'todos-short-file-name
+ (funcall todos-files-function))))
:group 'todos)
+;; FIXME: is there a better alternative to this?
+(defun todos-reevaluate-filter-files-defcustom ()
+ "Reevaluate defcustom of `todos-filter-files'.
+Called after adding or deleting a Todos file."
+ (eval (defcustom todos-filter-files nil
+ "List of files for multifile item filtering."
+ :type `(set ,@(mapcar (lambda (f) (list 'const f))
+ (mapcar 'todos-short-file-name
+ (funcall todos-files-function))))
+ :group 'todos)))
+
(defcustom todos-ignore-archived-categories nil
"Non-nil to ignore categories with only archived items.
When non-nil such categories are omitted from `todos-categories'
:set 'todos-reset-categories
:group 'todos)
-;; FIXME
-(defcustom todos-edit-buffer "*Todos Edit*"
- "Name of current buffer in Todos Edit mode."
- :type 'string
- :group 'todos)
-
-;; (defcustom todos-edit-buffer "*Todos Top Priorities*"
-;; "TODO Edit buffer name."
-;; :type 'string
-;; :group 'todos)
-
-;; (defcustom todos-edit-buffer "*Todos Diary Entries*"
-;; "TODO Edit buffer name."
-;; :type 'string
-;; :group 'todos)
+(defun todos-reset-categories (symbol value)
+ "The :set function for `todos-ignore-archived-categories'."
+ (custom-set-default symbol value)
+ (dolist (f (funcall todos-files-function))
+ (with-current-buffer (find-file-noselect f)
+ (if value
+ (setq todos-categories-full todos-categories
+ todos-categories (todos-truncate-categories-list))
+ (setq todos-categories todos-categories-full
+ todos-categories-full nil))
+ (todos-category-select))))
(defcustom todos-use-only-highlighted-region t
"Non-nil to enable inserting only highlighted region as new item."
:initialize 'custom-initialize-default
:set 'todos-reset-nondiary-marker)
+(defun todos-reset-nondiary-marker (symbol value)
+ "The :set function for user option `todos-nondiary-marker'."
+ (let ((oldvalue (symbol-value symbol))
+ (files (append todos-files todos-archives)))
+ (custom-set-default symbol value)
+ ;; Need to reset these to get font-locking right.
+ (setq todos-nondiary-start (nth 0 todos-nondiary-marker)
+ todos-nondiary-end (nth 1 todos-nondiary-marker)
+ todos-date-string-start
+ ;; See comment in defvar of `todos-date-string-start'.
+ (concat "^\\(" (regexp-quote todos-nondiary-start) "\\|"
+ (regexp-quote diary-nonmarking-symbol) "\\)?"))
+ (when (not (equal value oldvalue))
+ (dolist (f files)
+ (with-current-buffer (find-file-noselect f)
+ (let (buffer-read-only)
+ (widen)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (if (re-search-forward
+ (concat "^\\(" todos-done-string-start "[^][]+] \\)?"
+ "\\(?1:" (regexp-quote (car oldvalue))
+ "\\)" todos-date-pattern "\\( "
+ diary-time-regexp "\\)?\\(?2:"
+ (regexp-quote (cadr oldvalue)) "\\)")
+ nil t)
+ (progn
+ (replace-match (nth 0 value) t t nil 1)
+ (replace-match (nth 1 value) t t nil 2))
+ (forward-line)))
+ (todos-category-select)))))))
+
(defcustom todos-print-function 'ps-print-buffer-with-faces
"Function called to print buffer content; see `todos-print'."
:type 'symbol
:group 'todos)
-;; FIXME: rename, change meaning of zero, refer to todos-priorities-rules
-(defcustom todos-show-priorities 1
- "Default number of priorities to show by `todos-top-priorities'.
-0 means show all entries."
- :type 'integer
- :group 'todos)
-
-(defcustom todos-print-priorities 0
- "Default number of priorities to print by `todos-print'.
-0 means print all entries."
- :type 'integer
+(defcustom todos-completion-ignore-case nil
+ "Non-nil means case of user input in `todos-read-*' is ignored."
+ :type 'boolean
:group 'todos)
-(defcustom todos-completion-ignore-case t ;; FIXME: nil for release?
- "Non-nil means don't consider case significant in `todos-read-category'."
+(defcustom todos-highlight-item nil
+ "Non-nil means highlight items at point."
:type 'boolean
+ :initialize 'custom-initialize-default
+ :set 'todos-reset-highlight-item
:group 'todos)
+(defun todos-reset-highlight-item (symbol value)
+ "The :set function for `todos-highlight-item'."
+ (let ((oldvalue (symbol-value symbol))
+ (files (append todos-files todos-archives)))
+ (custom-set-default symbol value)
+ (when (not (equal value oldvalue))
+ (dolist (f files)
+ (let ((buf (get-file-buffer f)))
+ (when buf
+ (with-current-buffer buf
+ (require 'hl-line)
+ (if value
+ (hl-line-mode 1)
+ (hl-line-mode -1)))))))))
+
(defcustom todos-always-add-time-string nil
"Non-nil adds current time to a new item's date header by default.
When the Todos insertion commands have a non-nil \"maybe-notime\"
:group 'todos)
(defcustom todos-wrap-lines t
- "Non-nil to wrap long lines by `todos-line-wrapping-function'." ;FIXME
+ "Non-nil to wrap long lines via `todos-line-wrapping-function'."
:group 'todos
:type 'boolean)
(defcustom todos-line-wrapping-function 'todos-wrap-and-indent
- "Function called when `todos-wrap-lines' is non-nil." ;FIXME
+ "Line wrapping function used with non-nil `todos-wrap-lines'."
:group 'todos
:type 'function)
-(defcustom todos-indent-to-here 6
- "Number of spaces `todos-line-wrapping-function' indents to."
- :type 'integer
+(defun todos-wrap-and-indent ()
+ "Use word wrapping on long lines and indent with a wrap prefix.
+The amount of indentation is given by user option
+`todos-indent-to-here'."
+ (set (make-local-variable 'word-wrap) t)
+ (set (make-local-variable 'wrap-prefix) (make-string todos-indent-to-here 32))
+ (unless (member '(continuation) fringe-indicator-alist)
+ (push '(continuation) fringe-indicator-alist)))
+
+;; FIXME: :set function (otherwise change takes effect only after revisiting)
+(defcustom todos-indent-to-here 6
+ "Number of spaces `todos-line-wrapping-function' indents to."
+ :type '(integer :validate
+ (lambda (widget)
+ (unless (> (widget-value widget) 0)
+ (widget-put widget :error
+ "Invalid value: must be a positive integer")
+ widget)))
+ :group 'todos)
+
+(defun todos-indent ()
+ "Indent from point to `todos-indent-to-here'."
+ (indent-to todos-indent-to-here todos-indent-to-here))
+
+(defcustom todos-todo-mode-date-time-regexp
+ (concat "\\(?1:[0-9]\\{4\\}\\)-\\(?2:[0-9]\\{2\\}\\)-"
+ "\\(?3:[0-9]\\{2\\}\\) \\(?4:[0-9]\\{2\\}:[0-9]\\{2\\}\\)")
+ "Regexp matching legacy todo-mode.el item date-time strings.
+In order for `todos-convert-legacy-files' to correctly convert this
+string to the current Todos format, the regexp must contain four
+explicitly numbered groups (see `(elisp) Regexp Backslash'),
+where group 1 matches a string for the year, group 2 a string for
+the month, group 3 a string for the day and group 4 a string for
+the time. The default value converts date-time strings built
+using the default value of `todo-time-string-format' from
+todo-mode.el."
+ :type 'regexp
:group 'todos)
+(defgroup todos-categories nil
+ "Faces for Todos Categories mode."
+ :version "24.2"
+ :group 'todos)
+
+(defcustom todos-categories-category-label "Category"
+ "Category button label in Todos Categories mode."
+ :type 'string
+ :group 'todos-categories)
+
+(defcustom todos-categories-todo-label "Todo"
+ "Todo button label in Todos Categories mode."
+ :type 'string
+ :group 'todos-categories)
+
+(defcustom todos-categories-diary-label "Diary"
+ "Diary button label in Todos Categories mode."
+ :type 'string
+ :group 'todos-categories)
+
+(defcustom todos-categories-done-label "Done"
+ "Done button label in Todos Categories mode."
+ :type 'string
+ :group 'todos-categories)
+
+(defcustom todos-categories-archived-label "Archived"
+ "Archived button label in Todos Categories mode."
+ :type 'string
+ :group 'todos-categories)
+
+(defcustom todos-categories-totals-label "Totals"
+ "String to label total item counts in Todos Categories mode."
+ :type 'string
+ :group 'todos-categories)
+
+(defcustom todos-categories-number-separator " | "
+ "String between number and category in Todos Categories mode.
+This separates the number from the category name in the default
+categories display according to priority."
+ :type 'string
+ :group 'todos-categories)
+
+(defcustom todos-categories-align 'center
+ "Alignment of category names in Todos Categories mode."
+ :type '(radio (const left) (const center) (const right))
+ :group 'todos-categories)
+
;; ---------------------------------------------------------------------------
;;; Faces
(defgroup todos-faces nil
"Faces for the Todos modes."
- :version "24.1"
+ :version "24.2"
:group 'todos)
(defface todos-prefix-string
- '((t :inherit font-lock-constant-face))
+ ;; '((t :inherit font-lock-constant-face))
+ '((((class grayscale) (background light))
+ (:foreground "LightGray" :weight bold :underline t))
+ (((class grayscale) (background dark))
+ (:foreground "Gray50" :weight bold :underline t))
+ (((class color) (min-colors 88) (background light)) (:foreground "dark cyan"))
+ (((class color) (min-colors 88) (background dark)) (:foreground "Aquamarine"))
+ (((class color) (min-colors 16) (background light)) (:foreground "CadetBlue"))
+ (((class color) (min-colors 16) (background dark)) (:foreground "Aquamarine"))
+ (((class color) (min-colors 8)) (:foreground "magenta"))
+ (t (:weight bold :underline t)))
"Face for Todos prefix string."
:group 'todos-faces)
(defface todos-mark
- '((t :inherit font-lock-warning-face))
+ ;; '((t :inherit font-lock-warning-face))
+ '((((class color)
+ (min-colors 88)
+ (background light))
+ (:weight bold :foreground "Red1"))
+ (((class color)
+ (min-colors 88)
+ (background dark))
+ (:weight bold :foreground "Pink"))
+ (((class color)
+ (min-colors 16)
+ (background light))
+ (:weight bold :foreground "Red1"))
+ (((class color)
+ (min-colors 16)
+ (background dark))
+ (:weight bold :foreground "Pink"))
+ (((class color)
+ (min-colors 8))
+ (:foreground "red"))
+ (t
+ (:weight bold :inverse-video t)))
"Face for marks on Todos items."
:group 'todos-faces)
(defface todos-button
- '((t :inherit widget-field))
+ ;; '((t :inherit widget-field))
+ '((((type tty))
+ (:foreground "black" :background "yellow3"))
+ (((class grayscale color)
+ (background light))
+ (:background "gray85"))
+ (((class grayscale color)
+ (background dark))
+ (:background "dim gray"))
+ (t
+ (:slant italic)))
"Face for buttons in todos-display-categories."
:group 'todos-faces)
(defface todos-sorted-column
- '((t :inherit fringe))
+ ;; '((t :inherit fringe))
+ '((((class color)
+ (background light))
+ (:foreground "grey95"))
+ (((class color)
+ (background dark))
+ (:foreground "grey10"))
+ (t
+ (:foreground "gray")))
"Face for buttons in todos-display-categories."
:group 'todos-faces)
(defface todos-archived-only
- '((t (:inherit (shadow))))
+ ;; '((t (:inherit (shadow))))
+ '((((class color)
+ (background light))
+ (:foreground "grey50"))
+ (((class color)
+ (background dark))
+ (:foreground "grey70"))
+ (t
+ (:foreground "gray")))
"Face for archived-only categories in todos-display-categories."
:group 'todos-faces)
(defface todos-search
- '((t :inherit match))
+ ;; '((t :inherit match))
+ '((((class color)
+ (min-colors 88)
+ (background light))
+ (:background "yellow1"))
+ (((class color)
+ (min-colors 88)
+ (background dark))
+ (:background "RoyalBlue3"))
+ (((class color)
+ (min-colors 8)
+ (background light))
+ (:foreground "black" :background "yellow"))
+ (((class color)
+ (min-colors 8)
+ (background dark))
+ (:foreground "white" :background "blue"))
+ (((type tty)
+ (class mono))
+ (:inverse-video t))
+ (t
+ (:background "gray")))
"Face for matches found by todos-search."
:group 'todos-faces)
+(defface todos-diary-expired
+ ;; '((t :inherit font-lock-warning-face))
+ '((((class color)
+ (min-colors 16))
+ (:weight bold :foreground "DarkOrange"))
+ (((class color))
+ (:weight bold :foreground "yellow"))
+ (t
+ (:weight bold)))
+ "Face for expired dates of diary items."
+ :group 'todos-faces)
+(defvar todos-diary-expired-face 'todos-diary-expired)
+
(defface todos-date
'((t :inherit diary))
- "Face for Todos prefix string."
+ "Face for the date string of a Todos item."
:group 'todos-faces)
(defvar todos-date-face 'todos-date)
(defface todos-time
'((t :inherit diary-time))
- "Face for Todos prefix string."
+ "Face for the time string of a Todos item."
:group 'todos-faces)
(defvar todos-time-face 'todos-time)
(defface todos-done
- '((t :inherit font-lock-comment-face))
+ ;; '((t :inherit font-lock-comment-face))
+ '((((class grayscale)
+ (background light))
+ (:slant italic :weight bold :foreground "DimGray"))
+ (((class grayscale)
+ (background dark))
+ (:slant italic :weight bold :foreground "LightGray"))
+ (((class color)
+ (min-colors 88)
+ (background light))
+ (:foreground "Firebrick"))
+ (((class color)
+ (min-colors 88)
+ (background dark))
+ (:foreground "chocolate1"))
+ (((class color)
+ (min-colors 16)
+ (background light))
+ (:foreground "red"))
+ (((class color)
+ (min-colors 16)
+ (background dark))
+ (:foreground "red1"))
+ (((class color)
+ (min-colors 8)
+ (background light))
+ (:foreground "red"))
+ (((class color)
+ (min-colors 8)
+ (background dark))
+ (:foreground "yellow"))
+ (t
+ (:slant italic :weight bold)))
"Face for done Todos item header string."
:group 'todos-faces)
(defvar todos-done-face 'todos-done)
(defface todos-comment
- '((t :inherit font-lock-comment-face))
+ '((t :inherit todos-done))
"Face for comments appended to done Todos items."
:group 'todos-faces)
(defvar todos-comment-face 'todos-comment)
(defface todos-done-sep
- '((t :inherit font-lock-type-face))
+ ;; '((t :inherit font-lock-type-face))
+ '((((class grayscale)
+ (background light))
+ (:weight bold :foreground "Gray90"))
+ (((class grayscale)
+ (background dark))
+ (:weight bold :foreground "DimGray"))
+ (((class color)
+ (min-colors 88)
+ (background light))
+ (:foreground "ForestGreen"))
+ (((class color)
+ (min-colors 88)
+ (background dark))
+ (:foreground "PaleGreen"))
+ (((class color)
+ (min-colors 16)
+ (background light))
+ (:foreground "ForestGreen"))
+ (((class color)
+ (min-colors 16)
+ (background dark))
+ (:foreground "PaleGreen"))
+ (((class color)
+ (min-colors 8))
+ (:foreground "green"))
+ (t
+ (:underline t :weight bold)))
"Face for separator string bewteen done and not done Todos items."
:group 'todos-faces)
(defvar todos-done-sep-face 'todos-done-sep)
(defvar todos-font-lock-keywords
(list
+ ;; '(todos-nondiary-marker-matcher 1 todos-nondiary-face t)
+ ;; '(todos-nondiary-marker-matcher 2 todos-nondiary-face t)
+ '(todos-nondiary-marker-matcher 1 todos-done-sep-face t)
+ '(todos-nondiary-marker-matcher 2 todos-done-sep-face t)
+ ;; This is the face used by diary-lib.el.
+ '(todos-diary-nonmarking-matcher 1 font-lock-constant-face t)
'(todos-date-string-matcher 1 todos-date-face t)
'(todos-time-string-matcher 1 todos-time-face t)
'(todos-done-string-matcher 0 todos-done-face t)
'(todos-comment-string-matcher 1 todos-done-face t)
- '(todos-category-string-matcher 1 todos-done-sep-face t))
- "Font-locking for Todos mode.")
+ ;; '(todos-category-string-matcher 1 todos-done-sep-face t)
+ '(todos-category-string-matcher-1 1 todos-done-sep-face t t)
+ '(todos-category-string-matcher-2 1 todos-done-sep-face t t)
+ '(todos-diary-expired-matcher 1 todos-diary-expired-face t)
+ '(todos-diary-expired-matcher 2 todos-diary-expired-face t t)
+ )
+ "Font-locking for Todos modes.")
;; ---------------------------------------------------------------------------
-;;; Modes setup
+;;; Todos mode local variables and hook functions
(defvar todos-files (funcall todos-files-function)
"List of truenames of user's Todos files.")
(defvar todos-archives (funcall todos-files-function t)
"List of truenames of user's Todos archives.")
-(defvar todos-categories nil
- "Alist of categories in the current Todos file.
-The elements are cons cells whose car is a category name and
-whose cdr is a vector of the category's item counts. These are,
-in order, the numbers of todo items, todo items included in the
-Diary, done items and archived items.")
-
-(defvar todos-categories-full nil
- "Variable holding non-truncated copy of `todos-categories'.
-Set when `todos-ignore-archived-categories' is set to non-nil, to
-restore full `todos-categories' list when
-`todos-ignore-archived-categories' is reset to nil.")
-
(defvar todos-current-todos-file nil
"Variable holding the name of the currently active Todos file.")
-;; Automatically set by `todos-switch-todos-file'.")
-;; FIXME: Add function to kill-buffer-hook that sets this to the latest
-;; existing Todos file or else todos-default-todos-file on killing the buffer
-;; of a Todos file
-(defvar todos-global-current-todos-file nil
- "Variable holding name of current Todos file.
-Used by functions called from outside of Todos mode to visit the
-current Todos file rather than the default Todos file (i.e. when
-users option `todos-show-current-file' is non-nil).")
+(defun todos-show-current-file ()
+ "Visit current instead of default Todos file with `todos-show'.
+This function is added to `pre-command-hook' when user option
+`todos-show-current-file' is set to non-nil."
+ (setq todos-global-current-todos-file todos-current-todos-file))
+ ;; (and (eq major-mode 'todos-mode)
+ ;; (setq todos-global-current-todos-file (buffer-file-name))))
+
+(defun todos-after-find-file ()
+ "Show Todos files correctly when visited from outside of Todos mode."
+ (and (member this-command todos-visit-files-commands)
+ (= (- (point-max) (point-min)) (buffer-size))
+ (member major-mode '(todos-mode todos-archive-mode))
+ (todos-category-select)))
(defun todos-reset-global-current-todos-file ()
- ""
+ "Update the value of `todos-global-current-todos-file'.
+This becomes the latest existing Todos file or, if there is none,
+the value of `todos-default-todos-file'.
+This function is added to `kill-buffer-hook' in Todos mode."
(let ((buflist (copy-sequence (buffer-list)))
(cur todos-global-current-todos-file))
(catch 'done
(if (equal cur todos-global-current-todos-file)
(setq todos-global-current-todos-file todos-default-todos-file))))
+(defvar todos-categories nil
+ "Alist of categories in the current Todos file.
+The elements are cons cells whose car is a category name and
+whose cdr is a vector of the category's item counts. These are,
+in order, the numbers of todo items, todo items included in the
+Diary, done items and archived items.")
+
+(defvar todos-categories-full nil
+ "Variable holding non-truncated copy of `todos-categories'.
+Set when `todos-ignore-archived-categories' is set to non-nil, to
+restore full `todos-categories' list when
+`todos-ignore-archived-categories' is reset to nil.")
+
+(defvar todos-categories-with-marks nil
+ "Alist of categories and number of marked items they contain.")
+
(defvar todos-category-number 1
"Variable holding the number of the current Todos category.
-This number is one more than the index of the category in
-`todos-categories'.")
+Todos categories are numbered starting from 1.")
(defvar todos-first-visit t
"Non-nil if first display of this file in the current session.
See `todos-display-categories-first'.")
-;; FIXME: rename?
-(defvar todos-tmp-buffer-name " *todo tmp*")
+(defvar todos-show-done-only nil
+ "If non-nil display only done items in current category.
+Set by `todos-toggle-show-done-only' and used by
+`todos-category-select'.")
-(defvar todos-category-beg "--==-- "
- "String marking beginning of category (inserted with its name).")
+;; ---------------------------------------------------------------------------
+;;; Global variables and helper functions
-(defvar todos-category-done "==--== DONE "
- "String marking beginning of category's done items.")
+(defvar todos-global-current-todos-file nil
+ "Variable holding name of current Todos file.
+Used by functions called from outside of Todos mode to visit the
+current Todos file rather than the default Todos file (i.e. when
+users option `todos-show-current-file' is non-nil).")
+
+(defun todos-reevaluate-defcustoms ()
+ "Reevaluate defcustoms that show list of Todos files."
+ (custom-set-default 'todos-default-todos-file
+ (symbol-value 'todos-default-todos-file))
+ (todos-reevaluate-default-file-defcustom)
+ (custom-set-default 'todos-filter-files (symbol-value 'todos-filter-files))
+ (todos-reevaluate-filter-files-defcustom))
+
+(defvar todos-edit-buffer "*Todos Edit*"
+ "Name of current buffer in Todos Edit mode.")
+
+(defvar todos-categories-buffer "*Todos Categories*"
+ "Name of buffer in Todos Categories mode.")
+
+(defvar todos-print-buffer "*Todos Print*"
+ "Name of buffer containing printable Todos text.")
+
+(defvar todos-date-pattern
+ (let ((dayname (diary-name-pattern calendar-day-name-array nil t)))
+ (concat "\\(?:" dayname "\\|"
+ (let ((dayname)
+ ;; FIXME: how to choose between abbreviated and unabbreviated
+ ;; month name?
+ (monthname (format "\\(?:%s\\|\\*\\)"
+ (diary-name-pattern
+ calendar-month-name-array
+ calendar-month-abbrev-array t)))
+ (month "\\(?:[0-9]+\\|\\*\\)")
+ (day "\\(?:[0-9]+\\|\\*\\)")
+ (year "-?\\(?:[0-9]+\\|\\*\\)"))
+ (mapconcat 'eval calendar-date-display-form ""))
+ "\\)"))
+ "Regular expression matching a Todos date header.")
(defvar todos-nondiary-start (nth 0 todos-nondiary-marker)
"String inserted before item date to block diary inclusion.")
(defvar todos-nondiary-end (nth 1 todos-nondiary-marker)
"String inserted after item date matching `todos-nondiary-start'.")
-(defvar todos-show-done-only nil
- "If non-nil display only done items in current category.
-Set by `todos-toggle-show-done-only' and used by
-`todos-category-select'.")
+;; By itself this matches anything, because of the `?'; however, it's only
+;; used in the context of `todos-date-pattern' (but Emacs Lisp lacks
+;; lookahead).
+(defvar todos-date-string-start
+ (concat "^\\(" (regexp-quote todos-nondiary-start) "\\|"
+ (regexp-quote diary-nonmarking-symbol) "\\)?")
+ "Regular expression matching part of item header before the date.")
-;;; Todos insertion commands, key bindings and keymap
+(defvar todos-done-string-start
+ (concat "^\\[" (regexp-quote todos-done-string))
+ "Regular expression matching start of done item.")
-;; http://rosettacode.org/wiki/Power_set#Common_Lisp (GFDL)
-(defun powerset (l)
- (if (null l)
- (list nil)
- (let ((prev (powerset (cdr l))))
- (append (mapcar #'(lambda (elt) (cons (car l) elt)) prev)
- prev))))
+(defun todos-date-string-matcher (lim)
+ "Search for Todos date string within LIM for font-locking."
+ (re-search-forward
+ (concat todos-date-string-start "\\(?1:" todos-date-pattern "\\)") lim t))
-;; Return list of lists of non-nil atoms produced from ARGLIST. The elements
-;; of ARGLIST may be atoms or lists.
-(defun todos-gen-arglists (arglist)
- (let (arglists)
- (while arglist
- (let ((arg (pop arglist)))
- (cond ((symbolp arg)
- (setq arglists (if arglists
- (mapcar (lambda (l) (push arg l)) arglists)
- (list (push arg arglists)))))
- ((listp arg)
- (setq arglists
- (mapcar (lambda (a)
- (if (= 1 (length arglists))
- (apply (lambda (l) (push a l)) arglists)
- (mapcar (lambda (l) (push a l)) arglists)))
- arg))))))
- (setq arglists (mapcar 'reverse (apply 'append (mapc 'car arglists))))))
+(defun todos-time-string-matcher (lim)
+ "Search for Todos time string within LIM for font-locking."
+ (re-search-forward (concat todos-date-string-start todos-date-pattern
+ " \\(?1:" diary-time-regexp "\\)") lim t))
-(defvar todos-insertion-commands-args-genlist
- '(diary nonmarking (calendar date dayname) time (here region))
- "Generator list for argument lists of Todos insertion commands.")
+(defun todos-nondiary-marker-matcher (lim)
+ "Search for Todos nondiary markers within LIM for font-locking."
+ (re-search-forward (concat "^\\(?1:" (regexp-quote todos-nondiary-start) "\\)"
+ todos-date-pattern "\\(?: " diary-time-regexp
+ "\\)?\\(?2:" (regexp-quote todos-nondiary-end) "\\)")
+ lim t))
-(eval-when-compile (require 'cl)) ; remove-duplicates
+(defun todos-diary-nonmarking-matcher (lim)
+ "Search for diary nonmarking symbol within LIM for font-locking."
+ (re-search-forward (concat "^\\(?1:" (regexp-quote diary-nonmarking-symbol)
+ "\\)" todos-date-pattern) lim t))
+
+(defun todos-diary-expired-matcher (lim)
+ "Search for expired diary item date within LIM for font-locking."
+ (when (re-search-forward (concat "^\\(?:"
+ (regexp-quote diary-nonmarking-symbol)
+ "\\)?\\(?1:" todos-date-pattern "\\) \\(?2:"
+ diary-time-regexp "\\)?") lim t)
+ (let* ((date (match-string-no-properties 1))
+ (time (match-string-no-properties 2))
+ ;; days-between needs a non-empty time string.
+ (date-time (concat date " " (or time "00:00"))))
+ (or (and (not (string-match ".+day\\|\\*" date))
+ (< (days-between date-time (current-time-string)) 0))
+ (todos-diary-expired-matcher lim)))))
-(defvar todos-insertion-commands-args
- (let ((argslist (todos-gen-arglists todos-insertion-commands-args-genlist))
- res new)
- (setq res (remove-duplicates
- (apply 'append (mapcar 'powerset argslist)) :test 'equal))
- (dolist (l res)
- (unless (= 5 (length l))
- (let ((v (make-vector 5 nil)) elt)
- (while l
- (setq elt (pop l))
- (cond ((eq elt 'diary)
- (aset v 0 elt))
- ((eq elt 'nonmarking)
- (aset v 1 elt))
- ((or (eq elt 'calendar)
- (eq elt 'date)
- (eq elt 'dayname))
- (aset v 2 elt))
- ((eq elt 'time)
- (aset v 3 elt))
- ((or (eq elt 'here)
- (eq elt 'region))
- (aset v 4 elt))))
- (setq l (append v nil))))
- (setq new (append new (list l))))
- new)
- "List of all argument lists for Todos insertion commands.")
+(defun todos-done-string-matcher (lim)
+ "Search for Todos done header within LIM for font-locking."
+ (re-search-forward (concat todos-done-string-start
+ "[^][]+]")
+ lim t))
-(defun todos-insertion-command-name (arglist)
- "Generate Todos insertion command name from ARGLIST."
- (replace-regexp-in-string
- "-\\_>" ""
- (replace-regexp-in-string
- "-+" "-"
- (concat "todos-item-insert-"
- (mapconcat (lambda (e) (if e (symbol-name e))) arglist "-")))))
+(defun todos-comment-string-matcher (lim)
+ "Search for Todos done comment within LIM for font-locking."
+ (re-search-forward (concat "\\[\\(?1:" todos-comment-string "\\):")
+ lim t))
-(defvar todos-insertion-commands-names
- (mapcar (lambda (l)
- (todos-insertion-command-name l))
- todos-insertion-commands-args)
- "List of names of Todos insertion commands.")
+;; (defun todos-category-string-matcher (lim)
+;; "Search for Todos category name within LIM for font-locking.
+;; This is for fontifying category names appearing in Todos filter
+;; mode."
+;; (if (eq major-mode 'todos-filter-items-mode)
+;; (re-search-forward
+;; (concat "^\\(?:" todos-date-string-start "\\)?" todos-date-pattern
+;; "\\(?: " diary-time-regexp "\\)?\\(?:"
+;; (regexp-quote todos-nondiary-end) "\\)? \\(?1:\\[.+\\]\\)")
+;; lim t)))
+
+(defun todos-category-string-matcher-1 (lim)
+ "Search for Todos category name within LIM for font-locking.
+This is for fontifying category names appearing in Todos filter
+mode following done items."
+ (if (eq major-mode 'todos-filter-items-mode)
+ (re-search-forward (concat todos-done-string-start todos-date-pattern
+ "\\(?: " diary-time-regexp
+ ;; Use non-greedy operator to prevent
+ ;; capturing possible following non-diary
+ ;; date string.
+ "\\)?] \\(?1:\\[.+?\\]\\)")
+ lim t)))
+
+(defun todos-category-string-matcher-2 (lim)
+ "Search for Todos category name within LIM for font-locking.
+This is for fontifying category names appearing in Todos filter
+mode following todo (not done) items."
+ (if (eq major-mode 'todos-filter-items-mode)
+ (re-search-forward (concat todos-date-string-start todos-date-pattern
+ "\\(?: " diary-time-regexp "\\)?\\(?:"
+ (regexp-quote todos-nondiary-end)
+ "\\)? \\(?1:\\[.+\\]\\)")
+ lim t)))
-(defmacro todos-define-insertion-command (&rest args)
- (let ((name (intern (todos-insertion-command-name args)))
- (arg0 (nth 0 args))
- (arg1 (nth 1 args))
- (arg2 (nth 2 args))
- (arg3 (nth 3 args))
- (arg4 (nth 4 args)))
- `(defun ,name (&optional arg)
- "Todos item insertion command."
- (interactive)
- (todos-insert-item arg ',arg0 ',arg1 ',arg2 ',arg3 ',arg4))))
+(defun todos-category-number (cat)
+ "Return the number of category CAT in this Todos file.
+The buffer-local variable `todos-category-number' holds this
+number as its value."
+ (let ((categories (mapcar 'car todos-categories)))
+ (setq todos-category-number
+ ;; Increment by one, so that the highest priority category in Todos
+ ;; Categories mode is numbered one rather than zero.
+ (1+ (- (length categories)
+ (length (member cat categories)))))))
-(defvar todos-insertion-commands
- (mapcar (lambda (c)
- (eval `(todos-define-insertion-command ,@c)))
- todos-insertion-commands-args)
- "List of Todos insertion commands.")
+(defun todos-current-category ()
+ "Return the name of the current category."
+ (car (nth (1- todos-category-number) todos-categories)))
-(defvar todos-insertion-commands-arg-key-list
- '(("diary" "y" "yy")
- ("nonmarking" "k" "kk")
- ("calendar" "c" "cc")
- ("date" "d" "dd")
- ("dayname" "n" "nn")
- ("time" "t" "tt")
- ("here" "h" "h")
- ("region" "r" "r"))
- "")
+(defconst todos-category-beg "--==-- "
+ "String marking beginning of category (inserted with its name).")
-(defun todos-insertion-key-bindings (map)
- ""
- (dolist (c todos-insertion-commands)
- (let* ((key "")
- (cname (symbol-name c)))
- ;; (if (string-match "diary\\_>" cname) (setq key (concat key "yy")))
- ;; (if (string-match "diary.+" cname) (setq key (concat key "y")))
- ;; (if (string-match "nonmarking\\_>" cname) (setq key (concat key "kk")))
- ;; (if (string-match "nonmarking.+" cname) (setq key (concat key "k")))
- ;; (if (string-match "calendar\\_>" cname) (setq key (concat key "cc")))
- ;; (if (string-match "calendar.+" cname) (setq key (concat key "c")))
- ;; (if (string-match "date\\_>" cname) (setq key (concat key "dd")))
- ;; (if (string-match "date.+" cname) (setq key (concat key "d")))
- ;; (if (string-match "dayname\\_>" cname) (setq key (concat key "nn")))
- ;; (if (string-match "dayname.+" cname) (setq key (concat key "n")))
- ;; (if (string-match "time\\_>" cname) (setq key (concat key "tt")))
- ;; (if (string-match "time.+" cname) (setq key (concat key "t")))
- ;; (if (string-match "here" cname) (setq key (concat key "h")))
- ;; (if (string-match "region" cname) (setq key (concat key "r")))
- (mapc (lambda (l)
- (let ((arg (nth 0 l))
- (key1 (nth 1 l))
- (key2 (nth 2 l)))
- (if (string-match (concat (regexp-quote arg) "\\_>") cname)
- (setq key (concat key key2)))
- (if (string-match (concat (regexp-quote arg) ".+") cname)
- (setq key (concat key key1)))))
- todos-insertion-commands-arg-key-list)
- (if (string-match (concat (regexp-quote "todos-item-insert") "\\_>") cname)
- (setq key (concat key "i")))
- (define-key map key c))))
-
-(defvar todos-insertion-map
- (let ((map (make-keymap)))
- (todos-insertion-key-bindings map)
- map)
- "Keymap for Todos mode insertion commands.")
-
-(defvar todos-mode-map
- (let ((map (make-keymap)))
- ;; Don't suppress digit keys, so they can supply prefix arguments.
- (suppress-keymap map)
- ;; display commands
- (define-key map "Cd" 'todos-display-categories) ;FIXME: Cs todos-show-categories?
- ;; (define-key map "" 'todos-display-categories-alphabetically)
- (define-key map "H" 'todos-highlight-item)
- (define-key map "N" 'todos-toggle-item-numbering)
- (define-key map "D" 'todos-toggle-display-date-time)
- (define-key map "*" 'todos-toggle-mark-item)
- (define-key map "C*" 'todos-mark-category)
- (define-key map "Cu" 'todos-unmark-category)
- (define-key map "P" 'todos-print)
- ;; (define-key map "" 'todos-print-to-file)
- (define-key map "v" 'todos-toggle-view-done-items)
- (define-key map "V" 'todos-toggle-show-done-only)
- (define-key map "Av" 'todos-view-archived-items)
- (define-key map "As" 'todos-show-archive)
- (define-key map "Ac" 'todos-choose-archive)
- (define-key map "Y" 'todos-diary-items)
- ;; (define-key map "" 'todos-update-merged-files)
- ;; (define-key map "" 'todos-set-top-priorities)
- (define-key map "Ftt" 'todos-top-priorities)
- (define-key map "Ftm" 'todos-merged-top-priorities)
- (define-key map "Fdd" 'todos-diary-items)
- (define-key map "Fdm" 'todos-merged-diary-items)
- (define-key map "Frr" 'todos-regexp-items)
- (define-key map "Frm" 'todos-merged-regexp-items)
- (define-key map "Fcc" 'todos-custom-items)
- (define-key map "Fcm" 'todos-merged-custom-items)
- ;; (define-key map "" 'todos-save-top-priorities)
- ;; navigation commands
- (define-key map "f" 'todos-forward-category)
- (define-key map "b" 'todos-backward-category)
- (define-key map "j" 'todos-jump-to-category)
- (define-key map "J" 'todos-jump-to-category-other-file)
- (define-key map "n" 'todos-forward-item)
- (define-key map "p" 'todos-backward-item)
- (define-key map "S" 'todos-search)
- (define-key map "X" 'todos-clear-matches)
- ;; editing commands
- (define-key map "Fa" 'todos-add-file)
- ;; (define-key map "" 'todos-change-default-file)
- (define-key map "Ca" 'todos-add-category)
- (define-key map "Cr" 'todos-rename-category)
- (define-key map "Cg" 'todos-merge-category)
- ;; (define-key map "" 'todos-merge-categories)
- (define-key map "Cm" 'todos-move-category)
- (define-key map "Ck" 'todos-delete-category)
- (define-key map "d" 'todos-item-done)
- (define-key map "ee" 'todos-edit-item)
- (define-key map "em" 'todos-edit-multiline)
- (define-key map "eh" 'todos-edit-item-header)
- (define-key map "ed" 'todos-edit-item-date)
- (define-key map "ey" 'todos-edit-item-date-is-today)
- (define-key map "et" 'todos-edit-item-time)
- (define-key map "ec" 'todos-comment-done-item) ;FIXME: or just "c"?
- (define-key map "i" todos-insertion-map)
- (define-key map "k" 'todos-delete-item)
- (define-key map "m" 'todos-move-item)
- (define-key map "M" 'todos-move-item-to-file)
- ;; FIXME: This prevents `-' from being used in a numerical prefix argument
- ;; without typing C-u
- (define-key map "-" 'todos-raise-item-priority)
- (define-key map "r" 'todos-raise-item-priority)
- (define-key map "+" 'todos-lower-item-priority)
- (define-key map "l" 'todos-lower-item-priority)
- (define-key map "#" 'todos-set-item-priority)
- (define-key map "u" 'todos-item-undo)
- (define-key map "Ad" 'todos-archive-done-item-or-items) ;FIXME
- (define-key map "AD" 'todos-archive-category-done-items) ;FIXME
- ;; (define-key map "" 'todos-unarchive-items)
- ;; (define-key map "" 'todos-unarchive-category)
- (define-key map "y" 'todos-toggle-diary-inclusion)
- ;; (define-key map "" 'todos-toggle-diary-inclusion)
- ;; (define-key map "" 'todos-toggle-item-diary-nonmarking)
- ;; (define-key map "" 'todos-toggle-diary-nonmarking)
- (define-key map "s" 'todos-save)
- (define-key map "q" 'todos-quit)
- (define-key map [remap newline] 'newline-and-indent)
- map)
- "Todos mode keymap.")
-
-(easy-menu-define
- todos-menu todos-mode-map "Todos Menu"
- '("Todos"
- ("Navigation"
- ["Next Item" todos-forward-item t]
- ["Previous Item" todos-backward-item t]
- "---"
- ["Next Category" todos-forward-category t]
- ["Previous Category" todos-backward-category t]
- ["Jump to Category" todos-jump-to-category t]
- ["Jump to Category in Other File" todos-jump-to-category-other-file t]
- "---"
- ["Search Todos File" todos-search t]
- ["Clear Highlighting on Search Matches" todos-category-done t])
- ("Display"
- ["List Current Categories" todos-display-categories t]
- ;; ["List Categories Alphabetically" todos-display-categories-alphabetically t]
- ["Turn Item Highlighting on/off" todos-highlight-item t]
- ["Turn Item Numbering on/off" todos-toggle-item-numbering t]
- ["Turn Item Time Stamp on/off" todos-toggle-display-date-time t]
- ["View/Hide Done Items" todos-toggle-view-done-items t]
- "---"
- ["View Diary Items" todos-diary-items t]
- ["View Top Priority Items" todos-top-priorities t]
- ["View Merged Top Priority Items" todos-merged-top-priorities t]
- "---"
- ["View Archive" todos-view-archive t]
- ["Print Category" todos-print t]) ;FIXME
- ("Editing"
- ["Insert New Item" todos-insert-item t]
- ["Insert Item Here" todos-insert-item-here t]
- ("More Insertion Commands")
- ["Edit Item" todos-edit-item t]
- ["Edit Multiline Item" todos-edit-multiline t]
- ["Edit Item Header" todos-edit-item-header t]
- ["Edit Item Date" todos-edit-item-date t]
- ["Edit Item Time" todos-edit-item-time t]
- "---"
- ["Lower Item Priority" todos-lower-item-priority t]
- ["Raise Item Priority" todos-raise-item-priority t]
- ["Set Item Priority" todos-set-item-priority t]
- ["Move (Recategorize) Item" todos-move-item t]
- ["Delete Item" todos-delete-item t]
- ["Undo Done Item" todos-item-undo t]
- ["Mark/Unmark Item for Diary" todos-toggle-item-diary-inclusion t]
- ["Mark/Unmark Items for Diary" todos-toggle-diary-inclusion t]
- ["Mark & Hide Done Item" todos-item-done t]
- ["Archive Done Items" todos-archive-category-done-items t] ;FIXME
- "---"
- ["Add New Todos File" todos-add-file t]
- ["Add New Category" todos-add-category t]
- ["Delete Current Category" todos-delete-category t]
- ["Rename Current Category" todos-rename-category t]
- "---"
- ["Save Todos File" todos-save t]
- ["Save Top Priorities" todos-save-top-priorities t])
- "---"
- ["Quit" todos-quit t]
- ))
-
-(defvar todos-archive-mode-map
- (let ((map (make-sparse-keymap)))
- (suppress-keymap map t)
- ;; navigation commands
- (define-key map "f" 'todos-forward-category)
- (define-key map "b" 'todos-backward-category)
- (define-key map "j" 'todos-jump-to-category)
- (define-key map "n" 'todos-forward-item)
- (define-key map "p" 'todos-backward-item)
- ;; display commands
- (define-key map "C" 'todos-display-categories)
- (define-key map "H" 'todos-highlight-item)
- (define-key map "N" 'todos-toggle-item-numbering)
- ;; (define-key map "" 'todos-toggle-display-date-time)
- (define-key map "P" 'todos-print)
- (define-key map "q" 'todos-quit)
- (define-key map "s" 'todos-save)
- (define-key map "S" 'todos-search)
- (define-key map "t" 'todos-show) ;FIXME: should show same category
- ;; (define-key map "u" 'todos-unarchive-item)
- (define-key map "U" 'todos-unarchive-category)
- map)
- "Todos Archive mode keymap.")
+(defconst todos-category-done "==--== DONE "
+ "String marking beginning of category's done items.")
-(defvar todos-edit-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "\C-x\C-q" 'todos-edit-quit)
- (define-key map [remap newline] 'newline-and-indent)
- map)
- "Todos Edit mode keymap.")
+(defun todos-category-select ()
+ "Display the current category correctly."
+ (let ((name (todos-current-category))
+ cat-begin cat-end done-start done-sep-start done-end)
+ (widen)
+ (goto-char (point-min))
+ (re-search-forward
+ (concat "^" (regexp-quote (concat todos-category-beg name)) "$") nil t)
+ (setq cat-begin (1+ (line-end-position)))
+ (setq cat-end (if (re-search-forward
+ (concat "^" (regexp-quote todos-category-beg)) nil t)
+ (match-beginning 0)
+ (point-max)))
+ (setq mode-line-buffer-identification
+ (funcall todos-mode-line-function name))
+ (narrow-to-region cat-begin cat-end)
+ (todos-prefix-overlays)
+ (goto-char (point-min))
+ (if (re-search-forward (concat "\n\\(" (regexp-quote todos-category-done)
+ "\\)") nil t)
+ (progn
+ (setq done-start (match-beginning 0))
+ (setq done-sep-start (match-beginning 1))
+ (setq done-end (match-end 0)))
+ (error "Category %s is missing todos-category-done string" name))
+ (if todos-show-done-only
+ (narrow-to-region (1+ done-end) (point-max))
+ (when (and todos-show-with-done
+ (re-search-forward todos-done-string-start nil t))
+ ;; Now we want to see the done items, so reset displayed end to end of
+ ;; done items.
+ (setq done-start cat-end)
+ ;; Make display overlay for done items separator string, unless there
+ ;; already is one.
+ (let* ((done-sep todos-done-separator)
+ (ovs (overlays-at done-sep-start))
+ ov-sep)
+ (unless (and ovs (string= (overlay-get (car ovs) 'display) done-sep))
+ (setq ov-sep (make-overlay done-sep-start done-end))
+ (overlay-put ov-sep 'display done-sep))))
+ (narrow-to-region (point-min) done-start)
+ ;; Loading this from todos-mode, or adding it to the mode hook, causes
+ ;; Emacs to hang in todos-item-start, at looking-at.
+ (when todos-highlight-item
+ (require 'hl-line)
+ (hl-line-mode 1)))))
-(defvar todos-categories-mode-map
- (let ((map (make-sparse-keymap)))
- (suppress-keymap map t)
- ;; (define-key map "a" 'todos-display-categories-alphabetically)
- (define-key map "c" 'todos-display-categories)
- (define-key map "+" 'todos-lower-category)
- (define-key map "-" 'todos-raise-category)
- (define-key map "n" 'forward-button)
- (define-key map "p" 'backward-button)
- (define-key map [tab] 'forward-button)
- (define-key map [backtab] 'backward-button)
- (define-key map "q" 'todos-quit)
- ;; (define-key map "A" 'todos-add-category)
- ;; (define-key map "D" 'todos-delete-category)
- ;; (define-key map "R" 'todos-rename-category)
- map)
- "Todos Categories mode keymap.")
+(defun todos-get-count (type &optional category)
+ "Return count of TYPE items in CATEGORY.
+If CATEGORY is nil, default to the current category."
+ (let* ((cat (or category (todos-current-category)))
+ (counts (cdr (assoc cat todos-categories)))
+ (idx (cond ((eq type 'todo) 0)
+ ((eq type 'diary) 1)
+ ((eq type 'done) 2)
+ ((eq type 'archived) 3))))
+ (aref counts idx)))
-(defvar todos-filter-items-mode-map
- (let ((map (make-keymap)))
- (suppress-keymap map t)
- ;; navigation commands
- (define-key map "j" 'todos-jump-to-category)
- (define-key map "n" 'todos-forward-item)
- (define-key map "p" 'todos-backward-item)
- ;; (define-key map "S" 'todos-search)
- ;; display commands
- (define-key map "C" 'todos-display-categories)
- ;; (define-key map "" 'todos-display-categories-alphabetically)
- (define-key map "H" 'todos-highlight-item)
- (define-key map "N" 'todos-toggle-item-numbering)
- ;; (define-key map "" 'todos-toggle-display-date-time)
- (define-key map "P" 'todos-print)
- (define-key map "q" 'todos-quit)
- (define-key map "s" 'todos-save)
- (define-key map "V" 'todos-view-archive)
- (define-key map "v" 'todos-toggle-view-done-items)
- (define-key map "Y" 'todos-diary-items)
- ;; (define-key map "S" 'todos-save-top-priorities)
- ;; editing commands
- (define-key map "l" 'todos-lower-item-priority)
- (define-key map "r" 'todos-raise-item-priority)
- (define-key map "#" 'todos-set-item-priority)
- map)
- "Todos Top Priorities mode keymap.")
+(defun todos-set-count (type increment &optional category)
+ "Increment count of TYPE items in CATEGORY by INCREMENT.
+If CATEGORY is nil, default to the current category."
+ (let* ((cat (or category (todos-current-category)))
+ (counts (cdr (assoc cat todos-categories)))
+ (idx (cond ((eq type 'todo) 0)
+ ((eq type 'diary) 1)
+ ((eq type 'done) 2)
+ ((eq type 'archived) 3))))
+ (aset counts idx (+ increment (aref counts idx)))))
-;; FIXME: remove when part of Emacs
-(add-to-list 'auto-mode-alist '("\\.todo\\'" . todos-mode))
-(add-to-list 'auto-mode-alist '("\\.toda\\'" . todos-archive-mode))
+(defun todos-set-categories ()
+ "Set `todos-categories' from the sexp at the top of the file."
+ ;; New archive files created by `todos-move-category' are empty, which would
+ ;; make the sexp test fail and raise an error, so in this case we skip it.
+ (unless (zerop (buffer-size))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ ;; todos-truncate-categories-list needs non-nil todos-categories.
+ (setq todos-categories-full
+ (if (looking-at "\(\(\"")
+ (read (buffer-substring-no-properties
+ (line-beginning-position)
+ (line-end-position)))
+ (error "Invalid or missing todos-categories sexp"))
+ todos-categories todos-categories-full)))
+ (if (and todos-ignore-archived-categories
+ (eq major-mode 'todos-mode))
+ (todos-truncate-categories-list)
+ todos-categories-full)))
-(defun todos-modes-set-1 ()
- ""
- (set (make-local-variable 'font-lock-defaults) '(todos-font-lock-keywords t))
- (set (make-local-variable 'indent-line-function) 'todos-indent)
- (when todos-wrap-lines (funcall todos-line-wrapping-function))
-)
+(defun todos-update-categories-sexp ()
+ "Update the `todos-categories' sexp at the top of the file."
+ (let (buffer-read-only)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (if (looking-at (concat "^" (regexp-quote todos-category-beg)))
+ (progn (newline) (goto-char (point-min)))
+ ;; With empty buffer (e.g. with new archive in
+ ;; `todos-move-category') `kill-line' signals end of buffer.
+ (kill-region (line-beginning-position) (line-end-position)))
+ ;; todos-categories-full is nil on adding first category.
+ (prin1 (or todos-categories-full todos-categories)
+ (current-buffer))))))
-(defun todos-modes-set-2 ()
- ""
- (add-to-invisibility-spec 'todos)
- (setq buffer-read-only t)
- (set (make-local-variable 'hl-line-range-function)
- (lambda() (when (todos-item-end)
- (cons (todos-item-start) (todos-item-end)))))
-)
-
-;; Autoloading isn't needed if files are identified by auto-mode-alist
-;; ;; As calendar reads included Todos file before todos-mode is loaded.
-;; ;;;###autoload
-(define-derived-mode todos-mode nil "Todos" () ;FIXME: derive from special-mode?
- "Major mode for displaying, navigating and editing Todo lists.
+(defun todos-make-categories-list (&optional force)
+ "Return an alist of Todos categories and their item counts.
+With non-nil argument FORCE parse the entire file to build the
+list; otherwise, get the value by reading the sexp at the top of
+the file."
+ (setq todos-categories nil)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (let (counts cat archive)
+ (when buffer-file-name ; Don't check with `todos-convert-legacy-files'.
+ ;; FIXME: can todos-archives be too old here?
+ (unless (member buffer-file-name (funcall todos-files-function t))
+ (setq archive (concat (file-name-sans-extension
+ todos-current-todos-file) ".toda"))))
+ (while (not (eobp))
+ (cond ((looking-at (concat (regexp-quote todos-category-beg)
+ "\\(.*\\)\n"))
+ (setq cat (match-string-no-properties 1))
+ ;; Counts for each category: [todo diary done archive]
+ (setq counts (make-vector 4 0))
+ (setq todos-categories
+ (append todos-categories (list (cons cat counts))))
+ ;; todos-archives may be too old here (e.g. during
+ ;; todos-move-category).
+ (when (member archive (funcall todos-files-function t))
+ (let ((archive-count 0))
+ (with-current-buffer (find-file-noselect archive)
+ (widen)
+ (goto-char (point-min))
+ (when (re-search-forward
+ (concat (regexp-quote todos-category-beg) cat)
+ (point-max) t)
+ (forward-line)
+ (while (not (or (looking-at
+ (concat
+ (regexp-quote todos-category-beg)
+ "\\(.*\\)\n"))
+ (eobp)))
+ (when (looking-at todos-done-string-start)
+ (setq archive-count (1+ archive-count)))
+ (forward-line))))
+ (todos-set-count 'archived archive-count cat))))
+ ((looking-at todos-done-string-start)
+ (todos-set-count 'done 1 cat))
+ ((looking-at (concat "^\\("
+ (regexp-quote diary-nonmarking-symbol)
+ "\\)?" todos-date-pattern))
+ (todos-set-count 'diary 1 cat)
+ (todos-set-count 'todo 1 cat))
+ ((looking-at (concat todos-date-string-start todos-date-pattern))
+ (todos-set-count 'todo 1 cat))
+ ;; If first line is todos-categories list, use it and end loop
+ ;; -- unless FORCEd to scan whole file.
+ ((bobp)
+ (unless force
+ (setq todos-categories (read (buffer-substring-no-properties
+ (line-beginning-position)
+ (line-end-position))))
+ (goto-char (1- (point-max))))))
+ (forward-line)))))
+ todos-categories)
-\\{todos-mode-map}"
- (easy-menu-add todos-menu)
- (todos-modes-set-1)
- (todos-modes-set-2)
- (when (member (file-truename (buffer-file-name))
- (funcall todos-files-function))
- (set (make-local-variable 'todos-current-todos-file)
- (file-truename (buffer-file-name))))
- (set (make-local-variable 'todos-categories-full) nil)
- ;; todos-set-categories sets todos-categories-full.
- (set (make-local-variable 'todos-categories) (todos-set-categories))
- (set (make-local-variable 'todos-first-visit) t)
- (set (make-local-variable 'todos-category-number) 1) ;0)
- (set (make-local-variable 'todos-show-done-only) nil)
- (set (make-local-variable 'todos-categories-with-marks) nil)
- (when todos-show-current-file
- (add-hook 'pre-command-hook 'todos-show-current-file nil t))
- (add-hook 'post-command-hook 'todos-after-find-file nil t)
- (add-hook 'kill-buffer-hook 'todos-reset-global-current-todos-file nil t))
+(defun todos-truncate-categories-list ()
+ "Return a truncated alist of Todos categories plus item counts.
+Categories containing only archived items are omitted. This list
+is used in Todos mode when `todos-ignore-archived-categories' is
+non-nil."
+ (let (cats)
+ (dolist (catcons todos-categories-full cats)
+ (let ((cat (car catcons)))
+ (setq cats
+ (append cats
+ (unless (and (zerop (todos-get-count 'todo cat))
+ (zerop (todos-get-count 'done cat))
+ (not (zerop (todos-get-count 'archived cat))))
+ (list catcons))))))))
-;; FIXME:
-(defun todos-unload-hook ()
- ""
- (remove-hook 'pre-command-hook 'todos-show-current-file t)
- (remove-hook 'post-command-hook 'todos-after-find-file t)
- (remove-hook 'kill-buffer-hook 'todos-reset-global-current-todos-file t))
+(defun todos-check-format ()
+ "Signal an error if the current Todos file is ill-formatted.
+Otherwise return t. The error message gives the line number
+where the invalid formatting was found."
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ ;; Check for `todos-categories' sexp as the first line
+ (let ((cats (prin1-to-string (or todos-categories-full todos-categories))))
+ (unless (looking-at (regexp-quote cats))
+ (error "Invalid or missing todos-categories sexp")))
+ (forward-line)
+ (let ((legit (concat "\\(^" (regexp-quote todos-category-beg) "\\)"
+ "\\|\\(" todos-date-string-start todos-date-pattern "\\)"
+ "\\|\\(^[ \t]+[^ \t]*\\)"
+ "\\|^$"
+ "\\|\\(^" (regexp-quote todos-category-done) "\\)"
+ "\\|\\(" todos-done-string-start "\\)")))
+ (while (not (eobp))
+ (unless (looking-at legit)
+ (error "Illegitimate Todos file format at line %d"
+ (line-number-at-pos (point))))
+ (forward-line)))))
+ ;; (message "This Todos file is well-formatted.")
+ t)
-(define-derived-mode todos-archive-mode nil "Todos-Arch" ()
- "Major mode for archived Todos categories.
+(defun todos-repair-categories-sexp ()
+ "Repair corrupt Todos categories sexp."
+ (interactive)
+ (let ((todos-categories-full (todos-make-categories-list t)))
+ (todos-update-categories-sexp)))
-\\{todos-archive-mode-map}"
- (todos-modes-set-1)
- (todos-modes-set-2)
- (set (make-local-variable 'todos-show-done-only) t)
- (set (make-local-variable 'todos-current-todos-file)
- (file-truename (buffer-file-name)))
- (set (make-local-variable 'todos-categories) (todos-set-categories))
- (set (make-local-variable 'todos-category-number) 1) ; 0)
- (add-hook 'post-command-hook 'todos-after-find-file nil t))
+(defvar todos-item-start (concat "\\(" todos-date-string-start "\\|"
+ todos-done-string-start "\\)"
+ todos-date-pattern)
+ "String identifying start of a Todos item.")
-;; FIXME: return to Todos or Archive mode
-(define-derived-mode todos-raw-mode nil "Todos Raw" ()
- "Emergency repair mode for Todos files."
- (when (member major-mode '(todos-mode todos-archive-mode))
- (setq buffer-read-only nil)
- (set (make-local-variable 'font-lock-defaults) '(todos-font-lock-keywords t))
- (widen)
- ;; FIXME: doesn't DTRT here
- (todos-prefix-overlays)))
+(defun todos-item-start ()
+ "Move to start of current Todos item and return its position."
+ (unless (or
+ ;; Point is either on last item in this category or on the empty
+ ;; line between done and not done items.
+ (looking-at "^$")
+ ;; There are no done items in this category yet.
+ (looking-at (regexp-quote todos-category-beg)))
+ (goto-char (line-beginning-position))
+ (while (not (looking-at todos-item-start))
+ (forward-line -1))
+ (point)))
-(define-derived-mode todos-edit-mode nil "Todos-Ed" ()
- "Major mode for editing multiline Todo items.
+(defun todos-item-end ()
+ "Move to end of current Todos item and return its position."
+ ;; Items cannot end with a blank line.
+ (unless (looking-at "^$")
+ (let ((done (todos-done-item-p)))
+ (todos-forward-item)
+ ;; Adjust if item is last unfinished one before displayed done items.
+ (when (and (not done) (todos-done-item-p))
+ (forward-line -1))
+ (backward-char))
+ (point)))
-\\{todos-edit-mode-map}"
- (todos-modes-set-1))
+(defun todos-item-string ()
+ "Return bare text of current item as a string."
+ (let ((opoint (point))
+ (start (todos-item-start))
+ (end (todos-item-end)))
+ (goto-char opoint)
+ (and start end (buffer-substring-no-properties start end))))
-(define-derived-mode todos-categories-mode nil "Todos-Cats" ()
- "Major mode for displaying and editing Todos categories.
+(defun todos-remove-item ()
+ "Internal function called in editing, deleting or moving items."
+ (let* ((beg (todos-item-start))
+ (end (progn (todos-item-end) (1+ (point))))
+ (ovs (overlays-in beg beg)))
+ ;; There can be both prefix/number and mark overlays.
+ (while ovs (delete-overlay (car ovs)) (pop ovs))
+ (delete-region beg end)))
-\\{todos-categories-mode-map}"
- (set (make-local-variable 'todos-current-todos-file)
- todos-global-current-todos-file)
- (let ((cats (with-current-buffer (get-file-buffer todos-current-todos-file)
- (if todos-ignore-archived-categories
- todos-categories-full
- (todos-set-categories)))))
- (set (make-local-variable 'todos-categories) cats)))
+(defun todos-diary-item-p ()
+ "Return non-nil if item at point is marked for diary inclusion."
+ (save-excursion
+ (todos-item-start)
+ ;; (looking-at todos-date-pattern)))
+ (not (looking-at (regexp-quote todos-nondiary-start)))))
-(define-derived-mode todos-filter-items-mode nil "Todos-Top" ()
- "Mode for displaying and reprioritizing top priority Todos.
+(defun todos-done-item-p ()
+ "Return non-nil if item at point is a done item."
+ (save-excursion
+ (todos-item-start)
+ (looking-at todos-done-string-start)))
-\\{todos-filter-items-mode-map}"
- (todos-modes-set-1)
- (todos-modes-set-2))
+(defvar todos-item-mark (propertize (if (equal todos-prefix "*") "@" "*")
+ 'face 'todos-mark)
+ "String used to mark items.")
-;; FIXME: need this?
-(defun todos-save ()
- "Save the current Todos file."
- (interactive)
- ;; (todos-update-categories-sexp)
- (save-buffer)
- ;; (if todos-save-top-priorities-too (todos-save-top-priorities))
- )
+(defun todos-marked-item-p ()
+ "If this item is marked, return mark overlay."
+ (let ((ovs (overlays-in (line-beginning-position) (line-beginning-position)))
+ (mark todos-item-mark)
+ ov marked)
+ (catch 'stop
+ (while ovs
+ (setq ov (pop ovs))
+ (and (equal (overlay-get ov 'before-string) mark)
+ (throw 'stop (setq marked t)))))
+ (when marked ov)))
-(defun todos-quit ()
- "Exit the current Todos-related buffer.
-Depending on the specific mode, this either kills and the buffer
-or buries it."
- (interactive)
- (cond ((eq major-mode 'todos-categories-mode)
- (kill-buffer)
- (setq todos-descending-counts nil)
- (todos-show))
- ((eq major-mode 'todos-filter-items-mode)
- (kill-buffer)
- (todos-show))
- ((member major-mode (list 'todos-mode 'todos-archive-mode))
- (todos-save)
- (bury-buffer))))
+(defun todos-insert-with-overlays (item)
+ "Insert ITEM at point and update prefix/priority number overlays."
+ (todos-item-start)
+ (insert item "\n")
+ (todos-backward-item)
+ (todos-prefix-overlays))
-;; ---------------------------------------------------------------------------
-;;; Commands
+(defun todos-prefix-overlays ()
+ "Put before-string overlay in front of this category's items.
+The overlay's value is the string `todos-prefix' or with non-nil
+`todos-number-prefix' an integer in the sequence from 1 to the
+number of todo or done items in the category indicating the
+item's priority. Todo and done items are numbered independently
+of each other."
+ (when (or todos-number-prefix
+ (not (string-match "^[[:space:]]*$" todos-prefix)))
+ (let ((prefix (propertize (concat todos-prefix " ")
+ 'face 'todos-prefix-string))
+ (num 0))
+ (save-excursion
+ (goto-char (point-min))
+ (while (not (eobp))
+ (when (or (todos-date-string-matcher (line-end-position))
+ (todos-done-string-matcher (line-end-position)))
+ (goto-char (match-beginning 0))
+ (when todos-number-prefix
+ (setq num (1+ num))
+ ;; Reset number to 1 for first done item.
+ (when (and (looking-at todos-done-string-start)
+ (looking-back (concat "^"
+ (regexp-quote todos-category-done)
+ "\n")))
+ (setq num 1))
+ (setq prefix (propertize (concat (number-to-string num) " ")
+ 'face 'todos-prefix-string)))
+ (let ((ovs (overlays-in (point) (point)))
+ marked ov-pref)
+ (if ovs
+ (dolist (ov ovs)
+ (let ((val (overlay-get ov 'before-string)))
+ (if (equal val "*")
+ (setq marked t)
+ (setq ov-pref val)))))
+ (unless (equal ov-pref prefix)
+ ;; Why doesn't this work?
+ ;; (remove-overlays (point) (point) 'before-string)
+ (remove-overlays (point) (point))
+ (overlay-put (make-overlay (point) (point))
+ 'before-string prefix)
+ (and marked (overlay-put (make-overlay (point) (point))
+ 'before-string todos-item-mark)))))
+ (forward-line))))))
-;;; Display
+(defun todos-read-file-name (prompt &optional archive mustmatch)
+ "Choose and return the name of a Todos file, prompting with PROMPT.
-;;;###autoload
-(defun todos-show (&optional solicit-file)
- "Visit the current Todos file and display one of its categories.
+Show completions with TAB or SPC; the names are shown in short
+form but the absolute truename is returned. With non-nil ARCHIVE
+return the absolute truename of a Todos archive file. With non-nil
+MUSTMATCH the name of an existing file must be chosen;
+otherwise, a new file name is allowed."
+ (unless (file-exists-p todos-files-directory)
+ (make-directory todos-files-directory))
+ (let ((completion-ignore-case todos-completion-ignore-case)
+ (files (mapcar 'file-name-sans-extension
+ (directory-files todos-files-directory nil
+ (if archive "\.toda$" "\.todo$"))))
+ (file ""))
+ (while (string= "" file)
+ (setq file (completing-read prompt files nil mustmatch))
+ (setq prompt "Enter a non-empty name (TAB for list of current files): "))
+ (setq file (concat todos-files-directory file
+ (if archive ".toda" ".todo")))
+ (unless mustmatch
+ (when (not (member file todos-files))
+ (todos-validate-name file 'file)))
+ (file-truename file)))
-With non-nil prefix argument SOLICIT-FILE ask for file to visit.
-Otherwise, the first invocation of this command in a session
-visits `todos-default-todos-file' (creating it if it does not yet
-exist); subsequent invocations from outside of Todos mode revisit
-this file or, if user option `todos-show-current-file' is
-non-nil, whichever Todos file was visited last.
-
-The category displayed on initial invocation is the first member
-of `todos-categories' for the current Todos file, on subsequent
-invocations whichever category was displayed last. If
-`todos-display-categories-first' is non-nil, then the first
-invocation of `todos-show' displays a clickable listing of the
-categories in the current Todos file."
- (interactive "P")
- (let ((file (cond (solicit-file
- (if (funcall todos-files-function)
- (todos-read-file-name "Select a Todos file to visit: "
- nil t)
- (error "There are no Todos files")))
- ((eq major-mode 'todos-archive-mode)
- ;; FIXME: should it visit same category?
- (concat (file-name-sans-extension todos-current-todos-file)
- ".todo"))
- (t
- (or todos-current-todos-file
- (and todos-show-current-file
- todos-global-current-todos-file)
- todos-default-todos-file
- (todos-add-file))))))
- (if (and todos-first-visit todos-display-categories-first)
- (todos-display-categories)
- (set-window-buffer (selected-window)
- (set-buffer (find-file-noselect file)))
- ;; If no Todos file exists, initialize one.
- (if (zerop (buffer-size))
- ;; Call with empty category name to get initial prompt.
- (setq todos-category-number (todos-add-category "")))
- (save-excursion (todos-category-select)))
- (setq todos-first-visit nil)))
-
-(defun todos-toggle-item-numbering ()
- ""
- (interactive)
- (todos-reset-prefix 'todos-number-prefix (not todos-number-prefix)))
-
-(defun todos-toggle-view-done-items ()
- "Show hidden or hide visible done items in current category."
- (interactive)
- (save-excursion
- (goto-char (point-min))
- (let ((todos-show-with-done
- (if (re-search-forward todos-done-string-start nil t)
- nil
- t))
- (cat (todos-current-category)))
- (todos-category-select)
- (when (zerop (todos-get-count 'done cat))
- (message "There are no done items in this category.")))))
-
-;; FIXME: should there be `todos-toggle-view-todo-items'?
-(defun todos-toggle-show-done-only ()
- "Make category display done or back to todo items." ;FIXME
- (interactive)
- (setq todos-show-done-only (not todos-show-done-only))
- (todos-category-select))
-
-(defun todos-view-archived-items ()
- "Display the archived items of the current category.
-The buffer showing these items is in Todos Archive mode."
- (interactive)
- (let ((cat (todos-current-category)))
- (if (zerop (todos-get-count 'archived cat))
- (message "There are no archived items from this category.")
- (let* ((tfile-base (file-name-sans-extension todos-current-todos-file))
- (afile (concat tfile-base ".toda")))
- (set-window-buffer (selected-window) (set-buffer
- (find-file-noselect afile)))
- (todos-category-number cat)
- (todos-jump-to-category cat)))))
-
-(defun todos-show-archive (&optional ask)
- "Visit the archive of the current Todos file, if it exists.
-With non-nil argument ASK prompt to choose an archive to visit;
-see `todos-choose-archive'. The buffer showing the archive is in
-Todos Archive mode. The first visit in a session displays the
-first category in the archive, subsequent visits return to the
-last category displayed."
- (interactive)
- (let* ((tfile-base (file-name-sans-extension todos-current-todos-file))
- (afile (if ask
- (todos-read-file-name "Choose a Todos archive: " t t)
- (concat tfile-base ".toda"))))
- (if (not (file-exists-p afile))
- (message "There is currently no Todos archive for this file.")
- (set-window-buffer (selected-window) (set-buffer
- (find-file-noselect afile)))
- (todos-category-select))))
-
-(defun todos-choose-archive ()
- "Choose an archive and visit it."
- (interactive)
- (todos-show-archive t))
+(defun todos-read-category (prompt &optional mustmatch)
+ "Choose and return a category name, prompting with PROMPT.
+Show completions with TAB or SPC. With non-nil MUSTMATCH the
+name must be that of an existing category; otherwise, a new
+category name is allowed, after checking its validity."
+ ;; Allow SPC to insert spaces, for adding new category names.
+ (let ((map minibuffer-local-completion-map))
+ (define-key map " " nil)
+ ;; Make a copy of todos-categories in case history-delete-duplicates is
+ ;; non-nil, which makes completing-read alter todos-categories.
+ (let* ((categories (copy-sequence todos-categories))
+ (history (cons 'todos-categories (1+ todos-category-number)))
+ (completion-ignore-case todos-completion-ignore-case)
+ (cat (completing-read prompt todos-categories nil
+ mustmatch nil history
+ ;; Default for existing categories is the
+ ;; current category.
+ (if todos-categories
+ (todos-current-category)
+ ;; Trigger prompt for initial category
+ ""))))
+ (unless mustmatch
+ (when (not (assoc cat categories))
+ (todos-validate-name cat 'category)
+ (if (y-or-n-p (format (concat "There is no category \"%s\" in "
+ "this file; add it? ") cat))
+ (todos-add-category cat)
+ (keyboard-quit))))
+ ;; Restore the original value of todos-categories.
+ (setq todos-categories categories)
+ cat)))
-(defun todos-highlight-item ()
- "Highlight the todo item the cursor is on."
- (interactive)
- (if hl-line-mode ; todos-highlight-item
- (hl-line-mode 0)
- (hl-line-mode 1)))
+(defun todos-validate-name (name type)
+ "Prompt for new NAME for TYPE until it is valid, then return it.
+TYPE can be either a file or a category"
+ (let (prompt file cat shortname)
+ (while
+ (and (cond ((string= "" name)
+ (setq prompt
+ (cond ((eq type 'file)
+ ;; FIXME: just todos-files ?
+ (if (funcall (todos-files))
+ "Enter a non-empty file name: "
+ ;; Empty string passed by todos-show to
+ ;; prompt for initial Todos file.
+ (concat "Initial file name ["
+ todos-initial-file "]: ")))
+ ((eq type 'category)
+ (if todos-categories
+ "Enter a non-empty category name: "
+ ;; Empty string passed by todos-show to
+ ;; prompt for initial category of a new
+ ;; Todos file.
+ (concat "Initial category name ["
+ todos-initial-category "]: "))))))
+ ((string-match "\\`\\s-+\\'" name)
+ (setq prompt
+ "Enter a name that does not contain only white space: "))
+ ((and (eq type 'file) (member name todos-files))
+ (setq prompt "Enter a non-existing file name: "))
+ ((and (eq type 'category) (assoc name todos-categories))
+ (setq prompt "Enter a non-existing category name: ")))
+ (setq name (if (or (and (eq type 'file) todos-files)
+ (and (eq type 'category) todos-categories))
+ (read-from-minibuffer prompt)
+ ;; Offer default initial name.
+ (read-string prompt nil nil
+ (cond ((eq type 'file)
+ todos-initial-file)
+ ((eq type 'category)
+ todos-initial-category))))))))
+ name)
+
+;; Adapted from calendar-read-date and calendar-date-string.
+(defun todos-read-date ()
+ "Prompt for Gregorian date and return it in the current format.
+Also accepts `*' as an unspecified month, day, or year."
+ (let* ((year (calendar-read
+ ;; FIXME: maybe better like monthname with RET for current month
+ "Year (>0 or * for any year): "
+ (lambda (x) (or (eq x '*) (> x 0)))
+ (number-to-string (calendar-extract-year
+ (calendar-current-date)))))
+ (month-array (vconcat calendar-month-name-array (vector "*")))
+ (abbrevs (vconcat calendar-month-abbrev-array (vector "*")))
+ (completion-ignore-case todos-completion-ignore-case)
+ (monthname (completing-read
+ "Month name (RET for current month, * for any month): "
+ (mapcar 'list (append month-array nil))
+ nil t nil nil
+ (calendar-month-name (calendar-extract-month
+ (calendar-current-date)) t)))
+ (month (cdr (assoc-string
+ monthname (calendar-make-alist month-array nil nil
+ abbrevs))))
+ (last (if (= month 13)
+ 31 ; FIXME: what about shorter months?
+ (let ((yr (if (eq year '*)
+ 1999 ; FIXME: no Feb. 29
+ year)))
+ (calendar-last-day-of-month month yr))))
+ day dayname)
+ (while (if (numberp day) (or (< day 0) (< last day)) (not (eq day '*)))
+ (setq day (read-from-minibuffer
+ (format "Day (1-%d or RET for today or * for any day): " last)
+ nil nil t nil
+ (number-to-string
+ (calendar-extract-day (calendar-current-date))))))
+ (setq year (if (eq year '*) (symbol-name '*) (number-to-string year)))
+ (setq day (if (eq day '*) (symbol-name '*) (number-to-string day)))
+ ;; FIXME: make abbreviation customizable
+ (setq monthname
+ (or (and (= month 13) "*")
+ (calendar-month-name (calendar-extract-month (list month day year))
+ t)))
+ (mapconcat 'eval calendar-date-display-form "")))
-(defun todos-toggle-display-date-time (&optional all)
- "Hide or show date/time of todo items in current category.
-With non-nil prefix argument ALL do this in the whole file."
- (interactive "P")
- (save-excursion
- (save-restriction
- (goto-char (point-min))
- (let ((ovs (overlays-in (point) (1+ (point))))
- ov hidden)
- (while ovs
- (setq ov (pop ovs))
- (if (equal (overlay-get ov 'display) "")
- (setq ovs nil hidden t)))
- (when all (widen) (goto-char (point-min)))
- (if hidden
- (remove-overlays (point-min) (point-max) 'display "")
- (while (not (eobp))
- (when (re-search-forward
- (concat todos-date-string-start todos-date-pattern
- "\\( " diary-time-regexp "\\)?"
- (regexp-quote todos-nondiary-end) "? ")
- nil t)
- (unless (save-match-data (todos-done-item-p))
- (setq ov (make-overlay (match-beginning 0) (match-end 0) nil t))
- (overlay-put ov 'display "")))
- (todos-forward-item)))))))
+(defun todos-read-dayname ()
+ "Choose name of a day of the week with completion and return it."
+ (let ((completion-ignore-case todos-completion-ignore-case))
+ (completing-read "Enter a day name: "
+ (append calendar-day-name-array nil)
+ nil t)))
+
+(defun todos-read-time ()
+ "Prompt for and return a valid clock time as a string.
-(defun todos-toggle-mark-item (&optional n all)
- "Mark item at point if unmarked, or unmark it if marked.
+Valid time strings are those matching `diary-time-regexp'.
+Typing `<return>' at the prompt returns the current time, if the
+user option `todos-always-add-time-string' is non-nil, otherwise
+the empty string (i.e., no time string)."
+ (let (valid answer)
+ (while (not valid)
+ (setq answer (read-string "Enter a clock time: " nil nil
+ (when todos-always-add-time-string
+ (substring (current-time-string) 11 16))))
+ (when (or (string= "" answer)
+ (string-match diary-time-regexp answer))
+ (setq valid t)))
+ answer))
-With a positive numerical prefix argument N, change the
-markedness of the next N items. With non-nil argument ALL, mark
-all visible items in the category (depending on visibility, all
-todo and done items, or just todo or just done items).
+(defun todos-convert-legacy-date-time ()
+ "Return converted date-time string.
+Helper function for `todos-convert-legacy-files'."
+ (let* ((year (match-string 1))
+ (month (match-string 2))
+ (monthname (calendar-month-name (string-to-number month) t))
+ (day (match-string 3))
+ (time (match-string 4))
+ dayname)
+ (replace-match "")
+ (insert (mapconcat 'eval calendar-date-display-form "")
+ (when time (concat " " time)))))
-The mark is the character \"*\" inserted in front of the item's
-priority number or the `todos-prefix' string; if `todos-prefix'
-is \"*\", then the mark is \"@\"."
- (interactive "p")
- (if all (goto-char (point-min)))
- (unless (> n 0) (setq n 1))
- (let ((i 0))
- (while (or (and all (not (eobp)))
- (< i n))
- (let* ((cat (todos-current-category))
- (ov (todos-item-marked-p))
- (marked (assoc cat todos-categories-with-marks)))
- (if (and ov (not all))
- (progn
- (delete-overlay ov)
- (if (= (cdr marked) 1) ; Deleted last mark in this category.
- (setq todos-categories-with-marks
- (assq-delete-all cat todos-categories-with-marks))
- (setcdr marked (1- (cdr marked)))))
- (when (todos-item-start)
- (unless (and all (todos-item-marked-p))
- (setq ov (make-overlay (point) (point)))
- (overlay-put ov 'before-string todos-item-mark)
- (if marked
- (setcdr marked (1+ (cdr marked)))
- (push (cons cat 1) todos-categories-with-marks))))))
- (todos-forward-item)
- (setq i (1+ i)))))
+;; ---------------------------------------------------------------------------
+;;; Item filtering
-(defun todos-mark-category ()
- "Put the \"*\" mark on all items in this category.
-\(If `todos-prefix' is \"*\", then the mark is \"@\".)"
- (interactive)
- (todos-toggle-mark-item 0 t))
+(defvar todos-multiple-files nil
+ "List of files returned by `todos-multiple-files' widget.")
-(defun todos-unmark-category ()
- "Remove the \"*\" mark from all items in this category.
-\(If `todos-prefix' is \"*\", then the mark is \"@\".)"
- (interactive)
- (remove-overlays (point-min) (point-max) 'before-string todos-item-mark)
- (setq todos-categories-with-marks
- (delq (assoc (todos-current-category) todos-categories-with-marks)
- todos-categories-with-marks)))
+(defvar todos-multiple-files-widget nil
+ "Variable holding widget created by `todos-multiple-files'.")
-(defun todos-update-merged-files ()
- "Interactively add files to or remove from `todos-merged-files'.
-You can also customize `todos-merged-files' directly."
- (interactive) ;FIXME
- (let ((files (funcall todos-files-function)))
- (dolist (f files)
- (if (member f todos-merged-files)
- (and (y-or-n-p
- (format "Remove \"%s\" from list of merged Todos files? "
- (file-name-sans-extension (file-name-nondirectory f))))
- (setq todos-merged-files (delete f todos-merged-files)))
- (and (y-or-n-p
- (format "Add \"%s\" to list of merged Todos files? "
- (file-name-sans-extension (file-name-nondirectory f))))
- (setq todos-merged-files
- (append todos-merged-files (list f)))))))
- (customize-save-variable 'todos-merged-files todos-merged-files))
-
-(defvar todos-top-priorities-widgets nil
- "Widget placeholder used by `todos-set-top-priorities'.
-This variable temporarily holds user changed values which are
-saved to `todos-priorities-rules'.")
-
-(defun todos-set-top-priorities ()
- ""
- (interactive)
- (let ((buf (get-buffer-create "*Todos Top Priorities*"))
- (files (funcall todos-files-function))
- file frules cats fwidget cwidgets rules)
- (with-current-buffer buf
- (let ((inhibit-read-only t))
- (erase-buffer))
- (remove-overlays)
+(defun todos-multiple-files ()
+ "Pop to a buffer with a widget for choosing multiple filter files."
+ (require 'widget)
+ (eval-when-compile
+ (require 'wid-edit))
+ (with-current-buffer (get-buffer-create "*Todos Filter Files*")
+ (pop-to-buffer (current-buffer))
+ (erase-buffer)
(kill-all-local-variables)
- (setq todos-top-priorities-widgets nil)
- (dolist (f files)
- (with-temp-buffer
- (insert-file-contents f)
- (setq file (file-name-sans-extension (file-name-nondirectory f))
- frules (assoc file todos-priorities-rules)
- cats (mapcar 'car (todos-set-categories))))
- (setq fwidget
- (widget-create 'editable-field
- :size 2
- :value (or (and frules (cadr frules))
- "")
- :tag file
- :format " %v : %t\n"))
- (dolist (c cats)
- (let ((tp-num (cdr (assoc c cats)))
- cwidget)
- (widget-insert " ")
- (setq cwidget (widget-create 'editable-field
- :size 2
- :value (or tp-num "")
- :tag c
- :format " %v : %t\n"))
- (push cwidget cwidgets)))
- (push (cons fwidget cwidgets) todos-top-priorities-widgets))
- (widget-insert "\n\n")
+ (widget-insert "Select files for generating the top priorities list.\n\n")
+ (setq todos-multiple-files-widget
+ (widget-create
+ `(set ,@(mapcar (lambda (x) (list 'const x))
+ (mapcar 'todos-short-file-name
+ (funcall todos-files-function))))))
+ (widget-insert "\n")
(widget-create 'push-button
:notify (lambda (widget &rest ignore)
- (kill-buffer))
+ (setq todos-multiple-files 'quit)
+ (quit-window t)
+ (exit-recursive-edit))
"Cancel")
- (widget-insert " ")
+ (widget-insert " ")
(widget-create 'push-button
:notify (lambda (&rest ignore)
- (let ((widgets todos-top-priorities-widgets)
- (rules todos-priorities-rules)
- tp-cats)
- (setq rules nil)
- (dolist (w widgets)
- (let* ((fwid (car w))
- (cwids (cdr w))
- (fname (widget-get fwid :tag))
- (fval (widget-value fwid)))
- (dolist (c cwids)
- (let ((cat (widget-get c :tag))
- (cval (widget-value c)))
- (push (cons cat cval) tp-cats)))
- (push (list fname fval tp-cats) rules)))
- (setq todos-priorities-rules rules)
- (customize-save-variable 'todos-priorities-rules
- todos-priorities-rules)))
+ (setq todos-multiple-files
+ (mapcar (lambda (f)
+ (concat todos-files-directory
+ f ".todo"))
+ (widget-value
+ todos-multiple-files-widget)))
+ (quit-window t)
+ (exit-recursive-edit))
"Apply")
(use-local-map widget-keymap)
(widget-setup))
- (set-window-buffer (selected-window) (set-buffer buf))))
-
-(defun todos-filter-items (&optional filter merge)
- "Display a filtered list of items from different categories.
-
-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.
-
-Number of entries for each category is given by NUM, which
-defaults to `todos-show-priorities'. With non-nil argument
-MERGE list top priorities of all Todos files in
-`todos-merged-files'. If `todos-prompt-merged-files' is non-nil,
-prompt to update the list of merged files."
+ (message "Click \"Apply\" after selecting files.")
+ (recursive-edit))
+
+;; FIXME: should done and archived items be included? Maybe just for regexp
+;; and custom filters?
+(defun todos-filter-items (filter &optional multifile)
+ "Build and display a list of items from different categories.
+
+The items are selected according to the value of FILTER, which
+can be `top' for top priority items, `diary' for diary items,
+`regexp' for items matching a regular expresion entered by the
+user, or `custom' for items chosen by user-defined function
+`todos-filter-function'.
+
+With non-nil argument MULTIFILE list top priorities of multiple
+Todos files, by default those in `todos-filter-files'."
(let ((num (if (consp filter) (cdr filter) todos-show-priorities))
- (buf (get-buffer-create todos-tmp-buffer-name))
+ (buf (get-buffer-create todos-filter-buffer))
(files (list todos-current-todos-file))
regexp fname bufstr cat beg end done)
- (when merge
- ;; FIXME: same or different treatment for top priorities and other
- ;; filters? And what about todos-prompt-merged-files?
- (setq files (if (member filter '(diary regexp custom))
- (or (and todos-prompt-merged-files
- (todos-update-merged-files))
- todos-merged-files
- (todos-update-merged-files))
- ;; Set merged files for top priorities.
- (or (mapcar (lambda (f)
- (let ((file (car f))
- (val (nth 1 f)))
- (and val (not (zerop val))
- (push file files))))
- todos-priorities-rules)
- (if (y-or-n-p "Choose files for merging top priorities? ")
- (progn (todos-set-top-priorities) (error ""))
- (error "No files are set for merging top priorities"))))))
- (with-current-buffer buf
- (erase-buffer)
- (kill-all-local-variables)
- (todos-filter-items-mode))
- (when (eq filter 'regexp)
- (setq regexp (read-string "Enter a regular expression: ")))
- (save-current-buffer
- (dolist (f files)
- (setq fname (file-name-sans-extension (file-name-nondirectory f)))
- (with-temp-buffer
- (insert-file-contents f)
- (goto-char (point-min))
- ;; Unless the number of items to show was supplied by prefix
- ;; argument of caller, override `todos-show-priorities' with the
- ;; nonzero file-wide value from `todos-priorities-rules'.
- (unless (consp filter)
- (let ((tp-val (nth 1 (assoc fname todos-priorities-rules))))
- (unless (zerop (length tp-val))
- (setq num (string-to-number tp-val)))))
- (unless (looking-at (concat "^" (regexp-quote todos-category-beg)))
- (kill-line 1))
- (while (re-search-forward
- (concat "^" (regexp-quote todos-category-beg) "\\(.+\\)\n")
- nil t)
- (setq cat (match-string 1))
- ;; Unless the number of items to show was supplied by prefix
- ;; argument of caller, override `todos-show-priorities' with the
- ;; nonzero category-wide value from `todos-priorities-rules'.
- (unless (consp filter)
- (let* ((cats (nth 2 (assoc fname todos-priorities-rules)))
- (tp-val (cdr (assoc cat cats))))
- (unless (zerop (length tp-val))
- (setq num (string-to-number tp-val)))))
- (delete-region (match-beginning 0) (match-end 0))
- (setq beg (point)) ; Start of first entry.
- (setq end (if (re-search-forward
- (concat "^" (regexp-quote todos-category-beg)) nil t)
- (match-beginning 0)
- (point-max)))
- (goto-char beg)
- (setq done
- (if (re-search-forward
- (concat "\n" (regexp-quote todos-category-done)) end t)
- (match-beginning 0)
- end))
- (delete-region done end)
- (setq end done)
- (narrow-to-region beg end) ; Process current category.
+ (when multifile
+ (setq files (if (or (consp filter) (null todos-filter-files))
+ (progn (todos-multiple-files) todos-multiple-files)
+ todos-filter-files)
+ todos-multiple-files nil))
+ (if (eq files 'quit) (keyboard-quit))
+ (if (null files)
+ (error "No files have been chosen for filtering")
+ (with-current-buffer buf
+ (erase-buffer)
+ (kill-all-local-variables)
+ (todos-filter-items-mode))
+ (when (eq filter 'regexp)
+ (setq regexp (read-string "Enter a regular expression: ")))
+ (save-current-buffer
+ (dolist (f files)
+ ;; Before inserting file contents into temp buffer, save a modified
+ ;; buffer visiting it.
+ (let ((bf (find-buffer-visiting f)))
+ (when (buffer-modified-p bf)
+ (with-current-buffer bf (save-buffer))))
+ (setq fname (todos-short-file-name f))
+ (with-temp-buffer
+ (insert-file-contents f)
(goto-char (point-min))
- ;; Apply the filter.
- (cond ((eq filter 'diary)
- (while (not (eobp))
- (if (looking-at (regexp-quote todos-nondiary-start))
- (todos-remove-item)
- (todos-forward-item))))
- ((eq filter 'regexp)
- (while (not (eobp))
- (if (string-match regexp (todos-item-string))
- (todos-forward-item)
- (todos-remove-item))))
- ((eq filter 'custom)
- (if todos-filter-function
- (funcall todos-filter-function)
- (error "No custom filter function has been defined")))
- (t ; Filter top priority items.
- (todos-forward-item num)))
- (setq beg (point))
- (unless (member filter '(diary regexp custom))
- (delete-region beg end))
- (goto-char (point-min))
- ;; Add file (if using merged files) and category tags to item.
- (while (not (eobp))
- (when (re-search-forward
- (concat todos-date-string-start todos-date-pattern
- "\\( " diary-time-regexp "\\)?"
- (regexp-quote todos-nondiary-end) "?")
- nil t)
- (insert (concat " [" (if merge (concat fname ":")) cat "]")))
- (forward-line))
- (widen))
- (setq bufstr (buffer-string))
- (with-current-buffer buf
- (let (buffer-read-only)
- (insert bufstr))))))
- (set-window-buffer (selected-window) (set-buffer buf))
- (todos-prefix-overlays)
- (goto-char (point-min))
- ;; FIXME: this is necessary -- why?
- (font-lock-fontify-buffer)))
-
-(defun todos-top-priorities (&optional num)
- "List top priorities of each category in `todos-merged-files'.
-Number of entries for each category is given by NUM, which
-defaults to `todos-show-priorities'."
- (interactive "p")
- (let ((arg (if num (cons 'top num) 'top)))
- (todos-filter-items arg)))
+ (let (fnum)
+ ;; Unless the number of items to show was supplied by prefix
+ ;; argument of caller, override `todos-show-priorities' with the
+ ;; file-wide value from `todos-priorities-rules'.
+ (unless (consp filter)
+ (setq fnum (nth 1 (assoc f todos-priorities-rules))))
+ (unless (looking-at (concat "^" (regexp-quote todos-category-beg)))
+ (kill-line 1))
+ (while (re-search-forward
+ (concat "^" (regexp-quote todos-category-beg) "\\(.+\\)\n")
+ nil t)
+ (setq cat (match-string 1))
+ (let (cnum)
+ ;; Unless the number of items to show was supplied by prefix
+ ;; argument of caller, override the file-wide value from
+ ;; `todos-priorities-rules' if set, else
+ ;; `todos-show-priorities' with non-nil category-wide value
+ ;; from `todos-priorities-rules'.
+ (unless (consp filter)
+ (let ((cats (nth 2 (assoc f todos-priorities-rules))))
+ (setq cnum (or (cdr (assoc cat cats))
+ fnum
+ ;; FIXME: need this?
+ todos-show-priorities))))
+ (delete-region (match-beginning 0) (match-end 0))
+ (setq beg (point)) ; Start of first item.
+ (setq end (if (re-search-forward
+ (concat "^" (regexp-quote todos-category-beg))
+ nil t)
+ (match-beginning 0)
+ (point-max)))
+ (goto-char beg)
+ (setq done
+ (if (re-search-forward
+ (concat "\n" (regexp-quote todos-category-done))
+ end t)
+ (match-beginning 0)
+ end))
+ ;; Leave done items only with regexp filter.
+ ;; FIXME: and custom filter?
+ (unless (eq filter 'regexp)
+ (delete-region done end)
+ (setq end done))
+ (narrow-to-region beg end) ; Process current category.
+ (goto-char (point-min))
+ ;; Apply the filter.
+ (cond ((eq filter 'diary)
+ (while (not (eobp))
+ (if (looking-at (regexp-quote todos-nondiary-start))
+ (todos-remove-item)
+ (todos-forward-item))))
+ ((eq filter 'regexp)
+ (while (not (eobp))
+ (if (looking-at todos-item-start)
+ (if (string-match regexp (todos-item-string))
+ (todos-forward-item)
+ (todos-remove-item))
+ ;; Kill lines that aren't part of a todo or done
+ ;; item (empty or todos-category-done).
+ (delete-region (line-beginning-position)
+ (1+ (line-end-position))))
+ ;; If last todo item in file matches regexp and
+ ;; there are no following done items,
+ ;; todos-category-done string is left dangling,
+ ;; because todos-forward-item jumps over it.
+ (if (and (eobp) (looking-back
+ (concat (regexp-quote todos-done-string)
+ "\n")))
+ (delete-region (point) (progn
+ (forward-line -2)
+ (point))))))
+ ((eq filter 'custom)
+ (if todos-filter-function
+ (funcall todos-filter-function)
+ (error "No custom filter function has been defined")))
+ (t ; Filter top priority items.
+ (setq num (or cnum fnum num))
+ (unless (zerop num)
+ (todos-forward-item num))))
+ (setq beg (point))
+ (unless (member filter '(diary regexp custom))
+ (delete-region beg end))
+ (goto-char (point-min))
+ ;; Add file (if using multiple files) and category tags to
+ ;; item.
+ (while (not (eobp))
+ (when (re-search-forward
+ (concat "\\(" todos-done-string-start
+ todos-date-pattern "\\( " diary-time-regexp
+ "\\)?]\\)\\|\\("
+ ;; todos-date-string-start doesn't work
+ ;; here because of `^'
+ "\\(" (regexp-quote todos-nondiary-start)
+ "\\|" (regexp-quote diary-nonmarking-symbol)
+ "\\)?" todos-date-pattern "\\( "
+ diary-time-regexp "\\)?"
+ (regexp-quote todos-nondiary-end) "?\\)")
+ nil t)
+ (insert (concat " [" (if multifile (concat fname ":"))
+ cat "]")))
+ (forward-line))
+ (widen)))
+ (setq bufstr (buffer-string))
+ (with-current-buffer buf
+ (let (buffer-read-only)
+ (insert bufstr)))))))
+ ;; FIXME: let-bind todos-mode-line-control according to FILTER?
+ (set-window-buffer (selected-window) (set-buffer buf))
+ (todos-prefix-overlays)
+ (goto-char (point-min))
+ ;; FIXME: this is necessary -- why?
+ (font-lock-fontify-buffer))))
+
+(defun todos-set-top-priorities (&optional arg)
+ "Set number of top priorities shown by `todos-top-priorities'.
+With non-nil ARG, set the number only for the current Todos
+category; otherwise, set the number for all categories in the
+current Todos file.
+
+Calling this function via either of the commands
+`todos-set-top-priorities-in-file' or
+`todos-set-top-priorities-in-category' is the recommended way to
+set the user customizable option `todos-priorities-rules'."
+ (let* ((cat (todos-current-category))
+ (file todos-current-todos-file)
+ (rules todos-priorities-rules)
+ (frule (assoc-string file rules))
+ (crule (assoc-string cat (nth 2 frule)))
+ (cur (or (if arg (cdr crule) (nth 1 frule))
+ todos-show-priorities))
+ (prompt (concat "Current number of top priorities in this "
+ (if arg "category" "file") ": %d; "
+ "enter new number: "))
+ (new "-1")
+ nrule)
+ (while (or (not (string-match "[0-9]+" new)) ; Don't accept "" or "bla".
+ (< (string-to-number new) 0))
+ (let ((cur0 cur))
+ (setq new (read-string (format prompt cur0) nil nil cur0)
+ prompt "Enter a non-negative number: "
+ cur0 nil)))
+ (setq new (string-to-number new))
+ (setq nrule (if arg
+ (append (nth 2 (delete crule frule)) (list (cons cat new)))
+ (append (list file new) (list (nth 2 frule)))))
+ (setq rules (cons (if arg
+ (list file cur nrule)
+ nrule)
+ (delete frule rules)))
+ (customize-save-variable 'todos-priorities-rules rules)))
-(defun todos-merged-top-priorities (&optional num)
- "List top priorities of each category in `todos-merged-files'.
-Number of entries for each category is given by NUM, which
-defaults to `todos-show-priorities'."
- (interactive "p")
- (let ((arg (if num (cons 'top num) 'top)))
- (todos-filter-items arg t)))
-(defun todos-diary-items ()
- "Display todo items for diary inclusion in this Todos file."
- (interactive)
- (todos-filter-items 'diary))
+;; ---------------------------------------------------------------------------
+;;; Sorting and display routines for Todos Categories mode.
-(defun todos-merged-diary-items ()
- "Display todo items for diary inclusion in one or more Todos file.
-The files are those listed in `todos-merged-files'."
- (interactive)
- (todos-filter-items 'diary t))
+(defun todos-longest-category-name-length (categories)
+ "Return the length of the longest name in list CATEGORIES."
+ (let ((longest 0))
+ (dolist (c categories longest)
+ (setq longest (max longest (length c))))))
-(defun todos-regexp-items ()
- "Display todo items matching a user-entered regular expression.
-The items are those in the current Todos file."
- (interactive)
- (todos-filter-items 'regexp))
+(defun todos-padded-string (str)
+ "Return string STR padded with spaces.
+The placement of the padding is determined by the value of user
+option `todos-categories-align'."
+ (let* ((categories (mapcar 'car todos-categories))
+ (len (max (todos-longest-category-name-length categories)
+ (length todos-categories-category-label)))
+ (strlen (length str))
+ (strlen-odd (eq (logand strlen 1) 1)) ; oddp from cl.el
+ (padding (max 0 (/ (- len strlen) 2)))
+ (padding-left (cond ((eq todos-categories-align 'left) 0)
+ ((eq todos-categories-align 'center) padding)
+ ((eq todos-categories-align 'right)
+ (if strlen-odd (1+ (* padding 2)) (* padding 2)))))
+ (padding-right (cond ((eq todos-categories-align 'left)
+ (if strlen-odd (1+ (* padding 2)) (* padding 2)))
+ ((eq todos-categories-align 'center)
+ (if strlen-odd (1+ padding) padding))
+ ((eq todos-categories-align 'right) 0))))
+ (concat (make-string padding-left 32) str (make-string padding-right 32))))
-(defun todos-merged-regexp-items ()
- "Display todo items matching a user-entered regular expression.
-The items are those in the files listed in `todos-merged-files'."
- (interactive)
- (todos-filter-items 'regexp t))
+(defvar todos-descending-counts nil
+ "List of keys for category counts sorted in descending order.")
-(defun todos-custom-items ()
- "Display todo items filtered by `todos-filter-function'.
-The items are those in the current Todos file."
- (interactive)
- (todos-filter-items 'custom))
+(defun todos-sort (list &optional key)
+ "Return a copy of LIST, possibly sorted according to KEY."
+ (let* ((l (copy-sequence list))
+ (fn (if (eq key 'alpha)
+ (lambda (x) (upcase x)) ; Alphabetize case insensitively.
+ (lambda (x) (todos-get-count key x))))
+ (descending (member key todos-descending-counts))
+ (cmp (if (eq key 'alpha)
+ 'string<
+ (if descending '< '>)))
+ (pred (lambda (s1 s2) (let ((t1 (funcall fn (car s1)))
+ (t2 (funcall fn (car s2))))
+ (funcall cmp t1 t2)))))
+ (when key
+ (setq l (sort l pred))
+ (if descending
+ (setq todos-descending-counts
+ (delete key todos-descending-counts))
+ (push key todos-descending-counts)))
+ l))
-(defun todos-merged-custom-items ()
- "Display todo items filtered by `todos-filter-function'.
-The items are those in the files listed in `todos-merged-files'."
- (interactive)
- (todos-filter-items 'custom t))
+(defun todos-display-sorted (type)
+ "Keep point on the TYPE count sorting button just clicked."
+ (let ((opoint (point)))
+ (todos-update-categories-display type)
+ (goto-char opoint)))
-;;; Navigation
+(defun todos-label-to-key (label)
+ "Return symbol for sort key associated with LABEL."
+ (let (key)
+ (cond ((string= label todos-categories-category-label)
+ (setq key 'alpha))
+ ((string= label todos-categories-todo-label)
+ (setq key 'todo))
+ ((string= label todos-categories-diary-label)
+ (setq key 'diary))
+ ((string= label todos-categories-done-label)
+ (setq key 'done))
+ ((string= label todos-categories-archived-label)
+ (setq key 'archived)))
+ key))
-(defun todos-forward-category (&optional back)
- "Visit the numerically next category in this Todos file.
-With non-nil argument BACK, visit the numerically previous
-category."
- (interactive)
- (setq todos-category-number
- (1+ (mod (- todos-category-number (if back 2 0))
- (length todos-categories))))
- (todos-category-select)
- (goto-char (point-min)))
+(defun todos-insert-sort-button (label)
+ "Insert button for displaying categories sorted by item counts.
+LABEL determines which type of count is sorted."
+ (setq str (if (string= label todos-categories-category-label)
+ (todos-padded-string label)
+ label))
+ (setq beg (point))
+ (setq end (+ beg (length str)))
+ (insert-button str 'face nil
+ 'action
+ `(lambda (button)
+ (let ((key (todos-label-to-key ,label)))
+ (if (and (member key todos-descending-counts)
+ (eq key 'alpha))
+ (progn
+ ;; If display is alphabetical, switch back to
+ ;; category order.
+ (todos-display-sorted nil)
+ (setq todos-descending-counts
+ (delete key todos-descending-counts)))
+ (todos-display-sorted key)))))
+ (setq ovl (make-overlay beg end))
+ (overlay-put ovl 'face 'todos-button))
-(defun todos-backward-category ()
- "Visit the numerically previous category in this Todos file."
- (interactive)
- (todos-forward-category t))
+(defun todos-total-item-counts ()
+ "Return a list of total item counts for the current file."
+ (mapcar (lambda (i) (apply '+ (mapcar (lambda (l) (aref l i))
+ (mapcar 'cdr todos-categories))))
+ (list 0 1 2 3)))
-;; FIXME: autoload?
-(defun todos-jump-to-category (&optional cat other-file)
- "Jump to a category in this or another Todos file.
-Optional argument CAT provides the category name. Otherwise,
-prompt for the category, with TAB completion on existing
-categories. If a non-existing category name is entered, ask
-whether to add a new category with this name, if affirmed, do so,
-then jump to that category. With non-nil argument OTHER-FILE,
-prompt for a Todos file, otherwise jump within the current Todos
-file."
- (interactive)
- (let ((file (or (and other-file
- (todos-read-file-name "Choose a Todos file: " nil t))
- ;; Jump to archived-only Categories from Todos Categories mode.
- (and cat
- todos-ignore-archived-categories
- (zerop (todos-get-count 'todo cat))
- (zerop (todos-get-count 'done cat))
- (not (zerop (todos-get-count 'archived cat)))
- (concat (file-name-sans-extension
- todos-current-todos-file) ".toda"))
- todos-current-todos-file
- ;; If invoked from outside of Todos mode before todos-show...
- todos-default-todos-file)))
- (with-current-buffer (find-file-noselect file)
- (and other-file (setq todos-current-todos-file file))
- (let ((category (or (and (assoc cat todos-categories) cat)
- (todos-read-category "Jump to category: "))))
- ;; ;; FIXME: why is this needed?
- ;; (if (string= "" category)
- ;; (setq category (todos-current-category)))
- ;; Clean up after selecting category in Todos Categories mode.
- (if (string= (buffer-name) todos-categories-buffer)
- (kill-buffer))
- (if (or cat other-file)
- (set-window-buffer (selected-window)
- (set-buffer (get-file-buffer file))))
- (unless todos-global-current-todos-file
- (setq todos-global-current-todos-file todos-current-todos-file))
- (todos-category-number category)
- (if (> todos-category-number (length todos-categories))
- (setq todos-category-number (todos-add-category category)))
- (todos-category-select)
- (goto-char (point-min))))))
+(defun todos-insert-category-line (cat &optional nonum)
+ "Insert button displaying category CAT's name and item counts.
+With non-nil argument NONUM show only these; otherwise, insert a
+number in front of the button indicating the category's priority.
+The number and the category name are separated by the string
+which is the value of the user option
+`todos-categories-number-separator'."
+ (let* ((archive (member todos-current-todos-file todos-archives))
+ (str (todos-padded-string cat))
+ (opoint (point)))
+ ;; num is declared in caller.
+ (setq num (1+ num))
+ (insert-button
+ (concat (if nonum
+ (make-string (+ 4 (length todos-categories-number-separator))
+ 32)
+ (format " %3d%s" num todos-categories-number-separator))
+ str
+ (mapconcat (lambda (elt)
+ (concat
+ (make-string (1+ (/ (length (car elt)) 2)) 32) ; label
+ (format "%3d" (todos-get-count (cdr elt) cat)) ; count
+ ;; Add an extra space if label length is odd
+ ;; (using def of oddp from cl.el).
+ (if (eq (logand (length (car elt)) 1) 1) " ")))
+ (if archive
+ (list (cons todos-categories-done-label 'done))
+ (list (cons todos-categories-todo-label 'todo)
+ (cons todos-categories-diary-label 'diary)
+ (cons todos-categories-done-label 'done)
+ (cons todos-categories-archived-label
+ 'archived)))
+ ""))
+ 'face (if (and todos-ignore-archived-categories
+ (zerop (todos-get-count 'todo cat))
+ (zerop (todos-get-count 'done cat))
+ (not (zerop (todos-get-count 'archived cat))))
+ 'todos-archived-only
+ nil)
+ 'action `(lambda (button) (let ((buf (current-buffer)))
+ (todos-jump-to-category ,cat)
+ (kill-buffer buf))))
+ ;; Highlight the sorted count column.
+ (let* ((beg (+ opoint 6 (length str)))
+ end ovl)
+ (cond ((eq nonum 'todo)
+ (setq beg (+ beg 1 (/ (length todos-categories-todo-label) 2))))
+ ((eq nonum 'diary)
+ (setq beg (+ beg 1 (length todos-categories-todo-label)
+ 2 (/ (length todos-categories-diary-label) 2))))
+ ((eq nonum 'done)
+ (setq beg (+ beg 1 (length todos-categories-todo-label)
+ 2 (length todos-categories-diary-label)
+ 2 (/ (length todos-categories-done-label) 2))))
+ ((eq nonum 'archived)
+ (setq beg (+ beg 1 (length todos-categories-todo-label)
+ 2 (length todos-categories-diary-label)
+ 2 (length todos-categories-done-label)
+ 2 (/ (length todos-categories-archived-label) 2)))))
+ (unless (= beg (+ opoint 6 (length str)))
+ (setq end (+ beg 4))
+ (setq ovl (make-overlay beg end))
+ (overlay-put ovl 'face 'todos-sorted-column)))
+ (newline)))
-(defun todos-jump-to-category-other-file ()
- "Jump to a category in another Todos file.
-The category is chosen by prompt, with TAB completion."
- (interactive)
- (todos-jump-to-category nil t))
+(defun todos-display-categories-1 ()
+ "Prepare buffer for displaying table of categories and item counts."
+ (unless (eq major-mode 'todos-categories-mode)
+ (setq todos-global-current-todos-file (or todos-current-todos-file
+ todos-default-todos-file))
+ (set-window-buffer (selected-window)
+ (set-buffer (get-buffer-create todos-categories-buffer)))
+ (kill-all-local-variables)
+ (todos-categories-mode)
+ (let (buffer-read-only)
+ (erase-buffer)
+ ;; FIXME: add usage tips?
+ (insert (format "Category counts for Todos file \"%s\"."
+ (todos-short-file-name todos-current-todos-file)))
+ (newline 2)
+ ;; Make space for the column of category numbers.
+ (insert (make-string (+ 4 (length todos-categories-number-separator)) 32))
+ ;; Add the category and item count buttons (if this is the list of
+ ;; categories in an archive, show only done item counts).
+ (todos-insert-sort-button todos-categories-category-label)
+ (if (member todos-current-todos-file todos-archives)
+ (insert (concat (make-string 6 32)
+ (format "%s" todos-categories-archived-label)))
+ (insert (make-string 3 32))
+ (todos-insert-sort-button todos-categories-todo-label)
+ (insert (make-string 2 32))
+ (todos-insert-sort-button todos-categories-diary-label)
+ (insert (make-string 2 32))
+ (todos-insert-sort-button todos-categories-done-label)
+ (insert (make-string 2 32))
+ (todos-insert-sort-button todos-categories-archived-label))
+ (newline 2))))
+
+(defun todos-update-categories-display (sortkey)
+ ""
+ (let* ((cats0 (if (and todos-ignore-archived-categories
+ (not (eq major-mode 'todos-categories-mode)))
+ todos-categories-full
+ todos-categories))
+ (cats (todos-sort cats0 sortkey))
+ (archive (member todos-current-todos-file todos-archives))
+ ;; `num' is used by todos-insert-category-line.
+ (num 0)
+ ;; Find start of Category button if we just entered Todos Categories
+ ;; mode.
+ (pt (if (eq (point) (point-max))
+ (save-excursion
+ (forward-line -2)
+ (goto-char (next-single-char-property-change
+ (point) 'face nil (line-end-position))))))
+ (buffer-read-only))
+ (forward-line 2)
+ (delete-region (point) (point-max))
+ ;; Fill in the table with buttonized lines, each showing a category and
+ ;; its item counts.
+ (mapc (lambda (cat) (todos-insert-category-line cat sortkey))
+ (mapcar 'car cats))
+ (newline)
+ ;; Add a line showing item count totals.
+ (insert (make-string (+ 4 (length todos-categories-number-separator)) 32)
+ (todos-padded-string todos-categories-totals-label)
+ (mapconcat
+ (lambda (elt)
+ (concat
+ (make-string (1+ (/ (length (car elt)) 2)) 32)
+ (format "%3d" (nth (cdr elt) (todos-total-item-counts)))
+ ;; Add an extra space if label length is odd (using
+ ;; definition of oddp from cl.el).
+ (if (eq (logand (length (car elt)) 1) 1) " ")))
+ (if archive
+ (list (cons todos-categories-done-label 2))
+ (list (cons todos-categories-todo-label 0)
+ (cons todos-categories-diary-label 1)
+ (cons todos-categories-done-label 2)
+ (cons todos-categories-archived-label 3)))
+ ""))
+ ;; Put cursor on Category button initially.
+ (if pt (goto-char pt))
+ (setq buffer-read-only t)))
-;; FIXME ? disallow prefix arg value < 1 (re-search-* allows these)
-(defun todos-forward-item (&optional count)
- "Move point down to start of item with next lower priority.
-With numerical prefix COUNT, move point COUNT items downward,"
- (interactive "P")
- (let* ((not-done (not (or (todos-done-item-p) (looking-at "^$"))))
- (start (line-end-position)))
- (goto-char start)
- (if (re-search-forward todos-item-start nil t (or count 1))
- (goto-char (match-beginning 0))
- (goto-char (point-max)))
- ;; If points advances by one from a todo to a done item, go back to the
- ;; space above todos-done-separator, since that is a legitimate place to
- ;; insert an item. But skip this space if count > 1, since that should
- ;; only stop on an item (FIXME: or not?)
- (when (and not-done (todos-done-item-p))
- (if (or (not count) (= count 1))
- (re-search-backward "^$" start t)))))
+;; ---------------------------------------------------------------------------
+;;; Todos insertion commands, key bindings and keymap
-(defun todos-backward-item (&optional count)
- "Move point up to start of item with next higher priority.
-With numerical prefix COUNT, move point COUNT items upward,"
- (interactive "P")
- (let* ((done (todos-done-item-p)))
- ;; FIXME ? this moves to bob if on the first item (but so does previous-line)
- (todos-item-start)
- (unless (bobp)
- (re-search-backward todos-item-start nil t (or count 1)))
- ;; If points advances by one from a done to a todo item, go back to the
- ;; space above todos-done-separator, since that is a legitimate place to
- ;; insert an item. But skip this space if count > 1, since that should
- ;; only stop on an item (FIXME: or not?)
- (when (and done (not (todos-done-item-p))
- (or (not count) (= count 1)))
- (re-search-forward (concat "^" (regexp-quote todos-category-done)) nil t)
- (forward-line -1))))
+;; Can either of these be included in Emacs? The originals are GFDL'd.
+;; Slightly reformulated from
+;; http://rosettacode.org/wiki/Power_set#Common_Lisp.
+(defun powerset-recursive (l)
+ (cond ((null l)
+ (list nil))
+ (t
+ (let ((prev (todos-powerset (cdr l))))
+ (append (mapcar (lambda (elt) (cons (car l) elt)) prev)
+ prev)))))
+;; Elisp implementation of http://rosettacode.org/wiki/Power_set#C
+(defun powerset-bitwise (l)
+ (let ((binnum (lsh 1 (length l)))
+ pset elt)
+ (dotimes (i binnum)
+ (let ((bits i)
+ (ll l))
+ (while (not (zerop bits))
+ (let ((arg (pop ll)))
+ (unless (zerop (logand bits 1))
+ (setq elt (append elt (list arg))))
+ (setq bits (lsh bits -1))))
+ (setq pset (append pset (list elt)))
+ (setq elt nil)))
+ pset))
+
+;; (defalias 'todos-powerset 'powerset-recursive)
+(defalias 'todos-powerset 'powerset-bitwise)
-(defun todos-search ()
- "Search for a regular expression in this Todos file.
-The search runs through the whole file and encompasses all and
-only todo and done items; it excludes category names. Multiple
-matches are shown sequentially, highlighted in `todos-search'
-face."
- (interactive)
- (let ((regex (read-from-minibuffer "Enter a search string (regexp): "))
- (opoint (point))
- matches match cat in-done ov mlen msg)
- (widen)
- (goto-char (point-min))
- (while (not (eobp))
- (setq match (re-search-forward regex nil t))
- (goto-char (line-beginning-position))
- (unless (or (equal (point) 1)
- (looking-at (concat "^" (regexp-quote todos-category-beg))))
- (if match (push match matches)))
- (forward-line))
- (setq matches (reverse matches))
- (if matches
- (catch 'stop
- (while matches
- (setq match (pop matches))
- (goto-char match)
- (todos-item-start)
- (when (looking-at todos-done-string-start)
- (setq in-done t))
- (re-search-backward (concat "^" (regexp-quote todos-category-beg)
- "\\(.*\\)\n") nil t)
- (setq cat (match-string-no-properties 1))
- (todos-category-number cat)
- (todos-category-select)
- (if in-done
- (unless todos-show-with-done (todos-toggle-view-done-items)))
- (goto-char match)
- (setq ov (make-overlay (- (point) (length regex)) (point)))
- (overlay-put ov 'face 'todos-search)
- (when matches
- (setq mlen (length matches))
- (if (y-or-n-p
- (if (> mlen 1)
- (format "There are %d more matches; go to next match? "
- mlen)
- "There is one more match; go to it? "))
- (widen)
- (throw 'stop (setq msg (if (> mlen 1)
- (format "There are %d more matches."
- mlen)
- "There is one more match."))))))
- (setq msg "There are no more matches."))
- (todos-category-select)
- (goto-char opoint)
- (message "No match for \"%s\"" regex))
- (when msg
- (if (y-or-n-p (concat msg "\nUnhighlight matches? "))
- (todos-clear-matches)
- (message "You can unhighlight the matches later by typing %s"
- (key-description (car (where-is-internal
- 'todos-clear-matches))))))))
+;; Return list of lists of non-nil atoms produced from ARGLIST. The elements
+;; of ARGLIST may be atoms or lists.
+(defun todos-gen-arglists (arglist)
+ (let (arglists)
+ (while arglist
+ (let ((arg (pop arglist)))
+ (cond ((symbolp arg)
+ (setq arglists (if arglists
+ (mapcar (lambda (l) (push arg l)) arglists)
+ (list (push arg arglists)))))
+ ((listp arg)
+ (setq arglists
+ (mapcar (lambda (a)
+ (if (= 1 (length arglists))
+ (apply (lambda (l) (push a l)) arglists)
+ (mapcar (lambda (l) (push a l)) arglists)))
+ arg))))))
+ (setq arglists (mapcar 'reverse (apply 'append (mapc 'car arglists))))))
-(defun todos-clear-matches ()
- "Remove highlighting on matches found by todos-search."
- (interactive)
- (remove-overlays 1 (1+ (buffer-size)) 'face 'todos-search))
+(defvar todos-insertion-commands-args-genlist
+ '(diary nonmarking (calendar date dayname) time (here region))
+ "Generator list for argument lists of Todos insertion commands.")
-;;; Editing
+(defvar todos-insertion-commands-args
+ (let ((argslist (todos-gen-arglists todos-insertion-commands-args-genlist))
+ res new)
+ (setq res (remove-duplicates
+ (apply 'append (mapcar 'todos-powerset argslist)) :test 'equal))
+ (dolist (l res)
+ (unless (= 5 (length l))
+ (let ((v (make-vector 5 nil)) elt)
+ (while l
+ (setq elt (pop l))
+ (cond ((eq elt 'diary)
+ (aset v 0 elt))
+ ((eq elt 'nonmarking)
+ (aset v 1 elt))
+ ((or (eq elt 'calendar)
+ (eq elt 'date)
+ (eq elt 'dayname))
+ (aset v 2 elt))
+ ((eq elt 'time)
+ (aset v 3 elt))
+ ((or (eq elt 'here)
+ (eq elt 'region))
+ (aset v 4 elt))))
+ (setq l (append v nil))))
+ (setq new (append new (list l))))
+ new)
+ "List of all argument lists for Todos insertion commands.")
-(defun todos-add-file ()
- "Name and add a new Todos file.
-Interactively, prompt for a category and display it.
-Noninteractively, return the name of the new file."
- (interactive)
- (let ((default-file (if todos-default-todos-file
- (file-name-sans-extension
- (file-name-nondirectory todos-default-todos-file))))
- file prompt shortname)
- (while
- (and
- (cond
- ((or (not file) (member file todos-files))
- (setq prompt (concat "Enter name of new Todos file "
- "(TAB or SPC to see existing Todos files): ")))
- ((string-equal file "")
- (setq prompt "Enter a non-empty name: "))
- ((string-match "\\`\\s-+\\'" file)
- (setq prompt "Enter a name that is not only white space: ")))
- (setq file (todos-read-file-name prompt))))
- (setq shortname (file-name-sans-extension (file-name-nondirectory file)))
- (with-current-buffer (get-buffer-create file)
- (erase-buffer)
- (write-region (point-min) (point-max) file nil 'nomessage nil t)
- (kill-buffer file))
- ;; FIXME: todos-change-default-file yields a Custom mismatch
- ;; (if (or (not default-file)
- ;; (yes-or-no-p (concat (format "Make \"%s\" new default Todos file "
- ;; shortname)
- ;; (format "[current default is \"%s\"]? "
- ;; default-file))))
- ;; (todos-change-default-file file)
- ;; (message "\"%s\" remains the default Todos file." default-file))
- (if (called-interactively-p)
- (progn
- (setq todos-current-todos-file file)
- (todos-show))
- file)))
+(defun todos-insertion-command-name (arglist)
+ "Generate Todos insertion command name from ARGLIST."
+ (replace-regexp-in-string
+ "-\\_>" ""
+ (replace-regexp-in-string
+ "-+" "-"
+ (concat "todos-item-insert-"
+ (mapconcat (lambda (e) (if e (symbol-name e))) arglist "-")))))
-;; FIXME: omit this and just use defcustom? Says "changed outside of Custom
-;; (mismatch)"
-(defun todos-change-default-file (&optional file)
- ""
- (interactive)
- (let ((new-default (or file
- (todos-read-file-name "Choose new default Todos file: "
- nil t))))
- (customize-save-variable 'todos-default-todos-file new-default)
- (message "\"%s\" is new default Todos file."
- (file-name-sans-extension (file-name-nondirectory new-default)))))
+(defvar todos-insertion-commands-names
+ (mapcar (lambda (l)
+ (todos-insertion-command-name l))
+ todos-insertion-commands-args)
+ "List of names of Todos insertion commands.")
-(defun todos-add-category (&optional cat)
- "Add a new category to the current Todos file.
-Called interactively, prompt for category name, then visit the
-category in Todos mode. Non-interactively, argument CAT provides
-the category name, which is also the return value."
- (interactive)
- (let* ((buffer-read-only)
- ;; FIXME: check against todos-archive-done-item-or-items with empty file
- (buf (find-file-noselect todos-current-todos-file t))
- ;; (buf (get-file-buffer todos-current-todos-file))
- (num (1+ (length todos-categories)))
- (counts (make-vector 4 0))) ; [todo diary done archived]
- (unless (zerop (buffer-size buf))
- (and (null todos-categories)
- (error "Error in %s: File is non-empty but contains no category"
- todos-current-todos-file)))
- (unless cat (setq cat (read-from-minibuffer "Enter new category name: ")))
- (with-current-buffer buf
- (setq cat (todos-validate-category-name cat))
- (setq todos-categories (append todos-categories (list (cons cat counts))))
- (widen)
- (goto-char (point-max))
- (save-excursion ; Save point for todos-category-select.
- (insert todos-category-beg cat "\n\n" todos-category-done "\n"))
- (todos-update-categories-sexp)
- ;; If called by command, display the newly added category, else return
- ;; the category number to the caller.
- (if (called-interactively-p 'any) ; FIXME?
- (progn
- (setq todos-category-number num)
- (todos-category-select))
- num))))
+(defmacro todos-define-insertion-command (&rest args)
+ (let ((name (intern (todos-insertion-command-name args)))
+ (arg0 (nth 0 args))
+ (arg1 (nth 1 args))
+ (arg2 (nth 2 args))
+ (arg3 (nth 3 args))
+ (arg4 (nth 4 args)))
+ `(defun ,name (&optional arg)
+ "Todos item insertion command."
+ (interactive)
+ (todos-insert-item arg ',arg0 ',arg1 ',arg2 ',arg3 ',arg4))))
-(defun todos-rename-category ()
- "Rename current Todos category.
-If this file has an archive containing this category, rename the
-category there as well."
- (interactive)
- (let* ((cat (todos-current-category))
- (new (read-from-minibuffer (format "Rename category \"%s\" to: " cat))))
- (setq new (todos-validate-category-name new))
- (let* ((ofile todos-current-todos-file)
- (archive (concat (file-name-sans-extension ofile) ".toda"))
- (buffers (append (list ofile)
- (unless (zerop (todos-get-count 'archived cat))
- (list archive)))))
- (dolist (buf buffers)
- (with-current-buffer (find-file-noselect buf)
- (let (buffer-read-only)
- (setq todos-categories (todos-set-categories))
- (save-excursion
- (save-restriction
- (setcar (assoc cat todos-categories) new)
- (widen)
- (goto-char (point-min))
- (todos-update-categories-sexp)
- (re-search-forward (concat (regexp-quote todos-category-beg)
- "\\(" (regexp-quote cat) "\\)\n")
- nil t)
- (replace-match new t t nil 1)))))))
- (setq mode-line-buffer-identification
- (funcall todos-mode-line-function new)))
- (save-excursion (todos-category-select)))
+(defvar todos-insertion-commands
+ (mapcar (lambda (c)
+ (eval `(todos-define-insertion-command ,@c)))
+ todos-insertion-commands-args)
+ "List of Todos insertion commands.")
-(defun todos-delete-category (&optional arg)
- "Delete current Todos category provided it is empty.
-With ARG non-nil delete the category unconditionally,
-i.e. including all existing todo and done items."
- (interactive "P")
- (let* ((cat (todos-current-category))
- (todo (todos-get-count 'todo cat))
- (done (todos-get-count 'done cat))
- (archived (todos-get-count 'archived cat)))
- (if (and (not arg)
- (or (> todo 0) (> done 0)))
- (message "To delete a non-empty category, type C-u D.")
- (when (yes-or-no-p (concat "Permanently remove category \"" cat
- "\"" (and arg " and all its entries") "? "))
- ;; FIXME ? optionally delete archived category as well?
- (when (and archived
- (y-or-n-p (concat "This category has archived items; "
- "the archived category will remain\n"
- "after deleting the todo category. "
- "Do you still want to delete it\n"
- "(see 'todos-ignore-archived-categories' "
- "for another option)? ")))
- (widen)
- (let ((buffer-read-only)
- (beg (re-search-backward
- (concat "^" (regexp-quote (concat todos-category-beg cat))
- "\n") nil t))
- (end (if (re-search-forward
- (concat "\n\\(" (regexp-quote todos-category-beg)
- ".*\n\\)") nil t)
- (match-beginning 1)
- (point-max))))
- (remove-overlays beg end)
- (delete-region beg end)
- (setq todos-categories (delete (assoc cat todos-categories)
- todos-categories))
- (todos-update-categories-sexp)
- (setq todos-category-number
- (1+ (mod todos-category-number (length todos-categories))))
- (todos-category-select)
- (goto-char (point-min))
- (message "Deleted category %s" cat)))))))
+(defvar todos-insertion-commands-arg-key-list
+ '(("diary" "y" "yy")
+ ("nonmarking" "k" "kk")
+ ("calendar" "c" "cc")
+ ("date" "d" "dd")
+ ("dayname" "n" "nn")
+ ("time" "t" "tt")
+ ("here" "h" "h")
+ ("region" "r" "r"))
+ "")
-(defun todos-raise-category (&optional lower)
- "Raise priority of category point is on in Categories buffer.
-With non-nil argument LOWER, lower the category's priority."
- (interactive)
- (let (num)
- (save-excursion
- (forward-line 0)
- (skip-chars-forward " ")
- (setq num (number-at-point)))
- (when (and num (if lower
- (< num (length todos-categories))
- (> num 1)))
- (let* ((col (current-column))
- (beg (progn (forward-line (if lower 0 -1)) (point)))
- (num1 (progn (skip-chars-forward " ") (1- (number-at-point))))
- (num2 (1+ num1))
- (end (progn (forward-line 2) (point)))
- (catvec (vconcat todos-categories))
- (cat1-list (aref catvec num1))
- (cat2-list (aref catvec num2))
- (cat1 (car cat1-list))
- (cat2 (car cat2-list))
- buffer-read-only newcats)
- (delete-region beg end)
- (setq num1 (1+ num1))
- (setq num2 (1- num2))
- (setq num num2)
- (todos-insert-category-line cat2)
- (setq num num1)
- (todos-insert-category-line cat1)
- (aset catvec num2 (cons cat2 (cdr cat2-list)))
- (aset catvec num1 (cons cat1 (cdr cat1-list)))
- (setq todos-categories (append catvec nil))
- (setq newcats todos-categories)
- (with-current-buffer (get-file-buffer todos-current-todos-file)
- (setq todos-categories newcats)
- (todos-update-categories-sexp))
- (forward-line (if lower -1 -2))
- (forward-char col)))))
+(defun todos-insertion-key-bindings (map)
+ ""
+ (dolist (c todos-insertion-commands)
+ (let* ((key "")
+ (cname (symbol-name c)))
+ (mapc (lambda (l)
+ (let ((arg (nth 0 l))
+ (key1 (nth 1 l))
+ (key2 (nth 2 l)))
+ (if (string-match (concat (regexp-quote arg) "\\_>") cname)
+ (setq key (concat key key2)))
+ (if (string-match (concat (regexp-quote arg) ".+") cname)
+ (setq key (concat key key1)))))
+ todos-insertion-commands-arg-key-list)
+ (if (string-match (concat (regexp-quote "todos-item-insert") "\\_>") cname)
+ (setq key (concat key "i")))
+ (define-key map key c))))
-(defun todos-lower-category ()
- "Lower priority of category point is on in Categories buffer."
- (interactive)
- (todos-raise-category t))
+(defvar todos-insertion-map
+ (let ((map (make-keymap)))
+ (todos-insertion-key-bindings map)
+ map)
+ "Keymap for Todos mode insertion commands.")
-(defun todos-move-category ()
- "Move current category to a different Todos file.
-If current category has archived items, also move those to the
-archive of the file moved to, creating it if it does not exist."
- (interactive)
- (when (or (> (length todos-categories) 1)
- (y-or-n-p (concat "This is the only category in this file; "
- "moving it will also delete the file.\n"
- "Do you want to proceed? ")))
- (let* ((ofile todos-current-todos-file)
- (cat (todos-current-category))
- (nfile (todos-read-file-name "Choose a Todos file: " nil t))
- (archive (concat (file-name-sans-extension ofile) ".toda"))
- (buffers (append (list ofile)
- (unless (zerop (todos-get-count 'archived cat))
- (list archive))))
- new)
- (dolist (buf buffers)
- (with-current-buffer (find-file-noselect buf)
- (widen)
- (goto-char (point-max))
- (let* ((beg (re-search-backward
- (concat "^"
- (regexp-quote (concat todos-category-beg cat)))
- nil t))
- (end (if (re-search-forward
- (concat "^" (regexp-quote todos-category-beg))
- nil t 2)
- (match-beginning 0)
- (point-max)))
- (content (buffer-substring-no-properties beg end))
- (counts (cdr (assoc cat todos-categories)))
- buffer-read-only)
- ;; Move the category to the new file. Also update or create
- ;; archive file if necessary.
- (with-current-buffer
- (find-file-noselect
- ;; Regenerate todos-archives in case there
- ;; is a newly created archive.
- (if (member buf (funcall todos-files-function t))
- (concat (file-name-sans-extension nfile) ".toda")
- nfile))
- (let* ((nfile-short (file-name-sans-extension
- (file-name-nondirectory nfile)))
- (prompt (concat
- (format "Todos file \"%s\" already has "
- nfile-short)
- (format "the category \"%s\";\n" cat)
- "enter a new category name: "))
- buffer-read-only)
- (widen)
- (goto-char (point-max))
- (insert content)
- ;; If the file moved to has a category with the same
- ;; name, rename the moved category.
- (when (assoc cat todos-categories)
- (unless (member (file-truename (buffer-file-name))
- (funcall todos-files-function t))
- (setq new (read-from-minibuffer prompt))
- (setq new (todos-validate-category-name new))))
- ;; Replace old with new name in Todos and archive files.
- (when new
- (goto-char (point-max))
- (re-search-backward
- (concat "^" (regexp-quote todos-category-beg)
- "\\(" (regexp-quote cat) "\\)") nil t)
- (replace-match new nil nil nil 1)))
- (setq todos-categories
- (append todos-categories (list (cons new counts))))
- (todos-update-categories-sexp)
- ;; If archive was just created, save it to avoid "File <xyz> no
- ;; longer exists!" message on invoking
- ;; `todos-view-archived-items'. FIXME: maybe better to save
- ;; unconditionally?
- (unless (file-exists-p (buffer-file-name))
- (save-buffer))
- (todos-category-number (or new cat))
- (todos-category-select))
- ;; Delete the category from the old file, and if that was the
- ;; last category, delete the file. Also handle archive file
- ;; if necessary.
- (remove-overlays beg end)
- (delete-region beg end)
- (goto-char (point-min))
- ;; Put point after todos-categories sexp.
- (forward-line)
- (if (eobp) ; Aside from sexp, file is empty.
- (progn
- ;; Skip confirming killing the archive buffer.
- (set-buffer-modified-p nil)
- (delete-file todos-current-todos-file)
- (kill-buffer))
- (setq todos-categories (delete (assoc cat todos-categories)
- todos-categories))
- (todos-update-categories-sexp)
- (todos-category-select)))))
- (set-window-buffer (selected-window)
- (set-buffer (find-file-noselect nfile)))
- (todos-category-number (or new cat))
- (todos-category-select))))
+;; ??FIXME: use easy-mmode-define-keymap and easy-mmode-defmap
+(defvar todos-key-bindings
+ `(
+ ;; display
+ ("Cd" . todos-display-categories) ;FIXME: Cs todos-show-categories?
+ ;("" . todos-display-categories-alphabetically)
+ ("H" . todos-highlight-item)
+ ("N" . todos-toggle-item-numbering)
+ ("D" . todos-toggle-display-date-time)
+ ("*" . todos-toggle-mark-item)
+ ("C*" . todos-mark-category)
+ ("Cu" . todos-unmark-category)
+ ("PP" . todos-print)
+ ("PF" . todos-print-to-file)
+ ("v" . todos-toggle-view-done-items)
+ ("V" . todos-toggle-show-done-only)
+ ("Av" . todos-view-archived-items)
+ ("As" . todos-show-archive)
+ ("Ac" . todos-choose-archive)
+ ("Y" . todos-diary-items)
+ ;;("" . todos-update-filter-files)
+ ("Fe" . todos-edit-multiline)
+ ("Fh" . todos-highlight-item)
+ ("Fn" . todos-toggle-item-numbering)
+ ("Fd" . todos-toggle-display-date-time)
+ ("Ftt" . todos-top-priorities)
+ ("Ftm" . todos-top-priorities-multifile)
+ ("Fts" . todos-set-top-priorities-in-file)
+ ("Cts" . todos-set-top-priorities-in-category)
+ ("Fyy" . todos-diary-items)
+ ("Fym" . todos-diary-items-multifile)
+ ("Fxx" . todos-regexp-items)
+ ("Fxm" . todos-regexp-items-multifile)
+ ("Fcc" . todos-custom-items)
+ ("Fcm" . todos-custom-items-multifile)
+ ;;("" . todos-save-top-priorities)
+ ;; navigation
+ ("f" . todos-forward-category)
+ ("b" . todos-backward-category)
+ ("j" . todos-jump-to-category)
+ ("J" . todos-jump-to-category-other-file)
+ ("n" . todos-forward-item)
+ ("p" . todos-backward-item)
+ ("S" . todos-search)
+ ("X" . todos-clear-matches)
+ ;; editing
+ ("Fa" . todos-add-file)
+ ("Ca" . todos-add-category)
+ ("Cr" . todos-rename-category)
+ ("Cg" . todos-merge-category)
+ ;;("" . todos-merge-categories)
+ ("Cm" . todos-move-category)
+ ("Ck" . todos-delete-category)
+ ("d" . todos-item-done)
+ ("ee" . todos-edit-item)
+ ("em" . todos-edit-multiline-item)
+ ("eh" . todos-edit-item-header)
+ ("edd" . todos-edit-item-date)
+ ("edc" . todos-edit-item-date-from-calendar)
+ ("edt" . todos-edit-item-date-is-today)
+ ("et" . todos-edit-item-time)
+ ("eyy" . todos-edit-item-diary-inclusion)
+ ;; ("" . todos-edit-category-diary-inclusion)
+ ("eyn" . todos-edit-item-diary-nonmarking)
+ ;;("" . todos-edit-category-diary-nonmarking)
+ ("ec" . todos-comment-done-item) ;FIXME: or just "c"?
+ ("i" . ,todos-insertion-map)
+ ("k" . todos-delete-item)
+ ("m" . todos-move-item)
+ ("M" . todos-move-item-to-file)
+ ;; FIXME: This binding prevents `-' from being used in a numerical prefix
+ ;; argument without typing C-u
+ ;; ("-" . todos-raise-item-priority)
+ ("r" . todos-raise-item-priority)
+ ;; ("+" . todos-lower-item-priority)
+ ("l" . todos-lower-item-priority)
+ ("#" . todos-set-item-priority)
+ ("u" . todos-item-undo)
+ ("Ad" . todos-archive-done-item-or-items) ;FIXME
+ ("AD" . todos-archive-category-done-items) ;FIXME
+ ("Au" . todos-unarchive-items)
+ ("AU" . todos-unarchive-category)
+ ("s" . todos-save)
+ ("q" . todos-quit)
+ ([remap newline] . newline-and-indent)
+ )
+ "Alist pairing keys defined in Todos modes and their bindings.")
+
+(defvar todos-mode-map
+ (let ((map (make-keymap)))
+ ;; Don't suppress digit keys, so they can supply prefix arguments.
+ (suppress-keymap map)
+ (dolist (ck todos-key-bindings)
+ (define-key map (car ck) (cdr ck)))
+ map)
+ "Todos mode keymap.")
-(defun todos-merge-category ()
- "Merge this category with chosen category in this file. The
-current category's todo and done items are appended to the chosen
-category's todo and done items, respectively, which becomes the
-current category, and the category moved from is deleted."
- (interactive)
- (let ((buffer-read-only nil)
- (cat (todos-current-category))
- (goal (todos-read-category "Category to merge to: " t)))
- (widen)
- ;; FIXME: check if cat has archived items and merge those too
- (let* ((cbeg (progn
- (re-search-backward
- (concat "^" (regexp-quote todos-category-beg)) nil t)
- (point)))
- (tbeg (progn (forward-line) (point)))
- (dbeg (progn
- (re-search-forward
- (concat "^" (regexp-quote todos-category-done)) nil t)
- (forward-line) (point)))
- (tend (progn (forward-line -2) (point)))
- (cend (progn
- (if (re-search-forward
- (concat "^" (regexp-quote todos-category-beg)) nil t)
- (match-beginning 0)
- (point-max))))
- (todo (buffer-substring-no-properties tbeg tend))
- (done (buffer-substring-no-properties dbeg cend))
- here)
- (goto-char (point-min))
- (re-search-forward
- (concat "^" (regexp-quote (concat todos-category-beg goal))) nil t)
- (re-search-forward
- (concat "^" (regexp-quote todos-category-done)) nil t)
- (forward-line -1)
- (setq here (point))
- (insert todo)
- (goto-char (if (re-search-forward
- (concat "^" (regexp-quote todos-category-beg)) nil t)
- (match-beginning 0)
- (point-max)))
- (insert done)
- (remove-overlays cbeg cend)
- (delete-region cbeg cend)
- (todos-set-count 'todo (todos-get-count 'todo cat) goal)
- (todos-set-count 'done (todos-get-count 'done cat) goal)
- (setq todos-categories (delete (assoc cat todos-categories)
- todos-categories))
- (todos-update-categories-sexp)
- (todos-category-number goal)
- (todos-category-select)
- ;; Put point at the start of the merged todo items.
- ;; FIXME: what if there are no merged todo items but only done items?
- (goto-char here))))
-
;; FIXME
-(defun todos-merge-categories ()
+(easy-menu-define
+ todos-menu todos-mode-map "Todos Menu"
+ '("Todos"
+ ("Navigation"
+ ["Next Item" todos-forward-item t]
+ ["Previous Item" todos-backward-item t]
+ "---"
+ ["Next Category" todos-forward-category t]
+ ["Previous Category" todos-backward-category t]
+ ["Jump to Category" todos-jump-to-category t]
+ ["Jump to Category in Other File" todos-jump-to-category-other-file t]
+ "---"
+ ["Search Todos File" todos-search t]
+ ["Clear Highlighting on Search Matches" todos-category-done t])
+ ("Display"
+ ["List Current Categories" todos-display-categories t]
+ ;; ["List Categories Alphabetically" todos-display-categories-alphabetically t]
+ ["Turn Item Highlighting on/off" todos-highlight-item t]
+ ["Turn Item Numbering on/off" todos-toggle-item-numbering t]
+ ["Turn Item Time Stamp on/off" todos-toggle-display-date-time t]
+ ["View/Hide Done Items" todos-toggle-view-done-items t]
+ "---"
+ ["View Diary Items" todos-diary-items t]
+ ["View Top Priority Items" todos-top-priorities t]
+ ["View Multifile Top Priority Items" todos-top-priorities-multifile t]
+ "---"
+ ["View Archive" todos-view-archive t]
+ ["Print Category" todos-print t])
+ ("Editing"
+ ["Insert New Item" todos-insert-item t]
+ ["Insert Item Here" todos-insert-item-here t]
+ ("More Insertion Commands")
+ ["Edit Item" todos-edit-item t]
+ ["Edit Multiline Item" todos-edit-multiline t]
+ ["Edit Item Header" todos-edit-item-header t]
+ ["Edit Item Date" todos-edit-item-date t]
+ ["Edit Item Time" todos-edit-item-time t]
+ "---"
+ ["Lower Item Priority" todos-lower-item-priority t]
+ ["Raise Item Priority" todos-raise-item-priority t]
+ ["Set Item Priority" todos-set-item-priority t]
+ ["Move (Recategorize) Item" todos-move-item t]
+ ["Delete Item" todos-delete-item t]
+ ["Undo Done Item" todos-item-undo t]
+ ["Mark/Unmark Item for Diary" todos-toggle-item-diary-inclusion t]
+ ["Mark/Unmark Items for Diary" todos-edit-item-diary-inclusion t]
+ ["Mark & Hide Done Item" todos-item-done t]
+ ["Archive Done Items" todos-archive-category-done-items t]
+ "---"
+ ["Add New Todos File" todos-add-file t]
+ ["Add New Category" todos-add-category t]
+ ["Delete Current Category" todos-delete-category t]
+ ["Rename Current Category" todos-rename-category t]
+ "---"
+ ["Save Todos File" todos-save t]
+ ["Save Top Priorities" todos-save-top-priorities t])
+ "---"
+ ["Quit" todos-quit t]
+ ))
+
+(defvar todos-archive-mode-map
+ (let ((map (make-sparse-keymap)))
+ (suppress-keymap map t)
+ ;; navigation commands
+ (define-key map "f" 'todos-forward-category)
+ (define-key map "b" 'todos-backward-category)
+ (define-key map "j" 'todos-jump-to-category)
+ (define-key map "n" 'todos-forward-item)
+ (define-key map "p" 'todos-backward-item)
+ ;; display commands
+ (define-key map "C" 'todos-display-categories)
+ (define-key map "H" 'todos-highlight-item)
+ (define-key map "N" 'todos-toggle-item-numbering)
+ ;; (define-key map "" 'todos-toggle-display-date-time)
+ (define-key map "P" 'todos-print)
+ (define-key map "q" 'todos-quit)
+ (define-key map "s" 'todos-save)
+ (define-key map "S" 'todos-search)
+ (define-key map "t" 'todos-show) ;FIXME: should show same category
+ (define-key map "u" 'todos-unarchive-item)
+ (define-key map "U" 'todos-unarchive-category)
+ map)
+ "Todos Archive mode keymap.")
+
+(defvar todos-edit-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "\C-x\C-q" 'todos-edit-quit)
+ (define-key map [remap newline] 'newline-and-indent)
+ map)
+ "Todos Edit mode keymap.")
+
+(defvar todos-categories-mode-map
+ (let ((map (make-sparse-keymap)))
+ (suppress-keymap map t)
+ ;; (define-key map "a" 'todos-display-categories-alphabetically)
+ (define-key map "c" 'todos-display-categories)
+ (define-key map "l" 'todos-lower-category)
+ (define-key map "+" 'todos-lower-category)
+ (define-key map "r" 'todos-raise-category)
+ (define-key map "-" 'todos-raise-category)
+ (define-key map "n" 'forward-button)
+ (define-key map "p" 'backward-button)
+ (define-key map [tab] 'forward-button)
+ (define-key map [backtab] 'backward-button)
+ (define-key map "q" 'todos-quit)
+ ;; (define-key map "A" 'todos-add-category)
+ ;; (define-key map "D" 'todos-delete-category)
+ ;; (define-key map "R" 'todos-rename-category)
+ map)
+ "Todos Categories mode keymap.")
+
+(defvar todos-filter-items-mode-map
+ (let ((map (make-keymap)))
+ (suppress-keymap map t)
+ ;; navigation commands
+ (define-key map "j" 'todos-jump-to-item)
+ (define-key map [remap newline] 'todos-jump-to-item)
+ (define-key map "n" 'todos-forward-item)
+ (define-key map "p" 'todos-backward-item)
+ (define-key map "H" 'todos-highlight-item)
+ (define-key map "N" 'todos-toggle-item-numbering)
+ (define-key map "D" 'todos-toggle-display-date-time)
+ (define-key map "P" 'todos-print)
+ (define-key map "q" 'todos-quit)
+ (define-key map "s" 'todos-save)
+ ;; (define-key map "S" 'todos-save-top-priorities)
+ ;; editing commands
+ (define-key map "l" 'todos-lower-item-priority)
+ (define-key map "r" 'todos-raise-item-priority)
+ (define-key map "#" 'todos-set-item-priority)
+ map)
+ "Todos Top Priorities mode keymap.")
+
+;; FIXME: remove when part of Emacs
+(add-to-list 'auto-mode-alist '("\\.todo\\'" . todos-mode))
+(add-to-list 'auto-mode-alist '("\\.toda\\'" . todos-archive-mode))
+
+(defun todos-modes-set-1 ()
+ ""
+ (set (make-local-variable 'font-lock-defaults) '(todos-font-lock-keywords t))
+ (set (make-local-variable 'indent-line-function) 'todos-indent)
+ (when todos-wrap-lines (funcall todos-line-wrapping-function)))
+
+(defun todos-modes-set-2 ()
+ ""
+ (add-to-invisibility-spec 'todos)
+ (setq buffer-read-only t)
+ (set (make-local-variable 'hl-line-range-function)
+ (lambda() (when (todos-item-end)
+ (cons (todos-item-start) (todos-item-end))))))
+
+(defun todos-modes-set-3 ()
+ (set (make-local-variable 'todos-categories-full) nil)
+ ;; todos-set-categories sets todos-categories-full.
+ (set (make-local-variable 'todos-categories) (todos-set-categories))
+ (set (make-local-variable 'todos-category-number) 1)
+ (set (make-local-variable 'todos-first-visit) t)
+ (add-hook 'post-command-hook 'todos-after-find-file nil t))
+
+(put 'todos-mode 'mode-class 'special)
+
+;; Autoloading isn't needed if files are identified by auto-mode-alist
+;; ;; As calendar reads included Todos file before todos-mode is loaded.
+;; ;;;###autoload
+(define-derived-mode todos-mode special-mode "Todos" ()
+ "Major mode for displaying, navigating and editing Todo lists.
+
+\\{todos-mode-map}"
+ (easy-menu-add todos-menu)
+ (todos-modes-set-1)
+ (todos-modes-set-2)
+ (todos-modes-set-3)
+ ;; Initialize todos-current-todos-file.
+ (when (member (file-truename (buffer-file-name))
+ (funcall todos-files-function))
+ (set (make-local-variable 'todos-current-todos-file)
+ (file-truename (buffer-file-name))))
+ (set (make-local-variable 'todos-first-visit) t)
+ (set (make-local-variable 'todos-show-done-only) nil)
+ (set (make-local-variable 'todos-categoreis-with-marks) nil)
+ (when todos-show-current-file
+ (add-hook 'pre-command-hook 'todos-show-current-file nil t))
+ ;; FIXME: works more or less, but should be tied to the defcustom
+ (add-hook 'window-configuration-change-hook
+ (lambda ()
+ (setq todos-done-separator (make-string (window-width) ?_)))
+ nil t)
+ (add-hook 'kill-buffer-hook 'todos-reset-global-current-todos-file nil t))
+
+;; FIXME: need this?
+(defun todos-unload-hook ()
+ ""
+ (remove-hook 'pre-command-hook 'todos-show-current-file t)
+ (remove-hook 'post-command-hook 'todos-after-find-file t)
+ (remove-hook 'window-configuration-change-hook
+ (lambda ()
+ (setq todos-done-separator
+ (make-string (window-width) ?_))) t)
+ (remove-hook 'kill-buffer-hook 'todos-reset-global-current-todos-file t))
+
+(put 'todos-archive-mode 'mode-class 'special)
+
+(define-derived-mode todos-archive-mode todos-mode "Todos-Arch" ()
+ "Major mode for archived Todos categories.
+
+\\{todos-archive-mode-map}"
+ (todos-modes-set-1)
+ (todos-modes-set-2)
+ (todos-modes-set-3)
+ (set (make-local-variable 'todos-current-todos-file)
+ (file-truename (buffer-file-name)))
+ (set (make-local-variable 'todos-show-done-only) t))
+
+(defun todos-mode-external-set ()
""
- (interactive)
- (let* ((cats (mapcar 'car todos-categories))
- (goal (todos-read-category "Category to merge to: " t))
- (prompt (format "Merge to %s (type C-g to finish)? " goal))
- (source (let ((inhibit-quit t) l)
- (while (not (eq last-input-event 7))
- (dolist (c cats)
- (when (y-or-n-p prompt)
- (push c l)
- (setq cats (delete c cats))))))))
- (widen)
- ))
+ (set (make-local-variable 'todos-current-todos-file)
+ todos-global-current-todos-file)
+ (let ((cats (with-current-buffer (get-file-buffer todos-current-todos-file)
+ (if todos-ignore-archived-categories
+ todos-categories-full
+ (todos-set-categories)))))
+ (set (make-local-variable 'todos-categories) cats)))
-;; FIXME: make insertion options customizable per category
-;;;###autoload
-;; (defun todos-insert-item (&optional arg use-point date-type time
-;; diary nonmarking)
-(defun todos-insert-item (&optional arg diary nonmarking date-type time
- region-or-here)
- "Add a new Todo item to a category.
-See the note at the end of this document string about key
-bindings and convenience commands derived from this command.
+(define-derived-mode todos-edit-mode text-mode "Todos-Ed" ()
+ "Major mode for editing multiline Todo items.
-With no (or nil) prefix argument ARG, add the item to the current
-category; with one prefix argument (C-u), prompt for a category
-from the current Todos file; with two prefix arguments (C-u C-u),
-first prompt for a Todos file, then a category in that file. If
-a non-existing category is entered, ask whether to add it to the
-Todos file; if answered affirmatively, add the category and
-insert the item there.
+\\{todos-edit-mode-map}"{
+ (todos-modes-set-1)
+ (todos-mode-external-set))
-When argument DIARY is non-nil, this overrides the intent of the
-user option `todos-include-in-diary' for this item: if
-`todos-include-in-diary' is nil, include the item in the Fancy
-Diary display, and if it is non-nil, exclude the item from the
-Fancy Diary display. When DIARY is nil, `todos-include-in-diary'
-has its intended effect.
+(put 'todos-categories-mode 'mode-class 'special)
-When the item is included in the Fancy Diary display and the
-argument NONMARKING is non-nil, this overrides the intent of the
-user option `todos-diary-nonmarking' for this item: if
-`todos-diary-nonmarking' is nil, append `diary-nonmarking-symbol'
-to the item, and if it is non-nil, omit `diary-nonmarking-symbol'.
+(define-derived-mode todos-categories-mode special-mode "Todos-Cats" ()
+ "Major mode for displaying and editing Todos categories.
-The argument DATE-TYPE determines the content of the item's
-mandatory date header string and how it is added:
-- If DATE-TYPE is the symbol `calendar', the Calendar pops up and
- when the user puts the cursor on a date and hits RET, that
- date, in the format set by `calendar-date-display-form',
- becomes the date in the header.
-- If DATE-TYPE is the symbol `date', the header contains the date
- in the format set by `calendar-date-display-form', with year,
- month and day individually prompted for (month with tab
- completion).
-- If DATE-TYPE is the symbol `dayname' the header contains a
- weekday name instead of a date, prompted for with tab
- completion.
-- If DATE-TYPE has any other value (including nil or none) the
- header contains the current date (in the format set by
- `calendar-date-display-form').
+\\{todos-categories-mode-map}"
+ (todos-mode-external-set))
-With non-nil argument TIME prompt for a time string; this must
-either be empty or else match `diary-time-regexp'. If TIME is
-nil, add or omit the current time according to value of the user
-option `todos-always-add-time-string'.
+(put 'todos-filter-mode 'mode-class 'special)
-The argument REGION-OR-HERE determines the source and location of
-the new item:
-- If the REGION-OR-HERE is the symbol `here', prompt for the text
- of the new item and insert it directly above the todo item at
- point, or if point is on the empty line below the last todo
- item, insert the new item there. An error is signalled if
- `todos-insert-item' is invoked with `here' outside of the
- current category.
-- If REGION-OR-HERE is the symbol `region', use the region of the
- current buffer as the text of the new item, depending on the
- value of user option `todos-use-only-highlighted-region': if
- this is non-nil, then use the region only when it is
- highlighted; otherwise, use the region regardless of
- highlighting. An error is signalled if there is no region in
- the current buffer. Prompt for the item's priority in the
- category (an integer between 1 and one more than the number of
- items in the category), and insert the item accordingly.
-- If REGION-OR-HERE has any other value (in particular, nil or
- none), prompt for the text and the item's priority, and insert
- the item accordingly.
+(define-derived-mode todos-filter-items-mode special-mode "Todos-Fltr" ()
+ "Mode for displaying and reprioritizing top priority Todos.
-To facilitate using these arguments when inserting a new todo
-item, convenience commands have been defined for all admissible
-combinations (96 in all!) together with mnenomic key bindings
-based on on the name of the arguments and their order: _h_ere or
-_r_egion - _c_alendar or _d_ate or day_n_ame - _t_ime - diar_y_ -
-nonmar_k_ing. An alternative interface for customizing key
-binding is also provided with the function
-`todos-insertion-bindings'." ;FIXME
+\\{todos-filter-items-mode-map}"
+ (todos-modes-set-1)
+ (todos-modes-set-2))
+
+;; FIXME: need this?
+(defun todos-save ()
+ "Save the current Todos file."
+ (interactive)
+ (save-buffer)
+ ;; (if todos-save-top-priorities-too (todos-save-top-priorities))
+ )
+
+(defun todos-quit ()
+ "Exit the current Todos-related buffer.
+Depending on the specific mode, this either kills the buffer or
+buries it and restores state as needed."
+ (interactive)
+ (cond ((eq major-mode 'todos-categories-mode)
+ (kill-buffer)
+ (setq todos-descending-counts nil)
+ (todos-show))
+ ((eq major-mode 'todos-filter-items-mode)
+ (kill-buffer)
+ (todos-show))
+ ((member major-mode (list 'todos-mode 'todos-archive-mode))
+ ;; Have to write previously nonexistant archives to file.
+ (unless (file-exists-p (buffer-file-name)) (todos-save))
+ ;; FIXME: or should it save unconditionally?
+ ;; (todos-save)
+ (bury-buffer))))
+
+;; ---------------------------------------------------------------------------
+;;; Display Commands
+
+;;;###autoload
+(defun todos-show (&optional solicit-file)
+ "Visit the current Todos file and display one of its categories.
+
+With non-nil prefix argument SOLICIT-FILE ask for file to visit.
+Otherwise, the first invocation of this command in a session
+visits `todos-default-todos-file' (creating it if it does not yet
+exist); subsequent invocations from outside of Todos mode revisit
+this file or, if user option `todos-show-current-file' is
+non-nil, whichever Todos file was visited last.
+
+The category displayed on initial invocation is the first member
+of `todos-categories' for the current Todos file, on subsequent
+invocations whichever category was displayed last. If
+`todos-display-categories-first' is non-nil, then the first
+invocation of `todos-show' displays a clickable listing of the
+categories in the current Todos file.
+
+In Todos mode just the category's unfinished todo items are shown
+by default. The done items are hidden, but typing
+`\\[todos-toggle-view-done-items]' displays them below the todo
+items. With non-nil user option `todos-show-with-done' both todo
+and done items are always shown on visiting a category."
(interactive "P")
- (let ((region (eq region-or-here 'region))
- (here (eq region-or-here 'here)))
- (when region
- ;; FIXME: better to use use-region-p or region-active-p?
- (unless (and (if todos-use-only-highlighted-region
- transient-mark-mode
- t)
- mark-active)
- (error "The mark is not set now, so there is no region")))
- (let* ((buf (current-buffer))
- (new-item (if region
- ;; FIXME: or keep properties?
- (buffer-substring-no-properties
- (region-beginning) (region-end))
- (read-from-minibuffer "Todo item: ")))
- (date-string (cond
- ((eq date-type 'date)
- (todos-read-date))
- ((eq date-type 'dayname)
- (todos-read-dayname))
- ((eq date-type 'calendar)
- (setq todos-date-from-calendar t)
- (let (calendar-view-diary-initially-flag)
- (calendar))
- (with-current-buffer "*Calendar*"
- (todos-set-date-from-calendar))
- todos-date-from-calendar)
- (t (calendar-date-string (calendar-current-date) t t))))
- ;; FIXME: should TIME override `todos-always-add-time-string'? But
- ;; then add another option to use current time or prompt for time
- ;; string?
- (time-string (or (and time (todos-read-time))
- (and todos-always-add-time-string
- (substring (current-time-string) 11 16)))))
- (setq todos-date-from-calendar nil)
- (cond ((equal arg '(16)) ; FIXME: cf. set-mark-command
- (todos-jump-to-category nil t)
- (set-window-buffer
- (selected-window)
- (set-buffer (get-file-buffer todos-global-current-todos-file))))
- ((equal arg '(4)) ; FIXME: just arg?
- (todos-jump-to-category)
- (set-window-buffer
- (selected-window)
- (set-buffer (get-file-buffer todos-global-current-todos-file))))
- (t
- (when (not (derived-mode-p 'todos-mode)) (todos-show))))
- (let (buffer-read-only)
- (setq new-item
- ;; Add date, time and diary marking as required.
- (concat (if (not (and diary (not todos-include-in-diary)))
- todos-nondiary-start
- (when (and nonmarking (not todos-diary-nonmarking))
- diary-nonmarking-symbol))
- date-string (when time-string
- (concat " " time-string))
- (when (not (and diary (not todos-include-in-diary)))
- todos-nondiary-end)
- " " new-item))
- ;; Indent newlines inserted by C-q C-j if nonspace char follows.
- (setq new-item (replace-regexp-in-string
- "\\(\n\\)[^[:blank:]]"
- (concat "\n" (make-string todos-indent-to-here 32))
- new-item nil nil 1))
- (if here
- (cond ((not (eq major-mode 'todos-mode))
- (error "Cannot insert a todo item here outside of Todos mode"))
- ((not (eq buf (current-buffer)))
- (error "Cannot insert an item here after changing buffer"))
- ((or (todos-done-item-p)
- ;; Point on last blank line.
- (save-excursion (forward-line -1) (todos-done-item-p)))
- (error "Cannot insert a new item in the done item section"))
- (t
- (todos-insert-with-overlays new-item)))
- (todos-set-item-priority new-item (todos-current-category) t))
- (todos-set-count 'todo 1)
- (if (or diary todos-include-in-diary) (todos-set-count 'diary 1))
- (todos-update-categories-sexp)))))
+ (let ((file (cond (solicit-file
+ (if (funcall todos-files-function)
+ (todos-read-file-name "Choose a Todos file to visit: "
+ nil t)
+ (error "There are no Todos files")))
+ ((eq major-mode 'todos-archive-mode)
+ ;; FIXME: should it visit same category?
+ (concat (file-name-sans-extension todos-current-todos-file)
+ ".todo"))
+ (t
+ (or todos-current-todos-file
+ (and todos-show-current-file
+ todos-global-current-todos-file)
+ todos-default-todos-file
+ (todos-add-file))))))
+ (if (and todos-first-visit todos-display-categories-first)
+ (todos-display-categories)
+ (set-window-buffer (selected-window)
+ (set-buffer (find-file-noselect file)))
+ ;; If no Todos file exists, initialize one.
+ (if (zerop (buffer-size))
+ ;; Call with empty category name to get initial prompt.
+ (setq todos-category-number (todos-add-category "")))
+ (save-excursion (todos-category-select)))
+ (setq todos-first-visit nil)))
-;; FIXME: autoload when key-binding is defined in calendar.el
-(defun todos-insert-item-from-calendar ()
- ""
+(defun todos-display-categories ()
+ "Display a table of the current file's categories and item counts.
+
+In the initial display the categories are numbered, indicating
+their current order for navigating by \\[todos-forward-category]
+and \\[todos-backward-category]. You can persistantly change the
+order of the category at point by typing \\[todos-raise-category]
+or \\[todos-lower-category].
+
+The labels above the category names and item counts are buttons,
+and clicking these changes the display: sorted by category name
+or by the respective item counts (alternately descending or
+ascending). In these displays the categories are not numbered
+and \\[todos-raise-category] and \\[todos-lower-category] are
+disabled. (Programmatically, the sorting is triggered by passing
+a non-nil SORTKEY argument.)
+
+In addition, the lines with the category names and item counts
+are buttonized, and pressing one of these button jumps to the
+category in Todos mode (or Todos Archive mode, for categories
+containing only archived items, provided user option
+`todos-ignore-archived-categories' is non-nil. These categories
+are shown in `todos-archived-only' face."
(interactive)
- ;; FIXME: todos-current-todos-file is nil here, better to solicit Todos file?
- ;; FIXME: t-g-c-t-f is nil if no Todos file has been visited
- (pop-to-buffer (file-name-nondirectory todos-global-current-todos-file))
- (todos-show)
- ;; FIXME: this now calls todos-set-date-from-calendar
- (todos-insert-item t 'calendar))
+ (todos-display-categories-1)
+ (let (sortkey)
+ (todos-update-categories-display sortkey)))
-;; FIXME: calendar is loaded before todos
-;; (add-hook 'calendar-load-hook
- ;; (lambda ()
- (define-key calendar-mode-map "it" 'todos-insert-item-from-calendar);))
+;; ;; FIXME: make this toggle with todos-display-categories
+;; (defun todos-display-categories-alphabetically ()
+;; ""
+;; (interactive)
+;; (todos-display-sorted 'alpha))
-(defvar todos-date-from-calendar nil)
-(defun todos-set-date-from-calendar ()
- ""
- (when todos-date-from-calendar
- (local-set-key (kbd "RET") 'exit-recursive-edit)
- (message "Put cursor on a date and type <return> to set it.")
- ;; FIXME: is there a better way than recursive-edit?
- ;; FIXME: use unwind-protect? Check recursive-depth?
- (recursive-edit)
- (setq todos-date-from-calendar
- (calendar-date-string (calendar-cursor-to-date t) t t))
- (calendar-exit)))
+;; ;; FIXME: provide key bindings for these or delete them
+;; (defun todos-display-categories-sorted-by-todo ()
+;; ""
+;; (interactive)
+;; (todos-display-sorted 'todo))
-(defun todos-delete-item ()
- "Delete at least one item in this category.
+;; (defun todos-display-categories-sorted-by-diary ()
+;; ""
+;; (interactive)
+;; (todos-display-sorted 'diary))
-If there are marked items, delete all of these; otherwise, delete
-the item at point."
+;; (defun todos-display-categories-sorted-by-done ()
+;; ""
+;; (interactive)
+;; (todos-display-sorted 'done))
+
+;; (defun todos-display-categories-sorted-by-archived ()
+;; ""
+;; (interactive)
+;; (todos-display-sorted 'archived))
+
+(defun todos-toggle-item-numbering ()
+ ""
(interactive)
- (let* ((cat (todos-current-category))
- (marked (assoc cat todos-categories-with-marks))
- (item (unless marked (todos-item-string)))
- (ov (make-overlay (save-excursion (todos-item-start))
- (save-excursion (todos-item-end))))
- ;; FIXME: make confirmation an option
- (answer (if marked
- (y-or-n-p "Permanently delete all marked items? ")
- (when item
- (overlay-put ov 'face 'todos-search)
- (y-or-n-p (concat "Permanently delete this item? ")))))
- (opoint (point))
- buffer-read-only)
- (when answer
- (and marked (goto-char (point-min)))
- (catch 'done
- (while (not (eobp))
- (if (or (and marked (todos-item-marked-p)) item)
- (progn
- (if (todos-done-item-p)
- (todos-set-count 'done -1)
- (todos-set-count 'todo -1 cat)
- (and (todos-diary-item-p) (todos-set-count 'diary -1)))
- (delete-overlay ov)
- (todos-remove-item)
- ;; Don't leave point below last item.
- (and item (bolp) (eolp) (< (point-min) (point-max))
- (todos-backward-item))
- (when item
- (throw 'done (setq item nil))))
- (todos-forward-item))))
- (when marked
- (remove-overlays (point-min) (point-max) 'before-string todos-item-mark)
- (setq todos-categories-with-marks
- (assq-delete-all cat todos-categories-with-marks))
- (goto-char opoint))
- (todos-update-categories-sexp)
- (todos-prefix-overlays))
- (if ov (delete-overlay ov))))
+ (todos-reset-prefix 'todos-number-prefix (not todos-number-prefix)))
-(defun todos-edit-item ()
- "Edit current Todo item in the minibuffer."
+(defun todos-toggle-view-done-items ()
+ "Show hidden or hide visible done items in current category."
(interactive)
- (when (todos-item-string)
- (let* ((buffer-read-only)
- (start (todos-item-start))
- (item-beg (progn
- (re-search-forward
- (concat todos-date-string-start todos-date-pattern
- "\\( " diary-time-regexp "\\)?"
- (regexp-quote todos-nondiary-end) "?")
- (line-end-position) t)
- (1+ (- (point) start))))
- (item (todos-item-string))
- (multiline (> (length (split-string item "\n")) 1))
- (opoint (point)))
- (if multiline
- (todos-edit-multiline)
- (let ((new (read-string "Edit: " (cons item item-beg))))
- (while (not (string-match
- (concat todos-date-string-start todos-date-pattern) new))
- (setq new (read-from-minibuffer
- "Item must start with a date: " new)))
- ;; Indent newlines inserted by C-q C-j if nonspace char follows.
- (setq new (replace-regexp-in-string
- "\\(\n\\)[^[:blank:]]"
- (concat "\n" (make-string todos-indent-to-here 32)) new
- nil nil 1))
- ;; If user moved point during editing, make sure it moves back.
- (goto-char opoint)
- (todos-remove-item)
- (todos-insert-with-overlays new)
- (move-to-column item-beg))))))
-
-;; FIXME: run todos-check-format on exiting buffer (or check for date string
-;; and indentation)
-(defun todos-edit-multiline ()
- "Edit current Todo item in Todos Edit mode.
-Use of newlines invokes `todos-indent' to insure compliance with
-the format of Diary entries."
+ (if (zerop (todos-get-count 'done (todos-current-category)))
+ (message "There are no done items in this category.")
+ (save-excursion
+ (goto-char (point-min))
+ (let ((todos-show-with-done (not (re-search-forward
+ todos-done-string-start nil t))))
+ (todos-category-select)))))
+
+(defun todos-toggle-show-done-only ()
+ "Switch between displaying only done or only todo items."
(interactive)
- (let ((buffer-name (generate-new-buffer-name todos-edit-buffer)))
- (set-window-buffer
- (selected-window)
- (set-buffer (make-indirect-buffer
- (file-name-nondirectory todos-current-todos-file)
- buffer-name)))
- (narrow-to-region (todos-item-start) (todos-item-end))
- (todos-edit-mode)
- (message "Type %s to return to Todos mode."
- (key-description (car (where-is-internal 'todos-edit-quit))))))
+ (setq todos-show-done-only (not todos-show-done-only))
+ (todos-category-select))
-(defun todos-edit-quit ()
- "Return from Todos Edit mode to Todos mode."
+(defun todos-view-archived-items ()
+ "Display the archived items of the current category.
+The buffer showing these items is in Todos Archive mode."
(interactive)
- (kill-buffer)
- (todos-show))
+ (let ((cat (todos-current-category)))
+ (if (zerop (todos-get-count 'archived cat))
+ (message "There are no archived items from this category.")
+ (let* ((tfile-base (file-name-sans-extension todos-current-todos-file))
+ (afile (concat tfile-base ".toda")))
+ (set-window-buffer (selected-window) (set-buffer
+ (find-file-noselect afile)))
+ (todos-category-number cat)
+ (todos-jump-to-category cat)))))
-(defun todos-edit-item-header (&optional what)
- "Edit date/time header of at least one item.
+(defun todos-show-archive (&optional ask)
+ "Visit the archive of the current Todos file, if it exists.
+With non-nil argument ASK prompt to choose an archive to visit;
+see `todos-choose-archive'. The buffer showing the archive is in
+Todos Archive mode. The first visit in a session displays the
+first category in the archive, subsequent visits return to the
+last category displayed."
+ (interactive)
+ (let* ((tfile-base (file-name-sans-extension todos-current-todos-file))
+ (afile (if ask
+ (todos-read-file-name "Choose a Todos archive: " t t)
+ (concat tfile-base ".toda"))))
+ (if (not (file-exists-p afile))
+ (message "There is currently no Todos archive for this file.")
+ (set-window-buffer (selected-window) (set-buffer
+ (find-file-noselect afile)))
+ (todos-category-select))))
-Interactively, ask whether to edit year, month and day or day of
-the week, as well as time. If there are marked items, apply the
-changes to all of these; otherwise, edit just the item at point.
+(defun todos-choose-archive ()
+ "Choose an archive and visit it."
+ (interactive)
+ (todos-show-archive t))
-Non-interactively, argument WHAT specifies whether to edit only
-the date or only the time, or to set the date to today."
+(defun todos-highlight-item ()
+ "Toggle highlighting the todo item the cursor is on."
(interactive)
- (let* ((cat (todos-current-category))
- (marked (assoc cat todos-categories-with-marks))
- (first t)
- ndate ntime nheader)
- (save-excursion
- (or (and marked (goto-char (point-min))) (todos-item-start))
- (catch 'stop
- (while (not (eobp))
- (and marked
- (while (not (todos-item-marked-p))
- (todos-forward-item)
- (and (eobp) (throw 'stop nil))))
- (re-search-forward (concat todos-date-string-start "\\(?1:"
- todos-date-pattern
- "\\)\\(?2: " diary-time-regexp "\\)?")
- (line-end-position) t)
- (let* ((odate (match-string-no-properties 1))
- (otime (match-string-no-properties 2))
- (buffer-read-only))
- (if (eq what 'today)
- (progn
- (setq ndate (calendar-date-string (calendar-current-date) t t))
- (replace-match ndate nil nil nil 1))
- (unless (eq what 'timeonly)
- (when first
- (setq ndate (if (save-match-data (string-match "[0-9]+" odate))
- (if (y-or-n-p "Change date? ")
- (todos-read-date)
- (todos-read-dayname))
- (if (y-or-n-p "Change day? ")
- (todos-read-dayname)
- (todos-read-date)))))
- (replace-match ndate nil nil nil 1))
- (unless (eq what 'dateonly)
- (when first
- (setq ntime (save-match-data (todos-read-time)))
- (when (< 0 (length ntime)) (setq ntime (concat " " ntime))))
- (if otime
- (replace-match ntime nil nil nil 2)
- (goto-char (match-end 1))
- (insert ntime))))
- (setq first nil))
- (if marked
- (todos-forward-item)
- (goto-char (point-max))))))))
+ (require 'hl-line)
+ (if hl-line-mode
+ (hl-line-mode -1)
+ (hl-line-mode 1)))
+
+(defun todos-toggle-display-date-time () ;(&optional all)
+ "Hide or show date-time header of todo items.";; in current category.
+;; With non-nil prefix argument ALL do this in the whole file."
+ (interactive "P")
+ (save-excursion
+ (save-restriction
+ (goto-char (point-min))
+ (let ((ovs (overlays-in (point) (1+ (point))))
+ ov hidden)
+ (while ovs
+ (setq ov (pop ovs))
+ (if (equal (overlay-get ov 'display) "")
+ (setq ovs nil hidden t)))
+ ;; (when all
+ (widen)
+ (goto-char (point-min));)
+ (if hidden
+ (remove-overlays (point-min) (point-max) 'display "")
+ (while (not (eobp))
+ (when (re-search-forward
+ (concat todos-date-string-start todos-date-pattern
+ "\\( " diary-time-regexp "\\)?"
+ (regexp-quote todos-nondiary-end) "? ")
+ nil t)
+ (unless (save-match-data (todos-done-item-p))
+ (setq ov (make-overlay (match-beginning 0) (match-end 0) nil t))
+ (overlay-put ov 'display "")))
+ (todos-forward-item)))))))
+
+(defun todos-toggle-mark-item (&optional n all)
+ "Mark item at point if unmarked, or unmark it if marked.
+
+With a positive numerical prefix argument N, change the
+markedness of the next N items. With non-nil argument ALL, mark
+all visible items in the category (depending on visibility, all
+todo and done items, or just todo or just done items).
+
+The mark is the character \"*\" inserted in front of the item's
+priority number or the `todos-prefix' string; if `todos-prefix'
+is \"*\", then the mark is \"@\"."
+ (interactive "p")
+ (if all (goto-char (point-min)))
+ (unless (> n 0) (setq n 1))
+ (let ((i 0))
+ (while (or (and all (not (eobp)))
+ (< i n))
+ (let* ((cat (todos-current-category))
+ (ov (todos-marked-item-p))
+ (marked (assoc cat todos-categories-with-marks)))
+ (if (and ov (not all))
+ (progn
+ (delete-overlay ov)
+ (if (= (cdr marked) 1) ; Deleted last mark in this category.
+ (setq todos-categories-with-marks
+ (assq-delete-all cat todos-categories-with-marks))
+ (setcdr marked (1- (cdr marked)))))
+ (when (todos-item-start)
+ (unless (and all (todos-marked-item-p))
+ (setq ov (make-overlay (point) (point)))
+ (overlay-put ov 'before-string todos-item-mark)
+ (if marked
+ (setcdr marked (1+ (cdr marked)))
+ (push (cons cat 1) todos-categories-with-marks))))))
+ (todos-forward-item)
+ (setq i (1+ i)))))
-(defun todos-edit-item-date ()
- "Prompt For and apply changes to current item's date."
+(defun todos-mark-category ()
+ "Put the \"*\" mark on all items in this category.
+\(If `todos-prefix' is \"*\", then the mark is \"@\".)"
(interactive)
- (todos-edit-item-header 'dateonly))
+ (todos-toggle-mark-item 0 t))
-(defun todos-edit-item-date-is-today ()
- "Set item date to today's date."
+(defun todos-unmark-category ()
+ "Remove the \"*\" mark from all items in this category.
+\(If `todos-prefix' is \"*\", then the mark is \"@\".)"
(interactive)
- (todos-edit-item-header 'today))
-
-(defun todos-edit-item-time ()
- "Prompt For and apply changes to current item's time."
+ (remove-overlays (point-min) (point-max) 'before-string todos-item-mark)
+ (setq todos-categories-with-marks
+ (delq (assoc (todos-current-category) todos-categories-with-marks)
+ todos-categories-with-marks)))
+
+(defun todos-set-top-priorities-in-file ()
+ "Set number of top priorities for this file.
+See `todos-set-top-priorities' for more details."
(interactive)
- (todos-edit-item-header 'timeonly))
+ (todos-set-top-priorities))
-(defun todos-raise-item-priority (&optional lower)
- "Raise priority of current item by moving it up by one item.
-With non-nil argument LOWER lower item's priority."
+(defun todos-set-top-priorities-in-category ()
+ "Set number of top priorities for this category.
+See `todos-set-top-priorities' for more details."
(interactive)
- (unless (or (todos-done-item-p)
- (looking-at "^$")) ; We're between todo and done items.
- (let (buffer-read-only)
- (if (or (and lower
- (save-excursion
- ;; Can't lower final todo item.
- (todos-forward-item)
- (and (looking-at todos-item-start)
- (not (todos-done-item-p)))))
- ;; Can't raise or lower only todo item.
- (> (count-lines (point-min) (point)) 0))
- (let ((item (todos-item-string))
- (marked (todos-item-marked-p)))
- ;; In Todos Top Priorities mode, an item's priority can be changed
- ;; wrt items in another category, but not wrt items in the same
- ;; category.
- (when (eq major-mode 'todos-filter-items-mode)
- (let* ((regexp (concat todos-date-string-start todos-date-pattern
- "\\( " diary-time-regexp "\\)?"
- (regexp-quote todos-nondiary-end)
- "?\\(?1: \\[\\(.+:\\)?.+\\]\\)"))
- (cat1 (save-excursion
- (re-search-forward regexp nil t)
- (match-string 1)))
- (cat2 (save-excursion
- (if lower
- (todos-forward-item)
- (todos-backward-item))
- (re-search-forward regexp nil t)
- (match-string 1))))
- (if (string= cat1 cat2)
- ;; FIXME: better message
- (error (concat "Cannot change item's priority in its "
- "category; do this in Todos mode")))))
- (todos-remove-item)
- (if lower (todos-forward-item) (todos-backward-item))
- (todos-insert-with-overlays item)
- ;; If item was marked, retore the mark.
- (and marked (overlay-put (make-overlay (point) (point))
- 'before-string todos-item-mark)))
- (message ""))))) ;FIXME: no message ?
+ (todos-set-top-priorities t))
-(defun todos-lower-item-priority ()
- "Lower priority of current item by moving it down by one item."
+(defun todos-top-priorities (&optional num)
+ "List top priorities of each category in `todos-filter-files'.
+Number of entries for each category is given by NUM, which
+defaults to `todos-show-priorities'."
+ (interactive "P")
+ (let ((arg (if num (cons 'top num) 'top))
+ (buf todos-top-priorities-buffer)
+ (file todos-current-todos-file))
+ (todos-filter-items arg)
+ (todos-special-buffer-name buf file)))
+
+(defun todos-top-priorities-multifile (&optional arg)
+ "List top priorities of each category in `todos-filter-files'.
+
+If the prefix argument ARG is a number, this is the maximum
+number of top priorities to list in each category. If the prefix
+argument is `C-u', prompt for which files to filter and use
+`todos-show-priorities' as the number of top priorities to list
+in each category. If the prefix argument is `C-uC-u', prompt
+both for which files to filter and for how many top priorities to
+list in each category."
+ (interactive "P")
+ (let* ((buf todos-top-priorities-buffer)
+ files
+ (pref (if (numberp arg)
+ (cons 'top arg)
+ (setq files (if (or (consp arg)
+ (null todos-filter-files))
+ (todos-multiple-files)
+ todos-filter-files))
+ (if (equal arg '(16))
+ (cons 'top (read-number
+ "Enter number of top priorities to show: "
+ todos-show-priorities))
+ 'top))))
+ (todos-filter-items pref t)
+ (todos-special-buffer-name buf files)))
+
+(defun todos-diary-items ()
+ "Display todo items for diary inclusion in this Todos file."
(interactive)
- (todos-raise-item-priority t))
+ (let ((buf todos-diary-items-buffer)
+ (file todos-current-todos-file))
+ (todos-filter-items 'diary)
+ (todos-special-buffer-name buf file)))
-;; FIXME: incorporate todos-(raise|lower)-item-priority ?
-(defun todos-set-item-priority (item cat &optional new)
- "Set todo ITEM's priority in category CAT, moving item as needed.
-Interactively, the item and the category are the current ones,
-and the priority is a number between 1 and the number of items in
-the category. Non-interactively with argument NEW, the lowest
-priority is one more than the number of items in CAT."
- (interactive (list (todos-item-string) (todos-current-category)))
- (unless (called-interactively-p t)
- (todos-category-number cat)
- (todos-category-select))
- (let* ((todo (todos-get-count 'todo cat))
- (maxnum (if new (1+ todo) todo))
- (buffer-read-only)
- priority candidate prompt)
- (unless (zerop todo)
- (while (not priority)
- (setq candidate
- (string-to-number (read-from-minibuffer
- (concat prompt
- (format "Set item priority (1-%d): "
- maxnum)))))
- (setq prompt
- (when (or (< candidate 1) (> candidate maxnum))
- (format "Priority must be an integer between 1 and %d.\n"
- maxnum)))
- (unless prompt (setq priority candidate)))
- ;; Interactively, just relocate the item within its category.
- (when (called-interactively-p) (todos-remove-item))
- (goto-char (point-min))
- (unless (= priority 1) (todos-forward-item (1- priority))))
- (todos-insert-with-overlays item)))
+(defun todos-diary-items-multifile (&optional arg)
+ "Display todo items for diary inclusion in one or more Todos file.
+The files are those listed in `todos-filter-files'."
+ (interactive "P")
+ (let ((buf todos-diary-items-buffer)
+ (files (if (or arg (null todos-filter-files))
+ (todos-multiple-files)
+ todos-filter-files)))
+ (todos-filter-items 'diary t)
+ (todos-special-buffer-name buf files)))
-;; FIXME: apply to marked items?
-(defun todos-move-item (&optional file)
- "Move at least one todo item to another category.
+(defun todos-regexp-items ()
+ "Display todo items matching a user-entered regular expression.
+The items are those in the current Todos file."
+ (interactive)
+ (let ((buf todos-regexp-items-buffer)
+ (file todos-current-todos-file))
+ (todos-filter-items 'regexp)
+ (todos-special-buffer-name buf file)))
-If there are marked items, move all of these; otherwise, move
-the item at point.
+(defun todos-regexp-items-multifile (&optional arg)
+ "Display todo items matching a user-entered regular expression.
+The items are those in the files listed in `todos-filter-files'."
+ (interactive "P")
+ (let ((buf todos-regexp-items-buffer)
+ (files (if (or arg (null todos-filter-files))
+ (todos-multiple-files)
+ todos-filter-files)))
+ (todos-filter-items 'regexp t)
+ (todos-special-buffer-name buf files)))
-With non-nil argument FILE, first prompt for another Todos file and
-then a category in that file to move the item or items to.
+(defun todos-custom-items ()
+ "Display todo items filtered by `todos-filter-function'.
+The items are those in the current Todos file."
+ (interactive)
+ (let ((buf todos-custom-items-buffer)
+ (file todos-current-todos-file))
+ (todos-filter-items 'custom)
+ (todos-special-buffer-name buf file)))
-If the chosen category is not one of the existing categories,
-then it is created and the item(s) become(s) the first
-entry/entries in that category."
+(defun todos-custom-items-multifile (&optional arg)
+ "Display todo items filtered by `todos-filter-function'.
+The items are those in the files listed in `todos-filter-files'."
+ (interactive "P")
+ (let ((buf todos-custom-items-buffer)
+ (files (if (or arg (null todos-filter-files))
+ (todos-multiple-files)
+ todos-filter-files)))
+ (todos-filter-items 'custom t)
+ (todos-special-buffer-name buf files)))
+
+(defun todos-print (&optional to-file)
+ "Produce a printable version of the current Todos buffer.
+This converts overlays and soft line wrapping and, depending on
+the value of `todos-print-function', includes faces. With
+non-nil argument TO-FILE write the printable version to a file;
+otherwise, send it to the default printer."
(interactive)
- (unless (or (todos-done-item-p)
- (looking-at "^$")) ; We're between todo and done items.
- (let* ((buffer-read-only)
- (file1 todos-current-todos-file)
- (cat1 (todos-current-category))
- (marked (assoc cat1 todos-categories-with-marks))
- (num todos-category-number)
- (item (todos-item-string))
- (diary-item (todos-diary-item-p))
- (omark (save-excursion (todos-item-start) (point-marker)))
- (file2 (if file
- (todos-read-file-name "Choose a Todos file: " nil t)
- file1))
- (count 0)
- (count-diary 0)
- cat2 nmark)
- (set-buffer (find-file-noselect file2))
- (setq cat2 (let* ((pl (if (and marked (> (cdr marked) 1)) "s" ""))
- (name (todos-read-category
- (concat "Move item" pl " to category: ")))
- (prompt (concat "Choose a different category than "
- "the current one\n(type `"
- (key-description
- (car (where-is-internal
- 'todos-set-item-priority)))
- "' to reprioritize item "
- "within the same category): ")))
- (while (equal name cat1)
- (setq name (todos-read-category prompt)))
- name))
- (set-buffer (get-file-buffer file1))
- (if marked
- (progn
- (setq item nil)
- (goto-char (point-min))
- (while (not (eobp))
- (when (todos-item-marked-p)
- (setq item (concat item (todos-item-string) "\n"))
- (setq count (1+ count))
- (when (todos-diary-item-p)
- (setq count-diary (1+ count-diary))))
- (todos-forward-item))
- ;; Chop off last newline.
- (setq item (substring item 0 -1)))
- (setq count 1)
- (when (todos-diary-item-p) (setq count-diary 1)))
- (set-window-buffer (selected-window)
- (set-buffer (find-file-noselect file2)))
- (unless (assoc cat2 todos-categories) (todos-add-category cat2))
- (todos-set-item-priority item cat2 t)
- (setq nmark (point-marker))
- (todos-set-count 'todo count)
- (todos-set-count 'diary count-diary)
- (todos-update-categories-sexp)
- (with-current-buffer (get-file-buffer file1)
- (save-excursion
- (save-restriction
- (widen)
- (goto-char omark)
- (if marked
- (let (beg end)
- (setq item nil)
- (re-search-backward
- (concat "^" (regexp-quote todos-category-beg)) nil t)
- (forward-line)
- (setq beg (point))
- (re-search-forward
- (concat "^" (regexp-quote todos-category-done)) nil t)
- (setq end (match-beginning 0))
- (goto-char beg)
- (while (< (point) end)
- (if (todos-item-marked-p)
- (todos-remove-item)
- (todos-forward-item))))
- (todos-remove-item))))
- (todos-set-count 'todo (- count) cat1)
- (todos-set-count 'diary (- count-diary) cat1)
- (todos-update-categories-sexp))
- (set-window-buffer (selected-window)
- (set-buffer (find-file-noselect file2)))
- (setq todos-category-number (todos-category-number cat2))
- (todos-category-select)
- (goto-char nmark))))
+ (let ((buf todos-print-buffer)
+ (header (cond
+ ((eq major-mode 'todos-mode)
+ (concat "Todos File: "
+ (todos-short-file-name todos-current-todos-file)
+ "\nCategory: " (todos-current-category)))
+ ((eq major-mode 'todos-filter-items-mode)
+ "Todos Top Priorities")))
+ (prefix (propertize (concat todos-prefix " ")
+ 'face 'todos-prefix-string))
+ (num 0)
+ (fill-prefix (make-string todos-indent-to-here 32))
+ (content (buffer-string))
+ file)
+ (with-current-buffer (get-buffer-create buf)
+ (insert content)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (let ((beg (point))
+ (end (save-excursion (todos-item-end))))
+ (when todos-number-prefix
+ (setq num (1+ num))
+ (setq prefix (propertize (concat (number-to-string num) " ")
+ 'face 'todos-prefix-string)))
+ (insert prefix)
+ (fill-region beg end))
+ ;; Calling todos-forward-item infloops at todos-item-start due to
+ ;; non-overlay prefix, so search for item start instead.
+ (if (re-search-forward todos-item-start nil t)
+ (beginning-of-line)
+ (goto-char (point-max))))
+ (if (re-search-backward (concat "^" (regexp-quote todos-category-done))
+ nil t)
+ (replace-match todos-done-separator))
+ (goto-char (point-min))
+ (insert header)
+ (newline 2)
+ (if to-file
+ (let ((file (read-file-name "Print to file: ")))
+ (funcall todos-print-function file))
+ (funcall todos-print-function)))
+ (kill-buffer buf)))
-(defun todos-move-item-to-file ()
- "Move the current todo item to a category in another Todos file."
+(defun todos-print-to-file ()
+ "Save printable version of this Todos buffer to a file."
(interactive)
- (todos-move-item t))
+ (todos-print t))
-;; FIXME: apply to marked items?
-(defun todos-item-done (&optional arg)
- "Tag this item as done and move it to category's done section.
-With prefix argument ARG prompt for a comment and append it to the
-done item."
- (interactive "P")
- (unless (or (todos-done-item-p)
- (looking-at "^$"))
- (let* ((buffer-read-only)
- (item (todos-item-string))
- (diary-item (todos-diary-item-p))
- (date-string (calendar-date-string (calendar-current-date) t t))
- (time-string (if todos-always-add-time-string ;FIXME: delete condition
- (concat " " (substring (current-time-string) 11 16))
- ""))
- ;; FIXME: todos-nondiary-* ?
- (done-item (concat "[" todos-done-string date-string time-string "] "
- item))
- (comment (and arg (read-string "Enter a comment: "))))
- (todos-remove-item)
- (unless (zerop (length comment))
- (setq done-item (concat done-item " [" todos-comment-string ": "
- comment "]")))
- (save-excursion
- (widen)
- (re-search-forward (concat "^" (regexp-quote todos-category-done)) nil t)
- (forward-char)
- (todos-insert-with-overlays done-item))
- (todos-set-count 'todo -1)
- (todos-set-count 'done 1)
- (and diary-item (todos-set-count 'diary -1))
- (todos-update-categories-sexp)
- (save-excursion (todos-category-select)))))
+(defun todos-convert-legacy-files ()
+ "Convert legacy Todo files to the current Todos format.
+The files `todo-file-do' and `todo-file-done' are converted and
+saved (the latter as a Todos Archive file) with a new name in
+`todos-files-directory'. See also the documentation string of
+`todos-todo-mode-date-time-regexp' for further details."
+ (interactive)
+ (if (fboundp 'todo-mode)
+ (require 'todo-mode)
+ (error "Void function `todo-mode'"))
+ ;; Convert `todo-file-do'.
+ (if (file-exists-p todo-file-do)
+ (let ((default "todo-do-conv")
+ file archive-sexp)
+ (with-temp-buffer
+ (insert-file-contents todo-file-do)
+ (let ((end (search-forward ")" (line-end-position) t))
+ (beg (search-backward "(" (line-beginning-position) t)))
+ (setq todo-categories
+ (read (buffer-substring-no-properties beg end))))
+ (todo-mode)
+ (delete-region (line-beginning-position) (1+ (line-end-position)))
+ (while (not (eobp))
+ (cond
+ ((looking-at (regexp-quote (concat todo-prefix todo-category-beg)))
+ (replace-match todos-category-beg))
+ ((looking-at (regexp-quote todo-category-end))
+ (replace-match ""))
+ ((looking-at (regexp-quote (concat todo-prefix " "
+ todo-category-sep)))
+ (replace-match todos-category-done))
+ ((looking-at (concat (regexp-quote todo-prefix) " "
+ todos-todo-mode-date-time-regexp " "
+ (regexp-quote todo-initials) ":"))
+ (todos-convert-legacy-date-time)))
+ (forward-line))
+ (setq file (concat todos-files-directory
+ (read-string
+ (format "Save file as (default \"%s\"): " default)
+ nil nil default)
+ ".todo"))
+ (write-region (point-min) (point-max) file nil 'nomessage nil t))
+ (with-temp-buffer
+ (insert-file-contents file)
+ (let ((todos-categories (todos-make-categories-list t)))
+ (todos-update-categories-sexp))
+ (write-region (point-min) (point-max) file nil 'nomessage))
+ ;; Convert `todo-file-done'.
+ (when (file-exists-p todo-file-done)
+ (with-temp-buffer
+ (insert-file-contents todo-file-done)
+ (let ((beg (make-marker))
+ (end (make-marker))
+ cat cats comment item)
+ (while (not (eobp))
+ (when (looking-at todos-todo-mode-date-time-regexp)
+ (set-marker beg (point))
+ (todos-convert-legacy-date-time)
+ (set-marker end (point))
+ (goto-char beg)
+ (insert "[" todos-done-string)
+ (goto-char end)
+ (insert "]")
+ (forward-char)
+ (when (looking-at todos-todo-mode-date-time-regexp)
+ (todos-convert-legacy-date-time))
+ (when (looking-at (concat " " (regexp-quote todo-initials) ":"))
+ (replace-match "")))
+ (if (re-search-forward
+ (concat "^" todos-todo-mode-date-time-regexp) nil t)
+ (goto-char (match-beginning 0))
+ (goto-char (point-max)))
+ (backward-char)
+ (when (looking-back "\\[\\([^][]+\\)\\]")
+ (setq cat (match-string 1))
+ (goto-char (match-beginning 0))
+ (replace-match ""))
+ ;; If the item ends with a non-comment parenthesis not
+ ;; followed by a period, we lose (but we inherit that problem
+ ;; from todo-mode.el).
+ (when (looking-back "(\\(.*\\)) ")
+ (setq comment (match-string 1))
+ (replace-match "")
+ (insert "[" todos-comment-string ": " comment "]"))
+ (set-marker end (point))
+ (if (member cat cats)
+ ;; If item is already in its category, leave it there.
+ (unless (save-excursion
+ (re-search-backward
+ (concat "^" (regexp-quote todos-category-beg)
+ "\\(.*\\)$") nil t)
+ (string= (match-string 1) cat))
+ ;; Else move it to its category.
+ (setq item (buffer-substring-no-properties beg end))
+ (delete-region beg (1+ end))
+ (set-marker beg (point))
+ (re-search-backward
+ (concat "^" (regexp-quote (concat todos-category-beg cat)))
+ nil t)
+ (forward-line)
+ (if (re-search-forward
+ (concat "^" (regexp-quote todos-category-beg)
+ "\\(.*\\)$") nil t)
+ (progn (goto-char (match-beginning 0))
+ (newline)
+ (forward-line -1))
+ (goto-char (point-max)))
+ (insert item "\n")
+ (goto-char beg))
+ (push cat cats)
+ (goto-char beg)
+ (insert todos-category-beg cat "\n\n" todos-category-done "\n"))
+ (forward-line))
+ (set-marker beg nil)
+ (set-marker end nil))
+ (setq file (concat (file-name-sans-extension file) ".toda"))
+ (write-region (point-min) (point-max) file nil 'nomessage nil t))
+ (with-temp-buffer
+ (insert-file-contents file)
+ (let ((todos-categories (todos-make-categories-list t)))
+ (todos-update-categories-sexp))
+ (write-region (point-min) (point-max) file nil 'nomessage)
+ (setq archive-sexp (read (buffer-substring-no-properties
+ (line-beginning-position)
+ (line-end-position)))))
+ (setq file (concat (file-name-sans-extension file) ".todo"))
+ ;; Update categories sexp of converted Todos file again, adding
+ ;; counts of archived items.
+ (with-temp-buffer
+ (insert-file-contents file)
+ (let ((sexp (read (buffer-substring-no-properties
+ (line-beginning-position)
+ (line-end-position)))))
+ (dolist (cat sexp)
+ (let ((archive-cat (assoc (car cat) archive-sexp)))
+ (if archive-cat
+ (aset (cdr cat) 3 (aref (cdr archive-cat) 2)))))
+ (delete-region (line-beginning-position) (line-end-position))
+ (prin1 sexp (current-buffer)))
+ (write-region (point-min) (point-max) file nil 'nomessage)))
+ (todos-reevaluate-defcustoms)
+ (message "Format conversion done."))
+ (error "No legacy Todo file exists")))
-(defun todos-comment-done-item ()
- "Add a comment to this done item."
+;; ---------------------------------------------------------------------------
+;;; Navigation Commands
+
+(defun todos-forward-category (&optional back)
+ "Visit the numerically next category in this Todos file.
+If the current category is the highest numbered, visit the first
+category. With non-nil argument BACK, visit the numerically
+previous category (the highest numbered one, if the current
+category is the first)."
(interactive)
- (when (todos-done-item-p)
- (let ((comment (read-string "Enter a comment: "))
- buffer-read-only)
- (todos-item-end)
- (insert " [" todos-comment-string ": " comment "]"))))
+ (setq todos-category-number
+ (1+ (mod (- todos-category-number (if back 2 0))
+ (length todos-categories))))
+ (todos-category-select)
+ (goto-char (point-min)))
-;; FIXME: implement this or done item editing?
-(defun todos-uncomment-done-item ()
- ""
- )
+(defun todos-backward-category ()
+ "Visit the numerically previous category in this Todos file.
+If the current category is the highest numbered, visit the first
+category."
+ (interactive)
+ (todos-forward-category t))
-;; FIXME: delete comment from restored item or just leave it up to user?
-(defun todos-item-undo ()
- "Restore this done item to the todo section of this category."
+(defun todos-jump-to-category (&optional cat other-file)
+ "Jump to a category in this or another Todos file.
+
+Programmatically, optional argument CAT provides the category
+name. When nil (as in interactive calls), prompt for the
+category, with TAB completion on existing categories. If a
+non-existing category name is entered, ask whether to add a new
+category with this name; if affirmed, add it, then jump to that
+category. With non-nil argument OTHER-FILE, prompt for a Todos
+file, otherwise jump within the current Todos file."
(interactive)
- (when (todos-done-item-p)
- (let* ((buffer-read-only)
- (done-item (todos-item-string))
- (opoint (point))
- (orig-mrk (progn (todos-item-start) (point-marker)))
- ;; Find the end of the date string added upon making item done.
- (start (search-forward "] "))
- (item (buffer-substring start (todos-item-end)))
- undone)
- (todos-remove-item)
- ;; If user cancels before setting new priority, then restore everything.
- (unwind-protect
- (progn
- (todos-set-item-priority item (todos-current-category) t)
- (setq undone t)
- (todos-set-count 'todo 1)
- (todos-set-count 'done -1)
- (and (todos-diary-item-p) (todos-set-count 'diary 1))
- (todos-update-categories-sexp))
- (unless undone
- (widen)
- (goto-char orig-mrk)
- (todos-insert-with-overlays done-item)
- (let ((todos-show-with-done t))
+ (let ((file (or (and other-file
+ (todos-read-file-name "Choose a Todos file: " nil t))
+ ;; Jump to archived-only Categories from Todos Categories mode.
+ (and cat
+ todos-ignore-archived-categories
+ (zerop (todos-get-count 'todo cat))
+ (zerop (todos-get-count 'done cat))
+ (not (zerop (todos-get-count 'archived cat)))
+ (concat (file-name-sans-extension
+ todos-current-todos-file) ".toda"))
+ todos-current-todos-file
+ ;; If invoked from outside of Todos mode before todos-show...
+ todos-default-todos-file)))
+ (with-current-buffer (find-file-noselect file)
+ (and other-file (setq todos-current-todos-file file))
+ (let ((category (or (and (assoc cat todos-categories) cat)
+ (todos-read-category "Jump to category: "))))
+ ;; Clean up after selecting category in Todos Categories mode.
+ (if (string= (buffer-name) todos-categories-buffer)
+ (kill-buffer))
+ (if (or cat other-file)
+ (set-window-buffer (selected-window)
+ (set-buffer (get-file-buffer file))))
+ (unless todos-global-current-todos-file
+ (setq todos-global-current-todos-file todos-current-todos-file))
+ (todos-category-number category)
+ (if (> todos-category-number (length todos-categories))
+ (setq todos-category-number (todos-add-category category)))
(todos-category-select)
- (goto-char opoint)))
- (set-marker orig-mrk nil)))))
-
-(defun todos-archive-done-item-or-items (&optional all)
- "Archive at least one done item in this category.
+ (goto-char (point-min))))))
-If there are marked done items (and no marked todo items),
-archive all of these; otherwise, with non-nil argument ALL,
-archive all done items in this category; otherwise, archive the
-done item at point.
+(defun todos-jump-to-category-other-file ()
+ "Jump to a category in another Todos file.
+The category is chosen by prompt, with TAB completion."
+ (interactive)
+ (todos-jump-to-category nil t))
-If the archive of this file does not exist, it is created. If
-this category does not exist in the archive, it is created."
+(defun todos-jump-to-item ()
+ "Jump to the file and category of the filtered item at point."
(interactive)
- (when (not (member (buffer-file-name) (funcall todos-files-function t)))
- (if (and all (zerop (todos-get-count 'done cat)))
- (message "No done items in this category")
- (catch 'end
- (let* ((cat (todos-current-category))
- (tbuf (current-buffer))
- (marked (assoc cat todos-categories-with-marks))
- (afile (concat (file-name-sans-extension
- todos-current-todos-file) ".toda"))
- (archive (if (file-exists-p afile)
- (find-file-noselect afile t)
- (progn
- ;; todos-add-category requires an exisiting file...
- (with-current-buffer (get-buffer-create afile)
- (erase-buffer)
- (write-region (point-min) (point-max) afile
- nil 'nomessage nil t)))
- ;; ...but the file still lacks a categories sexp, so
- ;; visiting the file would barf on todos-set-categories,
- ;; hence we just return the buffer.
- (get-buffer afile)))
- (item (and (todos-done-item-p) (concat (todos-item-string) "\n")))
- (count 0)
- marked-items beg end all-done
- buffer-read-only)
- (cond
- (marked
- (save-excursion
- (goto-char (point-min))
- (while (not (eobp))
- (if (todos-item-marked-p)
- (if (not (todos-done-item-p))
- (throw 'end (message "Only done items can be archived"))
- (concat marked-items (todos-item-string) "\n")
- (setq count (1+ count)))
- (todos-forward-item)))))
- (all
- (if (y-or-n-p "Archive all done items in this category? ")
- (save-excursion
- (save-restriction
- (goto-char (point-min))
- (widen)
- (setq beg (progn
- (re-search-forward todos-done-string-start nil t)
- (match-beginning 0))
- end (if (re-search-forward
- (concat "^" (regexp-quote todos-category-beg))
- nil t)
- (match-beginning 0)
- (point-max))
- all-done (buffer-substring beg end)
- count (todos-get-count 'done))))
- (throw 'end nil))))
- (when (or marked all item)
- (with-current-buffer archive
- (let ((current todos-global-current-todos-file)
- (buffer-read-only))
- (widen)
- (goto-char (point-min))
- (if (progn
- (re-search-forward
- (concat "^" (regexp-quote (concat todos-category-beg cat)))
- nil t)
- (re-search-forward (regexp-quote todos-category-done) nil t))
- (forward-char)
- ;; todos-add-category uses t-c-t-f, so temporarily set it.
- (setq todos-current-todos-file afile)
- (todos-add-category cat)
- (goto-char (point-max)))
- (insert (cond (marked marked-items)
- (all all-done)
- (item)))
- (todos-set-count 'done (if (or marked all) count 1))
- (todos-update-categories-sexp)
- ;; Save to file now (using write-region in order not to visit
- ;; afile) so we can visit it later with todos-view-archived-items
- ;; or todos-show-archive.
- (write-region nil nil afile)
- (setq todos-current-todos-file current)))
- (with-current-buffer tbuf
- (cond ((or marked item)
- (and marked (goto-char (point-min)))
- (catch 'done
- (while (not (eobp))
- (if (or (and marked (todos-item-marked-p)) item)
- (progn
- (todos-remove-item)
- (todos-set-count 'done -1)
- (todos-set-count 'archived 1)
- ;; Don't leave point below last item.
- (and item (bolp) (eolp) (< (point-min) (point-max))
- (todos-backward-item))
- (when item
- (throw 'done (setq item nil))))
- (todos-forward-item)))))
- (all
- (remove-overlays beg end)
- (delete-region beg end)
- (todos-set-count 'done (- count))
- (todos-set-count 'archived count)))
- (when marked
- (remove-overlays (point-min) (point-max)
- 'before-string todos-item-mark)
- (setq todos-categories-with-marks
- (assq-delete-all cat todos-categories-with-marks))
- (goto-char opoint))
- (todos-update-categories-sexp)
- (todos-prefix-overlays)
- ;; FIXME: Heisenbug: item displays mark -- but not when edebugging
- (remove-overlays (point-min) (point-max)
- 'before-string todos-item-mark)))
- (display-buffer (find-file-noselect afile) t)
- ;; FIXME: how to avoid switch-to-buffer and still get tbuf above
- ;; afile? What about pop-to-buffer-same-window in recent trunk?
- (switch-to-buffer tbuf))))))
+ (let ((str (todos-item-string))
+ (buf (current-buffer))
+ cat file beg)
+ (string-match (concat todos-date-string-start todos-date-pattern
+ "\\(?: " diary-time-regexp "\\)?"
+ (regexp-quote todos-nondiary-end) "?"
+ "\\(?3: \\[\\(?2:.*:\\)?\\(?1:.*\\)\\]\\).*$") str)
+ (setq cat (match-string 1 str))
+ (setq file (match-string 2 str))
+ (setq str (replace-match "" nil nil str 3))
+ (setq file (if file
+ (concat todos-files-directory (substring file 0 -1) ".todo")
+ todos-global-current-todos-file))
+ (find-file-noselect file)
+ (with-current-buffer (get-file-buffer file)
+ (widen)
+ (goto-char (point-min))
+ (re-search-forward
+ (concat "^" (regexp-quote (concat todos-category-beg cat))) nil t)
+ (search-forward str)
+ (setq beg (match-beginning 0)))
+ (kill-buffer buf)
+ (set-window-buffer (selected-window) (set-buffer (get-file-buffer file)))
+ (setq todos-current-todos-file file)
+ (setq todos-category-number (todos-category-number cat))
+ (todos-category-select)
+ (goto-char beg)))
+
+;; FIXME ? disallow prefix arg value < 1 (re-search-* allows these)
+(defun todos-forward-item (&optional count)
+ "Move point down to start of item with next lower priority.
+With numerical prefix COUNT, move point COUNT items downward,"
+ (interactive "P")
+ (let* ((not-done (not (or (todos-done-item-p) (looking-at "^$"))))
+ (start (line-end-position)))
+ (goto-char start)
+ (if (re-search-forward todos-item-start nil t (or count 1))
+ (goto-char (match-beginning 0))
+ (goto-char (point-max)))
+ ;; If points advances by one from a todo to a done item, go back to the
+ ;; space above todos-done-separator, since that is a legitimate place to
+ ;; insert an item. But skip this space if count > 1, since that should
+ ;; only stop on an item (FIXME: or not?)
+ (when (and not-done (todos-done-item-p))
+ (if (or (not count) (= count 1))
+ (re-search-backward "^$" start t)))))
-(defun todos-archive-category-done-items ()
- "Move all done items in this category to its archive."
+(defun todos-backward-item (&optional count)
+ "Move point up to start of item with next higher priority.
+With numerical prefix COUNT, move point COUNT items upward,"
+ (interactive "P")
+ (let* ((done (todos-done-item-p)))
+ ;; FIXME ? this moves to bob if on the first item (but so does previous-line)
+ (todos-item-start)
+ (unless (bobp)
+ (re-search-backward todos-item-start nil t (or count 1)))
+ ;; If points advances by one from a done to a todo item, go back to the
+ ;; space above todos-done-separator, since that is a legitimate place to
+ ;; insert an item. But skip this space if count > 1, since that should
+ ;; only stop on an item (FIXME: or not?)
+ (when (and done (not (todos-done-item-p))
+ (or (not count) (= count 1)))
+ (re-search-forward (concat "^" (regexp-quote todos-category-done)) nil t)
+ (forward-line -1))))
+
+;; FIXME: (i) Extend search to other Todos files. (ii) Allow navigating among
+;; hits.
+(defun todos-search ()
+ "Search for a regular expression in this Todos file.
+The search runs through the whole file and encompasses all and
+only todo and done items; it excludes category names. Multiple
+matches are shown sequentially, highlighted in `todos-search'
+face."
(interactive)
- (todos-archive-done-item-or-items t))
+ (let ((regex (read-from-minibuffer "Enter a search string (regexp): "))
+ (opoint (point))
+ matches match cat in-done ov mlen msg)
+ (widen)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (setq match (re-search-forward regex nil t))
+ (goto-char (line-beginning-position))
+ (unless (or (equal (point) 1)
+ (looking-at (concat "^" (regexp-quote todos-category-beg))))
+ (if match (push match matches)))
+ (forward-line))
+ (setq matches (reverse matches))
+ (if matches
+ (catch 'stop
+ (while matches
+ (setq match (pop matches))
+ (goto-char match)
+ (todos-item-start)
+ (when (looking-at todos-done-string-start)
+ (setq in-done t))
+ (re-search-backward (concat "^" (regexp-quote todos-category-beg)
+ "\\(.*\\)\n") nil t)
+ (setq cat (match-string-no-properties 1))
+ (todos-category-number cat)
+ (todos-category-select)
+ (if in-done
+ (unless todos-show-with-done (todos-toggle-view-done-items)))
+ (goto-char match)
+ (setq ov (make-overlay (- (point) (length regex)) (point)))
+ (overlay-put ov 'face 'todos-search)
+ (when matches
+ (setq mlen (length matches))
+ (if (y-or-n-p
+ (if (> mlen 1)
+ (format "There are %d more matches; go to next match? "
+ mlen)
+ "There is one more match; go to it? "))
+ (widen)
+ (throw 'stop (setq msg (if (> mlen 1)
+ (format "There are %d more matches."
+ mlen)
+ "There is one more match."))))))
+ (setq msg "There are no more matches."))
+ (todos-category-select)
+ (goto-char opoint)
+ (message "No match for \"%s\"" regex))
+ (when msg
+ (if (y-or-n-p (concat msg "\nUnhighlight matches? "))
+ (todos-clear-matches)
+ (message "You can unhighlight the matches later by typing %s"
+ (key-description (car (where-is-internal
+ 'todos-clear-matches))))))))
-(defun todos-unarchive-items (&optional all)
- "Unarchive at least one item in this archive category.
+(defun todos-clear-matches ()
+ "Remove highlighting on matches found by todos-search."
+ (interactive)
+ (remove-overlays 1 (1+ (buffer-size)) 'face 'todos-search))
-If there are marked items, unarchive all of these; otherwise,
-with non-nil argument ALL, unarchive all items in this category;
-otherwise, unarchive the item at point.
+;; ---------------------------------------------------------------------------
+;;; Editing Commands
-Unarchived items are restored as done items to the corresponding
-category in the Todos file, inserted at the end of done section.
-If all items in the archive category were restored, the category
-is deleted from the archive. If this was the only category in the
-archive, the archive file is deleted."
+;; FIXME: autoload?
+;; FIXME: should there also be command todos-delete-file or is it enough to
+;; delete empty file on deleting last category with todos-delete-category?
+(defun todos-add-file ()
+ "Name and add a new Todos file.
+Interactively, prompt for a category and display it.
+Noninteractively, return the name of the new file."
(interactive)
- (when (member (buffer-file-name) (funcall todos-files-function t))
- (catch 'end
- (let* ((buffer-read-only nil)
- (tbuf (find-file-noselect
- (concat (file-name-sans-extension todos-current-todos-file)
- ".todo") t))
- (cat (todos-current-category))
- (marked (assoc cat todos-categories-with-marks))
- (item (concat (todos-item-string) "\n"))
- (all-items (buffer-substring (point-min) (point-max)))
- (all-count (todos-get-count 'done))
- marked-items marked-count)
- (save-excursion
- (goto-char (point-min))
- (while (not (eobp))
- (when (todos-item-marked-p)
- (concat marked-items (todos-item-string) "\n")
- (setq marked-count (1+ marked-count)))
- (todos-forward-item)))
- ;; Restore items to end of category's done section and update counts.
- (with-current-buffer tbuf
+ (let ((default-file (if todos-default-todos-file
+ (todos-short-file-name todos-default-todos-file)))
+ (prompt (concat "Enter name of new Todos file "
+ "(TAB or SPC to see current names): "))
+ file shortname)
+ (setq file (todos-read-file-name prompt));))
+ (setq shortname (todos-short-file-name file))
+ (with-current-buffer (get-buffer-create file)
+ (erase-buffer)
+ (write-region (point-min) (point-max) file nil 'nomessage nil t)
+ (kill-buffer file))
+ (todos-reevaluate-defcustoms)
+ (if (called-interactively-p)
+ (progn
+ (setq todos-current-todos-file file)
+ (todos-show))
+ file)))
+
+(defun todos-add-category (&optional cat)
+ "Add a new category to the current Todos file.
+Called interactively, prompt for category name, then visit the
+category in Todos mode. Non-interactively, argument CAT provides
+the category name, which is also the return value."
+ (interactive)
+ (let* ((buffer-read-only)
+ ;; FIXME: check against todos-archive-done-item-or-items with empty file
+ (buf (find-file-noselect todos-current-todos-file t))
+ ;; (buf (get-file-buffer todos-current-todos-file))
+ (num (1+ (length todos-categories)))
+ (counts (make-vector 4 0))) ; [todo diary done archived]
+ (unless (zerop (buffer-size buf))
+ (and (null todos-categories)
+ (error "Error in %s: File is non-empty but contains no category"
+ todos-current-todos-file)))
+ (unless cat (setq cat (read-from-minibuffer "Enter new category name: ")))
+ (with-current-buffer buf
+ (setq cat (todos-validate-name cat 'category))
+ (setq todos-categories (append todos-categories (list (cons cat counts))))
+ (if todos-categories-full
+ (setq todos-categories-full (append todos-categories-full
+ (list (cons cat counts)))))
+ (widen)
+ (goto-char (point-max))
+ (save-excursion ; Save point for todos-category-select.
+ (insert todos-category-beg cat "\n\n" todos-category-done "\n"))
+ (todos-update-categories-sexp)
+ ;; If called by command, display the newly added category, else return
+ ;; the category number to the caller.
+ (if (called-interactively-p 'any) ; FIXME?
+ (progn
+ (setq todos-category-number num)
+ (todos-category-select))
+ num))))
+
+(defun todos-rename-category ()
+ "Rename current Todos category.
+If this file has an archive containing this category, rename the
+category there as well."
+ (interactive)
+ (let* ((cat (todos-current-category))
+ (new (read-from-minibuffer (format "Rename category \"%s\" to: " cat))))
+ (setq new (todos-validate-name new 'category))
+ (let* ((ofile todos-current-todos-file)
+ (archive (concat (file-name-sans-extension ofile) ".toda"))
+ (buffers (append (list ofile)
+ (unless (zerop (todos-get-count 'archived cat))
+ (list archive)))))
+ (dolist (buf buffers)
+ (with-current-buffer (find-file-noselect buf)
(let (buffer-read-only)
- (widen)
- (goto-char (point-min))
- (re-search-forward (concat "^" (regexp-quote
- (concat todos-category-beg cat)))
- nil t)
- (if (re-search-forward (concat "^" (regexp-quote todos-category-beg))
+ (setq todos-categories (todos-set-categories))
+ (save-excursion
+ (save-restriction
+ (setcar (assoc cat todos-categories) new)
+ (widen)
+ (goto-char (point-min))
+ (todos-update-categories-sexp)
+ (re-search-forward (concat (regexp-quote todos-category-beg)
+ "\\(" (regexp-quote cat) "\\)\n")
nil t)
- (goto-char (match-beginning 0))
- (goto-char (point-max)))
- (cond (marked
- (insert marked-items)
- (todos-set-count 'done marked-count)
- (todos-set-count 'archived (- marked-count)))
- (all
- (if (y-or-n-p (concat "Restore this category's items "
- "to Todos file as done items "
- "and delete this category? "))
- (progn (insert all-items)
- (todos-set-count 'done all-count)
- (todos-set-count 'archived (- all-count)))
- (throw 'end nil)))
- (t
- (insert item)
- (todos-set-count 'done 1)
- (todos-set-count 'archived -1)))
- (todos-update-categories-sexp)))
- ;; Delete restored items from archive.
- (cond ((or marked item)
- (and marked (goto-char (point-min)))
- (catch 'done
- (while (not (eobp))
- (if (or (and marked (todos-item-marked-p)) item)
- (progn
- (todos-remove-item)
- (todos-set-count 'done -1)
- ;; Don't leave point below last item.
- (and item (bolp) (eolp) (< (point-min) (point-max))
- (todos-backward-item))
- (when item
- (throw 'done (setq item nil))))
- (todos-forward-item)))))
- (all
- (remove-overlays (point-min) (point-max))
- (delete-region (point-min) (point-max))
- (todos-set-count 'done (- all-count))))
- ;; If that was the last category in the archive, delete the whole file.
- (if (= (length todos-categories) 1)
- (progn
- (delete-file todos-current-todos-file)
- ;; Don't bother confirming killing the archive buffer.
- (set-buffer-modified-p nil)
- (kill-buffer))
- ;; Otherwise, if the archive category is now empty, delete it.
- (when (eq (point-min) (point-max))
+ (replace-match new t t nil 1)))))))
+ ;; FIXME: use force-mode-line-update instead?
+ (setq mode-line-buffer-identification
+ (funcall todos-mode-line-function new)))
+ (save-excursion (todos-category-select)))
+
+(defun todos-delete-category (&optional arg)
+ "Delete current Todos category provided it is empty.
+With ARG non-nil delete the category unconditionally,
+i.e. including all existing todo and done items."
+ (interactive "P")
+ (let* ((cat (todos-current-category))
+ (todo (todos-get-count 'todo cat))
+ (done (todos-get-count 'done cat))
+ (archived (todos-get-count 'archived cat)))
+ (when (or (> (length todos-categories) 1)
+ (y-or-n-p (concat "This is the only category in this file; "
+ "deleting it will also delete the file.\n"
+ "Do you want to proceed? ")))
+ (if (and (not arg)
+ (or (> todo 0) (> done 0)))
+ (message "To delete a non-empty category, type C-u %s."
+ (key-description
+ (car (where-is-internal 'todos-delete-category))))
+ (when (yes-or-no-p (concat "Permanently remove category \"" cat
+ "\"" (and arg " and all its entries") "? "))
+ (when (and archived
+ (y-or-n-p (concat "This category has archived items; "
+ "the archived category will remain\n"
+ "after deleting the todo category. "
+ "Do you still want to delete it\n"
+ "(see 'todos-ignore-archived-categories' "
+ "for another option)? ")))
(widen)
- (let ((beg (re-search-backward
- (concat "^" (regexp-quote todos-category-beg) cat)
- nil t))
+ (let ((buffer-read-only)
+ (beg (re-search-backward
+ (concat "^" (regexp-quote (concat todos-category-beg cat))
+ "\n") nil t))
(end (if (re-search-forward
- (concat "^" (regexp-quote todos-category-beg))
- nil t 2)
- (match-beginning 0)
+ (concat "\n\\(" (regexp-quote todos-category-beg)
+ ".*\n\\)") nil t)
+ (match-beginning 1)
(point-max))))
(remove-overlays beg end)
(delete-region beg end)
- (setq todos-categories (delete (assoc cat todos-categories)
- todos-categories))
- (todos-update-categories-sexp))))
- ;; Visit category in Todos file and show restored done items.
- (let ((tfile (buffer-file-name tbuf))
- (todos-show-with-done t))
- (set-window-buffer (selected-window)
- (set-buffer (find-file-noselect tfile)))
- (todos-category-number cat)
- (todos-show)
- (message "Items unarchived."))))))
-
-(defun todos-unarchive-category ()
- "Unarchive all items in this category. See `todos-unarchive-items'."
- (interactive)
- (todos-unarchive-items t))
-
-(defun todos-toggle-diary-inclusion (&optional all)
- "Toggle diary status of one or more todo items in this category.
-
-If a candidate item is marked with `todos-nondiary-marker',
-remove this marker; otherwise, insert it.
-
-With non-nil argument ALL toggle the diary status of all todo
-items in this category; otherwise, if there are marked todo
-items, toggle the diary status of all and only these, otherwise
-toggle the diary status of the item at point. "
- (interactive)
- (let ((marked (assoc (todos-current-category)
- todos-categories-with-marks)))
- (catch 'stop
- (save-excursion
- (save-restriction
- (when (or marked all) (goto-char (point-min)))
- (while (not (eobp))
- (if (todos-done-item-p)
- (throw 'stop (message "Done items cannot be changed"))
- (unless (and marked (not (todos-item-marked-p)))
- (save-excursion
- (let* ((buffer-read-only)
- (beg (todos-item-start))
- (lim (save-excursion (todos-item-end)))
- (end (save-excursion
- (or (todos-time-string-matcher lim)
- (todos-date-string-matcher lim)))))
- (if (looking-at (regexp-quote todos-nondiary-start))
- (progn
- (replace-match "")
- (search-forward todos-nondiary-end (1+ end) t)
- (replace-match "")
- (todos-set-count 'diary 1))
- (when end
- (insert todos-nondiary-start)
- (goto-char (1+ end))
- (insert todos-nondiary-end)
- (todos-set-count 'diary -1))))))
- (unless (or marked all) (throw 'stop nil))
- (todos-forward-item))))))
- (todos-update-categories-sexp)))
+ (if (= (length todos-categories) 1)
+ ;; If deleted category was the only one, delete the file.
+ (progn
+ ;; FIXME: need this?
+ (setq todos-categories nil)
+ (todos-reevaluate-defcustoms)
+ (delete-file todos-current-todos-file)
+ (kill-buffer)
+ (message "Deleted empty Todos file %s."
+ todos-current-todos-file))
+ ;; FIXME: what about todos-categories-full ?
+ (setq todos-categories (delete (assoc cat todos-categories)
+ todos-categories))
+ (todos-update-categories-sexp)
+ (setq todos-category-number
+ (1+ (mod todos-category-number (length todos-categories))))
+ (todos-category-select)
+ (goto-char (point-min))
+ (message "Deleted category %s." cat)))))))))
-(defun todos-toggle-item-diary-nonmarking ()
- "Mark or unmark this todos diary item for calendar display.
-See `diary-nonmarking-symbol'."
+(defun todos-raise-category (&optional lower)
+ "Raise priority of category point is on in Todos Categories buffer.
+With non-nil argument LOWER, lower the category's priority."
(interactive)
- (let ((buffer-read-only))
+ (let (num)
(save-excursion
- (todos-item-start)
- (unless (looking-at (regexp-quote todos-nondiary-start))
- (if (looking-at (regexp-quote diary-nonmarking-symbol))
- (replace-match "")
- (insert diary-nonmarking-symbol))))))
-
-(defun todos-toggle-diary-nonmarking ()
- "Mark or unmark this category's todos diary items for calendar.
-See `diary-nonmarking-symbol'."
- (interactive)
- (save-excursion
- (goto-char (point-min))
- (while (not (eobp))
- (todos-toggle-item-diary-nonmarking)
- (todos-forward-item))))
+ (forward-line 0)
+ (skip-chars-forward " ")
+ (setq num (number-at-point)))
+ (when (and num (if lower
+ (< num (length todos-categories))
+ (> num 1)))
+ (let* ((col (current-column))
+ (beg (progn (forward-line (if lower 0 -1)) (point)))
+ (num1 (progn (skip-chars-forward " ") (1- (number-at-point))))
+ (num2 (1+ num1))
+ (end (progn (forward-line 2) (point)))
+ (catvec (vconcat todos-categories))
+ (cat1-list (aref catvec num1))
+ (cat2-list (aref catvec num2))
+ (cat1 (car cat1-list))
+ (cat2 (car cat2-list))
+ buffer-read-only newcats)
+ (delete-region beg end)
+ (setq num1 (1+ num1))
+ (setq num2 (1- num2))
+ (setq num num2)
+ (todos-insert-category-line cat2)
+ (setq num num1)
+ (todos-insert-category-line cat1)
+ (aset catvec num2 (cons cat2 (cdr cat2-list)))
+ (aset catvec num1 (cons cat1 (cdr cat1-list)))
+ (setq todos-categories (append catvec nil))
+ (setq newcats todos-categories)
+ (with-current-buffer (get-file-buffer todos-current-todos-file)
+ (setq todos-categories newcats)
+ (todos-update-categories-sexp))
+ (forward-line (if lower -1 -2))
+ (forward-char col)))))
-(defun todos-print (&optional to-file)
- "Produce a printable version of the current Todos buffer.
-This includes overlays, indentation, and, depending on the value
-of `todos-print-function', faces. With non-nil argument TO-FILE
-write the printable version to a file; otherwise, send it to the
-default printer."
+(defun todos-lower-category ()
+ "Lower priority of category point is on in Todos Categories buffer."
(interactive)
- (let ((buf todos-tmp-buffer-name) ;FIXME
- (header (cond
- ((eq major-mode 'todos-mode)
- (concat "Todos File: "
- (file-name-sans-extension
- (file-name-nondirectory todos-current-todos-file))
- "\nCategory: " (todos-current-category)))
- ((eq major-mode 'todos-filter-items-mode)
- "Todos Top Priorities")))
- (prefix (propertize (concat todos-prefix " ")
- 'face 'todos-prefix-string))
- (num 0)
- (fill-prefix (make-string todos-indent-to-here 32))
- (content (buffer-string))
- file)
- (with-current-buffer (get-buffer-create buf)
- (insert content)
- (goto-char (point-min))
- (while (not (eobp))
- (let ((beg (point))
- (end (save-excursion (todos-item-end))))
- (when todos-number-prefix
- (setq num (1+ num))
- (setq prefix (propertize (concat (number-to-string num) " ")
- 'face 'todos-prefix-string)))
- (insert prefix)
- (fill-region beg end))
- ;; Calling todos-forward-item infloops at todos-item-start due to
- ;; non-overlay prefix, so search for item start instead.
- (if (re-search-forward todos-item-start nil t)
- (beginning-of-line)
- (goto-char (point-max))))
- (if (re-search-backward (concat "^" (regexp-quote todos-category-done))
- nil t)
- (replace-match todos-done-separator))
- (goto-char (point-min))
- (insert header)
- (newline 2)
- (if to-file
- (let ((file (read-file-name "Print to file: ")))
- (funcall todos-print-function file))
- (funcall todos-print-function)))
- (kill-buffer buf)))
+ (todos-raise-category t))
-(defun todos-print-to-file ()
- "Save printable version of this Todos buffer to a file."
+(defun todos-move-category ()
+ "Move current category to a different Todos file.
+If current category has archived items, also move those to the
+archive of the file moved to, creating it if it does not exist."
(interactive)
- (todos-print t))
-
-;; ---------------------------------------------------------------------------
-
-;;; Internals
-
-(defvar todos-date-pattern ;FIXME: start with "^" ?
- (let ((dayname (diary-name-pattern calendar-day-name-array nil t)))
- (concat "\\(?:" dayname "\\|"
- (let ((dayname)
- (monthname (format "\\(?:%s\\|\\*\\)"
- (diary-name-pattern
- calendar-month-name-array
- calendar-month-abbrev-array t)))
- (month "\\(?:[0-9]+\\|\\*\\)")
- (day "\\(?:[0-9]+\\|\\*\\)")
- (year "-?\\(?:[0-9]+\\|\\*\\)"))
- (mapconcat 'eval calendar-date-display-form ""))
- "\\)"))
- "Regular expression matching a Todos date header.")
-
-(defvar todos-date-string-start
- ;; FIXME: with ? matches anything
- (concat "^\\(" (regexp-quote todos-nondiary-start) "\\|"
- (regexp-quote diary-nonmarking-symbol) "\\)?")
- "Regular expression matching part of item header before the date.")
-
-(defvar todos-done-string-start
- (concat "^\\[" (regexp-quote todos-done-string))
- "Regular expression matching start of done item.")
-
-(defun todos-date-string-matcher (lim)
- "Search for Todos date strings within LIM for font-locking."
- (re-search-forward
- (concat todos-date-string-start "\\(?1:" todos-date-pattern "\\)") lim t))
-
-(defun todos-time-string-matcher (lim)
- "Search for Todos time strings within LIM for font-locking."
- (re-search-forward (concat todos-date-string-start todos-date-pattern
- " \\(?1:" diary-time-regexp "\\)") lim t))
-
-(defun todos-done-string-matcher (lim)
- "Search for Todos done headers within LIM for font-locking."
- (re-search-forward (concat todos-done-string-start
- "[^][]+]")
- lim t))
-
-(defun todos-comment-string-matcher (lim)
- "Search for Todos done comment within LIM for font-locking."
- (re-search-forward (concat "\\[\\(?1:" todos-comment-string "\\):")
- lim t))
-
-(defun todos-category-string-matcher (lim)
- "Search for Todos category headers within LIM for font-locking."
- (if (eq major-mode 'todos-filter-items-mode)
- (re-search-forward
- ;; (concat "^\\(?1:" (regexp-quote todos-category-beg) ".*\\)$")
- (concat "\\(?:^\\[?" todos-date-pattern "\\(?: " diary-time-regexp
- "\\)?\\]?\\) \\(?1:\\[.+\\]\\)") lim t)))
+ (when (or (> (length todos-categories) 1)
+ (y-or-n-p (concat "This is the only category in this file; "
+ "moving it will also delete the file.\n"
+ "Do you want to proceed? ")))
+ (let* ((ofile todos-current-todos-file)
+ (cat (todos-current-category))
+ (nfile (todos-read-file-name "Choose a Todos file: " nil t))
+ (archive (concat (file-name-sans-extension ofile) ".toda"))
+ (buffers (append (list ofile)
+ (unless (zerop (todos-get-count 'archived cat))
+ (list archive))))
+ new)
+ (dolist (buf buffers)
+ (with-current-buffer (find-file-noselect buf)
+ (widen)
+ (goto-char (point-max))
+ (let* ((beg (re-search-backward
+ (concat "^"
+ (regexp-quote (concat todos-category-beg cat)))
+ nil t))
+ (end (if (re-search-forward
+ (concat "^" (regexp-quote todos-category-beg))
+ nil t 2)
+ (match-beginning 0)
+ (point-max)))
+ (content (buffer-substring-no-properties beg end))
+ (counts (cdr (assoc cat todos-categories)))
+ buffer-read-only)
+ ;; Move the category to the new file. Also update or create
+ ;; archive file if necessary.
+ (with-current-buffer
+ (find-file-noselect
+ ;; Regenerate todos-archives in case there
+ ;; is a newly created archive.
+ (if (member buf (funcall todos-files-function t))
+ (concat (file-name-sans-extension nfile) ".toda")
+ nfile))
+ (let* ((nfile-short (todos-short-file-name nfile))
+ (prompt (concat
+ (format "Todos file \"%s\" already has "
+ nfile-short)
+ (format "the category \"%s\";\n" cat)
+ "enter a new category name: "))
+ buffer-read-only)
+ (widen)
+ (goto-char (point-max))
+ (insert content)
+ ;; If the file moved to has a category with the same
+ ;; name, rename the moved category.
+ (when (assoc cat todos-categories)
+ (unless (member (file-truename (buffer-file-name))
+ (funcall todos-files-function t))
+ (setq new (read-from-minibuffer prompt))
+ (setq new (todos-validate-name new 'category))))
+ ;; Replace old with new name in Todos and archive files.
+ (when new
+ (goto-char (point-max))
+ (re-search-backward
+ (concat "^" (regexp-quote todos-category-beg)
+ "\\(" (regexp-quote cat) "\\)") nil t)
+ (replace-match new nil nil nil 1)))
+ (setq todos-categories
+ (append todos-categories (list (cons new counts))))
+ (todos-update-categories-sexp)
+ ;; If archive was just created, save it to avoid "File <xyz> no
+ ;; longer exists!" message on invoking
+ ;; `todos-view-archived-items'. FIXME: maybe better to save
+ ;; unconditionally?
+ (unless (file-exists-p (buffer-file-name))
+ (save-buffer))
+ (todos-category-number (or new cat))
+ (todos-category-select))
+ ;; Delete the category from the old file, and if that was the
+ ;; last category, delete the file. Also handle archive file
+ ;; if necessary.
+ (remove-overlays beg end)
+ (delete-region beg end)
+ (goto-char (point-min))
+ ;; Put point after todos-categories sexp.
+ (forward-line)
+ (if (eobp) ; Aside from sexp, file is empty.
+ (progn
+ ;; Skip confirming killing the archive buffer.
+ (set-buffer-modified-p nil)
+ (delete-file todos-current-todos-file)
+ (kill-buffer)
+ (when (member todos-current-todos-file todos-files)
+ (todos-reevaluate-defcustoms)))
+ (setq todos-categories (delete (assoc cat todos-categories)
+ todos-categories))
+ (todos-update-categories-sexp)
+ (todos-category-select)))))
+ (set-window-buffer (selected-window)
+ (set-buffer (find-file-noselect nfile)))
+ (todos-category-number (or new cat))
+ (todos-category-select))))
-(defun todos-check-format ()
- "Signal an error if the current Todos file is ill-formatted."
- (save-excursion
- (save-restriction
- (widen)
+(defun todos-merge-category ()
+ "Merge current category into another category in this file.
+The current category's todo and done items are appended to the
+chosen category's todo and done items, respectively, which
+becomes the current category, and the category moved from is
+deleted."
+ (interactive)
+ (let ((buffer-read-only nil)
+ (cat (todos-current-category))
+ (goal (todos-read-category "Category to merge to: " t)))
+ (widen)
+ ;; FIXME: check if cat has archived items and merge those too
+ (let* ((cbeg (progn
+ (re-search-backward
+ (concat "^" (regexp-quote todos-category-beg)) nil t)
+ (point)))
+ (tbeg (progn (forward-line) (point)))
+ (dbeg (progn
+ (re-search-forward
+ (concat "^" (regexp-quote todos-category-done)) nil t)
+ (forward-line) (point)))
+ (tend (progn (forward-line -2) (point)))
+ (cend (progn
+ (if (re-search-forward
+ (concat "^" (regexp-quote todos-category-beg)) nil t)
+ (match-beginning 0)
+ (point-max))))
+ (todo (buffer-substring-no-properties tbeg tend))
+ (done (buffer-substring-no-properties dbeg cend))
+ here)
(goto-char (point-min))
- (let ((legit (concat "^\\(" (regexp-quote todos-category-beg) "\\)"
- "\\|\\(\\[?" todos-date-pattern "\\)"
- "\\|\\([ \t]+[^ \t]*\\)"
- "\\|$")))
- (while (not (eobp))
- (unless (looking-at legit)
- (error "Illegitimate Todos file format at line %d"
- (line-number-at-pos (point))))
- (forward-line)))))
- (message "This Todos file is well-formatted."))
-
-(defun todos-after-find-file ()
- "Show Todos files correctly when visited from outside of Todos mode."
- (and (member this-command todos-visit-files-commands)
- (= (- (point-max) (point-min)) (buffer-size))
- (member major-mode '(todos-mode todos-archive-mode))
- (todos-category-select)))
-
-(defun todos-wrap-and-indent ()
- "Use word wrapping on long lines and indent with a wrap prefix.
-The amount of indentation is given by user option
-`todos-indent-to-here'."
- (set (make-local-variable 'word-wrap) t)
- (set (make-local-variable 'wrap-prefix) (make-string todos-indent-to-here 32))
- (unless (member '(continuation) fringe-indicator-alist)
- (push '(continuation) fringe-indicator-alist)))
-
-(defun todos-indent ()
- "Indent from point to `todos-indent-to-here'."
- (indent-to todos-indent-to-here todos-indent-to-here))
-
-(defun todos-prefix-overlays ()
- "Put before-string overlay in front of this category's items.
-The overlay's value is the string `todos-prefix' or with non-nil
-`todos-number-prefix' an integer in the sequence from 1 to the
-number of todo or done items in the category indicating the
-item's priority. Todo and done items are numbered independently
-of each other."
- (when (or todos-number-prefix
- (not (string-match "^[[:space:]]*$" todos-prefix)))
- (let ((prefix (propertize (concat todos-prefix " ")
- 'face 'todos-prefix-string))
- (num 0))
- (save-excursion
- (goto-char (point-min))
- (while (not (eobp))
- (when (or (todos-date-string-matcher (line-end-position))
- (todos-done-string-matcher (line-end-position)))
- (goto-char (match-beginning 0))
- (when todos-number-prefix
- (setq num (1+ num))
- ;; Reset number for done items.
- (when
- ;; FIXME: really need this?
- ;; If last not done item is multiline, then
- ;; todos-done-string-matcher skips empty line, so have
- ;; to look back.
- (and (looking-at todos-done-string-start)
- (looking-back (concat "^"
- (regexp-quote todos-category-done)
- "\n")))
- (setq num 1))
- (setq prefix (propertize (concat (number-to-string num) " ")
- 'face 'todos-prefix-string)))
- (let ((ovs (overlays-in (point) (point)))
- marked ov-pref)
- (if ovs
- (dolist (ov ovs)
- (let ((val (overlay-get ov 'before-string)))
- (if (equal val "*")
- (setq marked t)
- (setq ov-pref val)))))
- (unless (equal ov-pref prefix)
- (remove-overlays (point) (point)) ; 'before-string) doesn't work
- (overlay-put (make-overlay (point) (point))
- 'before-string prefix)
- (and marked (overlay-put (make-overlay (point) (point))
- 'before-string todos-item-mark)))))
- (forward-line))))))
+ (re-search-forward
+ (concat "^" (regexp-quote (concat todos-category-beg goal))) nil t)
+ (re-search-forward
+ (concat "^" (regexp-quote todos-category-done)) nil t)
+ (forward-line -1)
+ (setq here (point))
+ (insert todo)
+ (goto-char (if (re-search-forward
+ (concat "^" (regexp-quote todos-category-beg)) nil t)
+ (match-beginning 0)
+ (point-max)))
+ (insert done)
+ (remove-overlays cbeg cend)
+ (delete-region cbeg cend)
+ (todos-set-count 'todo (todos-get-count 'todo cat) goal)
+ (todos-set-count 'done (todos-get-count 'done cat) goal)
+ (setq todos-categories (delete (assoc cat todos-categories)
+ todos-categories))
+ (todos-update-categories-sexp)
+ (todos-category-number goal)
+ (todos-category-select)
+ ;; Put point at the start of the merged todo items.
+ ;; FIXME: what if there are no merged todo items but only done items?
+ (goto-char here))))
+
+;; FIXME
+(defun todos-merge-categories ()
+ ""
+ (interactive)
+ (let* ((cats (mapcar 'car todos-categories))
+ (goal (todos-read-category "Category to merge to: " t))
+ (prompt (format "Merge to %s (type C-g to finish)? " goal))
+ (source (let ((inhibit-quit t) l)
+ (while (not (eq last-input-event 7))
+ (dolist (c cats)
+ (when (y-or-n-p prompt)
+ (push c l)
+ (setq cats (delete c cats))))))))
+ (widen)
+ ))
-(defun todos-reset-prefix (symbol value)
- "The :set function for `todos-prefix' and `todos-number-prefix'."
- (let ((oldvalue (symbol-value symbol))
- (files (append todos-files todos-archives)))
- (custom-set-default symbol value)
- (when (not (equal value oldvalue))
- (dolist (f files)
- (with-current-buffer (find-file-noselect f)
- (save-window-excursion
- (todos-show)
- (save-excursion
- (widen)
- (goto-char (point-min))
- (while (not (eobp))
- (remove-overlays (point) (point)); 'before-string prefix)
- (forward-line)))
- ;; Activate the new setting (save-restriction does not help).
- (save-excursion (todos-category-select))))))))
+;; FIXME: make insertion options customizable per category?
+;;;###autoload
+(defun todos-insert-item (&optional arg diary nonmarking date-type time
+ region-or-here)
+ "Add a new Todo item to a category.
+\(See the note at the end of this document string about key
+bindings and convenience commands derived from this command.)
-(defun todos-reset-nondiary-marker (symbol value)
- "The :set function for user option `todos-nondiary-marker'."
- (let ((oldvalue (symbol-value symbol))
- (files (append todos-files todos-archives)))
- (custom-set-default symbol value)
- ;; Need to reset these to get font-locking right.
- (setq todos-nondiary-start (nth 0 todos-nondiary-marker)
- todos-nondiary-end (nth 1 todos-nondiary-marker)
- todos-date-string-start
- ;; FIXME: with ? matches anything
- (concat "^\\(" (regexp-quote todos-nondiary-start) "\\|"
- (regexp-quote diary-nonmarking-symbol) "\\)?"))
- (when (not (equal value oldvalue))
- (dolist (f files)
- (with-current-buffer (find-file-noselect f)
- (let (buffer-read-only)
- (widen)
- (goto-char (point-min))
- (while (not (eobp))
- (if (re-search-forward
- (concat "^\\(" todos-done-string-start "[^][]+] \\)?"
- "\\(?1:" (regexp-quote (car oldvalue))
- "\\)" todos-date-pattern "\\( "
- diary-time-regexp "\\)?\\(?2:"
- (regexp-quote (cadr oldvalue)) "\\)")
- nil t)
- (progn
- (replace-match (nth 0 value) t t nil 1)
- (replace-match (nth 1 value) t t nil 2))
- (forward-line)))
- (todos-category-select)))))))
+With no (or nil) prefix argument ARG, add the item to the current
+category; with one prefix argument (C-u), prompt for a category
+from the current Todos file; with two prefix arguments (C-u C-u),
+first prompt for a Todos file, then a category in that file. If
+a non-existing category is entered, ask whether to add it to the
+Todos file; if answered affirmatively, add the category and
+insert the item there.
-(defun todos-reset-done-string (symbol value)
- "The :set function for user option `todos-done-string'."
- (let ((oldvalue (symbol-value symbol))
- (files (append todos-files todos-archives)))
- (custom-set-default symbol value)
- ;; Need to reset this to get font-locking right.
- (setq todos-done-string-start
- (concat "^\\[" (regexp-quote todos-done-string)))
- (when (not (equal value oldvalue))
- (dolist (f files)
- (with-current-buffer (find-file-noselect f)
- (let (buffer-read-only)
- (widen)
- (goto-char (point-min))
- (while (not (eobp))
- (if (re-search-forward
- (concat "^" (regexp-quote todos-nondiary-start)
- "\\(" (regexp-quote oldvalue) "\\)")
- nil t)
- (replace-match value t t nil 1)
- (forward-line)))
- (todos-category-select)))))))
+When argument DIARY is non-nil, this overrides the intent of the
+user option `todos-include-in-diary' for this item: if
+`todos-include-in-diary' is nil, include the item in the Fancy
+Diary display, and if it is non-nil, exclude the item from the
+Fancy Diary display. When DIARY is nil, `todos-include-in-diary'
+has its intended effect.
-(defun todos-reset-comment-string (symbol value)
- "The :set function for user option `todos-comment-string'."
- (let ((oldvalue (symbol-value symbol))
- (files (append todos-files todos-archives)))
- (custom-set-default symbol value)
- (when (not (equal value oldvalue))
- (dolist (f files)
- (with-current-buffer (find-file-noselect f)
- (let (buffer-read-only)
- (save-excursion
- (widen)
- (goto-char (point-min))
- (while (not (eobp))
- (if (re-search-forward
- (concat
- "\\[\\(" (regexp-quote oldvalue) "\\): [^]]*\\]")
- nil t)
- (replace-match value t t nil 1)
- (forward-line)))
- (todos-category-select))))))))
+When the item is included in the Fancy Diary display and the
+argument NONMARKING is non-nil, this overrides the intent of the
+user option `todos-diary-nonmarking' for this item: if
+`todos-diary-nonmarking' is nil, append `diary-nonmarking-symbol'
+to the item, and if it is non-nil, omit `diary-nonmarking-symbol'.
-(defun todos-reset-categories (symbol value)
- "The :set function for `todos-ignore-archived-categories'."
- (custom-set-default symbol value)
- (dolist (f (funcall todos-files-function))
- (with-current-buffer (find-file-noselect f)
- (if value
- (setq todos-categories-full todos-categories
- todos-categories (todos-truncate-categories-list))
- (setq todos-categories todos-categories-full
- todos-categories-full nil))
- (todos-category-select))))
+The argument DATE-TYPE determines the content of the item's
+mandatory date header string and how it is added:
+- If DATE-TYPE is the symbol `calendar', the Calendar pops up and
+ when the user puts the cursor on a date and hits RET, that
+ date, in the format set by `calendar-date-display-form',
+ becomes the date in the header.
+- If DATE-TYPE is the symbol `date', the header contains the date
+ in the format set by `calendar-date-display-form', with year,
+ month and day individually prompted for (month with tab
+ completion).
+- If DATE-TYPE is the symbol `dayname' the header contains a
+ weekday name instead of a date, prompted for with tab
+ completion.
+- If DATE-TYPE has any other value (including nil or none) the
+ header contains the current date (in the format set by
+ `calendar-date-display-form').
-(defun todos-toggle-show-current-file (symbol value)
- "The :set function for user option `todos-show-current-file'."
- (custom-set-default symbol value)
- (if value
- (add-hook 'pre-command-hook 'todos-show-current-file nil t)
- (remove-hook 'pre-command-hook 'todos-show-current-file t)))
+With non-nil argument TIME prompt for a time string, which must
+match `diary-time-regexp'. Typing `<return>' at the prompt
+returns the current time, if the user option
+`todos-always-add-time-string' is non-nil, otherwise the empty
+string (i.e., no time string). If TIME is absent or nil, add or
+omit the current time string according as
+`todos-always-add-time-string' is non-nil or nil, respectively.
-(defun todos-show-current-file ()
- "Visit current instead of default Todos file with `todos-show'.
-This function is added to `pre-command-hook' when user option
-`todos-show-current-file' is set to non-nil."
- (setq todos-global-current-todos-file todos-current-todos-file))
- ;; (and (eq major-mode 'todos-mode)
- ;; (setq todos-global-current-todos-file (buffer-file-name))))
+The argument REGION-OR-HERE determines the source and location of
+the new item:
+- If the REGION-OR-HERE is the symbol `here', prompt for the text
+ of the new item and insert it directly above the todo item at
+ point (hence lowering the priority of the remaining items), or
+ if point is on the empty line below the last todo item, insert
+ the new item there. An error is signalled if
+ `todos-insert-item' is invoked with `here' outside of the
+ current category.
+- If REGION-OR-HERE is the symbol `region', use the region of the
+ current buffer as the text of the new item, depending on the
+ value of user option `todos-use-only-highlighted-region': if
+ this is non-nil, then use the region only when it is
+ highlighted; otherwise, use the region regardless of
+ highlighting. An error is signalled if there is no region in
+ the current buffer. Prompt for the item's priority in the
+ category (an integer between 1 and one more than the number of
+ items in the category), and insert the item accordingly.
+- If REGION-OR-HERE has any other value (in particular, nil or
+ none), prompt for the text and the item's priority, and insert
+ the item accordingly.
-;; FIXME: rename to todos-set-category-number ?
-(defun todos-category-number (cat)
- "Set and return buffer-local value of `todos-category-number'.
-This value is one more than the index of category CAT, starting
-with one instead of zero, so that the highest priority
-category (see `todos-display-categories') has the number one."
- (let ((categories (mapcar 'car todos-categories)))
- (setq todos-category-number
- (1+ (- (length categories)
- (length (member cat categories)))))))
+To facilitate using these arguments when inserting a new todo
+item, convenience commands have been defined for all admissible
+combinations (96 in all!) together with mnenomic key bindings
+based on on the name of the arguments and their order in the
+command's argument list: diar_y_ - nonmar_k_ing - _c_alendar or
+_d_ate or day_n_ame - _t_ime - _r_egion or _h_ere. These key
+combinations are appended to the basic insertion key (i) and keys
+that allow a following key must be doubled when used finally.
+For example, `iyh' will insert a new item with today's date,
+marked according to the DIARY argument described above, and with
+priority according to the HERE argument; while `iyy' does the
+same except the priority is not given by HERE but by prompting."
+;; An alternative interface for customizing key
+;; binding is also provided with the function
+;; `todos-insertion-bindings'." ;FIXME
+ (interactive "P")
+ (let ((region (eq region-or-here 'region))
+ (here (eq region-or-here 'here)))
+ (when region
+ ;; FIXME: better to use use-region-p or region-active-p?
+ (unless (and (if todos-use-only-highlighted-region
+ transient-mark-mode
+ t)
+ mark-active)
+ (error "The mark is not set now, so there is no region")))
+ (let* ((buf (current-buffer))
+ (new-item (if region
+ ;; FIXME: or keep properties?
+ (buffer-substring-no-properties
+ (region-beginning) (region-end))
+ (read-from-minibuffer "Todo item: ")))
+ (date-string (cond
+ ((eq date-type 'date)
+ (todos-read-date))
+ ((eq date-type 'dayname)
+ (todos-read-dayname))
+ ((eq date-type 'calendar)
+ (setq todos-date-from-calendar t)
+ (todos-set-date-from-calendar))
+ (t (calendar-date-string (calendar-current-date) t t))))
+ (time-string (or (and time (todos-read-time))
+ (and todos-always-add-time-string
+ (substring (current-time-string) 11 16)))))
+ (setq todos-date-from-calendar nil)
+ (cond ((equal arg '(16)) ; FIXME: cf. set-mark-command
+ (todos-jump-to-category nil t)
+ (set-window-buffer
+ (selected-window)
+ (set-buffer (get-file-buffer todos-global-current-todos-file))))
+ ((equal arg '(4)) ; FIXME: just arg?
+ (todos-jump-to-category)
+ (set-window-buffer
+ (selected-window)
+ (set-buffer (get-file-buffer todos-global-current-todos-file))))
+ (t
+ (when (not (derived-mode-p 'todos-mode)) (todos-show))))
+ (let (buffer-read-only)
+ (setq new-item
+ ;; Add date, time and diary marking as required.
+ (concat (if (not (and diary (not todos-include-in-diary)))
+ todos-nondiary-start
+ (when (and nonmarking (not todos-diary-nonmarking))
+ diary-nonmarking-symbol))
+ date-string (unless (and time-string
+ (string= time-string ""))
+ (concat " " time-string))
+ (when (not (and diary (not todos-include-in-diary)))
+ todos-nondiary-end)
+ " " new-item))
+ ;; Indent newlines inserted by C-q C-j if nonspace char follows.
+ (setq new-item (replace-regexp-in-string
+ "\\(\n\\)[^[:blank:]]"
+ (concat "\n" (make-string todos-indent-to-here 32))
+ new-item nil nil 1))
+ (if here
+ (cond ((not (eq major-mode 'todos-mode))
+ (error "Cannot insert a todo item here outside of Todos mode"))
+ ((not (eq buf (current-buffer)))
+ (error "Cannot insert an item here after changing buffer"))
+ ((or (todos-done-item-p)
+ ;; Point on last blank line.
+ (save-excursion (forward-line -1) (todos-done-item-p)))
+ (error "Cannot insert a new item in the done item section"))
+ (t
+ (todos-insert-with-overlays new-item)))
+ (todos-set-item-priority new-item (todos-current-category) t))
+ (todos-set-count 'todo 1)
+ (if (or diary todos-include-in-diary) (todos-set-count 'diary 1))
+ (todos-update-categories-sexp)))))
-(defun todos-current-category ()
- "Return the name of the current category."
- (car (nth (1- todos-category-number) todos-categories)))
+(defvar todos-date-from-calendar nil
+ "Helper variable for setting item date from the Emacs Calendar.")
-(defun todos-category-select ()
- "Display the current category correctly.
+(defun todos-set-date-from-calendar ()
+ "Return string of date chosen from Calendar."
+ (when todos-date-from-calendar
+ (let (calendar-view-diary-initially-flag)
+ (calendar))
+ ;; *Calendar* is now current buffer.
+ (local-set-key (kbd "RET") 'exit-recursive-edit)
+ (message "Put cursor on a date and type <return> to set it.")
+ ;; FIXME: is there a better way than recursive-edit?
+ ;; FIXME: use unwind-protect? Check recursive-depth?
+ (recursive-edit)
+ (setq todos-date-from-calendar
+ (calendar-date-string (calendar-cursor-to-date t) t t))
+ (calendar-exit)
+ todos-date-from-calendar))
-With non-nil user option `todos-show-done-only' display only the
-category's done (but not archived) items; else (the default)
-display just the todo items, or with non-nil user option
-`todos-show-with-done' also display the category's done items
-below the todo items."
- (let ((name (todos-current-category))
- cat-begin cat-end done-start done-sep-start done-end)
- (widen)
- (goto-char (point-min))
- (re-search-forward
- (concat "^" (regexp-quote (concat todos-category-beg name)) "$") nil t)
- (setq cat-begin (1+ (line-end-position)))
- (setq cat-end (if (re-search-forward
- (concat "^" (regexp-quote todos-category-beg)) nil t)
- (match-beginning 0)
- (point-max)))
- (setq mode-line-buffer-identification
- (funcall todos-mode-line-function name))
- (narrow-to-region cat-begin cat-end)
- (todos-prefix-overlays)
- (goto-char (point-min))
- (if (re-search-forward (concat "\n\\(" (regexp-quote todos-category-done)
- "\\)") nil t)
- (progn
- (setq done-start (match-beginning 0))
- (setq done-sep-start (match-beginning 1))
- (setq done-end (match-end 0)))
- (error "Category %s is missing todos-category-done string" name))
- (if todos-show-done-only
- (narrow-to-region (1+ done-end) (point-max))
- ;; Display or hide done items as per todos-show-with-done.
- ;; FIXME: use todos-done-string-start ?
- (when (re-search-forward (concat "\n\\(\\["
- (regexp-quote todos-done-string)
- "\\)") nil t)
- (let (done-sep prefix ov-pref ov-done)
- ;; FIXME: delete overlay when not viewing done items?
- (when todos-show-with-done
- (setq done-sep todos-done-separator)
- (setq done-start cat-end)
- (setq ov-pref (make-overlay done-sep-start done-end))
- (overlay-put ov-pref 'display done-sep))))
- (narrow-to-region (point-min) done-start))))
+;; FIXME: autoload when key-binding is defined in calendar.el
+(defun todos-insert-item-from-calendar ()
+ ""
+ (interactive)
+ ;; FIXME: todos-current-todos-file is nil here, better to solicit Todos file?
+ ;; FIXME: t-g-c-t-f is nil if no Todos file has been visited
+ (pop-to-buffer (file-name-nondirectory todos-global-current-todos-file))
+ (todos-show)
+ ;; FIXME: this now calls todos-set-date-from-calendar
+ (todos-insert-item t 'calendar))
-(defun todos-insert-with-overlays (item)
- "Insert ITEM and update prefix/priority number overlays."
- (todos-item-start)
- (insert item "\n")
- (todos-backward-item)
- (todos-prefix-overlays))
+;; FIXME: calendar is loaded before todos
+;; (add-hook 'calendar-load-hook
+ ;; (lambda ()
+ (define-key calendar-mode-map "it" 'todos-insert-item-from-calendar);))
-(defvar todos-item-start ;; (concat "^\\(\\[\\(" (regexp-quote todos-done-string)
- ;; "\\)?\\)?" todos-date-pattern)
- (concat "\\(" todos-date-string-start "\\|" todos-done-string-start
- "\\)" todos-date-pattern)
- "String identifying start of a Todos item.")
+(defun todos-delete-item ()
+ "Delete at least one item in this category.
-(defun todos-item-start ()
- "Move to start of current Todos item and return its position."
- (unless (or
- ;; Point is either on last item in this category or on the empty
- ;; line between done and not done items.
- (looking-at "^$")
- ;; There are no done items in this category yet.
- (looking-at (regexp-quote todos-category-beg)))
- (goto-char (line-beginning-position))
- (while (not (looking-at todos-item-start))
- (forward-line -1))
- (point)))
+If there are marked items, delete all of these; otherwise, delete
+the item at point."
+ (interactive)
+ (let* ((cat (todos-current-category))
+ (marked (assoc cat todos-categories-with-marks))
+ (item (unless marked (todos-item-string)))
+ (ov (make-overlay (save-excursion (todos-item-start))
+ (save-excursion (todos-item-end))))
+ ;; FIXME: make confirmation an option
+ (answer (if marked
+ (y-or-n-p "Permanently delete all marked items? ")
+ (when item
+ (overlay-put ov 'face 'todos-search)
+ (y-or-n-p (concat "Permanently delete this item? ")))))
+ (opoint (point))
+ buffer-read-only)
+ (when answer
+ (and marked (goto-char (point-min)))
+ (catch 'done
+ (while (not (eobp))
+ (if (or (and marked (todos-marked-item-p)) item)
+ (progn
+ (if (todos-done-item-p)
+ (todos-set-count 'done -1)
+ (todos-set-count 'todo -1 cat)
+ (and (todos-diary-item-p) (todos-set-count 'diary -1)))
+ (delete-overlay ov)
+ (todos-remove-item)
+ ;; Don't leave point below last item.
+ (and item (bolp) (eolp) (< (point-min) (point-max))
+ (todos-backward-item))
+ (when item
+ (throw 'done (setq item nil))))
+ (todos-forward-item))))
+ (when marked
+ (remove-overlays (point-min) (point-max) 'before-string todos-item-mark)
+ (setq todos-categories-with-marks
+ (assq-delete-all cat todos-categories-with-marks))
+ (goto-char opoint))
+ (todos-update-categories-sexp)
+ (todos-prefix-overlays))
+ (if ov (delete-overlay ov))))
+
+(defun todos-edit-item ()
+ "Edit the Todo item at point.
+If the item consists of only one logical line, edit it in the
+minibuffer; otherwise, edit it in Todos Edit mode."
+ (interactive)
+ (when (todos-item-string)
+ (let* ((buffer-read-only)
+ (start (todos-item-start))
+ (item-beg (progn
+ (re-search-forward
+ (concat todos-date-string-start todos-date-pattern
+ "\\( " diary-time-regexp "\\)?"
+ (regexp-quote todos-nondiary-end) "?")
+ (line-end-position) t)
+ (1+ (- (point) start))))
+ (item (todos-item-string))
+ (multiline (> (length (split-string item "\n")) 1))
+ (opoint (point)))
+ (if multiline
+ (todos-edit-multiline t)
+ (let ((new (read-string "Edit: " (cons item item-beg))))
+ (while (not (string-match
+ (concat todos-date-string-start todos-date-pattern) new))
+ (setq new (read-from-minibuffer
+ "Item must start with a date: " new)))
+ ;; Indent newlines inserted by C-q C-j if nonspace char follows.
+ (setq new (replace-regexp-in-string
+ "\\(\n\\)[^[:blank:]]"
+ (concat "\n" (make-string todos-indent-to-here 32)) new
+ nil nil 1))
+ ;; If user moved point during editing, make sure it moves back.
+ (goto-char opoint)
+ (todos-remove-item)
+ (todos-insert-with-overlays new)
+ (move-to-column item-beg))))))
-(defun todos-item-end ()
- "Move to end of current Todos item and return its position."
- ;; Items cannot end with a blank line.
- (unless (looking-at "^$")
- (let ((done (todos-done-item-p)))
- (todos-forward-item)
- ;; Adjust if item is last unfinished one before displayed done items.
- (when (and (not done) (todos-done-item-p))
- (forward-line -1))
- (backward-char))
- (point)))
+(defun todos-edit-multiline-item ()
+ "Edit current Todo item in Todos Edit mode.
+Use of newlines invokes `todos-indent' to insure compliance with
+the format of Diary entries."
+ (interactive)
+ (todos-edit-multiline t))
-(defun todos-remove-item ()
- "Internal function called in editing, deleting or moving items."
- (let* ((beg (todos-item-start))
- (end (progn (todos-item-end) (1+ (point))))
- (ovs (overlays-in beg beg)))
- ;; There can be both prefix/number and mark overlays.
- (while ovs (delete-overlay (car ovs)) (pop ovs))
- (delete-region beg end)))
+(defun todos-edit-multiline (&optional item)
+ ""
+ (interactive)
+ ;; FIXME: should there be only one live Todos Edit buffer?
+ ;; (let ((buffer-name todos-edit-buffer))
+ (let ((buffer-name (generate-new-buffer-name todos-edit-buffer)))
+ (set-window-buffer
+ (selected-window)
+ (set-buffer (make-indirect-buffer
+ (file-name-nondirectory todos-current-todos-file)
+ buffer-name)))
+ (if item
+ (narrow-to-region (todos-item-start) (todos-item-end))
+ (widen))
+ (todos-edit-mode)
+ ;; (message (concat "Type %s to check file format validity and "
+ ;; "return to Todos mode.\n")
+ ;; (key-description (car (where-is-internal 'todos-edit-quit))))
+ (message "%s" (substitute-command-keys
+ (concat "Type \\[todos-edit-quit] to check file format "
+ "validity and return to Todos mode.\n")))))
-(defun todos-item-string ()
- "Return bare text of current item as a string."
- (let ((opoint (point))
- (start (todos-item-start))
- (end (todos-item-end)))
- (goto-char opoint)
- (and start end (buffer-substring-no-properties start end))))
+(defun todos-edit-quit ()
+ "Return from Todos Edit mode to Todos mode.
-(defun todos-diary-item-p ()
- "Return non-nil if item at point is marked for diary inclusion."
- (save-excursion
- (todos-item-start)
- (looking-at todos-date-pattern)))
+If the whole file was in Todos Edit mode, check before returning
+whether the file is still a valid Todos file and if so, also
+recalculate the Todos categories sexp, in case changes were made
+in the number or names of categories."
+ (interactive)
+ ;; FIXME: worth doing this only if file was actually changed?
+ (when (eq (buffer-size) (- (point-max) (point-min)))
+ (when (todos-check-format)
+ (todos-make-categories-list t)))
+ (kill-buffer)
+ ;; In case next buffer is not the one holding todos-current-todos-file.
+ (todos-show))
-(defun todos-done-item-p ()
- "Return non-nil if item at point is a done item."
- (save-excursion
- (todos-item-start)
- (looking-at todos-done-string-start)))
+(defun todos-edit-item-header (&optional what)
+ "Edit date/time header of at least one item.
-(defvar todos-item-mark (propertize (if (equal todos-prefix "*") "@" "*")
- 'face 'todos-mark)
- "String used to mark items.")
+Interactively, ask whether to edit year, month and day or day of
+the week, as well as time. If there are marked items, apply the
+changes to all of these; otherwise, edit just the item at point.
-(defun todos-item-marked-p ()
- "If this item is marked, return mark overlay."
- (let ((ovs (overlays-in (line-beginning-position) (line-beginning-position)))
- (mark todos-item-mark)
- ov marked)
- (catch 'stop
- (while ovs
- (setq ov (pop ovs))
- (and (equal (overlay-get ov 'before-string) mark)
- (throw 'stop (setq marked t)))))
- (when marked ov)))
+Non-interactively, argument WHAT specifies whether to set the
+date from the Calendar or to today, or whether to edit only the
+date or day, or only the time."
+ (interactive)
+ (let* ((cat (todos-current-category))
+ (marked (assoc cat todos-categories-with-marks))
+ (first t) ; Match only first of marked items.
+ (todos-date-from-calendar t)
+ ndate ntime nheader)
+ (save-excursion
+ (or (and marked (goto-char (point-min))) (todos-item-start))
+ (catch 'stop
+ (while (not (eobp))
+ (and marked
+ (while (not (todos-marked-item-p))
+ (todos-forward-item)
+ (and (eobp) (throw 'stop nil))))
+ (re-search-forward (concat todos-date-string-start "\\(?1:"
+ todos-date-pattern
+ "\\)\\(?2: " diary-time-regexp "\\)?")
+ (line-end-position) t)
+ (let* ((odate (match-string-no-properties 1))
+ (otime (match-string-no-properties 2))
+ (buffer-read-only))
+ (cond ((eq what 'today)
+ (progn
+ (setq ndate (calendar-date-string
+ (calendar-current-date) t t))
+ (replace-match ndate nil nil nil 1)))
+ ((eq what 'calendar)
+ (setq ndate (save-match-data (todos-set-date-from-calendar)))
+ (replace-match ndate nil nil nil 1))
+ (t
+ (unless (eq what 'timeonly)
+ (when first
+ (setq ndate (if (save-match-data
+ (string-match "[0-9]+" odate))
+ (if (y-or-n-p "Change date? ")
+ (todos-read-date)
+ (todos-read-dayname))
+ (if (y-or-n-p "Change day? ")
+ (todos-read-dayname)
+ (todos-read-date)))))
+ (replace-match ndate nil nil nil 1))
+ (unless (eq what 'dateonly)
+ (when first
+ (setq ntime (save-match-data (todos-read-time)))
+ (when (< 0 (length ntime))
+ (setq ntime (concat " " ntime))))
+ (if otime
+ (replace-match ntime nil nil nil 2)
+ (goto-char (match-end 1))
+ (insert ntime)))))
+ (setq todos-date-from-calendar nil)
+ (setq first nil))
+ (if marked
+ (todos-forward-item)
+ (goto-char (point-max))))))))
-(defvar todos-categories-with-marks nil
- "Alist of categories and number of marked items they contain.")
+(defun todos-edit-item-date ()
+ "Prompt for and apply changes to current item's date."
+ (interactive)
+ (todos-edit-item-header 'dateonly))
-(defun todos-get-count (type &optional category)
- "Return count of TYPE items in CATEGORY.
-If CATEGORY is nil, default to the current category."
- (let* ((cat (or category (todos-current-category)))
- (counts (cdr (assoc cat todos-categories)))
- (idx (cond ((eq type 'todo) 0)
- ((eq type 'diary) 1)
- ((eq type 'done) 2)
- ((eq type 'archived) 3))))
- (aref counts idx)))
+(defun todos-edit-item-date-from-calendar ()
+ "Prompt for changes to current item's date and apply from Calendar."
+ (interactive)
+ (todos-edit-item-header 'calendar))
-(defun todos-set-count (type increment &optional category)
- "Increment count of TYPE items in CATEGORY by INCREMENT.
-If CATEGORY is nil, default to the current category."
- (let* ((cat (or category (todos-current-category)))
- (counts (cdr (assoc cat todos-categories)))
- (idx (cond ((eq type 'todo) 0)
- ((eq type 'diary) 1)
- ((eq type 'done) 2)
- ((eq type 'archived) 3))))
- (aset counts idx (+ increment (aref counts idx)))))
+(defun todos-edit-item-date-is-today ()
+ "Set item date to today's date."
+ (interactive)
+ (todos-edit-item-header 'today))
+
+(defun todos-edit-item-time ()
+ "Prompt For and apply changes to current item's time."
+ (interactive)
+ (todos-edit-item-header 'timeonly))
-;; (defun todos-item-counts (operation &optional cat1 cat2)
-;; "Update item counts in category CAT1 changed by OPERATION.
-;; If CAT1 is nil, update counts from the current category. With
-;; non-nil CAT2 include specified counts from that category in the
-;; calculation for CAT1.
-;; After updating the item counts, update the `todos-categories' sexp."
-;; (let* ((cat (or cat1 (todos-current-category))))
-;; (cond ((eq type 'insert)
-;; (todos-set-count 'todo 1 cat))
-;; ((eq type 'diary)
-;; (todos-set-count 'diary 1 cat))
-;; ((eq type 'nondiary)
-;; (todos-set-count 'diary -1 cat))
-;; ((eq type 'delete)
-;; ;; FIXME: ok if last done item was deleted?
-;; (if (save-excursion
-;; (re-search-backward (concat "^" (regexp-quote
-;; todos-category-done)) nil t))
-;; (todos-set-count 'done -1 cat)
-;; (todos-set-count 'todo -1 cat)))
-;; ((eq type 'done)
-;; (unless (member (buffer-file-name) (funcall todos-files-function t))
-;; (todos-set-count 'todo -1 cat))
-;; (todos-set-count 'done 1 cat))
-;; ((eq type 'undo)
-;; (todos-set-count 'todo 1 cat)
-;; (todos-set-count 'done -1 cat))
-;; ((eq type 'archive1)
-;; (todos-set-count 'archived 1 cat)
-;; (todos-set-count 'done -1 cat))
-;; ((eq type 'archive)
-;; (if (member (buffer-file-name) (funcall todos-files-function t))
-;; ;; In Archive file augment done count with cat's previous
-;; ;; done count,
-;; (todos-set-count 'done (todos-get-count 'done cat) cat)
-;; ;; In Todos file augment archive count with cat's previous
-;; ;; done count, and make the latter zero.
-;; (todos-set-count 'archived (todos-get-count 'done cat) cat)
-;; (todos-set-count 'done (- (todos-get-count 'done cat)) cat)))
-;; ((eq type 'merge)
-;; ;; Augment todo and done counts of cat by those of cat2.
-;; (todos-set-count 'todo (todos-get-count 'todo cat2) cat)
-;; (todos-set-count 'done (todos-get-count 'done cat2) cat)))
-;; (todos-update-categories-sexp)))
+(defun todos-edit-item-diary-inclusion ()
+ "Change diary status of one or more todo items in this category.
+That is, insert `todos-nondiary-marker' if the candidate items
+lack this marking; otherwise, remove it.
-(defun todos-set-categories ()
- "Set `todos-categories' from the sexp at the top of the file."
- ;; New archive files created by `todos-move-category' are empty, which would
- ;; make the sexp test fail and raise an error, so in this case we skip it.
- (unless (zerop (buffer-size))
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- ;; todos-truncate-categories-list needs non-nil todos-categories.
- (setq todos-categories-full
- (if (looking-at "\(\(\"")
- (read (buffer-substring-no-properties
- (line-beginning-position)
- (line-end-position)))
- (error "Invalid or missing todos-categories sexp"))
- todos-categories todos-categories-full)))
- (if (and todos-ignore-archived-categories
- (eq major-mode 'todos-mode))
- (todos-truncate-categories-list)
- todos-categories-full)))
+If there are marked todo items, change the diary status of all
+and only these, otherwise change the diary status of the item at
+point."
+ (interactive)
+ (let ((buffer-read-only)
+ (marked (assoc (todos-current-category)
+ todos-categories-with-marks)))
+ (catch 'stop
+ (save-excursion
+ (when marked (goto-char (point-min)))
+ (while (not (eobp))
+ (if (todos-done-item-p)
+ (throw 'stop (message "Done items cannot be edited"))
+ (unless (and marked (not (todos-marked-item-p)))
+ (let* ((beg (todos-item-start))
+ (lim (save-excursion (todos-item-end)))
+ (end (save-excursion
+ (or (todos-time-string-matcher lim)
+ (todos-date-string-matcher lim)))))
+ (if (looking-at (regexp-quote todos-nondiary-start))
+ (progn
+ (replace-match "")
+ (search-forward todos-nondiary-end (1+ end) t)
+ (replace-match "")
+ (todos-set-count 'diary 1))
+ (when end
+ (insert todos-nondiary-start)
+ (goto-char (1+ end))
+ (insert todos-nondiary-end)
+ (todos-set-count 'diary -1)))))
+ (unless marked (throw 'stop nil))
+ (todos-forward-item)))))
+ (todos-update-categories-sexp)))
-;; FIXME: currently unused -- make this a command to rebuild a corrupted
-;; todos-cats sexp ?
-(defun todos-make-categories-list (&optional force)
- "Return an alist of Todos categories and their item counts.
-With non-nil argument FORCE parse the entire file to build the
-list; otherwise, get the value by reading the sexp at the top of
-the file."
- (setq todos-categories nil)
+(defun todos-edit-category-diary-inclusion (arg)
+ "Make all items in this category diary items.
+With prefix ARG, make all items in this category non-diary
+items."
+ (interactive "P")
(save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (let (counts cat archive)
- ;; FIXME: can todos-archives be too old here?
- (unless (member buffer-file-name (funcall todos-files-function t))
- (setq archive (concat (file-name-sans-extension
- todos-current-todos-file) ".toda")))
+ (goto-char (point-min))
+ (let ((todo-count (todos-get-count 'todo))
+ (diary-count (todos-get-count 'diary))
+ (buffer-read-only))
+ (catch 'stop
(while (not (eobp))
- (cond ((looking-at (concat (regexp-quote todos-category-beg)
- "\\(.*\\)\n"))
- (setq cat (match-string-no-properties 1))
- ;; Counts for each category: [todo diary done archive]
- (setq counts (make-vector 4 0))
- (setq todos-categories
- (append todos-categories (list (cons cat counts))))
- ;; todos-archives may be too old here (e.g. during
- ;; todos-move-category).
- (when (member archive (funcall todos-files-function t))
- (with-current-buffer (find-file-noselect archive)
- (widen)
- (goto-char (point-min))
- (when (re-search-forward
- (concat (regexp-quote todos-category-beg) cat)
- (point-max) t)
- (forward-line)
- (while (not (or (looking-at
- (concat
- (regexp-quote todos-category-beg)
- "\\(.*\\)\n"))
- (eobp)))
- (when (looking-at todos-done-string-start)
- (todos-set-count 'archived 1 cat))
- (forward-line))))))
- ((looking-at todos-done-string-start)
- (todos-set-count 'done 1 cat))
- ((looking-at (concat "^\\("
- (regexp-quote diary-nonmarking-symbol)
- "\\)?" todos-date-pattern))
- (todos-set-count 'diary 1 cat)
- (todos-set-count 'todo 1 cat))
- ((looking-at (concat todos-date-string-start todos-date-pattern))
- (todos-set-count 'todo 1 cat))
- ;; If first line is todos-categories list, use it and end loop
- ;; unless forced by non-nil parameter `force' to scan whole file.
- ((bobp)
- (unless force
- (setq todos-categories (read (buffer-substring-no-properties
- (line-beginning-position)
- (line-end-position))))
- (goto-char (1- (point-max))))))
- (forward-line)))))
- todos-categories)
+ (if (todos-done-item-p) ; We've gone too far.
+ (throw 'stop nil)
+ (let* ((beg (todos-item-start))
+ (lim (save-excursion (todos-item-end)))
+ (end (save-excursion
+ (or (todos-time-string-matcher lim)
+ (todos-date-string-matcher lim)))))
+ (if arg
+ (unless (looking-at (regexp-quote todos-nondiary-start))
+ (insert todos-nondiary-start)
+ (goto-char (1+ end))
+ (insert todos-nondiary-end))
+ (when (looking-at (regexp-quote todos-nondiary-start))
+ (replace-match "")
+ (search-forward todos-nondiary-end (1+ end) t)
+ (replace-match "")))))
+ (todos-forward-item))
+ (unless (if arg (zerop diary-count) (= diary-count todo-count))
+ (todos-set-count 'diary (if arg
+ (- diary-count)
+ (- todo-count diary-count))))
+ (todos-update-categories-sexp)))))
-(defun todos-truncate-categories-list ()
- "Return a truncated alist of Todos categories plus item counts.
-Categories containing only archived items are omitted. This list
-is used in Todos mode when `todos-ignore-archived-categories' is
-non-nil."
- (let (cats)
- (dolist (catcons todos-categories-full cats)
- (let ((cat (car catcons)))
- (setq cats
- (append cats
- (unless (and (zerop (todos-get-count 'todo cat))
- (zerop (todos-get-count 'done cat))
- (not (zerop (todos-get-count 'archived cat))))
- (list catcons))))))))
+(defun todos-edit-item-diary-nonmarking ()
+ "Change non-marking of one or more diary items in this category.
+That is, insert `diary-nonmarking-symbol' if the candidate items
+lack this marking; otherwise, remove it.
-(defun todos-update-categories-sexp ()
- "Update the `todos-categories' sexp at the top of the file."
- (let (buffer-read-only)
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (if (looking-at (concat "^" (regexp-quote todos-category-beg)))
- (progn (newline) (goto-char (point-min)))
- ;; With empty buffer (e.g. with new archive in
- ;; `todos-move-category') `kill-line' signals end of buffer.
- (kill-region (line-beginning-position) (line-end-position)))
- ;; FIXME
- ;; (prin1 todos-categories (current-buffer))))))
- (prin1 todos-categories-full (current-buffer))))))
+If there are marked todo items, change the non-marking status of
+all and only these, otherwise change the non-marking status of
+the item at point."
+ (interactive)
+ (let ((buffer-read-only)
+ (marked (assoc (todos-current-category)
+ todos-categories-with-marks)))
+ (catch 'stop
+ (save-excursion
+ (when marked (goto-char (point-min)))
+ (while (not (eobp))
+ (if (todos-done-item-p)
+ (throw 'stop (message "Done items cannot be edited"))
+ (unless (and marked (not (todos-marked-item-p)))
+ (todos-item-start)
+ (unless (looking-at (regexp-quote todos-nondiary-start))
+ (if (looking-at (regexp-quote diary-nonmarking-symbol))
+ (replace-match "")
+ (insert diary-nonmarking-symbol))))
+ (unless marked (throw 'stop nil))
+ (todos-forward-item)))))))
-(defun todos-read-file-name (prompt &optional archive mustmatch)
- "Choose and return the name of a Todos file, prompting with PROMPT.
-Show completions with TAB or SPC; the names are shown in short
-form but the absolute truename is returned. With non-nil ARCHIVE
-return the absolute truename of a Todos archive file. With non-nil
-MUSTMATCH the name of an existing file must be chosen;
-otherwise, a new file name is allowed." ;FIXME: is this possible?
- (unless (file-exists-p todos-files-directory)
- (make-directory todos-files-directory))
- (let* ((completion-ignore-case t)
- (files (mapcar 'file-name-sans-extension
- (directory-files todos-files-directory nil
- (if archive "\.toda$" "\.todo$"))))
- (file (concat todos-files-directory
- (completing-read prompt files nil mustmatch)
- (if archive ".toda" ".todo"))))
- (file-truename file)))
+(defun todos-edit-category-diary-nonmarking (arg)
+ "Add `diary-nonmarking-symbol' to all diary items in this category.
+With prefix ARG, remove `diary-nonmarking-symbol' from all diary
+items in this category."
+ (interactive "P")
+ (save-excursion
+ (goto-char (point-min))
+ (let (buffer-read-only)
+ (catch 'stop
+ (while (not (eobp))
+ (if (todos-done-item-p) ; We've gone too far.
+ (throw 'stop nil)
+ (unless (looking-at (regexp-quote todos-nondiary-start))
+ (if arg
+ (when (looking-at (regexp-quote diary-nonmarking-symbol))
+ (replace-match ""))
+ (unless (looking-at (regexp-quote diary-nonmarking-symbol))
+ (insert diary-nonmarking-symbol))))
+ (todos-forward-item)))))))
-(defun todos-read-category (prompt &optional mustmatch)
- "Choose and return a category name, prompting with PROMPT.
-Show completions with TAB or SPC. With non-nil MUSTMATCH the
-name must be that of an existing category; otherwise, a new
-category name is allowed, after checking its validity."
- ;; Allow SPC to insert spaces, for adding new category names.
- (let ((map minibuffer-local-completion-map))
- (define-key map " " nil)
- ;; Make a copy of todos-categories in case history-delete-duplicates is
- ;; non-nil, which makes completing-read alter todos-categories.
- (let* ((categories (copy-sequence todos-categories))
- (history (cons 'todos-categories (1+ todos-category-number)))
- (completion-ignore-case todos-completion-ignore-case)
- (category (completing-read prompt todos-categories nil
- mustmatch nil history
- (if todos-categories
- (todos-current-category)
- ;; Trigger prompt for initial category
- ""))))
- ;; FIXME: let "" return todos-current-category
- (unless mustmatch
- (when (and (not (assoc category categories))
- (y-or-n-p (format (concat "There is no category \"%s\" in "
- "this file; add it? ") category)))
- (todos-validate-category-name category)
- (todos-add-category category)))
- ;; Restore the original value of todos-categories.
- (setq todos-categories categories)
- category)))
+(defun todos-raise-item-priority (&optional lower)
+ "Raise priority of current item by moving it up by one item.
+With non-nil argument LOWER lower item's priority."
+ (interactive)
+ (unless (or (todos-done-item-p)
+ ;; Point is between todo and done items.
+ (looking-at "^$"))
+ (let (buffer-read-only)
+ (if (or (and lower
+ (save-excursion
+ ;; Can't lower final todo item.
+ (todos-forward-item)
+ (and (looking-at todos-item-start)
+ (not (todos-done-item-p)))))
+ ;; Can't raise or lower todo item when it's the only one.
+ (> (count-lines (point-min) (point)) 0))
+ (let ((item (todos-item-string))
+ (marked (todos-marked-item-p)))
+ ;; In Todos Top Priorities mode, an item's priority can be changed
+ ;; wrt items in another category, but not wrt items in the same
+ ;; category.
+ (when (eq major-mode 'todos-filter-items-mode)
+ (let* ((regexp (concat todos-date-string-start todos-date-pattern
+ "\\( " diary-time-regexp "\\)?"
+ (regexp-quote todos-nondiary-end)
+ "?\\(?1: \\[\\(.+:\\)?.+\\]\\)"))
+ (cat1 (save-excursion
+ (re-search-forward regexp nil t)
+ (match-string 1)))
+ (cat2 (save-excursion
+ (if lower
+ (todos-forward-item)
+ (todos-backward-item))
+ (re-search-forward regexp nil t)
+ (match-string 1))))
+ (if (string= cat1 cat2)
+ ;; FIXME: better message
+ (error (concat "Cannot change item's priority in its "
+ "category; do this in Todos mode")))))
+ (todos-remove-item)
+ (if lower (todos-forward-item) (todos-backward-item))
+ (todos-insert-with-overlays item)
+ ;; If item was marked, retore the mark.
+ (and marked (overlay-put (make-overlay (point) (point))
+ 'before-string todos-item-mark)))
+ (message ""))))) ;FIXME: no message ?
-(defun todos-validate-category-name (cat)
- "Check new category name CAT and when valid return it."
- (let (prompt)
- (while
- (and (cond ((string= "" cat)
- ;; (if todos-categories
- ;; (setq prompt "Enter a non-empty category name: ")
- ;; Prompt for initial category of a new Todos file.
- (setq prompt (concat "Initial category name ["
- todos-initial-category "]: ")));)
- ((string-match "\\`\\s-+\\'" cat)
- (setq prompt
- "Enter a category name that is not only white space: "))
- ;; FIXME: add completion
- ((assoc cat todos-categories)
- (setq prompt "Enter a non-existing category name: ")))
- (setq cat (if todos-categories
- (read-from-minibuffer prompt)
- ;; Offer default initial category name.
- (prin1-to-string
- (read-from-minibuffer prompt nil nil t nil
- (list todos-initial-category))))))))
- cat)
-
-;; (defun todos-read-category (prompt)
-;; "Prompt with PROMPT for an existing category name and return it.
-;; Show completions with TAB or SPC."
-;; ;; Make a copy of todos-categories in case history-delete-duplicates is
-;; ;; non-nil, which makes completing-read alter todos-categories.
-;; (let* ((categories (copy-sequence todos-categories))
-;; (history (cons 'todos-categories (1+ todos-category-number)))
-;; (completion-ignore-case todos-completion-ignore-case)
-;; (category (completing-read prompt todos-categories nil
-;; mustmatch nil history)))
-;; (setq category (completing-read prompt todos-categories nil t))
-;; ;; Restore the original value of todos-categories.
-;; (setq todos-categories categories)
-;; category))
-
-;; (defun todos-new-category-name (prompt)
-;; "Prompt with PROMPT for a new category name and return it."
-;; (let ((map minibuffer-local-completion-map)
-;; prompt-n)
-;; ;; Allow SPC to insert spaces, for adding new category names.
-;; (define-key map " " nil)
-;; (while
-;; ;; Validate entered category name.
-;; (and (cond ((string= "" cat)
-;; (setq prompt-n
-;; (if todos-categories
-;; "Enter a non-empty category name: "
-;; ;; Prompt for initial category of a new Todos file.
-;; (concat "Initial category name ["
-;; todos-initial-category "]: "))))
-;; ((string-match "\\`\\s-+\\'" cat)
-;; (setq prompt-n
-;; "Enter a category name that is not only white space: "))
-;; ((assoc cat todos-categories)
-;; (setq prompt-n "Enter a non-existing category name: ")))
-;; (setq cat (if todos-categories
-;; (read-from-minibuffer prompt)
-;; ;; Offer default initial category name.
-;; (prin1-to-string
-;; (read-from-minibuffer
-;; (or prompt prompt-n) nil nil t nil
-;; (list todos-initial-category))))))
-;; (setq prompt nil)))
-;; cat)
-
-;; ;; Adapted from calendar-read-date and calendar-date-string.
-(defun todos-read-date ()
- "Prompt for Gregorian date and return it in the current format.
-Also accepts `*' as an unspecified month, day, or year."
- (let* ((year (calendar-read
- ;; FIXME: maybe better like monthname with RET for current month
- "Year (>0 or * for any year): "
- (lambda (x) (or (eq x '*) (> x 0)))
- (number-to-string (calendar-extract-year
- (calendar-current-date)))))
- (month-array (vconcat calendar-month-name-array (vector "*")))
- (abbrevs (vconcat calendar-month-abbrev-array (vector "*")))
- (completion-ignore-case t)
- (monthname (completing-read
- "Month name (RET for current month, * for any month): "
- (mapcar 'list (append month-array nil))
- nil t nil nil
- (calendar-month-name (calendar-extract-month
- (calendar-current-date)) t)))
- (month (cdr (assoc-string
- monthname (calendar-make-alist month-array nil nil
- abbrevs))))
- (last (if (= month 13)
- 31 ; FIXME: what about shorter months?
- (let ((yr (if (eq year '*)
- 1999 ; FIXME: no Feb. 29
- year)))
- (calendar-last-day-of-month month yr))))
- day dayname)
- (while (if (numberp day) (or (< day 0) (< last day)) (not (eq day '*)))
- (setq day (read-from-minibuffer
- (format "Day (1-%d or RET for today or * for any day): " last)
- nil nil t nil
- (number-to-string
- (calendar-extract-day (calendar-current-date))))))
- (setq year (if (eq year '*) (symbol-name '*) (number-to-string year)))
- (setq day (if (eq day '*) (symbol-name '*) (number-to-string day)))
- ;; FIXME: make abbreviation customizable
- (setq monthname
- (or (and (= month 13) "*")
- (calendar-month-name (calendar-extract-month (list month day year))
- t)))
- (mapconcat 'eval calendar-date-display-form "")))
+(defun todos-lower-item-priority ()
+ "Lower priority of current item by moving it down by one item."
+ (interactive)
+ (todos-raise-item-priority t))
-(defun todos-read-dayname ()
- "Choose name of a day of the week with completion and return it."
- (let ((completion-ignore-case t))
- (completing-read "Enter a day name: "
- (append calendar-day-name-array nil)
- nil t)))
-
-(defun todos-read-time ()
- "Prompt for and return a valid clock time as a string.
-Valid time strings are those matching `diary-time-regexp'."
- (let (valid answer)
- (while (not valid)
- (setq answer (read-from-minibuffer
- "Enter a clock time (or return for none): "))
- (when (or (string= "" answer)
- (string-match diary-time-regexp answer))
- (setq valid t)))
- answer))
+;; FIXME: incorporate todos-(raise|lower)-item-priority ?
+;; FIXME: does this DTRT in todos-categories-mode?
+(defun todos-set-item-priority (item cat &optional new)
+ "Set todo ITEM's priority in category CAT, moving item as needed.
+Interactively, the item and the category are the current ones,
+and the priority is a number between 1 and the number of items in
+the category. Non-interactively with argument NEW, the lowest
+priority is one more than the number of items in CAT."
+ (interactive (list (todos-item-string) (todos-current-category)))
+ (unless (called-interactively-p t)
+ (todos-category-number cat)
+ (todos-category-select))
+ (let* ((todo (todos-get-count 'todo cat))
+ (maxnum (if new (1+ todo) todo))
+ (buffer-read-only)
+ priority candidate prompt)
+ (unless (zerop todo)
+ (while (not priority)
+ (setq candidate
+ (string-to-number (read-from-minibuffer
+ (concat prompt
+ (format "Set item priority (1-%d): "
+ maxnum)))))
+ (setq prompt
+ (when (or (< candidate 1) (> candidate maxnum))
+ (format "Priority must be an integer between 1 and %d.\n"
+ maxnum)))
+ (unless prompt (setq priority candidate)))
+ ;; Interactively, just relocate the item within its category.
+ (when (called-interactively-p) (todos-remove-item))
+ (goto-char (point-min))
+ (unless (= priority 1) (todos-forward-item (1- priority))))
+ (todos-insert-with-overlays item)))
-;;; Sorting and display routines for todos-categories-mode.
+(defun todos-move-item (&optional file)
+ "Move at least one todo item to another category.
-(defun todos-display-categories (&optional sortkey)
- "Display a table of the current file's categories and item counts.
+If there are marked items, move all of these; otherwise, move
+the item at point.
-In the initial display the categories are numbered, indicating
-their current order for navigating by \\[todos-forward-category]
-and \\[todos-backward-category]. You can persistantly change the
-order of the category at point by typing \\[todos-raise-category]
-or \\[todos-lower-category].
+With non-nil argument FILE, first prompt for another Todos file and
+then a category in that file to move the item or items to.
-The labels above the category names and item counts are buttons,
-and clicking these changes the display: sorted by category name
-or by the respective item counts (alternately descending or
-ascending). In these displays the categories are not numbered
-and \\[todos-raise-category] and \\[todos-lower-category] are
-disabled. (Programmatically, the sorting is triggered by passing
-a non-nil SORTKEY argument.)
+If the chosen category is not one of the existing categories,
+then it is created and the item(s) become(s) the first
+entry/entries in that category."
+ (interactive)
+ (unless (or (todos-done-item-p)
+ ;; Point is between todo and done items.
+ (looking-at "^$"))
+ (let* ((buffer-read-only)
+ (file1 todos-current-todos-file)
+ (cat1 (todos-current-category))
+ (marked (assoc cat1 todos-categories-with-marks))
+ (num todos-category-number)
+ (item (todos-item-string))
+ (diary-item (todos-diary-item-p))
+ (omark (save-excursion (todos-item-start) (point-marker)))
+ (file2 (if file
+ (todos-read-file-name "Choose a Todos file: " nil t)
+ file1))
+ (count 0)
+ (count-diary 0)
+ cat2 nmark)
+ (set-buffer (find-file-noselect file2))
+ (setq cat2 (let* ((pl (if (and marked (> (cdr marked) 1)) "s" ""))
+ (name (todos-read-category
+ (concat "Move item" pl " to category: ")))
+ (prompt (concat "Choose a different category than "
+ "the current one\n(type `"
+ (key-description
+ (car (where-is-internal
+ 'todos-set-item-priority)))
+ "' to reprioritize item "
+ "within the same category): ")))
+ (while (equal name cat1)
+ (setq name (todos-read-category prompt)))
+ name))
+ (set-buffer (get-file-buffer file1))
+ (if marked
+ (progn
+ (setq item nil)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (when (todos-marked-item-p)
+ (setq item (concat item (todos-item-string) "\n"))
+ (setq count (1+ count))
+ (when (todos-diary-item-p)
+ (setq count-diary (1+ count-diary))))
+ (todos-forward-item))
+ ;; Chop off last newline.
+ (setq item (substring item 0 -1)))
+ (setq count 1)
+ (when (todos-diary-item-p) (setq count-diary 1)))
+ (set-window-buffer (selected-window)
+ (set-buffer (find-file-noselect file2)))
+ (unless (assoc cat2 todos-categories) (todos-add-category cat2))
+ (todos-set-item-priority item cat2 t)
+ (setq nmark (point-marker))
+ (todos-set-count 'todo count)
+ (todos-set-count 'diary count-diary)
+ (todos-update-categories-sexp)
+ (with-current-buffer (get-file-buffer file1)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char omark)
+ (if marked
+ (let (beg end)
+ (setq item nil)
+ (re-search-backward
+ (concat "^" (regexp-quote todos-category-beg)) nil t)
+ (forward-line)
+ (setq beg (point))
+ (re-search-forward
+ (concat "^" (regexp-quote todos-category-done)) nil t)
+ (setq end (match-beginning 0))
+ (goto-char beg)
+ (while (< (point) end)
+ (if (todos-marked-item-p)
+ (todos-remove-item)
+ (todos-forward-item))))
+ (todos-remove-item))))
+ (todos-set-count 'todo (- count) cat1)
+ (todos-set-count 'diary (- count-diary) cat1)
+ (todos-update-categories-sexp))
+ (set-window-buffer (selected-window)
+ (set-buffer (find-file-noselect file2)))
+ (setq todos-category-number (todos-category-number cat2))
+ (todos-category-select)
+ (goto-char nmark))))
-In addition, the lines with the category names and item counts
-are buttonized, and pressing one of these button jumps to the
-category in Todos mode (or Todos Archive mode, for categories
-containing only archived items, provided user option
-`todos-ignore-archived-categories' is non-nil. These categories
-are shown in `todos-archived-only' face."
+(defun todos-move-item-to-file ()
+ "Move the current todo item to a category in another Todos file."
(interactive)
- (unless (eq major-mode 'todos-categories-mode)
- (setq todos-global-current-todos-file (or todos-current-todos-file
- todos-default-todos-file)))
- (let* ((cats0 (if (and todos-ignore-archived-categories
- (not (eq major-mode 'todos-categories-mode)))
- todos-categories-full
- todos-categories))
- (cats (todos-sort cats0 sortkey))
- (archive (member todos-current-todos-file todos-archives))
- ;; `num' is used by todos-insert-category-line.
- (num 0))
- (set-window-buffer (selected-window)
- (set-buffer (get-buffer-create todos-categories-buffer)))
- (let (buffer-read-only)
- (erase-buffer)
- (kill-all-local-variables)
- (todos-categories-mode)
- ;; FIXME: add usage tips?
- (insert (format "Category counts for Todos file \"%s\"."
- (file-name-sans-extension
- (file-name-nondirectory todos-current-todos-file))))
- (newline 2)
- ;; Make space for the column of category numbers.
- (insert (make-string (+ 4 (length todos-categories-number-separator)) 32))
- ;; Add the category and item count buttons (if this is the list of
- ;; categories in an archive, show only done item counts).
- (save-excursion
- (todos-insert-sort-button todos-categories-category-label)
- (if (member todos-current-todos-file todos-archives)
- (insert (concat (make-string 6 32)
- (format "%s" todos-categories-archived-label)))
- (insert (make-string 3 32))
- (todos-insert-sort-button todos-categories-todo-label)
- (insert (make-string 2 32))
- (todos-insert-sort-button todos-categories-diary-label)
- (insert (make-string 2 32))
- (todos-insert-sort-button todos-categories-done-label)
- (insert (make-string 2 32))
- (todos-insert-sort-button todos-categories-archived-label))
- (newline 2)
- ;; Fill in the table with buttonized lines, each showing a category and
- ;; its item counts.
- (mapc (lambda (cat) (todos-insert-category-line cat sortkey))
- (mapcar 'car cats))
- (newline)
- ;; Add a line showing item count totals.
- (insert (make-string (+ 4 (length todos-categories-number-separator)) 32)
- (todos-padded-string todos-categories-totals-label)
- (mapconcat
- (lambda (elt)
- (concat
- (make-string (1+ (/ (length (car elt)) 2)) 32)
- (format "%3d" (nth (cdr elt) (todos-total-item-counts)))
- ;; Add an extra space if label length is odd (using
- ;; definition of oddp from cl.el).
- (if (eq (logand (length (car elt)) 1) 1) " ")))
- (if archive
- (list (cons todos-categories-done-label 2))
- (list (cons todos-categories-todo-label 0)
- (cons todos-categories-diary-label 1)
- (cons todos-categories-done-label 2)
- (cons todos-categories-archived-label 3)))
- ""))))
- (setq buffer-read-only t)))
-
-;; ;; FIXME: make this toggle with todos-display-categories
-;; (defun todos-display-categories-alphabetically ()
-;; ""
-;; (interactive)
-;; (todos-display-sorted 'alpha))
+ (todos-move-item t))
-;; ;; FIXME: provide key bindings for these or delete them
-;; (defun todos-display-categories-sorted-by-todo ()
-;; ""
-;; (interactive)
-;; (todos-display-sorted 'todo))
+(defun todos-move-item-to-diary ()
+ "Move one or more items in current category to the diary file.
-;; (defun todos-display-categories-sorted-by-diary ()
-;; ""
-;; (interactive)
-;; (todos-display-sorted 'diary))
+If there are marked items, move all of these; otherwise, move
+the item at point."
+ (interactive)
+ ;; FIXME
+ )
-;; (defun todos-display-categories-sorted-by-done ()
-;; ""
-;; (interactive)
-;; (todos-display-sorted 'done))
+;; FIXME: make adding date customizable, and make this and time customization
+;; overridable via double prefix arg ??
+(defun todos-item-done (&optional arg)
+ "Tag at least one item in this category as done and hide it.
+
+With prefix argument ARG prompt for a comment and append it to
+the done item; this is only possible if there are no marked
+items. If there are marked items, tag all of these with
+`todos-done-string' plus the current date and, if
+`todos-always-add-time-string' is non-nil, the current time;
+otherwise, just tag the item at point. Items tagged as done are
+relocated to the category's (by default hidden) done section."
+ (interactive "P")
+ (let* ((cat (todos-current-category))
+ (marked (assoc cat todos-categories-with-marks)))
+ (unless (or (todos-done-item-p)
+ (and (looking-at "^$") (not marked)))
+ (let* ((date-string (calendar-date-string (calendar-current-date) t t))
+ (time-string (if todos-always-add-time-string
+ (concat " " (substring (current-time-string) 11 16))
+ ""))
+ (done-prefix (concat "[" todos-done-string date-string time-string
+ "] "))
+ (comment (and arg (not marked) (read-string "Enter a comment: ")))
+ (item-count 0)
+ (diary-count 0)
+ item done-item
+ (buffer-read-only))
+ (and marked (goto-char (point-min)))
+ (catch 'done
+ (while (not (eobp))
+ (if (or (not marked) (and marked (todos-marked-item-p)))
+ (progn
+ (setq item (todos-item-string))
+ (setq done-item (cond (marked
+ (concat done-item done-prefix item "\n"))
+ (comment
+ (concat done-prefix item " ["
+ todos-comment-string
+ ": " comment "]"))
+ (t
+ (concat done-prefix item))))
+ (setq item-count (1+ item-count))
+ (when (todos-diary-item-p)
+ (setq diary-count (1+ diary-count)))
+ (todos-remove-item)
+ (unless marked (throw 'done nil)))
+ (todos-forward-item))))
+ (when marked
+ ;; Chop off last newline of done item string.
+ (setq done-item (substring done-item 0 -1))
+ (remove-overlays (point-min) (point-max) 'before-string todos-item-mark)
+ (setq todos-categories-with-marks
+ (assq-delete-all cat todos-categories-with-marks)))
+ (save-excursion
+ (widen)
+ (re-search-forward
+ (concat "^" (regexp-quote todos-category-done)) nil t)
+ (forward-char)
+ (insert done-item "\n"))
+ (todos-set-count 'todo (- item-count))
+ (todos-set-count 'done item-count)
+ (todos-set-count 'diary (- diary-count))
+ (todos-update-categories-sexp)
+ (save-excursion (todos-category-select))))))
+
+;; FIXME: only if there's no comment, or edit an existing comment?
+(defun todos-comment-done-item ()
+ "Add a comment to this done item."
+ (interactive)
+ (when (todos-done-item-p)
+ (let ((comment (read-string "Enter a comment: "))
+ buffer-read-only)
+ (todos-item-end)
+ (insert " [" todos-comment-string ": " comment "]"))))
-;; (defun todos-display-categories-sorted-by-archived ()
-;; ""
-;; (interactive)
-;; (todos-display-sorted 'archived))
+;; FIXME: implement this or done item editing?
+(defun todos-uncomment-done-item ()
+ ""
+ )
-(defun todos-longest-category-name-length (categories)
- "Return the length of the longest name in list CATEGORIES."
- (let ((longest 0))
- (dolist (c categories longest)
- (setq longest (max longest (length c))))))
+;; FIXME: delete comment from restored item or just leave it up to user?
+(defun todos-item-undo ()
+ "Restore this done item to the todo section of this category."
+ (interactive)
+ (when (todos-done-item-p)
+ (let* ((buffer-read-only)
+ (done-item (todos-item-string))
+ (opoint (point))
+ (orig-mrk (progn (todos-item-start) (point-marker)))
+ ;; Find the end of the date string added upon making item done.
+ (start (search-forward "] "))
+ (item (buffer-substring start (todos-item-end)))
+ undone)
+ (todos-remove-item)
+ ;; If user cancels before setting new priority, then restore everything.
+ (unwind-protect
+ (progn
+ (todos-set-item-priority item (todos-current-category) t)
+ (setq undone t)
+ (todos-set-count 'todo 1)
+ (todos-set-count 'done -1)
+ (and (todos-diary-item-p) (todos-set-count 'diary 1))
+ (todos-update-categories-sexp))
+ (unless undone
+ (widen)
+ (goto-char orig-mrk)
+ (todos-insert-with-overlays done-item)
+ (let ((todos-show-with-done t))
+ (todos-category-select)
+ (goto-char opoint)))
+ (set-marker orig-mrk nil)))))
-(defun todos-padded-string (str)
- "Return string STR padded with spaces.
-The placement of the padding is determined by the value of user
-option `todos-categories-align'."
- (let* ((categories (mapcar 'car todos-categories))
- (len (max (todos-longest-category-name-length categories)
- (length todos-categories-category-label)))
- (strlen (length str))
- (strlen-odd (eq (logand strlen 1) 1)) ; oddp from cl.el
- (padding (max 0 (/ (- len strlen) 2)))
- (padding-left (cond ((eq todos-categories-align 'left) 0)
- ((eq todos-categories-align 'center) padding)
- ((eq todos-categories-align 'right)
- (if strlen-odd (1+ (* padding 2)) (* padding 2)))))
- (padding-right (cond ((eq todos-categories-align 'left)
- (if strlen-odd (1+ (* padding 2)) (* padding 2)))
- ((eq todos-categories-align 'center)
- (if strlen-odd (1+ padding) padding))
- ((eq todos-categories-align 'right) 0))))
- (concat (make-string padding-left 32) str (make-string padding-right 32))))
+(defun todos-archive-done-item-or-items (&optional all)
+ "Archive at least one done item in this category.
-(defvar todos-descending-counts nil
- "List of keys for category counts sorted in descending order.")
+If there are marked done items (and no marked todo items),
+archive all of these; otherwise, with non-nil argument ALL,
+archive all done items in this category; otherwise, archive the
+done item at point.
-(defun todos-sort (list &optional key)
- "Return a copy of LIST, possibly sorted according to KEY."
- (let* ((l (copy-sequence list))
- (fn (if (eq key 'alpha)
- (lambda (x) (upcase x)) ; Alphabetize case insensitively.
- (lambda (x) (todos-get-count key x))))
- (descending (member key todos-descending-counts))
- (cmp (if (eq key 'alpha)
- 'string<
- (if descending '< '>)))
- (pred (lambda (s1 s2) (let ((t1 (funcall fn (car s1)))
- (t2 (funcall fn (car s2))))
- (funcall cmp t1 t2)))))
- (when key
- (setq l (sort l pred))
- (if descending
- (setq todos-descending-counts
- (delete key todos-descending-counts))
- (push key todos-descending-counts)))
- l))
+If the archive of this file does not exist, it is created. If
+this category does not exist in the archive, it is created."
+ (interactive)
+ (when (not (member (buffer-file-name) (funcall todos-files-function t)))
+ (if (and all (zerop (todos-get-count 'done)))
+ (message "No done items in this category")
+ (catch 'end
+ (let* ((cat (todos-current-category))
+ (tbuf (current-buffer))
+ (marked (assoc cat todos-categories-with-marks))
+ (afile (concat (file-name-sans-extension
+ todos-current-todos-file) ".toda"))
+ (archive (if (file-exists-p afile)
+ (find-file-noselect afile t)
+ (progn
+ ;; todos-add-category requires an exisiting file...
+ (with-current-buffer (get-buffer-create afile)
+ (erase-buffer)
+ (write-region (point-min) (point-max) afile
+ nil 'nomessage nil t)))
+ ;; ...but the file still lacks a categories sexp, so
+ ;; visiting the file would barf on todos-set-categories,
+ ;; hence we just return the buffer.
+ (get-buffer afile)))
+ (item (and (todos-done-item-p) (concat (todos-item-string) "\n")))
+ (count 0)
+ marked-items beg end all-done
+ buffer-read-only)
+ (cond
+ (marked
+ (save-excursion
+ (goto-char (point-min))
+ (while (not (eobp))
+ (if (todos-marked-item-p)
+ (if (not (todos-done-item-p))
+ (throw 'end (message "Only done items can be archived"))
+ (concat marked-items (todos-item-string) "\n")
+ (setq count (1+ count)))
+ (todos-forward-item)))))
+ (all
+ (if (y-or-n-p "Archive all done items in this category? ")
+ (save-excursion
+ (save-restriction
+ (goto-char (point-min))
+ (widen)
+ (setq beg (progn
+ (re-search-forward todos-done-string-start nil t)
+ (match-beginning 0))
+ end (if (re-search-forward
+ (concat "^" (regexp-quote todos-category-beg))
+ nil t)
+ (match-beginning 0)
+ (point-max))
+ all-done (buffer-substring beg end)
+ count (todos-get-count 'done))))
+ (throw 'end nil))))
+ (when (or marked all item)
+ (with-current-buffer archive
+ (let ((current todos-global-current-todos-file)
+ (buffer-read-only))
+ (widen)
+ (goto-char (point-min))
+ (if (progn
+ (re-search-forward
+ (concat "^" (regexp-quote (concat todos-category-beg cat)))
+ nil t)
+ (re-search-forward (regexp-quote todos-category-done) nil t))
+ (forward-char)
+ ;; todos-add-category uses t-c-t-f, so temporarily set it.
+ (setq todos-current-todos-file afile)
+ (todos-add-category cat)
+ (goto-char (point-max)))
+ (insert (cond (marked marked-items)
+ (all all-done)
+ (item)))
+ (todos-set-count 'done (if (or marked all) count 1))
+ (todos-update-categories-sexp)
+ ;; Save to file now (using write-region in order not to visit
+ ;; afile) so we can visit it later with todos-view-archived-items
+ ;; or todos-show-archive.
+ (write-region nil nil afile)
+ (setq todos-current-todos-file current)))
+ (with-current-buffer tbuf
+ (cond ((or marked item)
+ (and marked (goto-char (point-min)))
+ (catch 'done
+ (while (not (eobp))
+ (if (or (and marked (todos-marked-item-p)) item)
+ (progn
+ (todos-remove-item)
+ (todos-set-count 'done -1)
+ (todos-set-count 'archived 1)
+ ;; Don't leave point below last item.
+ (and item (bolp) (eolp) (< (point-min) (point-max))
+ (todos-backward-item))
+ (when item
+ (throw 'done (setq item nil))))
+ (todos-forward-item)))))
+ (all
+ (remove-overlays beg end)
+ (delete-region beg end)
+ (todos-set-count 'done (- count))
+ (todos-set-count 'archived count)))
+ (when marked
+ (remove-overlays (point-min) (point-max)
+ 'before-string todos-item-mark)
+ (setq todos-categories-with-marks
+ (assq-delete-all cat todos-categories-with-marks))
+ (goto-char opoint))
+ (todos-update-categories-sexp)
+ (todos-prefix-overlays)
+ ;; FIXME: Heisenbug: item displays mark -- but not when edebugging
+ (remove-overlays (point-min) (point-max)
+ 'before-string todos-item-mark)))
+ (display-buffer (find-file-noselect afile) t)
+ ;; FIXME: how to avoid switch-to-buffer and still get tbuf above
+ ;; afile? What about pop-to-buffer-same-window in recent trunk?
+ (switch-to-buffer tbuf))))))
-(defun todos-display-sorted (type)
- "Keep point on the TYPE count sorting button just clicked."
- (let ((opoint (point)))
- (todos-display-categories type)
- (goto-char opoint)))
+(defun todos-archive-category-done-items ()
+ "Move all done items in this category to its archive."
+ (interactive)
+ (todos-archive-done-item-or-items t))
-(defun todos-label-to-key (label)
- "Return symbol for sort key associated with LABEL."
- (let (key)
- (cond ((string= label todos-categories-category-label)
- (setq key 'alpha))
- ((string= label todos-categories-todo-label)
- (setq key 'todo))
- ((string= label todos-categories-diary-label)
- (setq key 'diary))
- ((string= label todos-categories-done-label)
- (setq key 'done))
- ((string= label todos-categories-archived-label)
- (setq key 'archived)))
- key))
+(defun todos-unarchive-items (&optional all)
+ "Unarchive at least one item in this archive category.
-(defun todos-insert-sort-button (label)
- "Insert button for displaying categories sorted by item counts.
-LABEL determines which type of count is sorted."
- (setq str (if (string= label todos-categories-category-label)
- (todos-padded-string label)
- label))
- (setq beg (point))
- (setq end (+ beg (length str)))
- (insert-button str 'face nil
- 'action
- `(lambda (button)
- (let ((key (todos-label-to-key ,label)))
- (if (and (member key todos-descending-counts)
- (eq key 'alpha))
- (progn
- (todos-display-categories)
- (setq todos-descending-counts
- (delete key todos-descending-counts)))
- (todos-display-sorted key)))))
- (setq ovl (make-overlay beg end))
- (overlay-put ovl 'face 'todos-button))
+If there are marked items, unarchive all of these; otherwise,
+with non-nil argument ALL, unarchive all items in this category;
+otherwise, unarchive the item at point.
-(defun todos-total-item-counts ()
- "Return a list of total item counts for the current file."
- (mapcar (lambda (i) (apply '+ (mapcar (lambda (l) (aref l i))
- (mapcar 'cdr todos-categories))))
- (list 0 1 2 3)))
+Unarchived items are restored as done items to the corresponding
+category in the Todos file, inserted at the end of done section.
+If all items in the archive category were restored, the category
+is deleted from the archive. If this was the only category in the
+archive, the archive file is deleted."
+ (interactive)
+ (when (member (buffer-file-name) (funcall todos-files-function t))
+ (catch 'end
+ (let* ((buffer-read-only nil)
+ (tbuf (find-file-noselect
+ (concat (file-name-sans-extension todos-current-todos-file)
+ ".todo") t))
+ (cat (todos-current-category))
+ (marked (assoc cat todos-categories-with-marks))
+ (item (concat (todos-item-string) "\n"))
+ (all-items (buffer-substring (point-min) (point-max)))
+ (all-count (todos-get-count 'done))
+ marked-items marked-count)
+ (save-excursion
+ (goto-char (point-min))
+ (while (not (eobp))
+ (when (todos-marked-item-p)
+ (concat marked-items (todos-item-string) "\n")
+ (setq marked-count (1+ marked-count)))
+ (todos-forward-item)))
+ ;; Restore items to end of category's done section and update counts.
+ (with-current-buffer tbuf
+ (let (buffer-read-only)
+ (widen)
+ (goto-char (point-min))
+ (re-search-forward (concat "^" (regexp-quote
+ (concat todos-category-beg cat)))
+ nil t)
+ (if (re-search-forward (concat "^" (regexp-quote todos-category-beg))
+ nil t)
+ (goto-char (match-beginning 0))
+ (goto-char (point-max)))
+ (cond (marked
+ (insert marked-items)
+ (todos-set-count 'done marked-count)
+ (todos-set-count 'archived (- marked-count)))
+ (all
+ (if (y-or-n-p (concat "Restore this category's items "
+ "to Todos file as done items "
+ "and delete this category? "))
+ (progn (insert all-items)
+ (todos-set-count 'done all-count)
+ (todos-set-count 'archived (- all-count)))
+ (throw 'end nil)))
+ (t
+ (insert item)
+ (todos-set-count 'done 1)
+ (todos-set-count 'archived -1)))
+ (todos-update-categories-sexp)))
+ ;; Delete restored items from archive.
+ (cond ((or marked item)
+ (and marked (goto-char (point-min)))
+ (catch 'done
+ (while (not (eobp))
+ (if (or (and marked (todos-marked-item-p)) item)
+ (progn
+ (todos-remove-item)
+ (todos-set-count 'done -1)
+ ;; Don't leave point below last item.
+ (and item (bolp) (eolp) (< (point-min) (point-max))
+ (todos-backward-item))
+ (when item
+ (throw 'done (setq item nil))))
+ (todos-forward-item)))))
+ (all
+ (remove-overlays (point-min) (point-max))
+ (delete-region (point-min) (point-max))
+ (todos-set-count 'done (- all-count))))
+ ;; If that was the last category in the archive, delete the whole file.
+ (if (= (length todos-categories) 1)
+ (progn
+ (delete-file todos-current-todos-file)
+ ;; Don't bother confirming killing the archive buffer.
+ (set-buffer-modified-p nil)
+ (kill-buffer))
+ ;; Otherwise, if the archive category is now empty, delete it.
+ (when (eq (point-min) (point-max))
+ (widen)
+ (let ((beg (re-search-backward
+ (concat "^" (regexp-quote todos-category-beg) cat)
+ nil t))
+ (end (if (re-search-forward
+ (concat "^" (regexp-quote todos-category-beg))
+ nil t 2)
+ (match-beginning 0)
+ (point-max))))
+ (remove-overlays beg end)
+ (delete-region beg end)
+ (setq todos-categories (delete (assoc cat todos-categories)
+ todos-categories))
+ (todos-update-categories-sexp))))
+ ;; Visit category in Todos file and show restored done items.
+ (let ((tfile (buffer-file-name tbuf))
+ (todos-show-with-done t))
+ (set-window-buffer (selected-window)
+ (set-buffer (find-file-noselect tfile)))
+ (todos-category-number cat)
+ (todos-show)
+ (message "Items unarchived."))))))
-(defun todos-insert-category-line (cat &optional nonum)
- "Insert button displaying category CAT's name and item counts.
-With non-nil argument NONUM show only these; otherwise, insert a
-number in front of the button indicating the category's priority.
-The number and the category name are separated by the string
-which is the value of the user option
-`todos-categories-number-separator'."
- (let* ((archive (member todos-current-todos-file todos-archives))
- (str (todos-padded-string cat))
- (opoint (point)))
- ;; num is declared in caller.
- (setq num (1+ num))
- (insert-button
- (concat (if nonum
- (make-string (+ 4 (length todos-categories-number-separator))
- 32)
- (format " %3d%s" num todos-categories-number-separator))
- str
- (mapconcat (lambda (elt)
- (concat
- (make-string (1+ (/ (length (car elt)) 2)) 32) ; label
- (format "%3d" (todos-get-count (cdr elt) cat)) ; count
- ;; Add an extra space if label length is odd
- ;; (using def of oddp from cl.el).
- (if (eq (logand (length (car elt)) 1) 1) " ")))
- (if archive
- (list (cons todos-categories-done-label 'done))
- (list (cons todos-categories-todo-label 'todo)
- (cons todos-categories-diary-label 'diary)
- (cons todos-categories-done-label 'done)
- (cons todos-categories-archived-label
- 'archived)))
- ""))
- 'face (if (and todos-ignore-archived-categories
- (zerop (todos-get-count 'todo cat))
- (zerop (todos-get-count 'done cat))
- (not (zerop (todos-get-count 'archived cat))))
- 'todos-archived-only
- nil)
- 'action `(lambda (button) (let ((buf (current-buffer)))
- (todos-jump-to-category ,cat)
- (kill-buffer buf))))
- ;; Highlight the sorted count column.
- (let* ((beg (+ opoint 6 (length str)))
- end ovl)
- (cond ((eq nonum 'todo)
- (setq beg (+ beg 1 (/ (length todos-categories-todo-label) 2))))
- ((eq nonum 'diary)
- (setq beg (+ beg 1 (length todos-categories-todo-label)
- 2 (/ (length todos-categories-diary-label) 2))))
- ((eq nonum 'done)
- (setq beg (+ beg 1 (length todos-categories-todo-label)
- 2 (length todos-categories-diary-label)
- 2 (/ (length todos-categories-done-label) 2))))
- ((eq nonum 'archived)
- (setq beg (+ beg 1 (length todos-categories-todo-label)
- 2 (length todos-categories-diary-label)
- 2 (length todos-categories-done-label)
- 2 (/ (length todos-categories-archived-label) 2)))))
- (unless (= beg (+ opoint 6 (length str)))
- (setq end (+ beg 4))
- (setq ovl (make-overlay beg end))
- (overlay-put ovl 'face 'todos-sorted-column)))
- (newline)))
+(defun todos-unarchive-category ()
+ "Unarchive all items in this category. See `todos-unarchive-items'."
+ (interactive)
+ (todos-unarchive-items t))
(provide 'todos)
;;; todos.el ends here
+;; ---------------------------------------------------------------------------
;;; necessitated adaptations to diary-lib.el
;; (defun diary-goto-entry (button)