From a820dfe8e0d63e9fda849a4250204f525a3f022b Mon Sep 17 00:00:00 2001 From: Stephen Berman Date: Sun, 3 Jun 2012 21:10:46 +0100 Subject: [PATCH] * calendar/todos.el: Further comment revision. (todos-sorted-column): Change default value. (todos-item-start): Handle empty category (needed in todos-filter-items). (todos-read-date): Don't use calendar-read; make code cleaner. (todos-multiple-filter-files): Rename this variable from todos-multiple-files and adjust users. (todos-multiple-filter-files-widget): Rename from todos-multiple-files-widget and adjust users. (todos-multiple-filter-files): Rename this function from todos-multiple-files and adjust callers. (todos-filter-items): Remove unused code. (todos-insert-category-line): Add space so highlighting of last column is consistent with the others; adjust display of column highlighting. (todos-menu): Remove obsolete entry. (todos-categories-mode-map): Add new bindings. (todos-display-categories-alphabetically-or-by-priority): New command. (todos-display-categories-sorted-by-todo) (todos-display-categories-sorted-by-diary) (todos-display-categories-sorted-by-done) (todos-display-categories-sorted-by-archived): Restore and fix implementation. --- lisp/ChangeLog | 26 +++++ lisp/calendar/todos.el | 223 ++++++++++++++++++++++------------------- 2 files changed, 146 insertions(+), 103 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index bd81d41108e..bc6cdafee82 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,29 @@ +2012-09-23 Stephen Berman + + * calendar/todos.el: Further comment revision. + (todos-sorted-column): Change default value. + (todos-item-start): Handle empty category (needed in + todos-filter-items). + (todos-read-date): Don't use calendar-read; make code cleaner. + (todos-multiple-filter-files): Rename this variable from + todos-multiple-files and adjust users. + (todos-multiple-filter-files-widget): Rename from + todos-multiple-files-widget and adjust users. + (todos-multiple-filter-files): Rename this function from + todos-multiple-files and adjust callers. + (todos-filter-items): Remove unused code. + (todos-insert-category-line): Add space so highlighting of last + column is consistent with the others; adjust display of column + highlighting. + (todos-menu): Remove obsolete entry. + (todos-categories-mode-map): Add new bindings. + (todos-display-categories-alphabetically-or-by-priority): New command. + (todos-display-categories-sorted-by-todo) + (todos-display-categories-sorted-by-diary) + (todos-display-categories-sorted-by-done) + (todos-display-categories-sorted-by-archived): Restore and fix + implementation. + 2012-09-23 Stephen Berman * calendar/todos.el: Significant code rearrangement; further diff --git a/lisp/calendar/todos.el b/lisp/calendar/todos.el index 6b1e7b21067..19ab6deca74 100644 --- a/lisp/calendar/todos.el +++ b/lisp/calendar/todos.el @@ -607,15 +607,14 @@ categories display according to priority." :group 'todos-faces) (defface todos-sorted-column - ;; '((t :inherit fringe)) '((((class color) (background light)) - (:foreground "grey95")) + (:background "grey85")) (((class color) (background dark)) - (:foreground "grey10")) + (:background "grey10")) (t - (:foreground "gray"))) + (:background "gray"))) "Face for buttons in todos-display-categories." :group 'todos-faces) @@ -1141,7 +1140,6 @@ the file." (when buffer-file-name ; During conversion there is no file yet. ;; If the file is an archive, it doesn't have an archive. (unless (member (file-truename buffer-file-name) - ;; FIXME: can todos-archives be too old here? (funcall todos-files-function t)) (setq archive (concat (file-name-sans-extension todos-current-todos-file) ".toda")))) @@ -1250,6 +1248,10 @@ Helper function for `todos-convert-legacy-files'." (defun todos-item-start () "Move to start of current Todos item and return its position." (unless (or + ;; Buffer is empty (invocation possible e.g. via todos-forward-item + ;; from todos-filter-items when processing category with no todo + ;; items). + (eq (point-min) (point-max)) ;; Point is on the empty line between todo and done items. (and (looking-at "^$") (save-excursion @@ -1496,12 +1498,14 @@ TYPE can be either a file or a category" (defun todos-read-date () "Prompt for Gregorian date and return it in the current format. Also accepts `*' as an unspecified month, day, or year." - (let* ((year (calendar-read - ;; FIXME: maybe better like monthname with RET for current month - "Year (>0 or * for any year): " - (lambda (x) (or (eq x '*) (> x 0))) - (number-to-string (calendar-extract-year - (calendar-current-date))))) + (let* ((year (let (x) + (while (if (numberp x) (< x 0) (not (eq x '*))) + (setq x (read-from-minibuffer + "Year (>0 or RET for this year or * for any year): " + nil nil t nil (number-to-string + (calendar-extract-year + (calendar-current-date)))))) + x)) (month-array (vconcat calendar-month-name-array (vector "*"))) (abbrevs (vconcat calendar-month-abbrev-array (vector "*"))) (completion-ignore-case todos-completion-ignore-case) @@ -1520,13 +1524,16 @@ Also accepts `*' as an unspecified month, day, or year." 1999 ; FIXME: no Feb. 29 year))) (calendar-last-day-of-month month yr)))) - day dayname) - (while (if (numberp day) (or (< day 0) (< last day)) (not (eq day '*))) - (setq day (read-from-minibuffer - (format "Day (1-%d or RET for today or * for any day): " last) - nil nil t nil - (number-to-string - (calendar-extract-day (calendar-current-date)))))) + (day (let (x) + (while (if (numberp x) (or (< x 0) (< last x)) (not (eq x '*))) + (setq x (read-from-minibuffer + (format + "Day (1-%d or RET for today or * for any day): " + last) nil nil t nil (number-to-string + (calendar-extract-day + (calendar-current-date)))))) + x)) + dayname) ; Needed by calendar-date-display-form. (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 @@ -1563,13 +1570,13 @@ the empty string (i.e., no time string)." ;; --------------------------------------------------------------------------- ;;; Item filtering -(defvar todos-multiple-files nil - "List of files selected from `todos-multiple-files' widget.") +(defvar todos-multiple-filter-files nil + "List of files selected from `todos-multiple-filter-files' widget.") -(defvar todos-multiple-files-widget nil - "Variable holding widget created by `todos-multiple-files'.") +(defvar todos-multiple-filter-files-widget nil + "Variable holding widget created by `todos-multiple-filter-files'.") -(defun todos-multiple-files () +(defun todos-multiple-filter-files () "Pop to a buffer with a widget for choosing multiple filter files." (require 'widget) (eval-when-compile @@ -1579,7 +1586,7 @@ the empty string (i.e., no time string)." (erase-buffer) (kill-all-local-variables) (widget-insert "Select files for generating the top priorities list.\n\n") - (setq todos-multiple-files-widget + (setq todos-multiple-filter-files-widget (widget-create `(set ,@(mapcar (lambda (x) (list 'const x)) (mapcar 'todos-short-file-name @@ -1587,19 +1594,19 @@ the empty string (i.e., no time string)." (widget-insert "\n") (widget-create 'push-button :notify (lambda (widget &rest ignore) - (setq todos-multiple-files 'quit) + (setq todos-multiple-filter-files 'quit) (quit-window t) (exit-recursive-edit)) "Cancel") (widget-insert " ") (widget-create 'push-button :notify (lambda (&rest ignore) - (setq todos-multiple-files + (setq todos-multiple-filter-files (mapcar (lambda (f) (concat todos-files-directory f ".todo")) (widget-value - todos-multiple-files-widget))) + todos-multiple-filter-files-widget))) (quit-window t) (exit-recursive-edit)) "Apply") @@ -1624,12 +1631,13 @@ Todos files, by default those in `todos-filter-files'." (files (list todos-current-todos-file)) regexp fname bufstr cat beg end done) (when multifile - (setq files (or todos-multiple-files ; Passed from todos-*-multifile. + (setq files (or todos-multiple-filter-files ; Passed from todos-*-multifile. (if (or (consp filter) (null todos-filter-files)) - (progn (todos-multiple-files) todos-multiple-files) + (progn (todos-multiple-filter-files) + todos-multiple-filter-files) todos-filter-files)) - todos-multiple-files nil)) + todos-multiple-filter-files nil)) (if (eq files 'quit) (keyboard-quit)) (if (null files) (error "No files have been chosen for filtering") @@ -1678,8 +1686,9 @@ Todos files, by default those in `todos-filter-files'." (delete-region (line-beginning-position) (1+ (line-end-position))) (let (fnum) ;; Unless the number of items to show was supplied by prefix - ;; argument of caller, override `todos-show-priorities' with the - ;; file-wide value from `todos-priorities-rules'. + ;; argument of caller, the file-wide value from + ;; `todos-priorities-rules', if non-nil, overrides + ;; `todos-show-priorities'. (unless (consp filter) (setq fnum (nth 1 (assoc f todos-priorities-rules)))) (while (re-search-forward @@ -1688,16 +1697,13 @@ Todos files, by default those in `todos-filter-files'." (setq cat (match-string 1)) (let (cnum) ;; Unless the number of items to show was supplied by prefix - ;; argument of caller, override the file-wide value from - ;; `todos-priorities-rules' if set, else - ;; `todos-show-priorities' with non-nil category-wide value - ;; from `todos-priorities-rules'. + ;; argument of caller, the category-wide value from + ;; `todos-priorities-rules', if non-nil, overrides a non-nil + ;; file-wide value from `todos-priorities-rules' as well as + ;; `todos-show-priorities'. (unless (consp filter) (let ((cats (nth 2 (assoc f todos-priorities-rules)))) - (setq cnum (or (cdr (assoc cat cats)) - fnum - ;; FIXME: need this? - todos-show-priorities)))) + (setq cnum (or (cdr (assoc cat cats)) fnum)))) (delete-region (match-beginning 0) (match-end 0)) (setq beg (point)) ; First item in the current category. (setq end (if (re-search-forward @@ -1873,6 +1879,8 @@ option `todos-categories-align'." (fn (if (eq key 'alpha) (lambda (x) (upcase x)) ; Alphabetize case insensitively. (lambda (x) (todos-get-count key x)))) + ;; Keep track of whether the last sort by key was descending or + ;; ascending. (descending (member key todos-descending-counts)) (cmp (if (eq key 'alpha) 'string< @@ -1882,6 +1890,7 @@ option `todos-categories-align'." (funcall cmp t1 t2))))) (when key (setq l (sort l pred)) + ;; Switch between descending and ascending sort order. (if descending (setq todos-descending-counts (delete key todos-descending-counts)) @@ -1925,7 +1934,7 @@ LABEL determines which type of count is sorted." (eq key 'alpha)) (progn ;; If display is alphabetical, switch back to - ;; category order. + ;; category priority order. (todos-display-sorted nil) (setq todos-descending-counts (delete key todos-descending-counts))) @@ -1974,7 +1983,8 @@ which is the value of the user option (cons todos-categories-done-label 'done) (cons todos-categories-archived-label 'archived))) - "")) + "") + " ") ; So highlighting of last column is consistent with the others. 'face (if (and todos-skip-archived-categories (zerop (todos-get-count 'todo cat)) (zerop (todos-get-count 'done cat)) @@ -1985,7 +1995,7 @@ which is the value of the user option (todos-jump-to-category ,cat) (kill-buffer buf)))) ;; Highlight the sorted count column. - (let* ((beg (+ opoint 6 (length str))) + (let* ((beg (+ opoint 7 (length str))) end ovl) (cond ((eq nonum 'todo) (setq beg (+ beg 1 (/ (length todos-categories-todo-label) 2)))) @@ -2001,7 +2011,7 @@ which is the value of the user option 2 (length todos-categories-diary-label) 2 (length todos-categories-done-label) 2 (/ (length todos-categories-archived-label) 2))))) - (unless (= beg (+ opoint 6 (length str))) + (unless (= beg (+ opoint 7 (length str))) ; Don't highlight categories. (setq end (+ beg 4)) (setq ovl (make-overlay beg end)) (overlay-put ovl 'face 'todos-sorted-column))) @@ -2244,7 +2254,6 @@ which is the value of the user option ;; --------------------------------------------------------------------------- ;;; Key maps and menus -;; ??FIXME: use easy-mmode-define-keymap and easy-mmode-defmap (defvar todos-key-bindings `( ;; display @@ -2263,7 +2272,6 @@ which is the value of the user option ("As" . todos-show-archive) ("Ac" . todos-choose-archive) ("Y" . todos-diary-items) - ;;("" . todos-update-filter-files) ("Fe" . todos-edit-multiline) ("Fh" . todos-highlight-item) ("Fn" . todos-hide-show-item-numbering) @@ -2276,7 +2284,6 @@ which is the value of the user option ("Fym" . todos-diary-items-multifile) ("Fxx" . todos-regexp-items) ("Fxm" . todos-regexp-items-multifile) - ;;("" . todos-save-top-priorities) ;; navigation ("f" . todos-forward-category) ("b" . todos-backward-category) @@ -2311,18 +2318,12 @@ which is the value of the user option ("k" . todos-delete-item) ;FIXME: not single letter? ("m" . todos-move-item) ("M" . todos-move-item-to-file) - ;; FIXME: This binding prevents `-' from being used in a numerical prefix - ;; argument without typing C-u - ;; ("-" . todos-raise-item-priority) ("r" . todos-raise-item-priority) - ;; ("+" . todos-lower-item-priority) ("l" . todos-lower-item-priority) ("#" . todos-set-item-priority) ("u" . todos-item-undo) ("Ad" . todos-archive-done-item) ;FIXME: ad ("AD" . todos-archive-category-done-items) ;FIXME: aD or C-u ad ? - ;; ("Au" . todos-unarchive-items) ;FIXME: not in todos-mode! - ;; ("AU" . todos-unarchive-category) ;FIXME: not in todos-mode! ("s" . todos-save) ("q" . todos-quit) ([remap newline] . newline-and-indent) @@ -2393,7 +2394,7 @@ which is the value of the user option ["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] )) @@ -2432,8 +2433,11 @@ which is the value of the user option (defvar todos-categories-mode-map (let ((map (make-sparse-keymap))) (suppress-keymap map t) - ;; (define-key map "a" 'todos-display-categories-alphabetically) - (define-key map "c" 'todos-display-categories) + (define-key map "c" 'todos-display-categories-alphabetically-or-by-priority) + (define-key map "t" 'todos-display-categories-sorted-by-todo) + (define-key map "y" 'todos-display-categories-sorted-by-diary) + (define-key map "d" 'todos-display-categories-sorted-by-done) + (define-key map "a" 'todos-display-categories-sorted-by-archived) (define-key map "l" 'todos-lower-category-priority) (define-key map "+" 'todos-lower-category-priority) (define-key map "r" 'todos-raise-category-priority) @@ -2463,7 +2467,6 @@ which is the value of the user option (define-key map "P" 'todos-print) (define-key map "q" 'todos-quit) (define-key map "s" 'todos-save) - ;; (define-key map "S" 'todos-save-top-priorities) ;; editing commands (define-key map "l" 'todos-lower-item-priority) (define-key map "r" 'todos-raise-item-priority) @@ -2496,7 +2499,7 @@ which is the value of the user option (put 'todos-mode 'mode-class 'special) -;; Autoloading isn't needed if files are identified by auto-mode-alist +;; FIXME: Autoloading isn't needed if files are identified by auto-mode-alist ;; ;; As calendar reads included Todos file before todos-mode is loaded. ;; ;;;###autoload (define-derived-mode todos-mode special-mode "Todos" () @@ -2558,8 +2561,8 @@ which is the value of the user option "" (set (make-local-variable 'todos-current-todos-file) todos-global-current-todos-file) - (let ((cats (with-current-buffer (find-buffer-visiting todos-current-todos-file) - ;; FIXME: or (todos-set-categories)? + (let ((cats (with-current-buffer + (find-buffer-visiting todos-current-todos-file) todos-categories))) (set (make-local-variable 'todos-categories) cats))) @@ -2596,13 +2599,15 @@ which is the value of the user option ;;;###autoload (defun todos-show (&optional solicit-file) "Visit the current Todos file and display one of its categories. +With non-nil prefix argument SOLICIT-FILE prompt for which todo +file to visit. -With non-nil prefix argument SOLICIT-FILE ask for file to visit. -Otherwise, the first invocation of this command in a session -visits `todos-default-todos-file' (creating it if it does not yet -exist); subsequent invocations from outside of Todos mode revisit -this file or, if user option `todos-show-current-file' is -non-nil, whichever Todos file was visited last. +Without a prefix argument, the first invocation of this command +in a session visits `todos-default-todos-file' (creating it if it +does not yet exist); subsequent invocations from outside of Todos +mode revisit this file or, if the user option +`todos-show-current-file' is non-nil, whichever Todos file +\(either a todo or an archive file) was visited last. The category displayed on initial invocation is the first member of `todos-categories' for the current Todos file, on subsequent @@ -2634,10 +2639,6 @@ corresponding Todos file, displaying the corresponding category." (concat (file-name-sans-extension todos-current-todos-file) ".todo")) (t - ;; FIXME: If todos-current-todos-file is an archive, - ;; todos-show will revisit it rather than the - ;; corresponding todo file -- ok or make it - ;; customizable? (or todos-current-todos-file (and todos-show-current-file todos-global-current-todos-file) @@ -2688,33 +2689,50 @@ are shown in `todos-archived-only' face." (let (sortkey) (todos-update-categories-display sortkey))) -;; FIXME: provide key bindings for these or delete them - -;; ;; FIXME: make this toggle with todos-display-categories -;; (defun todos-display-categories-alphabetically () -;; "" -;; (interactive) -;; (todos-display-sorted 'alpha)) +(defun todos-display-categories-alphabetically-or-by-priority () + "" + (interactive) + (save-excursion + (goto-char (point-min)) + (forward-line 2) + (if (member 'alpha todos-descending-counts) + (progn + (todos-update-categories-display nil) + (setq todos-descending-counts + (delete 'alpha todos-descending-counts))) + (todos-update-categories-display 'alpha)))) -;; (defun todos-display-categories-sorted-by-todo () -;; "" -;; (interactive) -;; (todos-display-sorted 'todo)) +(defun todos-display-categories-sorted-by-todo () + "" + (interactive) + (save-excursion + (goto-char (point-min)) + (forward-line 2) + (todos-update-categories-display 'todo))) -;; (defun todos-display-categories-sorted-by-diary () -;; "" -;; (interactive) -;; (todos-display-sorted 'diary)) +(defun todos-display-categories-sorted-by-diary () + "" + (interactive) + (save-excursion + (goto-char (point-min)) + (forward-line 2) + (todos-update-categories-display 'diary))) -;; (defun todos-display-categories-sorted-by-done () -;; "" -;; (interactive) -;; (todos-display-sorted 'done)) +(defun todos-display-categories-sorted-by-done () + "" + (interactive) + (save-excursion + (goto-char (point-min)) + (forward-line 2) + (todos-update-categories-display 'done))) -;; (defun todos-display-categories-sorted-by-archived () -;; "" -;; (interactive) -;; (todos-display-sorted 'archived)) +(defun todos-display-categories-sorted-by-archived () + "" + (interactive) + (save-excursion + (goto-char (point-min)) + (forward-line 2) + (todos-update-categories-display 'archived))) (defun todos-show-archive (&optional ask) "Visit the archive of the current Todos category, if it exists. @@ -2761,9 +2779,7 @@ displayed." (defun todos-save () "Save the current Todos file." (interactive) - (save-buffer) - ;; (if todos-save-top-priorities-too (todos-save-top-priorities)) - ) + (save-buffer)) (defun todos-quit () "Exit the current Todos-related buffer. @@ -3382,8 +3398,8 @@ list in each category." (cons 'top arg) (setq files (if (or (consp arg) (null todos-filter-files)) - (progn (todos-multiple-files) - todos-multiple-files) + (progn (todos-multiple-filter-files) + todos-multiple-filter-files) todos-filter-files)) (if (equal arg '(16)) (cons 'top (read-number @@ -3407,8 +3423,8 @@ The files are those listed in `todos-filter-files'." (interactive "P") (let ((buf todos-diary-items-buffer) (files (if (or arg (null todos-filter-files)) - (progn (todos-multiple-files) - todos-multiple-files) + (progn (todos-multiple-filter-files) + todos-multiple-filter-files) todos-filter-files))) (todos-filter-items 'diary t) (todos-filtered-buffer-name buf files))) @@ -3428,8 +3444,8 @@ The items are those in the files listed in `todos-filter-files'." (interactive "P") (let ((buf todos-regexp-items-buffer) (files (if (or arg (null todos-filter-files)) - (progn (todos-multiple-files) - todos-multiple-files) + (progn (todos-multiple-filter-files) + todos-multiple-filter-files) todos-filter-files))) (todos-filter-items 'regexp t) (todos-filtered-buffer-name buf files))) @@ -4665,6 +4681,7 @@ With prefix ARG delete an existing comment." (todos-item-end) (insert " [" todos-comment-string ": " comment "]")))))) +;; FIXME: also with marked items ;; FIXME: delete comment from restored item or just leave it up to user? (defun todos-item-undo () "Restore this done item to the todo section of this category. @@ -4676,7 +4693,7 @@ the restored item." (done-item (todos-item-string)) (opoint (point)) (orig-mrk (progn (todos-item-start) (point-marker))) - ;; Find the end of the date string added upon marking item as done. + ;; Find the end of the date string added upon tagging item as done. (start (search-forward "] ")) item undone) (todos-item-start) -- 2.39.5