From d04d6b955b4caaa9817ec053eddb59e923a68cf8 Mon Sep 17 00:00:00 2001 From: Stephen Berman Date: Mon, 16 May 2011 01:00:28 +0100 Subject: [PATCH] * calendar/todos.el Add and revise various doc strings, remove further commented out code; add further comments; further code rearrangement. (todos-file-do, todos-archive-file, todos-mode-hook) (todos-edit-mode-hook, todos-exclusion-start, todos-exclusion-end) (todos-view-archive, todos-search-string) (todos-jump-to-category-noninteractively, todos-initial-setup): Remove. (todos-files): Remove this defcustom. (todos-initial-category, todos-display-categories-first) (todos-auto-switch-todos-file, todos-default-todos-file) (todos-categories-category-label, todos-categories-todo-label) (todos-categories-diary-label, todos-categories-done-label) (todos-categories-archived-label) (todos-categories-number-separator, todos-categories-align) (todos-ignore-archived-categories, todos-nondiary-marker): New defcustoms. (todos-prefix, todos-done-separator, todos-file-top) (todos-categories-buffer, todos-archived-categories-buffer) (todos-edit-buffer, todos-always-add-time-string, todos-button): Change default value. (todos-done-string): Add todos-reset-done-string as :set function, but keep this commented out. (todos-files, todos-archives, todos-insertion-map) (todos-category-done, todos-nondiary-start, todos-nondiary-end) (todos-show-done-only, todos-date-string-start) (todos-done-string-start): New variables. (todos-files-directory, todos-files-function, todos-merged-files) (todos-prompt-merged-files, todos-files, todos-modes-set-1) (todos-modes-set-2, todos-reset-done-string, todos-reset-categories) (todos-toggle-switch-todos-file-noninteractively) (todos-switch-todos-file, todos-counts, todos-get-count) (todos-set-count, todos-set-categories) (todos-truncate-categories-list, todos-update-categories-sexp) (todos-read-file-name, todos-sort, todos-display-sorted) (todos-label-to-key, todos-insert-sort-button): New functions. (todos-display-categories-sorted-by-todo) (todos-display-categories-sorted-by-diary) (todos-display-categories-sorted-by-done) (todos-display-categories-sorted-by-archived) (todos-update-merged-files, todos-switch-to-archive) (todos-choose-archive, todos-merged-top-priorities) (todos-jump-to-category-other-file, todos-clear-matches) (todos-add-file, todos-change-default-file, todos-move-category) (todos-merge-category, todos-merge-categories) (todos-edit-item-time, todos-move-item-to-file) (todos-unarchive-category, todos-toggle-item-diary-nonmarking) (todos-toggle-diary-nonmarking): New commands. (todos-toggle-show-done-only): New command replacing todos-view-archive. (todos-faces): New defgroup; use in all face definitions. (todos-sorted-column, todos-archived-only, todos-search): New faces. (todos-font-lock-keywords): Use subexpression 1 with matcher todos-category-string-match. (todos-mode-map, todos-archive-mode-map, todos-edit-mode-map) (todos-categories-mode-map): Add new key bindings; change some existing bindings. (todos-top-priorities-mode-map): New keymap. (todos-menu): Add submenues and new entries. (auto-mode-alist): Add extension of Todos and Todos archive files. (todos-mode, todos-archive-mode): Make derived mode; use todos-modes-set-1, todos-modes-set-2, todos-auto-switch-todos-file and todos-switch-todos-file; make todos-show-done-only local variable. (todos-edit-mode): Make derived mode; use todos-modes-set-1. (todos-categories-mode): Make derived mode. (todos-top-priorities-mode): New derived major mode. (todos-save): Remove unused code. (todos-quit): Handle todos-categories-mode; save archive buffer. (todos-show): Add optional argument to prompt for a Todos file; if called interactively or with prefix arg or from an archive, don't make a no-op but reset todos-current-todos-file, todos-categories and todos-category-number; use todos-read-file-name, todos-display-categories-first, todos-ignore-archived-categories. (todos-display-categories): Change argument name; refactor code for inserting table labels and lines, using todos-ignore-archived-categories, todos-sort, todos-categories-number-separator, todos-insert-sort-button, todos-categories-*-labels, and todos-insert-category-line. (todos-display-categories-alphabetically): Use todos-display-sorted. (todos-toggle-view-done-items): Use todos-done-string-start and todos-get-count. (todos-toggle-display-date-time): Use todos-done-string-start. (todos-top-priorities): Remove autoload cookie; partially rewrite: new argument list; allow combining top priorities of multiple Todos files; change display to include category (and file) name as part of item header; use todos-top-priorities-mode. (todos-diary-items): Reimplement using only todos-top-priorities. (todos-forward-category, todos-backward-category): Accommodate to 1-based numbering of categories; move point to top of category. (todos-jump-to-category): Rewrite, adding optional arguments to provide a category in non-interactive uses and to prompt for which Todos file to jump to. (todos-search): Reimplement; highlight each match as found, say how many matches remain and prompt whether to go to next one; at end of search prompt whether to remove highlighting. (todos-add-category): Remove autoload cookie; assign new category the highest category number; associate zero-initialized vector of item counts, instead of property list, with new category; use todos-validate-category-name and todos-update-categories-sexp. (todos-rename-category): Use todos-validate-category-name and todos-update-categories-sexp; take archive files into account. (todos-delete-category): Use todos-get-count and todos-update-categories-sexp, let-bind variable that were mistakenly global; use delete-region instead of kill-region; accommodate to 1-based numbering of categories; move point to top of category. (todos-raise-category): Handle item count vectors; use todos-insert-category-line and todos-update-categories-sexp. (todos-insert-item): Use nil time-string argument to omit time string; use todos-nondiary-start and todos-nondiary-end and todos-update-categories-sexp; if category named to insert into does not exist, add it; take new diary items into account. (todos-insert-item-ask-date, todos-insert-item-ask-date-time) (todos-insert-item-ask-date-time-for-diary) (todos-insert-item-ask-date-time-for-diary-here) (todos-insert-item-ask-date-time-here) (todos-insert-item-ask-date-maybe-notime) (todos-insert-item-ask-date-maybe-notime-for-diary) (todos-insert-item-ask-date-maybe-notime-for-diary-here) (todos-insert-item-ask-date-maybe-notime-here) (todos-insert-item-ask-date-for-diary) (todos-insert-item-ask-date-for-diary-here) (todos-insert-item-ask-date-here, todos-insert-item-ask-dayname) (todos-insert-item-ask-dayname-time) (todos-insert-item-ask-dayname-time-for-diary) (todos-insert-item-ask-dayname-time-for-diary-here) (todos-insert-item-ask-dayname-time-here) (todos-insert-item-ask-dayname-maybe-notime) (todos-insert-item-ask-dayname-maybe-notime-for-diary) (todos-insert-item-ask-dayname-maybe-notime-for-diary-here) (todos-insert-item-ask-dayname-maybe-notime-here) (todos-insert-item-ask-dayname-for-diary) (todos-insert-item-ask-dayname-for-diary-here) (todos-insert-item-ask-dayname-here, todos-insert-item-ask-time) (todos-insert-item-ask-time-for-diary) (todos-insert-item-ask-time-for-diary-here) (todos-insert-item-ask-time-here) (todos-insert-item-maybe-notime) (todos-insert-item-maybe-notime-for-diary) (todos-insert-item-maybe-notime-for-diary-here) (todos-insert-item-maybe-notime-here) (todos-insert-item-for-diary, todos-insert-item-for-diary-here): New insertion commands. (todos-insert-item-from-calendar): Use todos-current-todos-file. (todos-delete-item): Handle diary items; use todos-update-categories-sexp. (todos-edit-item): Check if point is with item string; use read-string instead of read-from-minibuffer; use todos-date-string-start; after editing put point at start of item text. (todos-edit-multiline): Narrow to item before invoking todos-edit-mode; show key binding of todos-edit-quit in a message. (todos-edit-quit): Use todos-save; kill buffer. (todos-edit-item-header): Add optional argument to prompt for editing only date string or only time string; use todos-date-string-start. (todos-edit-item-date, todos-edit-item-date-is-today) (todos-raise-item-priority, todos-lower-item-priority): Rename from todos-{raise, lower}-item and make them DTRT in todos-top-priorities-mode. (todos-set-item-priority): Make interactive; use todos-get-count and todos-insert-with-overlays; interactively, just relocate the item within its category. (todos-move-item): Add optional argument to prompt for a category in another Todos file; handle diary items; fix restoration after cancelling before inserting. (todos-item-done): Handle diary items; simplify handling of insertion in done items section. (todos-item-undo): Handle diary items. (todos-archive-done-items): Accommodate to new handling of archive files (in parallel with Todos files); handle diary items; use todos-done-string-start. (todos-toggle-item-diary-inclusion): Use todos-nondiary-start, todos-nondiary-end and todos-item-counts. (todos-toggle-diary-inclusion): Use todos-category-done instead of todos-category-end. (todos-print): Remove autoload cookie; rewrite to make overlays, line wrapping and wrap prefixes printable. (todos-date-pattern): Make parenthesized groups shy. (todos-date-string-match): Use todos-date-string-start; make todos-date-pattern an explicitly numbered group. (todos-time-string-match): Use todos-date-string-start. (todos-done-string-match): Use todos-done-string-start. (todos-category-string-match): Rewrite to match new category and category+filename patterns in todos-top-priorities-mode. (todos-prefix-overlays): Use todos-done-string-start and todos-category-done. (todos-reset-prefix): Handle archive files; restore point after changing prefix. (todos-reset-separator): Handle archive files. (todos-category-number): Make category number one more than its list index. (todos-current-category): Accommodate to 1-based numbering of categories. (todos-category-select): Simplify handling of done items and done separator string overlay. (todos-item-start): Use todos-date-string-start and todos-done-string-start. (todos-item-start, todos-item-end): Fix wrong parenthesizing. (todos-item-string): Restore point after getting item bounds; use buffer-substring-no-properties. (todos-done-item-p): Use todos-done-string-start. (todos-make-categories-list): Add optional argument to force looping through file to get categories and their item counts, otherwise set todos-categories from sexp in first line; use vectors of item counts instead of plists; count diary items. (todos-item-counts): Use todos-counts, todos-set-counts, todos-get-counts, and todos-update-categories-sexp instead of getting and setting properties; handle diary items. (todos-read-category): Add argument to set prompt; don't offer default category. (todos-validate-category-name): Rename from todos-check-category-name; take into account whether there are already categories or not. (todos-read-date): Accept `*' as an unspecified month, day, or year. (todos-padded-string): Accommodate new structure of todos-categories as alists; use todos-categories-align. (todos-descending-counts-store): New variable. (todos-insert-category-line): Rename from todos-insert-category-name and reimplement using labels and todos-get-counts instead of properties; use todos-ignore-archived-categories; highlight sorted column. --- lisp/ChangeLog | 225 +++ lisp/calendar/todos.el | 3176 ++++++++++++++++++++++++++++------------ 2 files changed, 2501 insertions(+), 900 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index fc8bbbac000..db18c225cde 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,228 @@ +2012-09-18 Stephen Berman + + * calendar/todos.el Add and revise various doc strings, remove + further commented out code; add further comments; further code + rearrangement. + (todos-file-do, todos-archive-file, todos-mode-hook) + (todos-edit-mode-hook, todos-exclusion-start, todos-exclusion-end) + (todos-view-archive, todos-search-string) + (todos-jump-to-category-noninteractively, todos-initial-setup): + Remove. + (todos-files): Remove this defcustom. + (todos-initial-category, todos-display-categories-first) + (todos-auto-switch-todos-file, todos-default-todos-file) + (todos-categories-category-label, todos-categories-todo-label) + (todos-categories-diary-label, todos-categories-done-label) + (todos-categories-archived-label) + (todos-categories-number-separator, todos-categories-align) + (todos-ignore-archived-categories, todos-nondiary-marker): + New defcustoms. + (todos-prefix, todos-done-separator, todos-file-top) + (todos-categories-buffer, todos-archived-categories-buffer) + (todos-edit-buffer, todos-always-add-time-string, todos-button): + Change default value. + (todos-done-string): Add todos-reset-done-string as :set function, + but keep this commented out. + (todos-files, todos-archives, todos-insertion-map) + (todos-category-done, todos-nondiary-start, todos-nondiary-end) + (todos-show-done-only, todos-date-string-start) + (todos-done-string-start): New variables. + (todos-files-directory, todos-files-function, todos-merged-files) + (todos-prompt-merged-files, todos-files, todos-modes-set-1) + (todos-modes-set-2, todos-reset-done-string, todos-reset-categories) + (todos-toggle-switch-todos-file-noninteractively) + (todos-switch-todos-file, todos-counts, todos-get-count) + (todos-set-count, todos-set-categories) + (todos-truncate-categories-list, todos-update-categories-sexp) + (todos-read-file-name, todos-sort, todos-display-sorted) + (todos-label-to-key, todos-insert-sort-button): New functions. + (todos-display-categories-sorted-by-todo) + (todos-display-categories-sorted-by-diary) + (todos-display-categories-sorted-by-done) + (todos-display-categories-sorted-by-archived) + (todos-update-merged-files, todos-switch-to-archive) + (todos-choose-archive, todos-merged-top-priorities) + (todos-jump-to-category-other-file, todos-clear-matches) + (todos-add-file, todos-change-default-file, todos-move-category) + (todos-merge-category, todos-merge-categories) + (todos-edit-item-time, todos-move-item-to-file) + (todos-unarchive-category, todos-toggle-item-diary-nonmarking) + (todos-toggle-diary-nonmarking): New commands. + (todos-toggle-show-done-only): New command replacing todos-view-archive. + (todos-faces): New defgroup; use in all face definitions. + (todos-sorted-column, todos-archived-only, todos-search): New faces. + (todos-font-lock-keywords): Use subexpression 1 with matcher + todos-category-string-match. + (todos-mode-map, todos-archive-mode-map, todos-edit-mode-map) + (todos-categories-mode-map): Add new key bindings; change some + existing bindings. + (todos-top-priorities-mode-map): New keymap. + (todos-menu): Add submenues and new entries. + (auto-mode-alist): Add extension of Todos and Todos archive files. + (todos-mode, todos-archive-mode): Make derived mode; use + todos-modes-set-1, todos-modes-set-2, todos-auto-switch-todos-file + and todos-switch-todos-file; make todos-show-done-only local + variable. + (todos-edit-mode): Make derived mode; use todos-modes-set-1. + (todos-categories-mode): Make derived mode. + (todos-top-priorities-mode): New derived major mode. + (todos-save): Remove unused code. + (todos-quit): Handle todos-categories-mode; save archive buffer. + (todos-show): Add optional argument to prompt for a Todos file; if + called interactively or with prefix arg or from an archive, don't + make a no-op but reset todos-current-todos-file, todos-categories + and todos-category-number; use todos-read-file-name, + todos-display-categories-first, todos-ignore-archived-categories. + (todos-display-categories): Change argument name; refactor code + for inserting table labels and lines, using + todos-ignore-archived-categories, todos-sort, + todos-categories-number-separator, todos-insert-sort-button, + todos-categories-*-labels, and todos-insert-category-line. + (todos-display-categories-alphabetically): Use todos-display-sorted. + (todos-toggle-view-done-items): Use todos-done-string-start and + todos-get-count. + (todos-toggle-display-date-time): Use todos-done-string-start. + (todos-top-priorities): Remove autoload cookie; partially rewrite: + new argument list; allow combining top priorities of multiple + Todos files; change display to include category (and file) name as + part of item header; use todos-top-priorities-mode. + (todos-diary-items): Reimplement using only todos-top-priorities. + (todos-forward-category, todos-backward-category): Accommodate to + 1-based numbering of categories; move point to top of category. + (todos-jump-to-category): Rewrite, adding optional arguments to + provide a category in non-interactive uses and to prompt for which + Todos file to jump to. + (todos-search): Reimplement; highlight each match as found, say + how many matches remain and prompt whether to go to next one; at + end of search prompt whether to remove highlighting. + (todos-add-category): Remove autoload cookie; assign new category + the highest category number; associate zero-initialized vector of + item counts, instead of property list, with new category; use + todos-validate-category-name and todos-update-categories-sexp. + (todos-rename-category): Use todos-validate-category-name and + todos-update-categories-sexp; take archive files into account. + (todos-delete-category): Use todos-get-count and + todos-update-categories-sexp, let-bind variable that were + mistakenly global; use delete-region instead of kill-region; + accommodate to 1-based numbering of categories; move point to top + of category. + (todos-raise-category): Handle item count vectors; use + todos-insert-category-line and todos-update-categories-sexp. + (todos-insert-item): Use nil time-string argument to omit time + string; use todos-nondiary-start and todos-nondiary-end and + todos-update-categories-sexp; if category named to insert into + does not exist, add it; take new diary items into account. + (todos-insert-item-ask-date, todos-insert-item-ask-date-time) + (todos-insert-item-ask-date-time-for-diary) + (todos-insert-item-ask-date-time-for-diary-here) + (todos-insert-item-ask-date-time-here) + (todos-insert-item-ask-date-maybe-notime) + (todos-insert-item-ask-date-maybe-notime-for-diary) + (todos-insert-item-ask-date-maybe-notime-for-diary-here) + (todos-insert-item-ask-date-maybe-notime-here) + (todos-insert-item-ask-date-for-diary) + (todos-insert-item-ask-date-for-diary-here) + (todos-insert-item-ask-date-here, todos-insert-item-ask-dayname) + (todos-insert-item-ask-dayname-time) + (todos-insert-item-ask-dayname-time-for-diary) + (todos-insert-item-ask-dayname-time-for-diary-here) + (todos-insert-item-ask-dayname-time-here) + (todos-insert-item-ask-dayname-maybe-notime) + (todos-insert-item-ask-dayname-maybe-notime-for-diary) + (todos-insert-item-ask-dayname-maybe-notime-for-diary-here) + (todos-insert-item-ask-dayname-maybe-notime-here) + (todos-insert-item-ask-dayname-for-diary) + (todos-insert-item-ask-dayname-for-diary-here) + (todos-insert-item-ask-dayname-here, todos-insert-item-ask-time) + (todos-insert-item-ask-time-for-diary) + (todos-insert-item-ask-time-for-diary-here) + (todos-insert-item-ask-time-here) + (todos-insert-item-maybe-notime) + (todos-insert-item-maybe-notime-for-diary) + (todos-insert-item-maybe-notime-for-diary-here) + (todos-insert-item-maybe-notime-here) + (todos-insert-item-for-diary, todos-insert-item-for-diary-here): + New insertion commands. + (todos-insert-item-from-calendar): Use todos-current-todos-file. + (todos-delete-item): Handle diary items; + use todos-update-categories-sexp. + (todos-edit-item): Check if point is with item string; + use read-string instead of read-from-minibuffer; + use todos-date-string-start; after editing put point at start of + item text. + (todos-edit-multiline): Narrow to item before invoking + todos-edit-mode; show key binding of todos-edit-quit in a message. + (todos-edit-quit): Use todos-save; kill buffer. + (todos-edit-item-header): Add optional argument to prompt for + editing only date string or only time string; + use todos-date-string-start. + (todos-edit-item-date, todos-edit-item-date-is-today) + (todos-raise-item-priority, todos-lower-item-priority): Rename + from todos-{raise, lower}-item and make them DTRT in + todos-top-priorities-mode. + (todos-set-item-priority): Make interactive; use todos-get-count + and todos-insert-with-overlays; interactively, just relocate the + item within its category. + (todos-move-item): Add optional argument to prompt for a category + in another Todos file; handle diary items; fix restoration after + cancelling before inserting. + (todos-item-done): Handle diary items; simplify handling of + insertion in done items section. + (todos-item-undo): Handle diary items. + (todos-archive-done-items): Accommodate to new handling of archive + files (in parallel with Todos files); handle diary items; use + todos-done-string-start. + (todos-toggle-item-diary-inclusion): Use todos-nondiary-start, + todos-nondiary-end and todos-item-counts. + (todos-toggle-diary-inclusion): Use todos-category-done instead of + todos-category-end. + (todos-print): Remove autoload cookie; rewrite to make overlays, + line wrapping and wrap prefixes printable. + (todos-date-pattern): Make parenthesized groups shy. + (todos-date-string-match): Use todos-date-string-start; make + todos-date-pattern an explicitly numbered group. + (todos-time-string-match): Use todos-date-string-start. + (todos-done-string-match): Use todos-done-string-start. + (todos-category-string-match): Rewrite to match new category and + category+filename patterns in todos-top-priorities-mode. + (todos-prefix-overlays): Use todos-done-string-start and + todos-category-done. + (todos-reset-prefix): Handle archive files; restore point after + changing prefix. + (todos-reset-separator): Handle archive files. + (todos-category-number): Make category number one more than its + list index. + (todos-current-category): Accommodate to 1-based numbering of + categories. + (todos-category-select): Simplify handling of done items and done + separator string overlay. + (todos-item-start): Use todos-date-string-start and + todos-done-string-start. + (todos-item-start, todos-item-end): Fix wrong parenthesizing. + (todos-item-string): Restore point after getting item bounds; use + buffer-substring-no-properties. + (todos-done-item-p): Use todos-done-string-start. + (todos-make-categories-list): Add optional argument to force + looping through file to get categories and their item counts, + otherwise set todos-categories from sexp in first line; use + vectors of item counts instead of plists; count diary items. + (todos-item-counts): Use todos-counts, todos-set-counts, + todos-get-counts, and todos-update-categories-sexp instead of + getting and setting properties; handle diary items. + (todos-read-category): Add argument to set prompt; don't offer + default category. + (todos-validate-category-name): Rename from + todos-check-category-name; take into account whether there are + already categories or not. + (todos-read-date): Accept `*' as an unspecified month, day, or year. + (todos-padded-string): Accommodate new structure of + todos-categories as alists; use todos-categories-align. + (todos-descending-counts-store): New variable. + (todos-insert-category-line): Rename from + todos-insert-category-name and reimplement using labels and + todos-get-counts instead of properties; use + todos-ignore-archived-categories; highlight sorted column. + 2012-09-14 Stephen Berman * calendar/todos.el Remove lots of commented out code; add various diff --git a/lisp/calendar/todos.el b/lisp/calendar/todos.el index 427056e6e26..5d9c9561669 100644 --- a/lisp/calendar/todos.el +++ b/lisp/calendar/todos.el @@ -264,12 +264,23 @@ ;;; Customizable options (defgroup todos nil - "Maintain lists of todo items." + "Maintain categorized lists of todo items." :link '(emacs-commentary-link "todos") - :version "21.1" + :version "24.1" :group 'calendar) -(defcustom todos-prefix "§" ; "*/*" FIXME ascii default +;; FIXME: need this? +(defcustom todos-initial-category "Todo" + "Default category name offered on initializing a new Todos file." + :type 'string + :group 'todos) + +(defcustom todos-display-categories-first nil + "Non-nil to display category list on first visit to a Todos file." + :type 'boolean + :group 'todos) + +(defcustom todos-prefix "" "String prefixed to todo items for visual distinction." :type 'string :initialize 'custom-initialize-default @@ -277,14 +288,16 @@ :group 'todos) (defcustom todos-number-prefix t - "Non-nil to show item prefixes as consecutively increasing integers." + "Non-nil to show item prefixes as consecutively increasing integers. +These reflect the priorities of the items in each category." :type 'boolean :initialize 'custom-initialize-default :set 'todos-reset-prefix :group 'todos) -;; FIXME: length (window-width) causes problems. Also, bad when window-width changes -(defcustom todos-done-separator (make-string (1- (window-width)) ?-) +;; FIXME: Update when window-width changes (add todos-reset-separator to +;; window-configuration-change-hook in todos-mode?) +(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 @@ -296,7 +309,7 @@ Displayed in a before-string overlay by `todos-toggle-view-done-items'." "Identifying string appended to the front of done todos items." :type 'string ;; :initialize 'custom-initialize-default - ;; :set + ;; :set 'todos-reset-done-string :group 'todos) (defcustom todos-show-with-done nil @@ -304,75 +317,142 @@ Displayed in a before-string overlay by `todos-toggle-view-done-items'." :type 'boolean :group 'todos) -;; FIXME: use user-emacs-directory here and below -(defcustom todos-file-do (convert-standard-filename "~/.emacs.d/.todos-do") - "TODO mode list file." - :type 'file +(defcustom todos-files-directory (locate-user-emacs-file "todos/") + "Directory where user's Todos files are saved." + :type 'directory :group 'todos) -(defcustom todos-files '((convert-standard-filename "~/.emacs.d/.todos")) - "List of Todos files." - :type 'list +(defun todos-files (&optional archives) + "Default value of `todos-files-function'. +This returns the case-insensitive alphabetically sorted list of +files in `todos-files-directory' with the extension \".todo\". +With non-nil ARCHIVES return the list of archive files." + (sort (directory-files todos-files-directory t + (if archives "\.toda$" "\.todo$") t) + (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'. +If this function is called with an optional non-nil argument, +then it returns the value of the variable `todos-archives'." + :type 'function :group 'todos) -(defcustom todos-archive-file (convert-standard-filename "~/.emacs.d/.todos-archive") - "File of finished Todos categories." - :type 'file +(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-mode-hook nil - "TODO mode hooks." - :type 'hook +(defcustom todos-prompt-merged-files nil + "Non-nil to prompt for merging files for `todos-top-priorities'." + :type 'boolean + :group 'todos) + +(defcustom todos-auto-switch-todos-file nil ;FIXME: t by default? + "Non-nil to make a Todos file current upon changing to it." + :type 'boolean + :initialize 'custom-initialize-default + :set 'todos-toggle-switch-todos-file-noninteractively + :group 'todos) + +(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-edit-mode-hook nil - "TODO Edit mode hooks." - :type 'hook +;; FIXME: make a defvar instead of a defcustom, and one for each member of todos-file +(defcustom todos-file-top "~/todos.todt" ;FIXME + "TODO mode top priorities file." + :type 'file :group 'todos) -(defcustom todos-categories-buffer "*TODOS Categories*" +(defcustom todos-categories-buffer "*Todos Categories*" "Name of buffer displayed by `todos-display-categories'." :type 'string :group 'todos) -(defcustom todos-archived-categories-buffer "*TODOS Archived Categories*" - "Name of buffer displayed by `todos-display-categories'." +(defcustom todos-categories-category-label "Category" + "Category button label in `todos-categories-buffer'." :type 'string :group 'todos) -(defcustom todos-edit-buffer " *TODO Edit*" - "TODO Edit buffer name." +(defcustom todos-categories-todo-label "Todo" + "Todo button label in `todos-categories-buffer'." :type 'string :group 'todos) -(defcustom todos-file-top (convert-standard-filename "~/.todos-top") - "TODO mode top priorities file. +(defcustom todos-categories-diary-label "Diary" + "Diary button label in `todos-categories-buffer'." + :type 'string + :group 'todos) -Not in TODO format, but diary compatible. -Automatically generated when `todos-save-top-priorities' is non-nil." +(defcustom todos-categories-done-label "Done" + "Done button label in `todos-categories-buffer'." :type 'string :group 'todos) -(defcustom todos-include-in-diary nil - "Non-nil to allow new Todo items to be included in the diary." +(defcustom todos-categories-archived-label "Archived" + "Archived button label in `todos-categories-buffer'." + :type 'string + :group 'todos) + +(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) + +(defcustom todos-categories-align 'center + "" + :type '(radio (const left) (const center) (const right)) + :group 'todos) + +;; FIXME: set for each Todos file? +(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' +and hence from commands that use this variable. An exception is +\\[todos-display-categories], which displays all categories; but +those with only archived items are shown in `todos-archived-only' +face and clicking them in Todos Categories mode visits the +archived categories." :type 'boolean + :initialize 'custom-initialize-default + :set 'todos-reset-categories :group 'todos) -(defcustom todos-exclusion-start "[" - "String prepended to item date to block diary inclusion." +(defcustom todos-archived-categories-buffer "*Todos Archived Categories*" + "Name of buffer displayed by `todos-display-categories'." :type 'string - :group 'todos - ;; :initialize 'custom-initialize-default - ;; :set ; change in whole Todos file - ) + :group 'todos) -(defcustom todos-exclusion-end "]" - "String appended to item date to match `todos-exclusion-start'." +(defcustom todos-edit-buffer "*Todos Edit*" + "TODO Edit buffer name." :type 'string + :group 'todos) + +(defcustom todos-include-in-diary nil + "Non-nil to allow new Todo items to be included in the diary." + :type 'boolean + :group 'todos) + +(defcustom todos-nondiary-marker '("[" "]") + "List of strings surrounding item date to block diary inclusion. +The first string is inserted before the item date and must be a +non-empty string that does not match a diary date in order to +have its intended effect. The second string is inserted after +the diary date." + :type '(list string string) :group 'todos - ;; :initialize 'custom-initialize-default - ;; :set ; change in whole Todos file - ) + :initialize 'custom-initialize-default + :set 'todos-reset-nondiary-marker) (defcustom todos-print-function 'ps-print-buffer-with-faces "Function to print the current buffer." @@ -401,8 +481,12 @@ Automatically generated when `todos-save-top-priorities' is non-nil." :type 'boolean :group 'todos) -(defcustom todos-always-add-time-string t - "Add current time to date string inserted in front of new items." +(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\" +argument, this reverses the effect of +`todos-always-add-time-string': if t, these commands omit the +current time, if nil, they include it." :type 'boolean :group 'todos) @@ -424,26 +508,52 @@ Automatically generated when `todos-save-top-priorities' is non-nil." ;; --------------------------------------------------------------------------- ;;; Faces +(defgroup todos-faces nil + "Faces for the Todos modes." + :version "24.1" + :group 'todos) + (defface todos-prefix-string '((t :inherit font-lock-constant-face )) "Face for Todos prefix string." - :group 'todos) + :group 'todos-faces) (defface todos-button '((t - :inherit tool-bar + :inherit widget-field )) "Face for buttons in todos-display-categories." - :group 'todos) + :group 'todos-faces) + +(defface todos-sorted-column + '((t + :inherit fringe + )) + "Face for buttons in todos-display-categories." + :group 'todos-faces) + +(defface todos-archived-only + '((t + (:inherit (shadow)) + )) + "Face for archived-only categories in todos-display-categories." + :group 'todos-faces) + +(defface todos-search + '((t + :inherit match + )) + "Face for matches found by todos-search." + :group 'todos-faces) (defface todos-date '((t :inherit diary )) "Face for Todos prefix string." - :group 'todos) + :group 'todos-faces) (defvar todos-date-face 'todos-date) (defface todos-time @@ -451,7 +561,7 @@ Automatically generated when `todos-save-top-priorities' is non-nil." :inherit diary-time )) "Face for Todos prefix string." - :group 'todos) + :group 'todos-faces) (defvar todos-time-face 'todos-time) (defface todos-done @@ -459,7 +569,7 @@ Automatically generated when `todos-save-top-priorities' is non-nil." :inherit font-lock-comment-face )) "Face for done Todos item header string." - :group 'todos) + :group 'todos-faces) (defvar todos-done-face 'todos-done) (defface todos-done-sep @@ -467,7 +577,7 @@ Automatically generated when `todos-save-top-priorities' is non-nil." :inherit font-lock-type-face )) "Face for separator string bewteen done and not done Todos items." - :group 'todos) + :group 'todos-faces) (defvar todos-done-sep-face 'todos-done-sep) (defvar todos-font-lock-keywords @@ -475,63 +585,117 @@ Automatically generated when `todos-save-top-priorities' is non-nil." '(todos-date-string-match 1 todos-date-face t) '(todos-time-string-match 1 todos-time-face t) '(todos-done-string-match 0 todos-done-face t) - '(todos-category-string-match 0 todos-done-sep-face t)) + '(todos-category-string-match 1 todos-done-sep-face t)) "Font-locking for Todos mode.") ;; --------------------------------------------------------------------------- -;;; Mode setup +;;; Modes setup -(defvar todos-current-todos-file nil - "") +(defvar todos-files (funcall todos-files-function) + "List of user's Todos files.") + +(defvar todos-archives (funcall todos-files-function t) + "List of user's Todos archives.") (defvar todos-categories nil - "TODO categories.") + "List of categories in the current Todos file. +The elements are lists whose car is a category name and whose cdr +is the category's property list.") + +(defvar todos-insertion-map + (let ((map (make-keymap))) + (define-key map "i" 'todos-insert-item) + (define-key map "h" 'todos-insert-item-here) + (define-key map "dd" 'todos-insert-item-ask-date) + (define-key map "dtt" 'todos-insert-item-ask-date-time) + (define-key map "dtyy" 'todos-insert-item-ask-date-time-for-diary) + (define-key map "dtyh" 'todos-insert-item-ask-date-time-for-diary-here) + (define-key map "dth" 'todos-insert-item-ask-date-time-here) + (define-key map "dmm" 'todos-insert-item-ask-date-maybe-notime) + (define-key map "dmyy" 'todos-insert-item-ask-date-maybe-notime-for-diary) + (define-key map "dmyh" 'todos-insert-item-ask-date-maybe-notime-for-diary-here) + (define-key map "dmh" 'todos-insert-item-ask-date-maybe-notime-here) + (define-key map "dyy" 'todos-insert-item-ask-date-for-diary) + (define-key map "dyh" 'todos-insert-item-ask-date-for-diary-here) + (define-key map "dh" 'todos-insert-item-ask-date-here) + (define-key map "nn" 'todos-insert-item-ask-dayname) + (define-key map "ntt" 'todos-insert-item-ask-dayname-time) + (define-key map "ntyy" 'todos-insert-item-ask-dayname-time-for-diary) + (define-key map "ntyh" 'todos-insert-item-ask-dayname-time-for-diary-here) + (define-key map "nth" 'todos-insert-item-ask-dayname-time-here) + (define-key map "nmm" 'todos-insert-item-ask-dayname-maybe-notime) + (define-key map "nmyy" 'todos-insert-item-ask-dayname-maybe-notime-for-diary) + (define-key map "nmyh" 'todos-insert-item-ask-dayname-maybe-notime-for-diary-here) + (define-key map "nmh" 'todos-insert-item-ask-dayname-maybe-notime-here) + (define-key map "nyy" 'todos-insert-item-ask-dayname-for-diary) + (define-key map "nyh" 'todos-insert-item-ask-dayname-for-diary-here) + (define-key map "nh" 'todos-insert-item-ask-dayname-here) + (define-key map "tt" 'todos-insert-item-ask-time) + (define-key map "tyy" 'todos-insert-item-ask-time-for-diary) + (define-key map "tyh" 'todos-insert-item-ask-time-for-diary-here) + (define-key map "th" 'todos-insert-item-ask-time-here) + (define-key map "mm" 'todos-insert-item-maybe-notime) + (define-key map "myy" 'todos-insert-item-maybe-notime-for-diary) + (define-key map "myh" 'todos-insert-item-maybe-notime-for-diary-here) + (define-key map "mh" 'todos-insert-item-maybe-notime-here) + (define-key map "yy" 'todos-insert-item-for-diary) + (define-key map "yh" 'todos-insert-item-for-diary-here) + map) + "Keymap for Todos mode insertion commands.") (defvar todos-mode-map (let ((map (make-keymap))) (suppress-keymap map t) ;; navigation commands - (define-key map "+" 'todos-forward-category) - (define-key map "-" 'todos-backward-category) + (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) ;; display commands - (define-key map "C" 'todos-display-categories) + (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 "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 "V" 'todos-toggle-show-done-only) + (define-key map "Av" 'todos-view-archived-items) + (define-key map "As" 'todos-switch-to-archive) + (define-key map "Ac" 'todos-choose-archive) (define-key map "Y" 'todos-diary-items) - ;; (define-key map "S" 'todos-save-top-priorities) (define-key map "t" 'todos-top-priorities) + (define-key map "T" 'todos-merged-top-priorities) + ;; (define-key map "" 'todos-save-top-priorities) ;; editing commands - (define-key map "A" 'todos-add-category) + (define-key map "Fa" 'todos-add-file) + (define-key map "Ca" 'todos-add-category) + (define-key map "Cr" 'todos-rename-category) + (define-key map "Cm" 'todos-move-category) + (define-key map "Ck" 'todos-delete-category) (define-key map "d" 'todos-item-done) - ;; (define-key map "" 'todos-archive-done-items) - (define-key map "D" 'todos-delete-category) - (define-key map "e" 'todos-edit-item) - (define-key map "E" 'todos-edit-multiline) - ;; (define-key map "" 'todos-change-date) - (define-key map "ii" 'todos-insert-item) - (define-key map "ih" 'todos-insert-item-here) - (define-key map "ia" 'todos-insert-item-ask-date-time) - (define-key map "id" 'todos-insert-item-for-diary) - ;; (define-key map "in" 'todos-insert-item-no-time) + (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 "et" 'todos-edit-item-time) + (define-key map "i" todos-insertion-map) (define-key map "k" 'todos-delete-item) - (define-key map "l" 'todos-lower-item) (define-key map "m" 'todos-move-item) - (define-key map "r" 'todos-raise-item) - (define-key map "R" 'todos-rename-category) + (define-key map "M" 'todos-move-item-to-file) + (define-key map "-" 'todos-raise-item-priority) + (define-key map "+" '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-items) (define-key map "y" 'todos-toggle-item-diary-inclusion) ;; (define-key map "" 'todos-toggle-diary-inclusion) + (define-key map "s" 'todos-save) + (define-key map "q" 'todos-quit) (define-key map [remap newline] 'newline-and-indent) map) "Todos mode keymap.") @@ -540,26 +704,28 @@ Automatically generated when `todos-save-top-priorities' is non-nil." (let ((map (make-sparse-keymap))) (suppress-keymap map t) ;; navigation commands - (define-key map "+" 'todos-forward-category) - (define-key map "-" 'todos-backward-category) + (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 "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-category) map) "Todos Archive mode keymap.") (defvar todos-edit-mode-map (let ((map (make-sparse-keymap))) - (define-key map "\C-c\C-q" 'todos-edit-quit) + (define-key map "\C-x\C-q" 'todos-edit-quit) (define-key map [remap newline] 'newline-and-indent) map) "Todos Edit mode keymap.") @@ -569,146 +735,218 @@ Automatically generated when `todos-save-top-priorities' is non-nil." (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 "r" 'todos-raise-category) - (define-key map "q" 'bury-buffer) ;FIXME ? + (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.") -(defvar todos-category-number 0 "TODO category number.") +(defvar todos-top-priorities-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.") + +(defvar todos-current-todos-file nil + "Variable holding the name of the currently active Todos file. +Automatically set by `todos-switch-todos-file'.") + +(defvar todos-category-number 0 + "Number.") (defvar todos-tmp-buffer-name " *todo tmp*") (defvar todos-category-beg "--==-- " - "Category start separator to be prepended onto category name.") - -(easy-menu-define todos-menu todos-mode-map "Todo Menu" - '("Todo" - ["Next category" todos-forward-category t] - ["Previous category" todos-backward-category t] - ["Jump to category" todos-jump-to-category t] - ["Show top priority items" todos-top-priorities t] - ["Print categories" todos-print t] - "---" - ["Edit item" todos-edit-item t] - ["File item" todos-file-item t] - ["Insert new item" todos-insert-item t] - ["Insert item here" todos-insert-item-here t] - ["Kill item" todos-delete-item t] - "---" - ["Lower item priority" todos-lower-item t] - ["Raise item priority" todos-raise-item t] - "---" - ["Next item" todos-forward-item t] - ["Previous item" todos-backward-item t] - "---" - ["Save" todos-save t] - ["Save Top Priorities" todos-save-top-priorities t] - "---" - ["Quit" todos-quit t] - )) - -;; As calendar reads .todos-do before todos-mode is loaded. -;;;###autoload -(defun todos-mode () - "Major mode for displaying, navigating and editing Todo lists. + "String marking beginning of category (inserted with its name).") + +(defvar todos-category-done "==--== DONE " + "String marking beginning of category's done items.") + +(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'.") + +(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-category 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-toggle-diary-inclusion t] + ["Mark & Hide Done Item" todos-item-done t] + ["Archive Done Items" todos-archive-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] + )) -\\{todos-mode-map}" - (interactive) - (kill-all-local-variables) - (setq major-mode 'todos-mode) - (setq mode-name "TODOS") - (use-local-map todos-mode-map) - (easy-menu-add todos-menu) +;; 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)) - (make-local-variable 'indent-line-function) - (setq indent-line-function 'todos-indent) - (make-local-variable 'font-lock-defaults) - (setq font-lock-defaults '(todos-font-lock-keywords t)) - (make-local-variable 'hl-line-range-function) - (setq hl-line-range-function - (lambda() (when (todos-item-end) - (cons (todos-item-start) (todos-item-end))))) - ;; (add-hook 'post-command-hook 'todos-show-paren-hack nil t) +) + +(defun todos-modes-set-2 () + "" (add-to-invisibility-spec 'todos) (setq buffer-read-only t) - (run-mode-hooks 'todos-mode-hook)) + (set (make-local-variable 'hl-line-range-function) + (lambda() (when (todos-item-end) + (cons (todos-item-start) (todos-item-end))))) +) + +;; ;; As calendar reads included Todos file before todos-mode is loaded. +;; ;;;###autoload +(define-derived-mode todos-mode nil "Todos" () + "Major mode for displaying, navigating and editing Todo lists. -(defun todos-archive-mode () +\\{todos-mode-map}" + (easy-menu-add todos-menu) + (todos-modes-set-1) + (todos-modes-set-2) + (set (make-local-variable 'todos-show-done-only) nil) + (when todos-auto-switch-todos-file + (add-hook 'post-command-hook + 'todos-switch-todos-file nil t))) + +(define-derived-mode todos-archive-mode nil "Todos-Arch" () "Major mode for archived Todos categories. \\{todos-archive-mode-map}" - (interactive) - (kill-all-local-variables) - (setq major-mode 'todos-archive-mode) - (setq mode-name "TODOS Archive") - (use-local-map todos-archive-mode-map) - ;; (easy-menu-add todos-menu) - (when todos-wrap-lines (funcall todos-line-wrapping-function)) - (make-local-variable 'font-lock-defaults) - (setq font-lock-defaults '(todos-font-lock-keywords t)) - (make-local-variable 'hl-line-range-function) - (setq hl-line-range-function - (lambda() (when (todos-item-end) - (cons (todos-item-start) (todos-item-end))))) - ;; (add-hook 'post-command-hook 'todos-show-paren-hack nil t) - (add-to-invisibility-spec 'todos) - (run-mode-hooks 'todos-mode-hook)) - -(defun todos-edit-mode () + (todos-modes-set-1) + (todos-modes-set-2) + (set (make-local-variable 'todos-show-done-only) t) + (when todos-auto-switch-todos-file + (add-hook 'post-command-hook + 'todos-switch-todos-file nil t))) + +(define-derived-mode todos-edit-mode nil "Todos-Ed" () "Major mode for editing multiline Todo items. \\{todos-edit-mode-map}" - (interactive) - (setq major-mode 'todos-edit-mode) - (setq mode-name "TODOS Edit") - (use-local-map todos-edit-mode-map) - (make-local-variable 'font-lock-defaults) - (setq font-lock-defaults '(todos-font-lock-keywords t)) - (make-local-variable 'indent-line-function) - (setq indent-line-function 'todos-indent) - (when todos-wrap-lines (funcall todos-line-wrapping-function))) + (todos-modes-set-1)) -(defun todos-categories-mode () +(define-derived-mode todos-categories-mode nil "Todos-Cats" () "Major mode for displaying and editing Todos categories. \\{todos-categories-mode-map}" - (interactive) - (setq major-mode 'todos-categories-mode) - (setq mode-name "TODOS Categories") - (use-local-map todos-categories-mode-map) (make-local-variable 'font-lock-defaults) (setq font-lock-defaults '(todos-font-lock-keywords t)) - (setq buffer-read-only t) -) + (setq buffer-read-only t)) + +(define-derived-mode todos-top-priorities-mode nil "Todos-Top" () + "Mode for displaying and reprioritizing top priority Todos. + +\\{todos-top-priorites-mode-map}" + (todos-modes-set-1) + (todos-modes-set-2)) (defun todos-save () "Save the TODO list." (interactive) - (let (buffer-read-only) - (save-excursion - (save-restriction - ;; (widen) - ;; (goto-char (point-min)) - ;; (unless (looking-at (concat "^" (regexp-quote todos-category-beg))) - ;; (kill-line)) - ;; (prin1 todos-categories (current-buffer)) - (save-buffer))) - ;; (if todos-save-top-priorities-too (todos-save-top-priorities))) - )) + ;; (todos-update-categories-sexp) + (save-buffer) + ;; (if todos-save-top-priorities-too (todos-save-top-priorities)) + ) (defun todos-quit () "Done with TODO list for now." (interactive) - (widen) - (todos-save) - ;; (message "") - (if (eq major-mode 'todos-archive-mode) - (todos-show) - (bury-buffer))) + (cond ((eq major-mode 'todos-categories-mode) + (kill-buffer) + (setq todos-descending-counts-store nil) + (setq todos-categories nil) + (todos-show)) + ((member major-mode (list 'todos-mode 'todos-archive-mode)) + (todos-save) + (bury-buffer)))) ;; --------------------------------------------------------------------------- ;;; Commands @@ -716,72 +954,133 @@ Automatically generated when `todos-save-top-priorities' is non-nil." ;;; Display ;;;###autoload -(defun todos-show () - "Show TODO list." - (interactive) - ;; Make this a no-op if called interactively in narrowed Todos mode, since - ;; it is in that case redundant, but in particular to work around the bug of - ;; item prefix reduplication with show-paren-mode enabled. - (unless (and (called-interactively-p) - (eq major-mode 'todos-mode) - (< (- ( point-max) (point-min)) (buffer-size))) - ;; Call todos-initial-setup only if there is neither a Todo file nor - ;; a corresponding unsaved buffer. - (if (or (file-exists-p todos-file-do) - (let* ((buf (get-buffer (file-name-nondirectory todos-file-do))) - (bufname (buffer-file-name buf))) - (equal (expand-file-name todos-file-do) bufname))) - (find-file todos-file-do) - (todos-initial-setup)) - (unless (eq major-mode 'todos-mode) (todos-mode)) - (unless (string= todos-current-todos-file todos-file-do) - (setq todos-current-todos-file todos-file-do) - (setq todos-category-number 0) - (setq todos-categories nil)) - (unless todos-categories - (setq todos-categories (todos-make-categories-list))) - (save-excursion - (todos-category-select)))) - -(defun todos-display-categories (&optional alpha) - "Display a numbered list of the Todos category names. -The numbers give the order of the categories. - -With non-nil ALPHA display a non-numbered alphabetical list. +(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 whichever Todos file has been made +current (e.g. by calling `todos-switch-todos-file'). + +The category displayed is initially the first member of +`todos-categories' for the current Todos file, subsequently +whichever category is current. 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") + ;; ;; Make this a no-op if called interactively in narrowed Todos mode, since + ;; ;; it is redundant in that case, but in particular to work around the bug of + ;; ;; item prefix reduplication with show-paren-mode enabled. + ;; (unless (and (called-interactively-p) + ;; (or (eq major-mode 'todos-mode) (eq major-mode 'todos-archive-mode)) + ;; (< (- ( point-max) (point-min)) (buffer-size))) + (when (and (called-interactively-p) + (or solicit-file + (member todos-current-todos-file todos-archives))) + (setq todos-current-todos-file nil + todos-categories nil + todos-category-number 0)) + (let ((first-visit (or (not todos-current-todos-file) ;first call + ;; after switching to a not yet visited Todos file + (not (buffer-live-p + (get-file-buffer todos-current-todos-file)))))) + (if solicit-file + (setq todos-current-todos-file + (todos-read-file-name "Select a Todos file to visit: ")) + (or todos-current-todos-file + (setq todos-current-todos-file (or todos-default-todos-file + (todos-add-file))))) + (if (and first-visit todos-display-categories-first) + (todos-display-categories) + (find-file todos-current-todos-file) + ;; (or (eq major-mode 'todos-mode) (todos-mode)) + ;; initialize new Todos file + (if (zerop (buffer-size)) + (setq todos-category-number (todos-add-category)) + ;; FIXME: let user choose category? + (if (zerop todos-category-number) (setq todos-category-number 1))) + (or todos-categories + (setq todos-categories (if todos-ignore-archived-categories + (todos-truncate-categories-list) + (todos-make-categories-list)))) + (save-excursion (todos-category-select)))));) + +;; FIXME: make core of this internal? +(defun todos-display-categories (&optional sortkey) + "Display the category names of the current Todos file. +The numbers indicate the current order of the categories. + +With non-nil SORTKEY display a non-numbered alphabetical list. The lists are in Todos Categories mode. The category names are buttonized, and pressing a button displays the category in Todos mode." (interactive) - (let ((categories (copy-sequence todos-categories)) - (num 0)) - (when alpha ;alphabetize the list case insensitively - (setq categories (sort categories (lambda (s1 s2) (let ((cis1 (upcase s1)) - (cis2 (upcase s2))) - (string< cis1 cis2)))))) + (let* ((cats0 (if (and todos-ignore-archived-categories + (not (eq major-mode 'todos-categories-mode))) + (todos-make-categories-list t) + todos-categories)) + (cats (todos-sort cats0 sortkey)) + ;; used by todos-insert-category-line + (num 0)) (with-current-buffer (get-buffer-create todos-categories-buffer) (switch-to-buffer (current-buffer)) (let (buffer-read-only) (erase-buffer) (kill-all-local-variables) - (insert "Press a button to display the corresponding category.\n\n") - ;; FIXME: abstract format from here and todos-insert-category-name - (insert (make-string 4 32) (todos-padded-string "Category") - (if (string= todos-current-todos-file todos-archive-file) - (concat (make-string 6 32) - (format "%s" "Archived")) - (concat (make-string 7 32) - (format "%-7s%-7s%s" "Todo" "Done" "Archived"))) - "\n\n") + (insert (format "Category counts for Todos file \"%s\"." + (file-name-sans-extension + (file-name-nondirectory todos-current-todos-file)))) + (newline 2) + ;; FIXME: abstract format from here and todos-insert-category-line + (insert (make-string (+ 3 (length todos-categories-number-separator)) 32)) (save-excursion - (mapc '(lambda (cat) (todos-insert-category-name cat alpha)) categories))) - (goto-char (next-single-char-property-change (point) 'button)) + (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) + (mapc (lambda (cat) (todos-insert-category-line cat sortkey)) + (mapcar 'car cats)))) (todos-categories-mode)))) +;; FIXME: make this toggle with todos-display-categories (defun todos-display-categories-alphabetically () "" (interactive) - (todos-display-categories t)) + (todos-display-sorted 'alpha)) + +;; FIXME: provide key bindings for these or delete them +(defun todos-display-categories-sorted-by-todo () + "" + (interactive) + (todos-display-sorted 'todo)) + +(defun todos-display-categories-sorted-by-diary () + "" + (interactive) + (todos-display-sorted 'diary)) + +(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 () "" @@ -793,84 +1092,69 @@ the category in Todos mode." (interactive) (save-excursion (goto-char (point-min)) - (let* ((todos-show-with-done - (if (re-search-forward (concat "\n\\(\\[" - (regexp-quote todos-done-string) - "\\)") nil t) - nil - t)) - (cat (todos-current-category)) - (catsym (intern-soft (concat "todos-" cat)))) + (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 (get catsym 'done)) + (when (zerop (todos-get-count 'done cat)) (message "There are no done items in this category."))))) -(defun todos-view-archive (&optional cat) +(defun todos-toggle-show-done-only () "" (interactive) - (if (file-exists-p todos-archive-file) - (progn ;let ((todos-show-with-done t)) - (find-file todos-archive-file) + (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"))) + (find-file afile) (todos-archive-mode) - (unless (string= todos-current-todos-file todos-archive-file) - (setq todos-current-todos-file todos-archive-file) + (unless (string= todos-current-todos-file afile) + (setq todos-current-todos-file afile) (setq todos-categories nil)) (unless todos-categories (setq todos-categories (todos-make-categories-list))) - (if cat - (if (member cat (todos-categories)) - (progn - (setq todos-category-number - (- (length todos-categories) - (length (member cat todos-categories)))) - (todos-jump-to-category-noninteractively cat)) - (message "No archived items from this category")) - (setq todos-category-number 0) - (todos-category-select))) - (message "There is currently no Todos archive"))) - -;; FIXME: slow -(defun todos-diary-items () - "Display all todo items marked for diary inclusion." - (interactive) - (let ((bufname "*Todo diary entries*") - opoint) - (save-restriction - (save-current-buffer - (widen) - (copy-to-buffer bufname (point-min) (point-max)))) - (with-current-buffer bufname - (goto-char (point-min)) - (while (not (eobp)) - (setq opoint (point)) - (cond ((looking-at "\\[") - (progn - (todos-forward-item) - (if (string-match - (concat "^" (regexp-quote todos-category-beg) ".*$") - (buffer-substring opoint (point))) - (kill-region opoint (+ opoint (match-beginning 0))) - (kill-region opoint (point))))) - ((looking-at "^$") - (kill-line)) - (t - (todos-forward-item)))) - (goto-char (point-min)) - (while (not (eobp)) - (setq opoint (point)) - (if (looking-at (regexp-quote todos-category-beg)) - (when (progn (forward-line) - (or (looking-at (regexp-quote todos-category-beg)) - ;; category has done but no unfinished items - (and (looking-at "^$") (forward-line)) - (eobp))) - (kill-region opoint (point))) - (forward-line))) - (make-local-variable 'font-lock-defaults) - (setq font-lock-defaults '(todos-font-lock-keywords t)) - (font-lock-fontify-buffer) - (setq buffer-read-only t)) - (display-buffer bufname))) + (setq todos-category-number + (- (length todos-categories) + (length (member cat todos-categories)))) ;FIXME + (todos-jump-to-category cat))))) + +(defun todos-switch-to-archive (&optional ask) + "Visit the archive of the current Todos file, if it exists. +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) + (concat tfile-base ".toda")))) + (if (not (file-exists-p afile)) + (message "There is currently no Todos archive for this file.") + (find-file afile) + (todos-archive-mode) + (unless (string= todos-current-todos-file afile) + (setq todos-current-todos-file afile) + (setq todos-categories nil)) + (unless todos-categories + (setq todos-categories (todos-make-categories-list)) + (setq todos-category-number 1)) + (todos-category-select)))) + +(defun todos-choose-archive () + "Choose an archive and visit it." + (interactive) + (todos-switch-to-archive t)) (defun todos-highlight-item () "Highlight the todo item the cursor is on." @@ -895,7 +1179,7 @@ the category in Todos mode." (setq ovs (cdr ovs)))) (if hidden (remove-overlays (point-min) (point-max) 'display "") (while (not (eobp)) - (re-search-forward (concat "^\\[?" todos-date-pattern + (re-search-forward (concat todos-date-string-start todos-date-pattern "\\( " diary-time-regexp "\\)?\\]? ") ; FIXME: this space in header? ^ nil t) @@ -903,107 +1187,186 @@ the category in Todos mode." (setq ov (make-overlay (match-beginning 0) (match-end 0) nil t)) (overlay-put ov 'display "") (forward-line)))))) - -;;;###autoload -(defun todos-top-priorities (&optional nof-priorities category-pr-page show-done) - "List top priorities for each category. -Number of entries for each category is given by NOF-PRIORITIES which -defaults to \'todos-show-priorities\'. - -If CATEGORY-PR-PAGE is non-nil, a page separator \'^L\' is inserted -between each category. - -With non-nil SHOW-DONE, include done items in the listing." +(defun todos-update-merged-files () + "" + (interactive) + (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)) + +(defun todos-top-priorities (&optional num merge) ;FIXME: rename b/c of diary items + "List top priorities for each category. - (interactive "P") - (or nof-priorities (setq nof-priorities todos-show-priorities)) - (if (listp nof-priorities) ;universal argument - (setq nof-priorities (car nof-priorities))) +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." + (interactive "p") + (or num (setq num todos-show-priorities)) (let ((todos-print-buffer-name todos-tmp-buffer-name) - (todos-category-break (if category-pr-page " " "")) - beg end done) - (save-excursion - (todos-show)) - (save-restriction - (save-current-buffer - (widen) - (if (buffer-live-p (get-buffer todos-print-buffer-name)) - (kill-buffer todos-print-buffer-name)) - (copy-to-buffer todos-print-buffer-name (point-min) (point-max)))) - (with-current-buffer todos-print-buffer-name - (goto-char (point-min)) - (while (re-search-forward ;Find category start - (concat "^" (regexp-quote todos-category-beg)) - nil t) - (setq beg (+ (line-end-position) 1)) ;Start of first entry. - (setq end (if (re-search-forward todos-category-beg nil t) + (files (list todos-current-todos-file)) + file bufstr cat beg end done) + (when merge + (if (or todos-prompt-merged-files (null todos-merged-files)) + (todos-update-merged-files)) + (setq files todos-merged-files)) + (if (buffer-live-p (get-buffer todos-print-buffer-name)) + (kill-buffer todos-print-buffer-name)) + (save-current-buffer + (dolist (f files) + (find-file f) + (todos-switch-todos-file) + (setq file (file-name-sans-extension + (file-name-nondirectory todos-current-todos-file))) + (with-current-buffer (get-file-buffer f) + (save-restriction + (widen) + (setq bufstr (buffer-string)))) + (with-temp-buffer + (insert bufstr) + (goto-char (point-min)) + (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)) + (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) - (point-max))) - (goto-char beg) - (setq done - (if (re-search-forward - (concat - (if (looking-at "^$") "" "\n") ; no unfinished items - "\n\\(\\[" (regexp-quote todos-done-string) "\\)") - end t) - (match-beginning 1) - end)) - (unless show-done - (delete-region done end) - (setq end done)) - (narrow-to-region beg end) ;In case we have too few entries. - (goto-char (point-min)) - (if (zerop nof-priorities) ;Traverse entries. - (goto-char end) ;All entries - (todos-forward-item nof-priorities)) - (setq beg (point)) - (delete-region beg end) - (widen)) - (and (looking-at " ") (replace-match "")) ;Remove trailing form-feed. + end)) + (delete-region done end) + (setq end done) + (narrow-to-region beg end) ;In case we have too few entries. + (goto-char (point-min)) + (cond ((< num 0) ; get only diary items + (while (not (eobp)) + (if (looking-at (regexp-quote todos-nondiary-start)) + (todos-remove-item) + (todos-forward-item)))) + ((zerop num) ; keep all items + (goto-char end)) + (t + (todos-forward-item num))) + (setq beg (point)) + (if (>= num 0) (delete-region beg end)) + (goto-char (point-min)) + (while (not (eobp)) + (when (re-search-forward (concat todos-date-string-start + todos-date-pattern + "\\( " diary-time-regexp "\\)?\\]?") + nil t) + (insert (concat " [" (if merge (concat file ":")) cat "]"))) + (forward-line)) + (widen)) + (append-to-buffer todos-print-buffer-name (point-min) (point-max))))) + (with-current-buffer todos-print-buffer-name + (todos-prefix-overlays) + (todos-top-priorities-mode) (goto-char (point-min)) ;Due to display buffer - (make-local-variable 'font-lock-defaults) - (setq font-lock-defaults '(todos-font-lock-keywords t)) - (font-lock-fontify-buffer) - (setq buffer-read-only t)) + ;; (make-local-variable 'font-lock-defaults) + ;; (setq font-lock-defaults '(todos-font-lock-keywords t)) + (font-lock-fontify-buffer)) + ;; (setq buffer-read-only t)) ;; Could have used switch-to-buffer as it has a norecord argument, ;; which is nice when we are called from e.g. todos-print. ;; Else we could have used pop-to-buffer. - ;; (display-buffer todos-print-buffer-name) (display-buffer todos-print-buffer-name) (message "Type C-x 1 to remove %s window. M-C-v to scroll the help." todos-print-buffer-name))) +(defun todos-merged-top-priorities (&optional num) + "" + (interactive "p") + (todos-top-priorities num t)) + +(defun todos-diary-items (&optional merge) + "Display todo items marked for diary inclusion. +The items are those in the current Todos file, or with prefix +argument MERGE those in all Todos files in `todos-merged-files'." + (interactive "P") + (todos-top-priorities -1 merge)) + ;;; Navigation (defun todos-forward-category () "Go forward to TODO list of next category." (interactive) (setq todos-category-number - (mod (1+ todos-category-number) (length todos-categories))) - (todos-category-select)) + (1+ (mod todos-category-number (length todos-categories)))) + (todos-category-select) + (goto-char (point-min))) (defun todos-backward-category () "Go back to TODO list of previous category." (interactive) (setq todos-category-number - (mod (1- todos-category-number) (length todos-categories))) - (todos-category-select)) + (1+ (mod (- todos-category-number 2) (length todos-categories)))) + (todos-category-select) + (goto-char (point-min))) ;; FIXME: Document that a non-existing name creates that category, and add ;; y-or-n-p confirmation -- or eliminate this possibility? -(defun todos-jump-to-category () - "Jump to a category. Default is previous category." +(defun todos-jump-to-category (&optional cat other-file) + "Jump to a category in a Todos file. +When called interactively, prompt for the category. +Non-interactively, the argument CAT provides the category. With +non-nil argument OTHER-FILE, prompt for a Todos file, otherwise +stay with the current Todos file. See also +`todos-jump-to-category-other-file'." (interactive) - (let ((category (todos-read-category))) + (when (or (and other-file + (setq todos-current-todos-file + (todos-read-file-name "Choose a Todos file: "))) + (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))) + (setq todos-current-todos-file + (concat (file-name-sans-extension todos-current-todos-file) + ".toda")))) + (with-current-buffer (find-file-noselect todos-current-todos-file) + ;; (or (eq major-mode 'todos-mode) (todos-mode)) + (setq todos-categories (todos-make-categories-list)))) + (let ((category (or (and (assoc cat todos-categories) cat) + (todos-read-category "Jump to category: ")))) (if (string= "" category) (setq category (todos-current-category))) + (if (string= (buffer-name) todos-categories-buffer) + (kill-buffer)) + (if (or cat other-file) + (switch-to-buffer (get-file-buffer todos-current-todos-file))) (setq todos-category-number - (if (member category todos-categories) - (- (length todos-categories) - (length (member category todos-categories))) - (todos-add-category category))) - (todos-category-select))) + (or (todos-category-number category) + (todos-add-category category))) + (todos-category-select) + (goto-char (point-min)))) + +(defun todos-jump-to-category-other-file () + "" + (interactive) + (todos-jump-to-category nil t)) ;; FIXME ? todos-{backward,forward}-item skip over empty line between done and ;; not done items (but todos-forward-item gets there when done items are not @@ -1024,126 +1387,201 @@ With non-nil SHOW-DONE, include done items in the listing." (goto-char (match-beginning 0)) (goto-char (point-max)))) -;; FIXME: continue search with same regexp -(defvar todos-search-string nil - "" - ) (defun todos-search () - "" + "Perform a search for a regular expression, with repetition. +The search encompasses all todo and done items within the current Todos file; it excludes category names. Matches are highlighted +" (interactive) (let ((regex (read-from-minibuffer "Enter a search string (regexp): ")) - (start (point)) - found cat in-done) + (opoint (point)) + matches match cat in-done ov mlen msg) (widen) (goto-char (point-min)) - (while (and (setq found (re-search-forward regex nil t)) - (save-excursion - (goto-char (line-beginning-position)) - (looking-at (concat "^" (regexp-quote todos-category-beg))))) + (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)) - (if found - (progn - (setq found (match-beginning 0)) ;FIXME: ok if looking-at returns nil? - (todos-item-start) - (when (looking-at (concat "^\\[" (regexp-quote todos-done-string))) - (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) - (when in-done (unless todos-show-with-done (todos-toggle-view-done-items))) - (goto-char found)) + (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 start) - (message "No match for \"%s\"" regex)))) + (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-clear-matches () + "Removing highlighting on matches found by todos-search." + (interactive) + (remove-overlays 1 (1+ (buffer-size)) 'face 'todos-search)) ;;; Editing -;;;###autoload +(defun todos-add-file (&optional arg) + "" + (interactive "p") + (let ((default-file (if todos-default-todos-file + (file-name-sans-extension + (file-name-nondirectory todos-default-todos-file)))) + file prompt) + (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)))) + (if (or (not default-file) + (yes-or-no-p (concat "Make %s new default Todos file " + "[current default is \"%s\"]? ") + file default-file)) + (todos-change-default-file file) + (message "\"%s\" remains the default Todos file." default-file)) + (with-current-buffer (get-buffer-create todos-default-todos-file) + (erase-buffer) + (write-region (point-min) (point-max) todos-default-todos-file + nil 'nomessage nil t)) + (if arg (todos-show) file))) + +;; FIXME: omit this and just use defcustom? +(defun todos-change-default-file (&optional file) + "" + (interactive) + (let ((new-default (or file + (todos-read-file-name "Choose new default Todos file: ")))) + (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))))) + (defun todos-add-category (&optional cat) "Add new category CAT to the TODO list." (interactive) - (let ((buffer-read-only) - (buf (find-file-noselect todos-file-do t)) - catsym) + (let* ((buffer-read-only) + (buf (find-file-noselect todos-current-todos-file t)) + (num (1+ (length todos-categories))) + (counts (make-vector 4 0))) ; [todo diary done archived] + ;; (counts (list 'todo 0 'diary 0 'done 0 'archived 0))) (unless (zerop (buffer-size buf)) (and (null todos-categories) (error "Error in %s: File is non-empty but contains no category" - todos-file-do))) - (unless cat (setq cat (read-from-minibuffer "Category: "))) + todos-current-todos-file))) + (unless cat (setq cat (read-from-minibuffer "Enter new category name: "))) (with-current-buffer buf - (setq cat (todos-check-category-name cat)) - ;; initialize a newly created Todo buffer for Todo mode - (unless (file-exists-p todos-file-do) (todos-mode)) - (setq catsym (intern (concat "todos-" cat))) - (setplist catsym (list 'todo 0 'done 0 'archived 0)) - (nconc todos-categories (list cat)) ;FIXME: is this TRTD? + (setq cat (todos-validate-category-name cat)) + (setq todos-categories (append todos-categories (list (cons cat counts)))) (widen) - ;; FIXME: make this (point-max) - (goto-char (point-min)) - ;; make sure file does not begin with empty lines (shouldn't, but may be - ;; added by mistake), otherwise new categories will contain them, so - ;; won't be really empty - (while (looking-at "^$") (kill-line)) - (insert todos-category-beg cat "\n") - (if (interactive-p) + (goto-char (point-max)) + (save-excursion ; for subsequent todos-category-select + (insert todos-category-beg cat "\n\n" todos-category-done "\n")) + (todos-update-categories-sexp) + (if (called-interactively-p 'any) ; FIXME ;; properly display the newly added category - (progn (setq todos-category-number (1- (length todos-categories))) - (todos-category-select)) - (1- (length todos-categories)))))) + (progn + (setq todos-category-number num) + (todos-category-select)) + num)))) (defun todos-rename-category () "Rename current Todos category." (interactive) - (let* ((buffer-read-only) - (cat (todos-current-category)) - (vec (vconcat todos-categories)) + (let* ((cat (todos-current-category)) (new (read-from-minibuffer (format "Rename category \"%s\" to: " cat)))) - (setq new (todos-check-category-name new)) - (aset vec todos-category-number new) - (setq todos-categories (append vec nil)) - (save-excursion - (widen) - (re-search-backward (concat (regexp-quote todos-category-beg) "\\(" - (regexp-quote cat) "\\)\n") nil t) - (replace-match new t t nil 1) - (goto-char (point-min)) - (setq mode-line-buffer-identification (concat "Category: " new)))) - (todos-category-select)) + (setq new (todos-validate-category-name new)) + (let* ((ofile (buffer-file-name)) + (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 (if (string= buf archive) + ;; (todos-make-categories-list t) + ;; 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 + (format "Category %d: %s" todos-category-number new))) + (save-excursion (todos-category-select))) +;; FIXME: what if cat has archived items? (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 entries." (interactive "P") (let* ((cat (todos-current-category)) - (catsym (intern-soft (concat "todos-" cat))) - (todo (get catsym 'todo)) - (done (get catsym 'done)) - beg end) - (if (and (null arg) + (todo (todos-get-count 'todo cat)) + (done (todos-get-count 'done cat))) + (if (and (not arg) (or (> todo 0) (> done 0))) (message "To delete a non-empty category, type C-u D.") (when (y-or-n-p (concat "Permanently remove category \"" cat "\"" (and arg " and all its entries") "? ")) - (let ((buffer-read-only)) - (widen) - (setq beg (re-search-backward (concat "^" (regexp-quote todos-category-beg) - cat "\n") nil t)) - (setq end (if (re-search-forward (concat "\n\\(" - (regexp-quote todos-category-beg) - ".*\n\\)") nil t) - (match-beginning 1) - (point-max))) + (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) - (kill-region beg end) - (setq todos-categories (delete cat todos-categories)) - (setplist catsym nil) - (unintern catsym) + (delete-region beg end) + (setq todos-categories (delete (assoc cat todos-categories) + todos-categories)) + (todos-update-categories-sexp) (setq todos-category-number - (mod todos-category-number (length todos-categories))) + (1+ (mod todos-category-number (length todos-categories)))) (todos-category-select) + (goto-char (point-min)) (message "Deleted category %s" cat)))))) (defun todos-raise-category (&optional lower) @@ -1164,19 +1602,23 @@ With non-nil argument LOWER, lower the category's priority." (num2 (1+ num1)) (end (progn (forward-line 2) (point))) (catvec (vconcat todos-categories)) - (cat1 (aref catvec num1)) - (cat2 (aref catvec num2)) + (cat1-list (aref catvec num1)) + (cat2-list (aref catvec num2)) + (cat1 (car cat1-list)) + (cat2 (car cat2-list)) (buffer-read-only)) (delete-region beg end) - (setq num1 (1+ num1) - num2 (1- num2)) + (setq num1 (1+ num1)) + (setq num2 (1- num2)) (setq num num2) - (todos-insert-category-name cat2) + (todos-insert-category-line cat2) (setq num num1) - (todos-insert-category-name cat1) - (aset catvec num2 cat2) - (aset catvec num1 cat1) + (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)) + (with-current-buffer (get-file-buffer todos-current-todos-file) + (todos-update-categories-sexp)) (forward-line (if lower -1 -2)) (forward-char col))))) @@ -1185,6 +1627,152 @@ With non-nil argument LOWER, lower the category's priority." (interactive) (todos-raise-category t)) +;; FIXME: use save-restriction? +(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) + ;; FIXME: warn if only category in file? If so, delete file after moving category + (when (or (> (length todos-categories) 1) + (y-or-n-p (concat "This is the only category in this file; " + "moving it will delete the file.\n" + "Do you want to proceed? "))) + (let* ((ofile (buffer-file-name)) + (cat (todos-current-category)) + ;; FIXME: check if cat exists in nfile, and if so rename it + (nfile (todos-read-file-name "Choose a 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) + (save-excursion + (save-restriction + (widen) + (goto-char (point-max)) + (let ((buffer-read-only nil) + (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))) + (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 (buffer-read-only) + (save-excursion + (save-restriction + (widen) + (goto-char (point-max)) + (insert content) + (goto-char (point-min)) + (if (zerop (buffer-size)) + (progn + (set-buffer-modified-p nil) ; no questions + (delete-file (buffer-file-name)) + (kill-buffer)) + (unless (looking-at + (concat "^" (regexp-quote todos-category-beg))) + (kill-whole-line)) + (save-buffer))))) + (remove-overlays beg end) + (delete-region beg end) + (goto-char (point-min)) + (if (zerop (buffer-size)) + (progn + (set-buffer-modified-p nil) + (delete-file (buffer-file-name)) + (kill-buffer)) + (unless (looking-at + (concat "^" (regexp-quote todos-category-beg))) + (kill-whole-line)) + (save-buffer)))))))) + ;; (todos-switch-todos-file nfile)))) + (find-file nfile) + (setq todos-current-todos-file nfile + todos-categories (todos-make-categories-list t) + todos-category-number (todos-category-number cat)) + (todos-category-select)))) + +(defun todos-merge-category () + "Merge this category's items to another category in this file. +The todo and done items are appended to the todo and done items, +respectively, of the category merged to, which becomes the +current category, and the category merged from is deleted." + (interactive) + (let ((buffer-read-only nil) + (cat (todos-current-category)) + (goal (todos-read-category "Category to merge to: "))) + (widen) + ;; FIXME: what if cat has archived items? + (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) + (match-beginning 0))) + (tend (forward-line -1)) + (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 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) + (setq todos-categories (delete (assoc cat todos-categories) + todos-categories)) + (todos-update-categories-sexp) + (setq todos-category-number (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)))) + +(defun todos-merge-categories () + "" + (interactive) + (let* ((cats (mapcar 'car todos-categories)) + (goal (todos-read-category "Category to merge to: ")) + (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) + )) + ;;;###autoload (defun todos-insert-item (&optional arg date-type time diary here) "Insert new TODO list item. @@ -1216,6 +1804,7 @@ there." (interactive "P") (unless (or (todos-done-item-p) (save-excursion (forward-line -1) (todos-done-item-p))) + ;; FIXME: deletable if command not autoloaded (when (not (derived-mode-p 'todos-mode)) (todos-show)) (let* ((buffer-read-only) (date-string (cond @@ -1228,41 +1817,55 @@ there." (with-current-buffer "*Calendar*" (calendar-date-string (calendar-cursor-to-date t) t t))) (t (calendar-date-string (calendar-current-date) t t)))) - (time-string (cond ((eq time 'omit) nil) ;FIXME: delete - ((eq time 'ask-time) + (time-string (cond ((eq time 'ask-time) (todos-read-time)) (todos-always-add-time-string - (substring (current-time-string) 11 16)))) - (new-item (concat (unless (or diary todos-include-in-diary) "[") ;FIXME + (substring (current-time-string) 11 16)) + (t nil))) + (new-item (concat (unless (or diary todos-include-in-diary) + todos-nondiary-start) date-string (when time-string (concat " " time-string)) - ;; FIXME - (unless (or diary todos-include-in-diary) "]") " " + (unless (or diary todos-include-in-diary) + todos-nondiary-end) + " " (read-from-minibuffer "New TODO entry: "))) - (cat (if arg (todos-read-category) (todos-current-category)))) + (cat (if arg (todos-read-category "Insert item in category: ") + (todos-current-category)))) ;; 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)) - (unless here (todos-set-item-priority new-item cat)) - (todos-insert-with-overlays new-item) - (todos-item-counts cat 'insert)))) + (unless (assoc cat todos-categories) (todos-add-category cat)) + ;; (unless here (todos-set-item-priority new-item cat)) + ;; (todos-insert-with-overlays new-item) + (if here + (todos-insert-with-overlays new-item) + (todos-set-item-priority new-item cat)) + (todos-item-counts cat 'insert) + (if (or diary todos-include-in-diary) (todos-item-counts cat 'diary)) + (todos-update-categories-sexp)))) ;; FIXME: make insertion options customizable per category ;; current date ~ current day ~ ask date ~ ask day -;; current time ~ ask time ~ no time +;; current time ~ ask time ~ maybe no time ;; for diary ~ not for diary ;; here ~ ask priority -;; date-type: d n (c) - time - diary - here +;; date-type: date name (calendar) - (maybe-no)time - diary - here -;; ii todos-insert-item +;; ii todos-insert-item + current-date/dayname + current/no-time +;; ih todos-insert-item-here ;; idd todos-insert-item-ask-date ;; idtt todos-insert-item-ask-date-time ;; idtyy todos-insert-item-ask-date-time-for-diary ;; idtyh todos-insert-item-ask-date-time-for-diary-here ;; idth todos-insert-item-ask-date-time-here +;; idmm todos-insert-item-ask-date-maybe-notime +;; idmyy todos-insert-item-ask-date-maybe-notime-for-diary +;; idmyh todos-insert-item-ask-date-maybe-notime-for-diary-here +;; idmh todos-insert-item-ask-date-maybe-notime-here ;; idyy todos-insert-item-ask-date-for-diary ;; idyh todos-insert-item-ask-date-for-diary-here ;; idh todos-insert-item-ask-date-here @@ -1271,28 +1874,218 @@ there." ;; intyy todos-insert-item-ask-dayname-time-for-diary ;; intyh todos-insert-item-ask-dayname-time-for-diary-here ;; inth todos-insert-item-ask-dayname-time-here +;; inmm todos-insert-item-ask-dayname-maybe-notime +;; inmyy todos-insert-item-ask-dayname-maybe-notime-for-diary +;; inmyh todos-insert-item-ask-dayname-maybe-notime-for-diary-here +;; inmh todos-insert-item-ask-dayname-maybe-notime-here ;; inyy todos-insert-item-ask-dayname-for-diary ;; inyh todos-insert-item-ask-dayname-for-diary-here ;; inh todos-insert-item-ask-dayname-here -;; itt todos-insert-item-time -;; ityy todos-insert-item-time-for-diary -;; ityh todos-insert-item-time-for-diary-here -;; ith todos-insert-item-time-here +;; itt todos-insert-item-ask-time +;; ityy todos-insert-item-ask-time-for-diary +;; ityh todos-insert-item-ask-time-for-diary-here +;; ith todos-insert-item-ask-time-here +;; im todos-insert-item-maybe-notime +;; imyy todos-insert-item-maybe-notime-for-diary +;; imyh todos-insert-item-maybe-notime-for-diary-here +;; imh todos-insert-item-maybe-notime-here ;; iyy todos-insert-item-for-diary ;; iyh todos-insert-item-for-diary-here -;; ih todos-insert-item-here -(defun todos-insert-item-here () +(defun todos-insert-item-ask-date (&optional arg) "" - (interactive) - (todos-insert-item nil nil nil nil t)) + (interactive "P") + (todos-insert-item arg 'ask-date)) -;; FIXME: autoload when key-binding is defined in calendar.el -(defun todos-insert-item-from-calendar () +(defun todos-insert-item-ask-date-time (&optional arg) + "" + (interactive "P") + (todos-insert-item arg 'ask-date 'ask-time)) + +(defun todos-insert-item-ask-date-time-for-diary (&optional arg) + "" + (interactive "P") + (todos-insert-item arg 'ask-date 'ask-time t)) + +(defun todos-insert-item-ask-date-time-for-diary-here () + "" + (interactive) + (todos-insert-item nil 'ask-date 'ask-time t t)) + +(defun todos-insert-item-ask-date-time-here () + "" + (interactive) + (todos-insert-item nil 'ask-date 'ask-time nil t)) + +(defun todos-insert-item-ask-date-maybe-notime (&optional arg) + "" + (interactive "P") + (let ((todos-always-add-time-string (not todos-always-add-time-string))) + (todos-insert-item arg 'ask-date))) + +(defun todos-insert-item-ask-date-maybe-notime-for-diary (&optional arg) + "" + (interactive "P") + (let ((todos-always-add-time-string (not todos-always-add-time-string))) + (todos-insert-item arg 'ask-date nil t))) + +(defun todos-insert-item-ask-date-maybe-notime-for-diary-here () + "" + (interactive) + (let ((todos-always-add-time-string (not todos-always-add-time-string))) + (todos-insert-item nil 'ask-date nil t t))) + +(defun todos-insert-item-ask-date-maybe-notime-here () + "" + (interactive) + (let ((todos-always-add-time-string (not todos-always-add-time-string))) + (todos-insert-item nil 'ask-date nil nil nil t))) + +(defun todos-insert-item-ask-date-for-diary (&optional arg) + "" + (interactive "P") + (todos-insert-item arg 'ask-date nil t)) + +(defun todos-insert-item-ask-date-for-diary-here () + "" + (interactive) + (todos-insert-item nil 'ask-date nil t t)) + +(defun todos-insert-item-ask-date-here () + "" + (interactive) + (todos-insert-item nil 'ask-date nil nil t)) + +(defun todos-insert-item-ask-dayname (&optional arg) + "" + (interactive "P") + (todos-insert-item arg 'ask-dayname)) + +(defun todos-insert-item-ask-dayname-time (&optional arg) + "" + (interactive "P") + (todos-insert-item arg 'ask-dayname 'ask-time)) + +(defun todos-insert-item-ask-dayname-time-for-diary (&optional arg) + "" + (interactive "P") + (todos-insert-item arg 'ask-dayname 'ask-time t)) + +(defun todos-insert-item-ask-dayname-time-for-diary-here () + "" + (interactive) + (todos-insert-item nil 'ask-dayname 'ask-time t t)) + +(defun todos-insert-item-ask-dayname-time-here () + "" + (interactive) + (todos-insert-item nil 'ask-dayname 'ask-time nil t)) + +(defun todos-insert-item-ask-dayname-maybe-notime (&optional arg) + "" + (interactive "P") + (let ((todos-always-add-time-string (not todos-always-add-time-string))) + (todos-insert-item arg 'ask-dayname))) + +(defun todos-insert-item-ask-dayname-maybe-notime-for-diary (&optional arg) + "" + (interactive "P") + (let ((todos-always-add-time-string (not todos-always-add-time-string))) + (todos-insert-item arg 'ask-dayname nil t))) + +(defun todos-insert-item-ask-dayname-maybe-notime-for-diary-here () + "" + (interactive) + (let ((todos-always-add-time-string (not todos-always-add-time-string))) + (todos-insert-item nil 'ask-dayname nil t t))) + +(defun todos-insert-item-ask-dayname-maybe-notime-here () + "" + (interactive) + (let ((todos-always-add-time-string (not todos-always-add-time-string))) + (todos-insert-item nil 'ask-dayname nil nil t))) + +(defun todos-insert-item-ask-dayname-for-diary (&optional arg) + "" + (interactive "P") + (todos-insert-item arg 'ask-dayname nil t)) + +(defun todos-insert-item-ask-dayname-for-diary-here () + "" + (interactive) + (todos-insert-item nil 'ask-dayname nil t t)) + +(defun todos-insert-item-ask-dayname-here () + "" + (interactive) + (todos-insert-item nil 'ask-dayname nil nil t)) + +(defun todos-insert-item-ask-time (&optional arg) + "" + (interactive "P") + (todos-insert-item arg nil 'ask-time)) + +(defun todos-insert-item-ask-time-for-diary (&optional arg) + "" + (interactive "P") + (todos-insert-item arg nil 'ask-time t)) + +(defun todos-insert-item-ask-time-for-diary-here () + "" + (interactive) + (todos-insert-item nil nil 'ask-time t t)) + +(defun todos-insert-item-ask-time-here () + "" + (interactive) + (todos-insert-item nil nil 'ask-time nil t)) + +(defun todos-insert-item-maybe-notime (&optional arg) + "" + (interactive "P") + (let ((todos-always-add-time-string (not todos-always-add-time-string))) + (todos-insert-item arg))) + +(defun todos-insert-item-maybe-notime-for-diary (&optional arg) + "" + (interactive "P") + (let ((todos-always-add-time-string (not todos-always-add-time-string))) + (todos-insert-item arg nil nil t))) + +(defun todos-insert-item-maybe-notime-for-diary-here () + "" + (interactive) + (let ((todos-always-add-time-string (not todos-always-add-time-string))) + (todos-insert-item nil nil nil t t))) + +(defun todos-insert-item-maybe-notime-here () + "" + (interactive) + (let ((todos-always-add-time-string (not todos-always-add-time-string))) + (todos-insert-item nil nil nil nil t))) + +(defun todos-insert-item-for-diary (&optional arg) + "" + (interactive "P") + (todos-insert-item nil nil nil t)) + +(defun todos-insert-item-for-diary-here () + "" + (interactive) + (todos-insert-item nil nil nil t t)) + +(defun todos-insert-item-here () + "Insert new Todo item directly above the item at point. +If point is on an empty line, insert the new item there." + (interactive) + (todos-insert-item nil nil nil nil t)) + +;; FIXME: autoload when key-binding is defined in calendar.el +(defun todos-insert-item-from-calendar () "" (interactive) - (pop-to-buffer (file-name-nondirectory todos-file-do)) - (todos-show) ;FIXME: todos-category-select ? + (pop-to-buffer (file-name-nondirectory todos-current-todos-file)) + (todos-show) (todos-insert-item t 'calendar)) ;; FIXME: calendar is loaded before todos @@ -1305,39 +2098,53 @@ there." (interactive) (if (> (count-lines (point-min) (point-max)) 0) (let* ((buffer-read-only) - (todos-entry (todos-item-string-start)) - (todos-answer (y-or-n-p (concat "Permanently remove '" - todos-entry "'? ")))) - (when todos-answer + (item (todos-item-string-start)) + (diary-item (todos-diary-item-p)) + (cat (todos-current-category)) + (answer (y-or-n-p (concat "Permanently remove '" item "'? ")))) + (when answer (todos-remove-item) (when (and (bolp) (eolp) ;; not if last item was deleted (< (point-min) (point-max))) (todos-backward-item)) - (todos-item-counts (todos-current-category) 'delete) + (todos-item-counts cat 'delete) + (and diary-item (todos-item-counts cat 'nondiary)) + (todos-update-categories-sexp) (todos-prefix-overlays))) (message "No TODO list entry to delete"))) ;FIXME: better message (defun todos-edit-item () "Edit current TODO list entry." (interactive) - (let ((buffer-read-only) - (item (todos-item-string)) - (opoint (point))) - (if (todos-string-multiline-p item) - (todos-edit-multiline) - (let ((new (read-from-minibuffer "Edit: " item))) - (while (not (string-match (concat "^\\[?" 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))))) + (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)) + (opoint (point))) + (if (todos-string-multiline-p item) + (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) @@ -1347,30 +2154,72 @@ there." (let ((buffer-name (generate-new-buffer-name todos-edit-buffer))) (switch-to-buffer (make-indirect-buffer - (file-name-nondirectory todos-file-do) buffer-name)) - (message "To exit, simply kill this buffer and return to list.") + (file-name-nondirectory todos-current-todos-file) buffer-name)) + (narrow-to-region (todos-item-start) (todos-item-end)) (todos-edit-mode) - (narrow-to-region (todos-item-start) (todos-item-end)))) + (message "Type %s to return to Todos mode." + (key-description (car (where-is-internal 'todos-edit-quit)))))) (defun todos-edit-quit () "" (interactive) + (todos-save) + ;; (unlock-buffer) + (kill-buffer) (save-excursion (todos-category-select))) -;; FIXME: complete -(defun todos-edit-item-header () +(defun todos-edit-item-header (&optional part) "" (interactive) (todos-item-start) - (re-search-forward (concat "^\\[?\\(?1:" todos-date-pattern - "\\) \\(?2:" diary-time-regexp "\\)") + (re-search-forward (concat todos-date-string-start "\\(?1:" todos-date-pattern + "\\)\\(?2: " diary-time-regexp "\\)?") (line-end-position) t) - ;; ask date or dayname - (replace-match new-date nil nil nil 1) - ;; ask time - (replace-match new-date nil nil nil 2)) + (let* ((odate (match-string-no-properties 1)) + (otime (match-string-no-properties 2)) + (buffer-read-only) + ndate ntime nheader) + (unless (eq part 'timeonly) + (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 part 'dateonly) + (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))))) + +(defun todos-edit-item-date () + "" + (interactive) + (todos-edit-item-header 'dateonly)) + +(defun todos-edit-item-date-is-today () + "" + (interactive) + (todos-edit-item-header 'today)) + +(defun todos-edit-item-time () + "" + (interactive) + (todos-edit-item-header 'timeonly)) + +;; (progn +;; (re-search-forward "\\(?1:foo\\)\\(ba\\)\\(?2:z\\)?" nil t) +;; (goto-char (point-max)) +;; (concat (match-string-no-properties 1) ", " (match-string-no-properties 2))) + +;; foobaz + -(defun todos-raise-item () +(defun todos-raise-item-priority () "Raise priority of current entry." (interactive) (unless (or (todos-done-item-p) @@ -1378,17 +2227,35 @@ there." (let (buffer-read-only) (if (> (count-lines (point-min) (point)) 0) (let ((item (todos-item-string))) + (when (eq major-mode 'todos-top-priorities-mode) + (let ((cat1 (save-excursion + (re-search-forward + (concat todos-date-string-start todos-date-pattern + "\\( " diary-time-regexp + "\\)?\\]?\\(?1: \\[\\(.+:\\)?.+\\]\\)") + nil t) + (match-string 1))) + (cat2 (save-excursion + (todos-backward-item) + (re-search-forward + (concat todos-date-string-start todos-date-pattern + "\\( " diary-time-regexp + "\\)?\\]?\\(?1: \\[\\(.+:\\)?.+\\]\\)") + nil t) + (match-string 1)))) + (if (string= cat1 cat2) + (error "Cannot change item's priority in its category; do this in Todos mode")))) (todos-remove-item) (todos-backward-item) (todos-insert-with-overlays item)) (message "No TODO list entry to raise"))))) ;FIXME: better message -(defun todos-lower-item () +(defun todos-lower-item-priority () "Lower priority of current entry." (interactive) (unless (or (todos-done-item-p) (looking-at "^$")) ; between done and not done items - (let* ((buffer-read-only)) + (let (buffer-read-only) (if (save-excursion ;; can only lower non-final unfinished item (todos-forward-item) @@ -1396,118 +2263,162 @@ there." (not (todos-done-item-p)))) ;; Assume there is a final newline (let ((item (todos-item-string))) + (when (eq major-mode 'todos-top-priorities-mode) + (let ((cat1 (save-excursion + (re-search-forward + (concat todos-date-string-start todos-date-pattern + "\\( " diary-time-regexp + "\\)?\\]?\\(?1: \\[\\(.+:\\)?.+\\]\\)") + nil t) + (match-string 1))) + (cat2 (save-excursion + (todos-forward-item) + (re-search-forward + (concat todos-date-string-start todos-date-pattern + "\\( " diary-time-regexp + "\\)?\\]?\\(?1: \\[\\(.+:\\)?.+\\]\\)") + nil t) + (match-string 1)))) + (if (string= cat1 cat2) + (error "Cannot change item's priority in its category; do this in Todos mode")))) (todos-remove-item) (todos-forward-item) (when (todos-done-item-p) (forward-line -1)) (todos-insert-with-overlays item)) (message "No TODO list entry to lower"))))) ;FIXME: better message -(defun todos-move-item () +(defun todos-set-item-priority (item cat) + "Set priority of todo ITEM in category CAT and move item to suit." + (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 (1+ 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-set-item-top-priority () +;; "Set priority of item at point in the top priorities listing." +;; (interactive) +;; (let* ((item (todos-item-string)) +;; (cat (save-excursion +;; (re-search-forward +;; (concat todos-date-string-start todos-date-pattern +;; "\\( " diary-time-regexp +;; "\\)?\\]?\\(?1: \\[\\(.+:\\)?.+\\]\\)") +;; nil t) +;; (match-string 1))) +;; (opoint (point)) +;; (count 1) +;; (old-priority (save-excursion +;; (goto-char (point-min)) +;; (while (< (point) opoint) +;; (todos-forward-item) +;; (setq count (1+ count)))))) +;; ) + +(defun todos-move-item (&optional file) "Move the current todo item to another, interactively named, category. -If the named category is not one of the current todo categories, then -it is created and the item becomes the first entry in that category." +If the named category is not one of the current todo categories, +then it is created and the item becomes the first entry in that +category. + +With optional non-nil argument FILE, first ask for another Todos +file and then solicit a category within that file to move the +item to." (interactive) (unless (or (todos-done-item-p) (looking-at "^$")) ; between done and not done items (let ((buffer-read-only) + (modified (buffer-modified-p)) + (oldfile todos-current-todos-file) (oldnum todos-category-number) (oldcat (todos-current-category)) (item (todos-item-string)) - (newcat (todos-read-category)) + (diary-item (todos-diary-item-p)) + (newfile (if file (todos-read-file-name "Choose a Todos file: "))) (opoint (point)) (orig-mrk (progn (todos-item-start) (point-marker))) - moved) - (todos-remove-item) + newcat moved) (unwind-protect (progn - (unless (member newcat todos-categories) (todos-add-category newcat)) + (todos-remove-item) + (todos-item-counts oldcat 'delete) + (and diary-item (todos-item-counts oldcat 'nondiary)) + (when newfile + (find-file-existing newfile) + (setq todos-current-todos-file newfile + todos-categories (todos-make-categories-list))) + (setq newcat (todos-read-category "Move item to category: ")) + (unless (assoc newcat todos-categories) (todos-add-category newcat)) (todos-set-item-priority item newcat) - (todos-insert-with-overlays item) (setq moved t) - (todos-item-counts oldcat 'delete) - (todos-item-counts newcat 'insert)) + (todos-item-counts newcat 'insert) + (and diary-item (todos-item-counts newcat 'diary))) (unless moved + (if newfile + (find-file-existing oldfile) + (setq todos-current-todos-file oldfile + todos-categories (todos-make-categories-list))) (widen) (goto-char orig-mrk) (todos-insert-with-overlays item) (setq todos-category-number oldnum) + (todos-item-counts oldcat 'insert) + (and diary-item (todos-item-counts oldcat 'diary)) (todos-category-select) - ;; FIXME: does this work? + (set-buffer-modified-p modified) (goto-char opoint)) (set-marker orig-mrk nil))))) +(defun todos-move-item-to-file () + "" + (interactive) + (todos-move-item t)) + (defun todos-item-done () "Mark current item as done and move it to category's done section." (interactive) (unless (or (todos-done-item-p) (looking-at "^$")) (let* ((buffer-read-only) + (cat (todos-current-category)) (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)) "")) - (done-item (concat "[" todos-done-string date-string time-string "] " item)) - (items-end (point-max)) - next-cat) + ;; FIXME: todos-nondiary-* + (done-item (concat "[" todos-done-string date-string time-string "] " + item))) (todos-remove-item) (save-excursion (widen) - (setq next-cat - (save-excursion - (if (re-search-forward (concat "^" (regexp-quote todos-category-beg)) - nil t) - (match-beginning 0) - (point-max)))) - ;; insert next done item at the top of the done items list - (if (re-search-forward (concat "^\\[" (regexp-quote todos-done-string)) - next-cat t) - (goto-char (match-beginning 0)) - ;; need empty line between done and not done items in order not to have - ;; hanging todos-prefix when done items are hidden - (goto-char next-cat) - (newline)) - (todos-insert-with-overlays done-item))) - (todos-item-counts (todos-current-category) 'done) - (todos-category-select))) - -(defun todos-archive-done-items () - "Archive the done items in the current category." - (interactive) - (let ((archive (find-file-noselect todos-archive-file t)) - (cat (todos-current-category)) - (buffer-read-only) - beg end) - (save-excursion - (save-restriction - (widen) - (setq end (if (re-search-forward - (concat "^" (regexp-quote todos-category-beg)) nil t) - (match-beginning 0) - (point-max))) - (re-search-backward (concat "^" (regexp-quote todos-category-beg) - (regexp-quote cat)) - nil t) - (if (not (re-search-forward (concat "^\\[" (regexp-quote todos-done-string)) - nil t)) - (error "No done items in this category") - (setq beg (match-beginning 0)) - (setq done (buffer-substring beg end)) - ;; FIXME: update archive alist - (with-current-buffer archive - (goto-char (point-min)) - (if (re-search-forward (regexp-quote (concat "^" todos-category-beg cat)) - nil t) - (forward-char) - (insert todos-category-beg cat "\n")) - (insert done) - (save-buffer)) - (delete-region beg end) - (remove-overlays beg end) - (kill-line -1) - (todos-item-counts cat 'archive))))) - (message "Done items archived.")) + (re-search-forward (concat "^" (regexp-quote todos-category-done)) nil t) + (forward-char) + (todos-insert-with-overlays done-item)) + (todos-item-counts cat 'done) + (and diary-item (todos-item-counts cat 'nondiary)) + (save-excursion (todos-category-select))))) (defun todos-item-undo () "" @@ -1525,9 +2436,9 @@ it is created and the item becomes the first entry in that category." (unwind-protect (progn (todos-set-item-priority item cat) - (todos-insert-with-overlays item) (setq undone t) - (todos-item-counts cat 'undo)) + (todos-item-counts cat 'undo) + (and (todos-diary-item-p) (todos-item-counts cat 'diary))) (unless undone (widen) (goto-char orig-mrk) @@ -1537,6 +2448,101 @@ it is created and the item becomes the first entry in that category." (goto-char opoint))) (set-marker orig-mrk nil))))) +(defun todos-archive-done-items () + "Archive the done items in the current category." + (interactive) + (let ((cat (todos-current-category))) + (if (zerop (todos-get-count 'done cat)) + (message "No done items in this category") + (when (y-or-n-p "Move all done items in this category to the archive? ") + (let* ((afile (concat (file-name-sans-extension (buffer-file-name)) ".toda")) + (archive (find-file-noselect afile t)) + beg end + (buffer-read-only nil)) + (save-excursion + (save-restriction + (goto-char (point-min)) + (widen) + (setq beg (progn + (re-search-forward todos-done-string-start nil t) + (match-beginning 0))) + (setq end (if (re-search-forward + (concat "^" (regexp-quote todos-category-beg)) nil t) + (match-beginning 0) + (point-max))) + (setq done (buffer-substring beg end)) + (with-current-buffer archive + (let (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) + (insert todos-category-beg cat "\n\n" todos-category-done "\n")) + (insert done) + (save-buffer))) + (remove-overlays beg end) + (delete-region beg end) + (todos-item-counts cat 'archive))))) + (message "Done items archived.")))) + +(defun todos-unarchive-category () + "Restore this archived category to done items in Todos file." + (interactive) + (when (y-or-n-p "Restore all items in this category to Todos file as done items? ") + (let ((buffer-read-only nil) + (tbuf (find-file-noselect + (concat (file-name-sans-extension (buffer-file-name)) ".todo") + t)) + (cat (todos-current-category)) + (items (buffer-substring (point-min) (point-max)))) + (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))) + (insert items))) + (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)) + (goto-char (point-min)) + (if (re-search-forward + (concat "^" (regexp-quote todos-category-beg)) nil t) + (progn + ;; delete category from archive + (setq todos-categories (delete (assoc cat todos-categories) + todos-categories)) + (todos-update-categories-sexp)) + ;; no more categories in archive, so delete it + (set-buffer-modified-p nil) ; no questions + (delete-file (buffer-file-name)) + (kill-buffer)) + (let ((tfile (buffer-file-name tbuf)) + (todos-show-with-done t)) + (find-file tfile) + (setq todos-current-todos-file tfile + ;; also updates item counts + todos-categories (todos-make-categories-list t) + todos-category-number (todos-category-number cat)) + (todos-show) + (message "Items unarchived."))))) + (defun todos-toggle-item-diary-inclusion () "" (interactive) @@ -1546,16 +2552,19 @@ it is created and the item becomes the first entry in that category." (lim (save-excursion (todos-item-end))) (end (save-excursion (or (todos-time-string-match lim) - (todos-date-string-match lim))))) - (if (looking-at "\\[") ; FIXME use todos-exclusion-start + (todos-date-string-match lim)))) + (cat (todos-current-category))) + (if (looking-at (regexp-quote todos-nondiary-start)) (progn (replace-match "") - (search-forward "]" (1+ end) t) ; FIXME use todos-exclusion-end - (replace-match "")) + (search-forward todos-nondiary-end (1+ end) t) + (replace-match "") + (todos-item-counts cat 'nondiary)) (when end - (insert "[") ; FIXME use todos-exclusion-start + (insert todos-nondiary-start) (goto-char (1+ end)) - (insert "]")))))) ; FIXME use todos-exclusion-end + (insert todos-nondiary-end) + (todos-item-counts cat 'diary)))))) (defun todos-toggle-diary-inclusion (arg) "" @@ -1568,11 +2577,32 @@ it is created and the item becomes the first entry in that category." (when (eq arg 2) (re-search-forward (concat "^" (regexp-quote todos-category-beg)) nil t) (forward-line) - (when (looking-at (regexp-quote todos-category-end)) (forward-line))) + (when (looking-at (regexp-quote todos-category-done)) (forward-line))) (while (not (eobp)) (todos-toggle-item-diary-inclusion) (todos-forward-item)))))) +(defun todos-toggle-item-diary-nonmarking () + "" + (interactive) + (let ((buffer-read-only)) + (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 () + "" + (interactive) + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (todos-toggle-item-diary-nonmarking) + (todos-forward-item)))) + +;; FIXME: save to a file named according to the current todos file (defun todos-save-top-priorities (&optional nof-priorities) "Save top priorities for each category in `todos-file-top'. @@ -1587,62 +2617,110 @@ defaults to `todos-show-priorities'." (write-file todos-file-top) (kill-this-buffer))))) -;;;###autoload -(defun todos-print (&optional category-pr-page) - "Print todo summary using `todos-print-function'. -If CATEGORY-PR-PAGE is non-nil, a page separator `^L' is inserted -between each category. +;; ;;;###autoload +;; (defun todos-print (&optional category-pr-page) +;; "Print todo summary using `todos-print-function'. +;; If CATEGORY-PR-PAGE is non-nil, a page separator `^L' is inserted +;; between each category. -Number of entries for each category is given by `todos-print-priorities'." - (interactive "P") - (when (yes-or-no-p "Print Todos list? ") - (save-window-excursion - (save-excursion - (save-restriction - (todos-top-priorities todos-print-priorities - category-pr-page) - (set-buffer todos-tmp-buffer-name) - (and (funcall todos-print-function) - (kill-this-buffer)) - (message "Todo printing done.")))))) +;; Number of entries for each category is given by `todos-print-priorities'." +;; (interactive "P") +;; (when (yes-or-no-p "Print Todos list? ") +;; (save-window-excursion +;; (save-excursion +;; (save-restriction +;; (todos-top-priorities todos-print-priorities +;; category-pr-page) +;; (set-buffer todos-tmp-buffer-name) +;; (and (funcall todos-print-function) +;; (kill-this-buffer)) +;; (message "Todo printing done.")))))) + +(defun todos-print () + "" + (interactive) + (let ((buf (cond ((eq major-mode 'todos-mode) + (concat "Category: " (todos-current-category) " (" + (file-name-nondirectory todos-current-todos-file) ") ")) + ((eq major-mode 'todos-top-priorities-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))) + (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)) + (todos-forward-item)) + ;; FIXME: ask user to choose between sending to printer: + ;; (ps-print-buffer-with-faces) + ;; and printing to a file: + (ps-spool-buffer-with-faces) + ;; (write-file ) + ) + (kill-buffer buf))) ;; --------------------------------------------------------------------------- -;;; Internal functions +;;; Internals -(defvar todos-date-pattern +(defvar todos-date-pattern ;FIXME: start with "^" ? (let ((dayname (diary-name-pattern calendar-day-name-array nil t))) - (concat "\\(" dayname "\\|" + (concat "\\(?:" dayname "\\|" (let ((dayname) - (monthname (format "\\(%s\\|\\*\\)" + (monthname (format "\\(?:%s\\|\\*\\)" (diary-name-pattern calendar-month-name-array calendar-month-abbrev-array t))) - (month "\\([0-9]+\\|\\*\\)") - (day "\\([0-9]+\\|\\*\\)") - (year "-?\\([0-9]+\\|\\*\\)")) + (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 + (concat "^\\(" (regexp-quote todos-nondiary-start) "\\|" + (regexp-quote diary-nonmarking-symbol) "\\)?") ;FIXME: matches anything + "Regular expression matching part of item header before the date.") + +(defvar todos-done-string-start + (concat "^" (regexp-quote todos-nondiary-start) (regexp-quote todos-done-string)) + "Regular expression matching start of done item.") + +;; FIXME: rename these *-matcher (defun todos-date-string-match (lim) - "Find Todos date strings within LIM for font-locking." - (re-search-forward (concat "^\\[?" todos-date-pattern) lim t)) + "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-match (lim) - "Find Todos time strings within LIM for font-locking." - (re-search-forward (concat "^\\[?" todos-date-pattern - " \\(?1:" diary-time-regexp "\\)") lim t)) + "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-match (lim) - "Find Todos done headers within LIM for font-locking." - (re-search-forward (concat "^\\[" (regexp-quote todos-done-string) "[^][]+]") - lim t)) + "Search for Todos done headers within LIM for font-locking." + (re-search-forward (concat todos-done-string-start + "[^][]+]") + lim t)) (defun todos-category-string-match (lim) - "Find Todos category headers within LIM for font-locking." - (re-search-forward (concat "^" (regexp-quote todos-category-beg) ".*$") - lim t)) + "Search for Todos category headers within LIM for font-locking." + (if (eq major-mode 'todos-top-priorities-mode) + (re-search-forward + ;; (concat "^\\(?1:" (regexp-quote todos-category-beg) ".*\\)$") + (concat "\\(?:^\\[?" todos-date-pattern "\\(?: " diary-time-regexp + "\\)?\\]?\\) \\(?1:\\[.+\\]\\)") lim t))) (defun todos-check-format () "Signal an error if the current Todos file is ill-formatted." @@ -1694,19 +2772,22 @@ Number of entries for each category is given by `todos-print-priorities'." ;; if last not done item is multiline, then ;; todos-done-string-match skips empty line, so have ;; to look back. - (and (looking-at (concat "^\\[" (regexp-quote todos-done-string))) - (looking-back "\n\n")) + (and (looking-at ;; (concat "^\\[" (regexp-quote todos-done-string)) + 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))) (ov-pref (car ovs)) (val (when ov-pref (overlay-get ov-pref 'before-string)))) + ;; FIXME: is this possible? (when (and (> (length ovs) 1) (not (equal val prefix))) (setq ov-pref (cadr ovs))) (when (not (equal val prefix)) - ;; (delete-overlay ov-pref) ; why doesn't this work ??? + ;; (when ov-pref (delete-overlay ov-pref)) ; why doesn't this work ??? (remove-overlays (point) (point)); 'before-string val) ; or this ??? (setq ov-pref (make-overlay (point) (point))) (overlay-put ov-pref 'before-string prefix)))) @@ -1714,125 +2795,174 @@ Number of entries for each category is given by `todos-print-priorities'." (defun todos-reset-prefix (symbol value) "Set SYMBOL's value to VALUE, and ." ; FIXME - (let ((oldvalue (symbol-value symbol))) + (let ((oldvalue (symbol-value symbol)) + (files (append todos-files todos-archives))) (custom-set-default symbol value) (when (not (equal value oldvalue)) - (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 prefix setting (save-restriction does not help) - (todos-category-select))))) + (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)))))))) (defun todos-reset-separator (symbol value) "Set SYMBOL's value to VALUE, and ." ; FIXME - (let ((oldvalue (symbol-value symbol))) + (let ((oldvalue (symbol-value symbol)) + (files (append todos-files todos-archives))) (custom-set-default symbol value) (when (not (equal value oldvalue)) - (save-window-excursion - (todos-show) - (save-excursion - (goto-char (point-min)) - (when (re-search-forward (concat "^\\[" (regexp-quote todos-done-string)) - nil t) - (remove-overlays (point) (point)))) - ;; activate the prefix setting (save-restriction does not help) - (todos-category-select))))) + (dolist (f files) + (with-current-buffer (find-file-noselect f) + (save-window-excursion + (todos-show) + (save-excursion + (goto-char (point-min)) + (when (re-search-forward + ;; (concat "^\\[" (regexp-quote todos-done-string)) + todos-done-string-start nil t) + (remove-overlays (point) (point)))) + ;; activate the new setting (save-restriction does not help) + ;; FIXME: need to wrap in save-excursion ? + (todos-category-select))))))) + +(defun todos-reset-done-string (symbol value) + "Set SYMBOL's value to VALUE, and ." ; FIXME + ;; (let ((oldvalue (symbol-value symbol))) + ;; (custom-set-default symbol value) + ;; (when (not (equal value oldvalue)) + ;; (save-window-excursion + ;; (todos-show) + ;; (save-excursion + ;; (goto-char (point-min)) + ;; (when (re-search-forward ;; (concat "^\\[" (regexp-quote todos-done-string)) + ;; todos-done-string-start nil t) + ;; (remove-overlays (point) (point)))) + ;; ;; activate the new setting (save-restriction does not help) + ;; ;; FIXME: need to wrap in save-excursion ? + ;; (todos-category-select)))) + ) + +(defun todos-reset-categories (symbol value) + "Set SYMBOL's value to VALUE, and ." ; FIXME + (custom-set-default symbol value) + (save-window-excursion + (todos-show) + (setq todos-categories + (if value + (todos-truncate-categories-list) + ;; FIXME: with-current-buffer Todos + ;; file and update + ;; todos-categories-sexp + (todos-make-categories-list t))))) + ;; (save-excursion + ;; ;; activate the new setting (save-restriction does not help) + ;; ;; FIXME: need to wrap in save-excursion ? + ;; (todos-category-select))))) + +(defun todos-toggle-switch-todos-file-noninteractively (symbol value) + "" + (custom-set-default symbol value) + (if value + (add-hook 'post-command-hook + 'todos-switch-todos-file nil t) + (remove-hook 'post-command-hook + 'todos-switch-todos-file t))) + +(defun todos-switch-todos-file (&optional file) ;FIXME: need FILE? + "Make another Todos file the current Todos file. +Called by post-command-hook if `todos-auto-switch-todos-file' is +non-nil (and also in `todos-top-priorities'), it makes the +current buffer the current Todos file if it is visiting a Todos +file." + (let ((file (or file (buffer-file-name))) + (files (if todos-show-done-only ;FIXME: should only hold for + (funcall todos-files-function t) ; todos-archives + (funcall todos-files-function))) + cat) + (when (and (member file files) + (not (equal todos-current-todos-file file))) + ;; (let ((catbuf (get-buffer todos-categories-buffer))) + ;; (if catbuf (not (eq (other-buffer) catbuf))))) + (if todos-ignore-archived-categories + (progn + (setq todos-categories nil) + (setq todos-categories (todos-truncate-categories-list))) + (setq todos-categories (todos-make-categories-list))) + ;; if file is already in a buffer, redisplay the previous current category + (when (< (- (point-max) (point-min)) (buffer-size)) + (widen) + (when (re-search-backward (concat "^" (regexp-quote todos-category-beg) + "\\(.+\\)\n") nil t) + (setq cat (match-string-no-properties 1)) + (setq todos-category-number (todos-category-number cat)))) + (setq todos-current-todos-file file) + ;; (or todos-category-number (setq todos-category-number 1)) + ;; (if (zerop todos-category-number) (setq todos-category-number 1)) + (todos-show)))) -;; FIXME: should be defsubst? (defun todos-category-number (cat) "Set todos-category-number to index of CAT in todos-categories." - (setq todos-category-number (- (length todos-categories) - (length (member cat todos-categories))))) + (let ((categories (mapcar 'car todos-categories))) + (setq todos-category-number + (1+ (- (length categories) + (length (member cat categories))))))) + (defun todos-current-category () "Return the name of the current category." - (nth todos-category-number todos-categories)) + (car (nth (1- todos-category-number) todos-categories))) +;; FIXME: wrap in save-excursion (or else have to use todos-show in +;; e.g. todos-{forward, backward}-category) (defun todos-category-select () - "Make TODO mode display the current category correctly." - (let ((name (todos-current-category))) - (setq mode-line-buffer-identification (concat "Category: " name)) + "Display the current category correctly. + +With non-nil `todos-show-with-done' display the category's done +\(but not archived) items below the unfinished todo items; else +display just the todo items." + (let ((name (todos-current-category)) + cat-begin cat-end done-start done-sep-start done-end) (widen) (goto-char (point-min)) - (search-forward-regexp - (concat "^" (regexp-quote (concat todos-category-beg name)) - "$")) - (let ((begin (1+ (line-end-position))) - (end (if (re-search-forward (concat "^" todos-category-beg) nil t) - (match-beginning 0) - (point-max)))) - (narrow-to-region begin end) - (goto-char (point-min)))) - (todos-prefix-overlays) - (unless (eq major-mode 'todos-archive-mode) - ;; display or hide done items as per todos-show-with-done - (save-excursion + (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 + (concat (format "Category %d: %s" todos-category-number 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 end done-sep prefix ov-pref ov-done) - (setq done (match-beginning 1) - end (match-beginning 0)) - (if todos-show-with-done - (progn - (setq done-sep todos-done-separator) - (unless (string-match "^[[:space:]]*$" todos-done-separator) - (setq done-sep (propertize (concat todos-done-separator "\n") - 'face 'todos-done-sep)) - (setq prefix (propertize (concat (if todos-number-prefix - "1" - todos-prefix) " ") - 'face 'todos-prefix-string)) - ;; FIXME? Just deleting done-sep overlay results in bad - ;; display (except when stepping though in edebug) - (remove-overlays done done) - ;; must make separator overlay after making prefix overlay to get - ;; the order separator before prefix - (setq ov-pref (make-overlay done done) - ov-done (make-overlay done done)) - (overlay-put ov-pref 'before-string prefix) - (overlay-put ov-done 'before-string done-sep))) - (narrow-to-region (point-min) end))))))) - -(defun todos-set-item-priority (item cat) - "Set the priority of unfinished item ITEM in category CAT." - (todos-category-number cat) - (todos-category-select) - (let* ((catsym (intern-soft (concat "todos-" cat))) - (todo (get catsym 'todo)) - (maxnum (1+ todo)) - priority candidate prompt) - (unless (zerop todo) - (while (null 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))) - (goto-char (point-min)) - (unless (= priority 1) (todos-forward-item (1- priority)))))) - -(defun todos-jump-to-category-noninteractively (cat) - "" - ;; (let ((bufname (buffer-name))) - ;; (cond ((string= bufname todos-categories-buffer) - ;; (switch-to-buffer (file-name-nondirectory todos-file-do))) - ;; ((string= bufname todos-archived-categories-buffer) - ;; ;; FIXME: is pop-to-buffer better for this case? - ;; (switch-to-buffer (file-name-nondirectory todos-archive-file)))) - ;; (kill-buffer bufname)) - (switch-to-buffer (file-name-nondirectory todos-current-todos-file)) - (widen) - (goto-char (point-min)) - (todos-category-number cat) - (todos-category-select)) + (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)))) (defun todos-insert-with-overlays (item) "" @@ -1849,8 +2979,10 @@ Number of entries for each category is given by `todos-print-priorities'." (setq item (concat (substring item 0 56) "..."))) item)) -(defvar todos-item-start (concat "^\\(\\[\\(" (regexp-quote todos-done-string) - "\\)?\\)?" todos-date-pattern) +(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-item-start () @@ -1859,8 +2991,8 @@ Number of entries for each category is given by `todos-print-priorities'." (looking-at (regexp-quote todos-category-beg))) ; for todos-count-items (goto-char (line-beginning-position)) (while (not (looking-at todos-item-start)) - (forward-line -1))) - (point)) + (forward-line -1)) + (point))) (defun todos-item-end () "Move to end of current TODO list item and return its position." @@ -1870,8 +3002,8 @@ Number of entries for each category is given by `todos-print-priorities'." ;; 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)) + (backward-char)) + (point))) (defun todos-remove-item () "Delete the current entry from the TODO list." @@ -1884,81 +3016,190 @@ Number of entries for each category is given by `todos-print-priorities'." (defun todos-item-string () "Return current TODO list entry as a string." - (buffer-substring (todos-item-start) (todos-item-end))) + (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-diary-item-p () + "" + (save-excursion + (todos-item-start) + (looking-at todos-date-pattern))) (defun todos-done-item-p () "" (save-excursion (todos-item-start) - (looking-at (concat "^\\[" (regexp-quote todos-done-string))))) + (looking-at todos-done-string-start))) -(defun todos-make-categories-list () - "Return a list of Todos categories and set their property lists. -The properties are at least the category number and the numbers -of todo items, done items and archived items in the category." - (let (catlist) +;; FIXME: should be defsubst? +(defun todos-counts (cat) + "Plist/Vector of item type counts in category CAT. +The counted types are all todo items, todo items for diary +inclusion, done items and archived items." + (cdr (assoc cat todos-categories))) + +(defun todos-get-count (type cat) + "Return count of TYPE items in category CAT." + (let (idx) + (cond ((eq type 'todo) + (setq idx 0)) + ((eq type 'diary) + (setq idx 1)) + ((eq type 'done) + (setq idx 2)) + ((eq type 'archived) + (setq idx 3))) + (aref (todos-counts cat) idx) + ;; (plist-get (todos-counts cat) type) + )) + +(defun todos-set-count (type counts increment) + "Increment count of item TYPE in vector COUNTS by INCREMENT." + (let (idx) + (cond ((eq type 'todo) + (setq idx 0)) + ((eq type 'diary) + (setq idx 1)) + ((eq type 'done) + (setq idx 2)) + ((eq type 'archived) + (setq idx 3))) + (aset counts idx (+ increment (aref counts idx))) + ;; (plist-put counts type (1+ (plist-get counts type))) + )) + +(defun todos-set-categories () + "Set todos-categories from the sexp at the top of the file." + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (if (looking-at "\(\(\"") + (setq todos-categories (read (buffer-substring-no-properties + (line-beginning-position) + (line-end-position)))) + (error "Invalid or missing todos-categories sexp"))))) + +(defun todos-make-categories-list (&optional force) + "Return a list of Todos categories and their item counts. +The items counts are contained in a vector specifying the numbers +of todo items, done items and archived items in the category, in +that order." + (setq todos-categories nil) + (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"))) + (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 counts (list 'todo 0 'diary 0 'done 0 'archived 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 counts 1)) + (forward-line)))))) + ((looking-at todos-done-string-start) + (todos-set-count 'done counts 1)) + ((looking-at (concat "^\\(" (regexp-quote diary-nonmarking-symbol) + "\\)?" todos-date-pattern)) + (todos-set-count 'diary counts 1) + (todos-set-count 'todo counts 1)) + ((looking-at (concat todos-date-string-start todos-date-pattern)) + (todos-set-count 'todo counts 1)) + ;; 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) + +;; FIXME: don't let truncated list get written by todos-update-categories-sexp +(defun todos-truncate-categories-list () + "Return a truncated list 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) + (unless todos-categories + (setq todos-categories (todos-make-categories-list))) + (dolist (catcons todos-categories 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-update-categories-sexp () + "" + (let (buffer-read-only) (save-excursion (save-restriction (widen) (goto-char (point-min)) - (let ((num 0) - cat catsym archive-check) - (while (not (eobp)) - (cond ((looking-at (concat (regexp-quote todos-category-beg) - "\\(.*\\)\n")) - (setq cat (match-string-no-properties 1)) - (setq num (1+ num)) - (setq archive-check nil) - ;; FIXME: ok to intern in global obarray? - (setq catsym (intern (concat "todos-" cat))) - (setplist catsym (list 'catnum num 'todo 0 'done 0 'archived 0)) - (push cat catlist)) - ((looking-at (concat "^\\[" (regexp-quote todos-done-string))) - (put catsym 'done (1+ (get catsym 'done)))) - ((looking-at (concat "^\\[?" todos-date-pattern)) - (put catsym 'todo (1+ (get catsym 'todo))))) - (unless (or archive-check - (string= (buffer-file-name) - (expand-file-name todos-archive-file))) - (let ((archive (find-file-noselect todos-archive-file))) - (with-current-buffer archive - (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 - (concat "^\\[" (regexp-quote todos-done-string))) - (put catsym 'archived (1+ (get catsym 'archived)))) - (forward-line))))) - (setq archive-check t)) - (forward-line))))) - catlist)) - -(defun todos-item-counts (cat &optional how) - "" - (let ((catsym (intern-soft (concat "todos-" cat)))) - ;; FIXME: need this? - ;; (when catsym - (cond ((eq how 'insert) - (put catsym 'todo (1+ (get catsym 'todo)))) - ((eq how 'delete) - (if (todos-done-item-p) ;FIXME: fails if last done item was deleted - (put catsym 'done (1- (get catsym 'done))) - (put catsym 'todo (1- (get catsym 'todo))))) - ((eq how 'done) - (put catsym 'todo (1- (get catsym 'todo))) - (put catsym 'done (1+ (get catsym 'done)))) - ((eq how 'undo) - (put catsym 'todo (1+ (get catsym 'todo))) - (put catsym 'done (1- (get catsym 'done)))) - ((eq how 'archive) - (put catsym 'archived (+ (get catsym 'done) (get catsym 'archived))) - (put catsym 'done 0))))) + (if (looking-at (concat "^" (regexp-quote todos-category-beg))) + (progn (newline) (goto-char (point-min))) + (kill-line)) + (prin1 todos-categories (current-buffer)))))) + +;; FIXME: should done diary items count as diary? +(defun todos-item-counts (cat &optional type) + "" + (let ((counts (todos-counts cat))) + (cond ((eq type 'insert) + (todos-set-count 'todo counts 1)) + ((eq type 'diary) + (todos-set-count 'diary counts 1)) + ((eq type 'nondiary) + (todos-set-count 'diary counts -1)) + ((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 counts -1) + (todos-set-count 'todo counts -1))) + ((eq type 'done) + (todos-set-count 'todo counts -1) + (todos-set-count 'done counts 1)) + ((eq type 'undo) + (todos-set-count 'todo counts 1) + (todos-set-count 'done counts -1)) + ((eq type 'archive) + (todos-set-count 'archived counts (todos-get-count 'done cat)) ;arch+done + (todos-set-count 'done counts (- (todos-get-count 'done cat))))) ; 0 + (todos-update-categories-sexp))) (defun todos-longest-category-name-length (categories) "" @@ -1974,8 +3215,22 @@ of todo items, done items and archived items in the category." "Return non-nil if STRING spans several lines." (> (todos-string-count-lines string) 1)) -(defun todos-read-category () - "Return a category name (existing names with tab completion)." +(defun todos-read-file-name (prompt &optional archive) + "" + (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 t) + (if archive ".toda" ".todo")))) + (expand-file-name file))) + +(defun todos-read-category (prompt) + "Return a category name from the current Todos file, with completion. +Prompt with PROMPT." ;; allow SPC to insert spaces, for adding new category names with ;; todos-move-item (let ((map minibuffer-local-completion-map)) @@ -1984,53 +3239,79 @@ of todo items, done items and archived items in the category." ;; non-nil, which makes completing-read alter todos-categories (let* ((categories (copy-sequence todos-categories)) (history (cons 'todos-categories (1+ todos-category-number))) - (default (todos-current-category)) ;FIXME: why this default? + ;; (default (todos-current-category)) ;FIXME: why this default? (completion-ignore-case todos-completion-ignore-case) - (category (completing-read - (concat "Category [" default "]: ") - todos-categories nil nil nil history default))) + (category (completing-read prompt + ;; (concat "Category [" default "]: ") + todos-categories nil nil nil history))); default))) ;; restore the original value of todos-categories (setq todos-categories categories) category))) -(defun todos-check-category-name (cat) - "Reject names for category CAT that could yield bugs or confusion." +(defun todos-validate-category-name (cat) + "Check new category name CAT and when valid return it." (let (prompt) - (while (and (cond ((string= "" cat) - (setq prompt "Enter a non-empty category name: ")) - ((string-match "\\`\\s-+\\'" cat) - (setq prompt - "Enter a category name that is not only white space: ")) - ((member cat todos-categories) - (setq prompt "Enter a non-existing category name: "))) - (setq cat (read-from-minibuffer 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: ")) + ((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 + ;; FIXME: if input is just whitespace, raises "End of + ;; file during parsing" error + (prin1-to-string + (read-from-minibuffer prompt nil nil t nil + (list todos-initial-category)))))))) cat) -;; adapted from calendar-read-date +;; adapted from calendar-read-date and calendar-date-string (defun todos-read-date () - "Prompt for Gregorian date and return it in the current format." + "Prompt for Gregorian date and return it in the current format. +Also accepts `*' as an unspecified month, day, or year." (let* ((year (calendar-read - "Year (>0): " - (lambda (x) (> x 0)) + "Year (>0 or * for any year): " + (lambda (x) (or (eq x '*) (> x 0))) (number-to-string (calendar-extract-year (calendar-current-date))))) - (month-array calendar-month-name-array) + (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 - (completing-read - "Month name (RET for current month): " - (mapcar 'list (append month-array nil)) - nil t nil nil - (calendar-month-name (calendar-extract-month - (calendar-current-date)))) - (calendar-make-alist month-array 1) t))) - (last (calendar-last-day-of-month month year)) - day) - (while (or (not (numberp day)) (< day 0) (< last day)) + monthname (calendar-make-alist month-array nil nil abbrevs)))) + (last (if (eq 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): " last) nil nil t nil - (number-to-string (calendar-extract-day (calendar-current-date)))))) - (calendar-date-string (list month day year) t t))) + (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 + (calendar-month-name (calendar-extract-month (list month day year)) t)) + (mapconcat 'eval calendar-date-display-form ""))) (defun todos-read-dayname () "" @@ -2050,60 +3331,155 @@ of todo items, done items and archived items in the category." (setq valid t))) answer)) -;; (defun todos-categories-list (buf) -;; "Return a list of the Todo mode categories in buffer BUF." -;; (let (categories) -;; (with-current-buffer buf -;; (save-excursion -;; (save-restriction -;; (widen) -;; (goto-char (point-max)) -;; (while (re-search-backward (concat "^" (regexp-quote todos-category-beg) -;; "\\(.*\\)\n") nil t) -;; (push (match-string-no-properties 1) categories))))) -;; categories)) - (defun todos-padded-string (str) "" - (let* ((len (todos-longest-category-name-length todos-categories)) + (let* ((categories (mapcar 'car todos-categories)) + (len (todos-longest-category-name-length categories)) (strlen (length str)) (strlen-odd (eq (logand strlen 1) 1)) ; oddp from cl.el - (padding (/ (- len strlen) 2))) - (concat (make-string padding 32) str - (make-string (if strlen-odd (1+ padding) padding) 32)))) - -(defun todos-insert-category-name (cat &optional nonum) + (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)))) + +(defvar todos-descending-counts-store nil + "Alist of current sorted category counts, keyed by sort key.") + +;; FIXME: rename to todos-insert-category-info ? +(defun todos-sort (list &optional key) + "Return a copy of LIST, possibly sorted according to KEY." ;FIXME + (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-store)) + (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-store + (delete key todos-descending-counts-store)) + (push key todos-descending-counts-store))) + l)) + +(defun todos-display-sorted (type) + "Keep point on the count sorting button just clicked." + (let ((opoint (point))) + (todos-display-categories type) + (goto-char opoint))) + +(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-insert-sort-button (label) "" - (let ((catsym (intern-soft (concat "todos-" cat))) - (archive (string= todos-current-todos-file todos-archive-file))) + (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-store) + (eq key 'alpha)) + (progn + (todos-display-categories) + (setq todos-descending-counts-store + (delete key todos-descending-counts-store))) + (todos-display-sorted key))))) + (setq ovl (make-overlay beg end)) + (overlay-put ovl 'face 'todos-button)) + +(defun todos-insert-category-line (cat &optional nonum) + "" + (let ((archive (member todos-current-todos-file todos-archives)) + (str (todos-padded-string cat)) + (opoint (point))) + ;; beg end ovl) ;; num is declared in caller (setq num (1+ num)) - (if nonum - (insert (make-string 4 32)) - (insert " " (format "%2d" num) " ")) - (insert-button (todos-padded-string cat) - 'face 'todos-button - 'action - `(lambda (button) - (todos-jump-to-category-noninteractively ,cat))) - (insert (concat (make-string 8 32) - (unless archive - (concat - (format "%2d" (get catsym 'todo)) - (make-string 5 32))) - (format "%2d" (get catsym 'done)) - (unless archive - (concat - (make-string 5 32) - (format "%2d" (get catsym 'archived)))) - "\n")))) - -(defun todos-initial-setup () - "Set up things to work properly in TODO mode." - (find-file todos-file-do) - (erase-buffer) - (todos-mode) - (todos-add-category "Todos")) + ;; (if nonum + ;; (insert (make-string 4 32)) + ;; (insert " " (format "%2d" num) " | ")) + ;; (setq beg (point)) + ;; (setq end (+ beg (length str))) + (insert-button + ;; FIXME: use mapconcat? + (concat (if nonum + (make-string (+ 3 (length todos-categories-number-separator)) 32) + (format " %2d%s" num todos-categories-number-separator)) + str + (make-string (+ 2 (/ (length todos-categories-todo-label) 2)) 32) + (unless archive + (concat + (format "%2d" (todos-get-count 'todo cat)) + (make-string (+ 2 (/ (length todos-categories-diary-label) 2)) 32))) + (unless archive + (concat + (format "%2d" (todos-get-count 'diary cat)) + (make-string (+ 3 (/ (length todos-categories-done-label) 2)) 32))) + (format "%2d" (todos-get-count 'done cat)) + (unless archive + (concat + (make-string (+ 2 (/ (length todos-categories-archived-label) 2)) 32) + (format "%2d" (todos-get-count 'archived cat)) + (make-string 2 32)))) + '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) (todos-jump-to-category ,cat))) + ;; (setq ovl (make-overlay beg end)) + ;; (overlay-put ovl 'face 'todos-button) + (let* ((beg1 (+ opoint 6 (length str))) + end1 ovl1) + (cond ((eq nonum 'todo) + (setq beg1 (+ beg1 1 (/ (length todos-categories-todo-label) 2)))) + ((eq nonum 'diary) + (setq beg1 (+ beg1 1 (length todos-categories-todo-label) + 2 (/ (length todos-categories-diary-label) 2)))) + ((eq nonum 'done) + (setq beg1 (+ beg1 1 (length todos-categories-todo-label) + 2 (length todos-categories-diary-label) + 2 (/ (length todos-categories-done-label) 2)))) + ((eq nonum 'archived) + (setq beg1 (+ beg1 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 (= beg1 (+ opoint 6 (length str))) + (setq end1 (+ beg1 4)) + (setq ovl1 (make-overlay beg1 end1)) + (overlay-put ovl1 'face 'todos-sorted-column))) + (insert (concat "\n")))) (provide 'todos) -- 2.39.5