diff options
| author | Stephen Berman | 2013-04-22 00:25:03 +0200 |
|---|---|---|
| committer | Stephen Berman | 2013-04-22 00:25:03 +0200 |
| commit | 308f5beb340bfa840f427eae1bbd3d4193930d7f (patch) | |
| tree | c0424de1f6a77e0aa631e454c1dff0e27e5d0637 | |
| parent | f1806c78f4da16f9f0123eddac86246ccfa960da (diff) | |
| download | emacs-308f5beb340bfa840f427eae1bbd3d4193930d7f.tar.gz emacs-308f5beb340bfa840f427eae1bbd3d4193930d7f.zip | |
* todos.el: Fixes and improvements related to item relocation.
(todos-category-completions): On ensuring proper category display,
if done items in category are visible, keep them visible.
(todos-set-item-priority): Keep top of category in view while
setting priority.
(todos-move-item): Restore prevention of moving within the same
category. Move done items to top, not end, of done items section.
When user quits before setting priority, make sure to return to
starting file.
(todos-item-undo): Partly reimplement along lines of
todos-move-item, adding highlighting of single item as undo
target, setting priority of multiple undone items, improving
handling of quitting before setting priority.
(todos-unarchive-items): Restore items to top, not end, of
category's done section.
| -rw-r--r-- | lisp/calendar/ChangeLog | 18 | ||||
| -rw-r--r-- | lisp/calendar/todos.el | 185 |
2 files changed, 119 insertions, 84 deletions
diff --git a/lisp/calendar/ChangeLog b/lisp/calendar/ChangeLog index d4d06352131..5168fe33671 100644 --- a/lisp/calendar/ChangeLog +++ b/lisp/calendar/ChangeLog | |||
| @@ -1,3 +1,21 @@ | |||
| 1 | 2013-04-21 Stephen Berman <stephen.berman@gmx.net> | ||
| 2 | |||
| 3 | * todos.el: Fixes and improvements related to item relocation. | ||
| 4 | (todos-category-completions): On ensuring proper category display, | ||
| 5 | if done items in category are visible, keep them visible. | ||
| 6 | (todos-set-item-priority): Keep top of category in view while | ||
| 7 | setting priority. | ||
| 8 | (todos-move-item): Restore prevention of moving within the same | ||
| 9 | category. Move done items to top, not end, of done items section. | ||
| 10 | When user quits before setting priority, make sure to return to | ||
| 11 | starting file. | ||
| 12 | (todos-item-undo): Partly reimplement along lines of | ||
| 13 | todos-move-item, adding highlighting of single item as undo | ||
| 14 | target, setting priority of multiple undone items, improving | ||
| 15 | handling of quitting before setting priority. | ||
| 16 | (todos-unarchive-items): Restore items to top, not end, of | ||
| 17 | category's done section. | ||
| 18 | |||
| 1 | 2013-04-19 Stephen Berman <stephen.berman@gmx.net> | 19 | 2013-04-19 Stephen Berman <stephen.berman@gmx.net> |
| 2 | 20 | ||
| 3 | * todos.el: Extend and improve item filtering and handling of | 21 | * todos.el: Extend and improve item filtering and handling of |
diff --git a/lisp/calendar/todos.el b/lisp/calendar/todos.el index 628af73a9b1..30c64efb0f0 100644 --- a/lisp/calendar/todos.el +++ b/lisp/calendar/todos.el | |||
| @@ -1193,8 +1193,15 @@ Todos files named in `todos-category-completions-files'." | |||
| 1193 | (dolist (f files listall) | 1193 | (dolist (f files listall) |
| 1194 | (with-current-buffer (find-file-noselect f 'nowarn) | 1194 | (with-current-buffer (find-file-noselect f 'nowarn) |
| 1195 | ;; Ensure category is properly displayed in case user | 1195 | ;; Ensure category is properly displayed in case user |
| 1196 | ;; switches to file via a non-Todos command. | 1196 | ;; switches to file via a non-Todos command. And if done |
| 1197 | (todos-category-select) | 1197 | ;; items in category are visible, keep them visible. |
| 1198 | (let ((done todos-show-with-done)) | ||
| 1199 | (when (> (buffer-size) (- (point-max) (point-min))) | ||
| 1200 | (save-excursion | ||
| 1201 | (goto-char (point-min)) | ||
| 1202 | (setq done (re-search-forward todos-done-string-start nil t)))) | ||
| 1203 | (let ((todos-show-with-done done)) | ||
| 1204 | (todos-category-select))) | ||
| 1198 | (save-excursion | 1205 | (save-excursion |
| 1199 | (save-restriction | 1206 | (save-restriction |
| 1200 | (widen) | 1207 | (widen) |
| @@ -5380,7 +5387,9 @@ meaning to raise or lower the item's priority by one." | |||
| 5380 | (goto-char (point-min)) | 5387 | (goto-char (point-min)) |
| 5381 | (setq done (re-search-forward todos-done-string-start nil t)))) | 5388 | (setq done (re-search-forward todos-done-string-start nil t)))) |
| 5382 | (let ((todos-show-with-done done)) | 5389 | (let ((todos-show-with-done done)) |
| 5383 | (todos-category-select)))) | 5390 | (todos-category-select) |
| 5391 | ;; Keep top of category in view while setting priority. | ||
| 5392 | (goto-char (point-min))))) | ||
| 5384 | ;; Prompt for priority only when the category has at least one todo item. | 5393 | ;; Prompt for priority only when the category has at least one todo item. |
| 5385 | (when (> maxnum 1) | 5394 | (when (> maxnum 1) |
| 5386 | (while (not priority) | 5395 | (while (not priority) |
| @@ -5462,12 +5471,12 @@ With moved Todo items, prompt to set the priority in the category | |||
| 5462 | moved to (with multiple todos items, the one that had the highest | 5471 | moved to (with multiple todos items, the one that had the highest |
| 5463 | priority in the category moved from gets the new priority and the | 5472 | priority in the category moved from gets the new priority and the |
| 5464 | rest of the moved todo items are inserted in sequence below it). | 5473 | rest of the moved todo items are inserted in sequence below it). |
| 5465 | Moved done items are appended to the end of the done items | 5474 | Moved done items are appended to the top of the done items |
| 5466 | section in the category moved to." | 5475 | section in the category moved to." |
| 5467 | (interactive "P") | 5476 | (interactive "P") |
| 5468 | (let* ((cat1 (todos-current-category)) | 5477 | (let* ((cat1 (todos-current-category)) |
| 5469 | (marked (assoc cat1 todos-categories-with-marks))) | 5478 | (marked (assoc cat1 todos-categories-with-marks))) |
| 5470 | ;; NOP if point is not on an item and there are no marked items. | 5479 | ;; Noop if point is not on an item and there are no marked items. |
| 5471 | (unless (and (looking-at "^$") | 5480 | (unless (and (looking-at "^$") |
| 5472 | (not marked)) | 5481 | (not marked)) |
| 5473 | (let* ((buffer-read-only) | 5482 | (let* ((buffer-read-only) |
| @@ -5480,20 +5489,23 @@ section in the category moved to." | |||
| 5480 | (todo 0) | 5489 | (todo 0) |
| 5481 | (diary 0) | 5490 | (diary 0) |
| 5482 | (done 0) | 5491 | (done 0) |
| 5483 | ov cat+file cat2 file2 moved nmark todo-items done-items) | 5492 | ov cat2 file2 moved nmark todo-items done-items) |
| 5484 | (unwind-protect | 5493 | (unwind-protect |
| 5485 | (progn | 5494 | (progn |
| 5486 | (unless marked | 5495 | (unless marked |
| 5487 | (setq ov (make-overlay (save-excursion (todos-item-start)) | 5496 | (setq ov (make-overlay (save-excursion (todos-item-start)) |
| 5488 | (save-excursion (todos-item-end)))) | 5497 | (save-excursion (todos-item-end)))) |
| 5489 | (overlay-put ov 'face 'todos-search)) | 5498 | (overlay-put ov 'face 'todos-search)) |
| 5490 | (setq cat+file (let ((pl (if (and marked (> (cdr marked) 1)) | 5499 | (let* ((pl (if (and marked (> (cdr marked) 1)) "s" "")) |
| 5491 | "s" ""))) | 5500 | (cat+file (todos-read-category (concat "Move item" pl |
| 5492 | (todos-read-category (concat "Move item" pl | ||
| 5493 | " to category: ") | 5501 | " to category: ") |
| 5494 | nil file)) | 5502 | nil file))) |
| 5495 | cat2 (car cat+file) | 5503 | (while (and (equal (car cat+file) cat1) |
| 5496 | file2 (cdr cat+file))) | 5504 | (equal (cdr cat+file) file1)) |
| 5505 | (setq cat+file (todos-read-category | ||
| 5506 | "Choose a different category: "))) | ||
| 5507 | (setq cat2 (car cat+file) | ||
| 5508 | file2 (cdr cat+file)))) | ||
| 5497 | (if ov (delete-overlay ov))) | 5509 | (if ov (delete-overlay ov))) |
| 5498 | (set-buffer (find-buffer-visiting file1)) | 5510 | (set-buffer (find-buffer-visiting file1)) |
| 5499 | (if marked | 5511 | (if marked |
| @@ -5527,7 +5539,7 @@ section in the category moved to." | |||
| 5527 | (progn | 5539 | (progn |
| 5528 | (when (or todo-items (and item (not done-item))) | 5540 | (when (or todo-items (and item (not done-item))) |
| 5529 | (todos-set-item-priority (or todo-items item) cat2 t)) | 5541 | (todos-set-item-priority (or todo-items item) cat2 t)) |
| 5530 | ;; Move done items en bloc to end of done item section. | 5542 | ;; Move done items en bloc to top of done items section. |
| 5531 | (when (or done-items done-item) | 5543 | (when (or done-items done-item) |
| 5532 | (todos-category-number cat2) | 5544 | (todos-category-number cat2) |
| 5533 | (widen) | 5545 | (widen) |
| @@ -5536,11 +5548,9 @@ section in the category moved to." | |||
| 5536 | (concat todos-category-beg cat2)) | 5548 | (concat todos-category-beg cat2)) |
| 5537 | "$") | 5549 | "$") |
| 5538 | nil t) | 5550 | nil t) |
| 5539 | (goto-char (if (re-search-forward | 5551 | (re-search-forward |
| 5540 | (concat "^" (regexp-quote todos-category-beg)) | 5552 | (concat "^" (regexp-quote todos-category-done)) nil t) |
| 5541 | nil t) | 5553 | (forward-line) |
| 5542 | (match-beginning 0) | ||
| 5543 | (point-max))) | ||
| 5544 | (insert (or done-items done-item))) | 5554 | (insert (or done-items done-item))) |
| 5545 | (setq moved t)) | 5555 | (setq moved t)) |
| 5546 | (cond | 5556 | (cond |
| @@ -5595,6 +5605,8 @@ section in the category moved to." | |||
| 5595 | ;; User quit before setting priority of todo item(s), so | 5605 | ;; User quit before setting priority of todo item(s), so |
| 5596 | ;; return to starting category. | 5606 | ;; return to starting category. |
| 5597 | (t | 5607 | (t |
| 5608 | (set-window-buffer (selected-window) | ||
| 5609 | (set-buffer (find-file-noselect file1 'nowarn))) | ||
| 5598 | (todos-category-number cat1) | 5610 | (todos-category-number cat1) |
| 5599 | (todos-category-select) | 5611 | (todos-category-select) |
| 5600 | (goto-char omark)))))))) | 5612 | (goto-char omark)))))))) |
| @@ -5698,22 +5710,28 @@ With prefix ARG delete an existing comment." | |||
| 5698 | (insert " [" todos-comment-string ": " comment "]")))))) | 5710 | (insert " [" todos-comment-string ": " comment "]")))))) |
| 5699 | 5711 | ||
| 5700 | (defun todos-item-undo () | 5712 | (defun todos-item-undo () |
| 5701 | "Restore this done item to the todo section of this category. | 5713 | "Restore at least one done item to this category's todo section. |
| 5702 | If done item has a comment, ask whether to omit the comment from | 5714 | Prompt for the new priority. If there are marked items, undo all |
| 5703 | the restored item." ;FIXME: marked done items | 5715 | of these, giving the first undone item the new priority and the |
| 5716 | rest following directly in sequence; otherwise, undo just the | ||
| 5717 | item at point. | ||
| 5718 | |||
| 5719 | If the done item has a comment, ask whether to omit the comment | ||
| 5720 | from the restored item. With multiple marked done items with | ||
| 5721 | comments, only ask once, and if affirmed, omit subsequent | ||
| 5722 | comments without asking." | ||
| 5704 | (interactive) | 5723 | (interactive) |
| 5705 | (let* ((cat (todos-current-category)) | 5724 | (let* ((cat (todos-current-category)) |
| 5706 | (marked (assoc cat todos-categories-with-marks))) | 5725 | (marked (assoc cat todos-categories-with-marks)) |
| 5726 | (pl (if (and marked (> (cdr marked) 1)) "s" ""))) | ||
| 5707 | (when (or marked (todos-done-item-p)) | 5727 | (when (or marked (todos-done-item-p)) |
| 5708 | (let ((buffer-read-only) | 5728 | (let ((buffer-read-only) |
| 5709 | (bufmod (buffer-modified-p)) | ||
| 5710 | (opoint (point)) | 5729 | (opoint (point)) |
| 5711 | (orig-mrk (progn (todos-item-start) (point-marker))) | 5730 | (omark (point-marker)) |
| 5712 | (orig-item (todos-item-string)) | ||
| 5713 | (first 'first) | 5731 | (first 'first) |
| 5714 | (item-count 0) | 5732 | (item-count 0) |
| 5715 | (diary-count 0) | 5733 | (diary-count 0) |
| 5716 | start end item undone) | 5734 | start end item ov npoint undone) |
| 5717 | (and marked (goto-char (point-min))) | 5735 | (and marked (goto-char (point-min))) |
| 5718 | (catch 'done | 5736 | (catch 'done |
| 5719 | (while (not (eobp)) | 5737 | (while (not (eobp)) |
| @@ -5721,6 +5739,10 @@ the restored item." ;FIXME: marked done items | |||
| 5721 | (if (not (todos-done-item-p)) | 5739 | (if (not (todos-done-item-p)) |
| 5722 | (error "Only done items can be undone") | 5740 | (error "Only done items can be undone") |
| 5723 | (todos-item-start) | 5741 | (todos-item-start) |
| 5742 | (unless marked | ||
| 5743 | (setq ov (make-overlay (save-excursion (todos-item-start)) | ||
| 5744 | (save-excursion (todos-item-end)))) | ||
| 5745 | (overlay-put ov 'face 'todos-search)) | ||
| 5724 | ;; Find the end of the date string added upon tagging item as | 5746 | ;; Find the end of the date string added upon tagging item as |
| 5725 | ;; done. | 5747 | ;; done. |
| 5726 | (setq start (search-forward "] ")) | 5748 | (setq start (search-forward "] ")) |
| @@ -5736,61 +5758,52 @@ the restored item." ;FIXME: marked done items | |||
| 5736 | (if (eq first 'first) | 5758 | (if (eq first 'first) |
| 5737 | (setq first | 5759 | (setq first |
| 5738 | (if (eq todos-undo-item-omit-comment 'ask) | 5760 | (if (eq todos-undo-item-omit-comment 'ask) |
| 5739 | (when (y-or-n-p | 5761 | (when (y-or-n-p (concat "Omit comment" pl |
| 5740 | "Omit comment from restored item? ") | 5762 | " from restored item" |
| 5763 | pl "? ")) | ||
| 5741 | 'omit) | 5764 | 'omit) |
| 5742 | (when todos-undo-item-omit-comment 'omit))) | 5765 | (when todos-undo-item-omit-comment 'omit))) |
| 5743 | t) | 5766 | t) |
| 5744 | (when (eq first 'omit) | 5767 | (when (eq first 'omit) |
| 5745 | (delete-region (match-beginning 0) (match-end 0)) | 5768 | (setq end (match-beginning 0))) |
| 5746 | (setq end (point)))) | ||
| 5747 | (setq item (concat item | 5769 | (setq item (concat item |
| 5748 | (buffer-substring-no-properties start end) | 5770 | (buffer-substring-no-properties start end) |
| 5749 | (when marked "\n"))) | 5771 | (when marked "\n"))) |
| 5750 | (todos-remove-item) | 5772 | (unless marked (throw 'done nil))))) |
| 5751 | (unless marked (throw 'done nil))) | 5773 | (todos-forward-item))) |
| 5752 | (todos-forward-item)))) | 5774 | (unwind-protect |
| 5753 | (if marked | ||
| 5754 | (progn | 5775 | (progn |
| 5755 | (setq todos-categories-with-marks | 5776 | ;; Chop off last newline of multiple items string, since |
| 5756 | (assq-delete-all cat todos-categories-with-marks)) | 5777 | ;; it will be reinserted on setting priority. |
| 5757 | ;; Insert undone items that were marked at end of todo item list. | 5778 | (and marked (setq item (substring item 0 -1))) |
| 5758 | (goto-char (point-min)) | 5779 | (todos-set-item-priority item cat t) |
| 5759 | (re-search-forward (concat "^" (regexp-quote todos-category-done)) | 5780 | (setq npoint (point)) |
| 5760 | nil t) | 5781 | (setq undone t)) |
| 5761 | (forward-line -1) | 5782 | (if ov (delete-overlay ov)) |
| 5762 | (insert item) | 5783 | (if (not undone) |
| 5763 | (todos-update-count 'todo item-count) | 5784 | (goto-char opoint) |
| 5764 | (todos-update-count 'done (- item-count)) | 5785 | (if marked |
| 5765 | (when diary-count (todos-update-count 'diary diary-count)) | 5786 | (progn |
| 5766 | (todos-update-categories-sexp) | 5787 | (setq item nil) |
| 5767 | (let ((todos-show-with-done (> (todos-get-count 'done) 0))) | 5788 | (re-search-forward |
| 5768 | (todos-category-select))) | 5789 | (concat "^" (regexp-quote todos-category-done)) nil t) |
| 5769 | ;; With an unmarked undone item, prompt for its priority. If user | 5790 | (while (not (eobp)) |
| 5770 | ;; cancels before setting new priority, then leave the done item | 5791 | (if (todos-marked-item-p) |
| 5771 | ;; unchanged. | 5792 | (todos-remove-item) |
| 5772 | (unwind-protect | 5793 | (todos-forward-item))) |
| 5773 | (progn | 5794 | (setq todos-categories-with-marks |
| 5774 | (todos-set-item-priority item (todos-current-category) t) | 5795 | (assq-delete-all cat todos-categories-with-marks))) |
| 5775 | (setq undone t | 5796 | (goto-char omark) |
| 5776 | opoint (point)) | 5797 | (todos-remove-item)) |
| 5777 | (todos-update-count 'todo 1) | 5798 | (todos-update-count 'todo item-count) |
| 5778 | (todos-update-count 'done -1) | 5799 | (todos-update-count 'done (- item-count)) |
| 5779 | (and (todos-diary-item-p) (todos-update-count 'diary 1)) | 5800 | (when diary-count (todos-update-count 'diary diary-count)) |
| 5780 | (todos-update-categories-sexp) | 5801 | (todos-update-categories-sexp) |
| 5781 | (let ((todos-show-with-done (> (todos-get-count 'done) 0))) | 5802 | (let ((todos-show-with-done (> (todos-get-count 'done) 0))) |
| 5782 | (todos-category-select) | 5803 | (todos-category-select)) |
| 5783 | ;; Put the cursor on the undone item. | 5804 | ;; Put cursor on undone item. |
| 5784 | (goto-char opoint))) | 5805 | (goto-char npoint))) |
| 5785 | (unless undone | 5806 | (set-marker omark nil))))) |
| 5786 | (let ((todos-show-with-done t)) | ||
| 5787 | (widen) | ||
| 5788 | (goto-char orig-mrk) | ||
| 5789 | (todos-insert-with-overlays orig-item) | ||
| 5790 | (set-buffer-modified-p bufmod) | ||
| 5791 | (todos-category-select)) | ||
| 5792 | (goto-char opoint)))) | ||
| 5793 | (set-marker orig-mrk nil))))) | ||
| 5794 | 5807 | ||
| 5795 | (defun todos-archive-done-item (&optional all) | 5808 | (defun todos-archive-done-item (&optional all) |
| 5796 | "Archive at least one done item in this category. | 5809 | "Archive at least one done item in this category. |
| @@ -5937,7 +5950,7 @@ If there are marked items, unarchive all of these; otherwise, | |||
| 5937 | unarchive the item at point. | 5950 | unarchive the item at point. |
| 5938 | 5951 | ||
| 5939 | Unarchived items are restored as done items to the corresponding | 5952 | Unarchived items are restored as done items to the corresponding |
| 5940 | category in the Todos file, inserted at the end of done items | 5953 | category in the Todos file, inserted at the top of done items |
| 5941 | section. If all items in the archive category have been | 5954 | section. If all items in the archive category have been |
| 5942 | restored, the category is deleted from the archive. If this was | 5955 | restored, the category is deleted from the archive. If this was |
| 5943 | the only category in the archive, the archive file is deleted." | 5956 | the only category in the archive, the archive file is deleted." |
| @@ -5960,7 +5973,7 @@ the only category in the archive, the archive file is deleted." | |||
| 5960 | (setq marked-items (concat marked-items (todos-item-string) "\n")) | 5973 | (setq marked-items (concat marked-items (todos-item-string) "\n")) |
| 5961 | (setq marked-count (1+ marked-count))) | 5974 | (setq marked-count (1+ marked-count))) |
| 5962 | (todos-forward-item)))) | 5975 | (todos-forward-item)))) |
| 5963 | ;; Restore items to end of category's done section and update counts. | 5976 | ;; Restore items to top of category's done section and update counts. |
| 5964 | (with-current-buffer tbuf | 5977 | (with-current-buffer tbuf |
| 5965 | (let (buffer-read-only newcat) | 5978 | (let (buffer-read-only newcat) |
| 5966 | (widen) | 5979 | (widen) |
| @@ -5971,15 +5984,19 @@ the only category in the archive, the archive file is deleted." | |||
| 5971 | (concat "^" (regexp-quote (concat todos-category-beg cat)) | 5984 | (concat "^" (regexp-quote (concat todos-category-beg cat)) |
| 5972 | "$") nil t) | 5985 | "$") nil t) |
| 5973 | (todos-add-category nil cat) | 5986 | (todos-add-category nil cat) |
| 5974 | (setq newcat t) | 5987 | (setq newcat t)) |
| 5975 | ;; Put point below newly added category beginning, | 5988 | ;; Go to top of category's done section. |
| 5976 | ;; otherwise the following search wrongly succeeds. | 5989 | (re-search-forward |
| 5977 | (forward-line)) | 5990 | (concat "^" (regexp-quote todos-category-done)) nil t) |
| 5978 | ;; Go to end of category's done section. | 5991 | (forward-line) |
| 5979 | (if (re-search-forward (concat "^" (regexp-quote todos-category-beg)) | 5992 | ;; FIXME: delete after checking |
| 5980 | nil t) | 5993 | ;; ;; Put point below newly added category beginning, |
| 5981 | (goto-char (match-beginning 0)) | 5994 | ;; ;; otherwise the following search wrongly succeeds. |
| 5982 | (goto-char (point-max))) | 5995 | ;; (forward-line)) |
| 5996 | ;; (if (re-search-forward (concat "^" (regexp-quote todos-category-beg)) | ||
| 5997 | ;; nil t) | ||
| 5998 | ;; (goto-char (match-beginning 0)) | ||
| 5999 | ;; (goto-char (point-max))) | ||
| 5983 | (cond (marked | 6000 | (cond (marked |
| 5984 | (insert marked-items) | 6001 | (insert marked-items) |
| 5985 | (todos-update-count 'done marked-count cat) | 6002 | (todos-update-count 'done marked-count cat) |