:version "24.2"
:group 'calendar)
-;; FIXME: use file-truename (but in a defcustom) ?
(defcustom todos-files-directory (locate-user-emacs-file "todos/")
"Directory where user's Todos files are saved."
:type 'directory
(funcall todos-files-function))))
:group 'todos)
-;; FIXME: is there a better alternative to this?
(defun todos-reevaluate-default-file-defcustom ()
"Reevaluate defcustom of `todos-default-todos-file'.
Called after adding or deleting a Todos file."
(funcall todos-files-function))))
:group 'todos)
-;; FIXME: is there a better alternative to this?
(defun todos-reevaluate-category-completions-files-defcustom ()
"Reevaluate defcustom of `todos-category-completions-files'.
Called after adding or deleting a Todos file."
(defcustom todos-prefix ""
"String prefixed to todo items for visual distinction."
- :type 'string
+ :type '(string :validate
+ (lambda (widget)
+ (when (string= (widget-value widget) todos-item-mark)
+ (widget-put
+ widget :error
+ "Invalid value: must be distinct from `todos-item-mark'")
+ widget)))
:initialize 'custom-initialize-default
:set 'todos-reset-prefix
:group 'todos-mode-display)
;; Activate the new setting (save-restriction does not help).
(save-excursion (todos-category-select))))))))
-(defcustom todos-done-separator-string "_"
+(defcustom todos-item-mark "*"
+ "String used to mark items.
+To ensure item marking works, change the value of this option
+only when no items are marked."
+ :type '(string :validate
+ (lambda (widget)
+ (when (string= (widget-value widget) todos-prefix)
+ (widget-put
+ widget :error
+ "Invalid value: must be distinct from `todos-prefix'")
+ widget)))
+ :set (lambda (symbol value)
+ (custom-set-default symbol (propertize value 'face 'todos-mark)))
+ :group 'todos-mode-display)
+
+(defcustom todos-done-separator-string "="
"String for generating `todos-done-separator'.
If the string consists of a single character,
(files todos-file-buffers)
(sep todos-done-separator))
(custom-set-default symbol value)
- (setq todos-done-separator (todos-done-separator))
- (when (= 1 (length value))
- (todos-reset-done-separator sep))))
+ (when (not (equal value oldvalue))
+ (dolist (f files)
+ (with-current-buffer (find-file-noselect f)
+ (let (buffer-read-only)
+ (setq todos-done-separator (todos-done-separator))
+ (when (= 1 (length value))
+ (todos-reset-done-separator sep)))
+ (todos-category-select))))))
(defcustom todos-done-string "DONE "
"Identifying string appended to the front of done todos items."
(unless (member '(continuation) fringe-indicator-alist)
(push '(continuation) fringe-indicator-alist)))
-;; FIXME: :set function to refill items with hard newlines and to immediately
-;; update wrapped prefix display
(defcustom todos-indent-to-here 6
"Number of spaces `todos-line-wrapping-function' indents to."
:type '(integer :validate
:type 'integer
:group 'todos-filtered)
-;; (defcustom todos-save-top-priorities nil ;FIXME: use or delete this
-;; "Non-nil to"
-;; :type 'boolean
-;; :group 'todos-filtered)
-
(defcustom todos-filter-files nil
"List of default files for multifile item filtering."
:type `(set ,@(mapcar (lambda (f) (list 'const f))
(funcall todos-files-function))))
:group 'todos-filtered)
-;; FIXME: is there a better alternative to this?
(defun todos-reevaluate-filter-files-defcustom ()
"Reevaluate defcustom of `todos-filter-files'.
Called after adding or deleting a Todos file."
:group 'todos-faces)
(defface todos-top-priority
- ;; '((t :inherit font-lock-comment-face))
- '((((class grayscale) (background light))
- :foreground "DimGray" :weight bold :slant italic)
- (((class grayscale) (background dark))
- :foreground "LightGray" :weight bold :slant italic)
- (((class color) (min-colors 88) (background light))
- :foreground "Firebrick" :weight bold)
- (((class color) (min-colors 88) (background dark))
- :foreground "chocolate1" :weight bold)
- (((class color) (min-colors 16) (background light))
- :foreground "red" :weight bold)
- (((class color) (min-colors 16) (background dark))
- :foreground "red1" :weight bold)
- (((class color) (min-colors 8) (background light))
- :foreground "red" :weight bold)
- (((class color) (min-colors 8) (background dark))
- :foreground "yellow" :weight bold)
- (t :weight bold :slant italic))
+ ;; bold font-lock-comment-face
+ '((default :weight bold)
+ (((class grayscale) (background light)) :foreground "DimGray" :slant italic)
+ (((class grayscale) (background dark)) :foreground "LightGray" :slant italic)
+ (((class color) (min-colors 88) (background light)) :foreground "Firebrick")
+ (((class color) (min-colors 88) (background dark)) :foreground "chocolate1")
+ (((class color) (min-colors 16) (background light)) :foreground "red")
+ (((class color) (min-colors 16) (background dark)) :foreground "red1")
+ (((class color) (min-colors 8) (background light)) :foreground "red")
+ (((class color) (min-colors 8) (background dark)) :foreground "yellow")
+ (t :slant italic))
"Face for top priority Todos item numerical priority string.
The item's priority number string has this face if the number is
less than or equal the category's top priority setting."
:group 'todos-faces)
(defface todos-diary-expired
- ;; '((t :inherit font-lock-warning-face))
- '((((class color)
- (min-colors 16))
- (:weight bold :foreground "DarkOrange"))
- (((class color))
- (:weight bold :foreground "yellow"))
- (t
- (:weight bold)))
+ ;; Doesn't contrast enough with todos-date (= diary) face.
+ ;; ;; '((t :inherit warning))
+ ;; '((default :weight bold)
+ ;; (((class color) (min-colors 16)) :foreground "DarkOrange")
+ ;; (((class color)) :foreground "yellow"))
+ ;; bold font-lock-function-name-face
+ '((default :weight bold)
+ (((class color) (min-colors 88) (background light)) :foreground "Blue1")
+ (((class color) (min-colors 88) (background dark)) :foreground "LightSkyBlue")
+ (((class color) (min-colors 16) (background light)) :foreground "Blue")
+ (((class color) (min-colors 16) (background dark)) :foreground "LightSkyBlue")
+ (((class color) (min-colors 8)) :foreground "blue")
+ (t :inverse-video t))
"Face for expired dates of diary items."
:group 'todos-faces)
(defvar todos-diary-expired-face 'todos-diary-expired)
:group 'todos-faces)
(defvar todos-time-face 'todos-time)
+(defface todos-nondiary
+ ;; '((t :inherit font-lock-type-face))
+ '((((class grayscale) (background light)) :foreground "Gray90" :weight bold)
+ (((class grayscale) (background dark)) :foreground "DimGray" :weight bold)
+ (((class color) (min-colors 88) (background light)) :foreground "ForestGreen")
+ (((class color) (min-colors 88) (background dark)) :foreground "PaleGreen")
+ (((class color) (min-colors 16) (background light)) :foreground "ForestGreen")
+ (((class color) (min-colors 16) (background dark)) :foreground "PaleGreen")
+ (((class color) (min-colors 8)) :foreground "green")
+ (t :weight bold :underline t))
+ "Face for non-diary markers around todo item date/time header."
+ :group 'todos-faces)
+(defvar todos-nondiary-face 'todos-nondiary)
+
+(defface todos-category-string
+ ;; '((t :inherit font-lock-type-face))
+ '((((class grayscale) (background light)) :foreground "Gray90" :weight bold)
+ (((class grayscale) (background dark)) :foreground "DimGray" :weight bold)
+ (((class color) (min-colors 88) (background light)) :foreground "ForestGreen")
+ (((class color) (min-colors 88) (background dark)) :foreground "PaleGreen")
+ (((class color) (min-colors 16) (background light)) :foreground "ForestGreen")
+ (((class color) (min-colors 16) (background dark)) :foreground "PaleGreen")
+ (((class color) (min-colors 8)) :foreground "green")
+ (t :weight bold :underline t))
+ "Face for category file names in Todos Filtered Item."
+ :group 'todos-faces)
+(defvar todos-category-string-face 'todos-category-string)
+
(defface todos-done
+ ;; '((t :inherit font-lock-keyword-face))
+ '((((class grayscale) (background light)) :foreground "LightGray" :weight bold)
+ (((class grayscale) (background dark)) :foreground "DimGray" :weight bold)
+ (((class color) (min-colors 88) (background light)) :foreground "Purple")
+ (((class color) (min-colors 88) (background dark)) :foreground "Cyan1")
+ (((class color) (min-colors 16) (background light)) :foreground "Purple")
+ (((class color) (min-colors 16) (background dark)) :foreground "Cyan")
+ (((class color) (min-colors 8)) :foreground "cyan" :weight bold)
+ (t :weight bold))
+ "Face for done Todos item header string."
+ :group 'todos-faces)
+(defvar todos-done-face 'todos-done)
+
+(defface todos-comment
;; '((t :inherit font-lock-comment-face))
'((((class grayscale) (background light))
:foreground "DimGray" :weight bold :slant italic)
(((class color) (min-colors 88) (background dark))
:foreground "chocolate1")
(((class color) (min-colors 16) (background light))
- ;; FIXME: this is the same as todos-date with default value of diary face
:foreground "red")
(((class color) (min-colors 16) (background dark))
:foreground "red1")
(((class color) (min-colors 8) (background dark))
:foreground "yellow")
(t :weight bold :slant italic))
- "Face for done Todos item header string."
- :group 'todos-faces)
-(defvar todos-done-face 'todos-done)
-
-(defface todos-comment
- ;; '((t :inherit font-lock-keyword-face))
- '((((class grayscale) (background light)) :foreground "LightGray" :weight bold)
- (((class grayscale) (background dark)) :foreground "DimGray" :weight bold)
- (((class color) (min-colors 88) (background light)) :foreground "Purple")
- (((class color) (min-colors 88) (background dark)) :foreground "Cyan1")
- (((class color) (min-colors 16) (background light)) :foreground "Purple")
- (((class color) (min-colors 16) (background dark)) :foreground "Cyan")
- (((class color) (min-colors 8)) :foreground "cyan" :weight bold)
- (t :weight bold))
"Face for comments appended to done Todos items."
:group 'todos-faces)
(defvar todos-comment-face 'todos-comment)
(defface todos-done-sep
- ;; '((t :inherit font-lock-type-face))
- '((((class grayscale) (background light)) :foreground "Gray90" :weight bold)
+ ;; '((t :inherit font-lock-builtin-face))
+ '((((class grayscale) (background light)) :foreground "LightGray" :weight bold)
(((class grayscale) (background dark)) :foreground "DimGray" :weight bold)
- (((class color) (min-colors 88) (background light)) :foreground "ForestGreen")
- (((class color) (min-colors 88) (background dark)) :foreground "PaleGreen")
- (((class color) (min-colors 16) (background light)) :foreground "ForestGreen")
- (((class color) (min-colors 16) (background dark)) :foreground "PaleGreen")
- (((class color) (min-colors 8)) :foreground "green")
- (t :weight bold :underline t))
+ (((class color) (min-colors 88) (background light)) :foreground "dark slate blue")
+ (((class color) (min-colors 88) (background dark)) :foreground "LightSteelBlue")
+ (((class color) (min-colors 16) (background light)) :foreground "Orchid")
+ (((class color) (min-colors 16) (background dark)) :foreground "LightSteelBlue")
+ (((class color) (min-colors 8)) :foreground "blue" :weight bold)
+ (t :weight bold))
"Face for separator string bewteen done and not done Todos items."
:group 'todos-faces)
(defvar todos-done-sep-face 'todos-done-sep)
(defun todos-category-string-matcher-1 (lim)
"Search for Todos category name within LIM for font-locking.
-This is for fontifying category names appearing in Todos filter
-mode following done items."
+This is for fontifying category and file names appearing in Todos
+Filtered Items mode following done items."
(if (eq major-mode 'todos-filtered-items-mode)
(re-search-forward (concat todos-done-string-start todos-date-pattern
"\\(?: " diary-time-regexp
(defun todos-category-string-matcher-2 (lim)
"Search for Todos category name within LIM for font-locking.
-This is for fontifying category names appearing in Todos filter
-mode following todo (not done) items."
+This is for fontifying category and file names appearing in Todos
+Filtered Items mode following todo (not done) items."
(if (eq major-mode 'todos-filtered-items-mode)
(re-search-forward (concat todos-date-string-start todos-date-pattern
"\\(?: " diary-time-regexp "\\)?\\(?:"
(defvar todos-font-lock-keywords
(list
- '(todos-nondiary-marker-matcher 1 todos-done-sep-face t)
- '(todos-nondiary-marker-matcher 2 todos-done-sep-face t)
- ;; This is the face used by diary-lib.el.
+ '(todos-nondiary-marker-matcher 1 todos-nondiary-face t)
+ '(todos-nondiary-marker-matcher 2 todos-nondiary-face t)
+ ;; diary-lib.el uses font-lock-constant-face for diary-nonmarking-symbol.
'(todos-diary-nonmarking-matcher 1 font-lock-constant-face t)
'(todos-date-string-matcher 1 todos-date-face t)
'(todos-time-string-matcher 1 todos-time-face t)
'(todos-done-string-matcher 0 todos-done-face t)
'(todos-comment-string-matcher 1 todos-comment-face t)
- ;; '(todos-category-string-matcher 1 todos-done-sep-face t)
- '(todos-category-string-matcher-1 1 todos-done-sep-face t t)
- '(todos-category-string-matcher-2 1 todos-done-sep-face t t)
+ '(todos-category-string-matcher-1 1 todos-category-string-face t t)
+ '(todos-category-string-matcher-2 1 todos-category-string-face t t)
'(todos-diary-expired-matcher 1 todos-diary-expired-face t)
'(todos-diary-expired-matcher 2 todos-diary-expired-face t t)
)
`todos-category-select'.")
(defun todos-reset-and-enable-done-separator ()
- "Show resized catagory separator overlay after window size change.
+ "Show resized done items separator overlay after window change.
Added to `window-configuration-change-hook' in `todos-mode'."
(when (= 1 (length todos-done-separator-string))
(let ((sep todos-done-separator))
(setq todos-done-separator (todos-done-separator))
- (save-match-data (todos-reset-done-separator sep)))
- ;; FIXME: If this is called while the separator overlay is shown, the
- ;; separator with deleted overlay becomes visible when waiting for user
- ;; input and remains so. The following workaround prevents this, but it
- ;; also prevents widening category when edebugging todos.el.
- ;; (save-excursion
- ;; (goto-char (point-min))
- ;; (when (re-search-forward todos-done-string-start nil t)
- ;; (let ((todos-show-with-done nil))
- ;; (todos-category-select))
- ;; (let ((todos-show-with-done t))
- ;; (todos-category-select))))
- ))
+ (save-match-data (todos-reset-done-separator sep)))))
;; ---------------------------------------------------------------------------
;;; Global variables and helper functions for files and buffers
(save-restriction
(widen)
(goto-char (point-min))
- ;; Check for `todos-categories' sexp as the first line
- (let ((cats (prin1-to-string todos-categories)))
- (unless (looking-at (regexp-quote cats))
+ (let ((cats (prin1-to-string todos-categories))
+ (sexp (buffer-substring-no-properties (line-beginning-position)
+ (line-end-position))))
+ ;; Check for `todos-categories' sexp as the first line
+ (unless (string= sexp cats)
(error "Invalid or missing todos-categories sexp")))
(forward-line)
(let ((legit (concat "\\(^" (regexp-quote todos-category-beg) "\\)"
(1+ (- (length categories)
(length (member cat categories)))))))
-(defun todos-current-category () ;FIXME: arg FILE ?
+(defun todos-current-category ()
"Return the name of the current category."
(car (nth (1- todos-category-number) todos-categories)))
(defun todos-done-separator ()
"Return string used as value of variable `todos-done-separator'."
(let ((sep todos-done-separator-string))
- (if (= 1 (length sep))
- (make-string (window-width) (string-to-char sep))
- todos-done-separator-string)))
+ (propertize (if (= 1 (length sep))
+ ;; If separator's length is window-width, an
+ ;; indented empty line appears between the
+ ;; separator and the first done item.
+ ;; FIXME: should this be customizable?
+ (make-string (1- (window-width)) (string-to-char sep))
+ todos-done-separator-string)
+ 'face 'todos-done-sep)))
(defvar todos-done-separator (todos-done-separator)
"String used to visually separate done from not done items.
(let* ((beg (match-beginning 1))
(end (match-end 0))
(ovs (overlays-at beg))
- old-sep new-sep)
- (and ovs
- (setq old-sep (overlay-get (car ovs) 'display))
- (string= old-sep sep)
- (delete-overlay (car ovs))
- (setq new-sep (make-overlay beg end))
- (overlay-put new-sep 'display
- todos-done-separator)))))))
+ (ov (when ovs (car ovs)))
+ (old-sep (when ov (overlay-get ov 'display)))
+ new-ov)
+ (when (string= old-sep sep)
+ (setq new-ov (make-overlay beg end))
+ (overlay-put new-ov 'display todos-done-separator)
+ (delete-overlay ov)))))))
(defun todos-category-completions ()
"Return a list of completions for `todos-read-category'.
(point-max)))
(setq mode-line-buffer-identification
(funcall todos-mode-line-function name))
- ;; FIXME: When, starting from `C-u i i' (and apparently only from
- ;; this, e.g. `m' does not trigger the problem), after the
- ;; following line is executed, the last line of the narrowed
- ;; region (sometimes, always?) is at (window-start)... (continued
- ;; below)
(narrow-to-region cat-begin cat-end)
(todos-prefix-overlays)
(goto-char (point-min))
;; already is one.
(let* ((done-sep todos-done-separator)
(ovs (overlays-at done-sep-start))
+ ;; ov-sep0 ov-sep1)
ov-sep)
;; There should never be more than one overlay here, so car suffices.
(unless (and ovs (string= (overlay-get (car ovs) 'display) done-sep))
(setq ov-sep (make-overlay done-sep-start done-end))
(overlay-put ov-sep 'display done-sep))))
- ;; FIXME: (continued) ...and after the following line, now the
- ;; new last line of the narrowed region is (sometimes?) at
- ;; (window-start), and after inserting the new item at the
- ;; bottom of the list, the latter remains at (window-start).
- ;; But `M-<' corrects the display, and since the narrowed region
- ;; is shorter than (window-height), there is no way to
- ;; interactively make Emacs show the last line at
- ;; (window-start).
+ ;; (setq ov-sep0 (make-overlay done-sep-start done-end))
+ ;; (setq ov-sep1 (make-overlay done-end done-end))
+ ;; (overlay-put ov-sep0 'invisible t)
+ ;; (overlay-put ov-sep1 'after-string done-sep)))
(narrow-to-region (point-min) done-start)
;; Loading this from todos-mode, or adding it to the mode hook, causes
;; Emacs to hang in todos-item-start, at (looking-at todos-item-start).
(goto-char (point-min))
(if (looking-at (concat "^" (regexp-quote todos-category-beg)))
(progn (newline) (goto-char (point-min)) ; Make space for sexp.
- ;; No categories sexp means the first item was just added
- ;; to this file, so have to initialize Todos file and
- ;; categories variables in order e.g. to enable categories
- ;; display.
- ;; FIXME: is this right?
- (setq todos-default-todos-file (buffer-file-name))
(setq todos-categories (todos-make-categories-list t)))
- ;; With empty buffer (e.g. with new archive in
- ;; `todos-move-category') `kill-line' signals end of buffer.
- (kill-region (line-beginning-position) (line-end-position)))
+ (delete-region (line-beginning-position) (line-end-position)))
(prin1 todos-categories (current-buffer))))))
(defun todos-make-categories-list (&optional force)
(defun todos-repair-categories-sexp ()
"Repair corrupt Todos categories sexp.
This should only be needed as a consequence of careless manual
-editing or a bug in todos.el."
+editing or a bug in todos.el.
+
+*Warning*: Calling this command restores the category order to
+the list element order in the Todos categories sexp, so any order
+changes made in Todos Categories mode will have to be made again."
(interactive)
(let ((todos-categories (todos-make-categories-list t)))
(todos-update-categories-sexp)))
(let ((dayname (diary-name-pattern calendar-day-name-array nil t)))
(concat "\\(?5:" dayname "\\|"
(let ((dayname)
- ;; FIXME: how to choose between abbreviated and unabbreviated
- ;; month name?
- ;; (monthname (format "\\(?6:%s\\|\\*\\)"
- ;; (diary-name-pattern
- ;; calendar-month-name-array
- ;; calendar-month-abbrev-array)))
(monthname (format "\\(?6:%s\\)" (diary-name-pattern
todos-month-name-array
todos-month-abbrev-array)))
(todos-item-start)
(looking-at todos-done-string-start)))
-(defvar todos-item-mark (propertize (if (equal todos-prefix "*") "@" "*")
- 'face 'todos-mark)
- "String used to mark items.")
+(defun todos-done-item-section-p ()
+ "Return non-nil if point is in category's done items section."
+ (save-excursion
+ (or (re-search-backward (concat "^" (regexp-quote todos-category-done))
+ nil t)
+ (progn (goto-char (point-min))
+ (looking-at todos-done-string-start)))))
+
+(defun todos-prefix-overlay ()
+ "Return this item's prefix overlay."
+ (let* ((lbp (line-beginning-position))
+ (ovs (overlays-in lbp lbp)))
+ (car ovs)))
(defun todos-marked-item-p ()
- "If this item begins with `todos-item-mark', return mark overlay."
- (let ((ovs (overlays-in (line-beginning-position) (line-beginning-position)))
- (mark todos-item-mark)
- ov marked)
- (catch 'stop
- (while ovs
- (setq ov (pop ovs))
- (and (equal (overlay-get ov 'before-string) mark)
- (throw 'stop (setq marked t)))))
+ "Non-nil if this item begins with `todos-item-mark'.
+ In that case, return the item's prefix overlay."
+ ;; If a todos-item-insert command is called on a Todos file before
+ ;; it is visited, it has no prefix overlays, so conditionalize:
+ (let* ((ov (todos-prefix-overlay))
+ (pref (when ov (overlay-get ov 'before-string)))
+ (marked (when pref
+ (string-match (concat "^" (regexp-quote todos-item-mark))
+ pref))))
(when marked ov)))
(defun todos-insert-with-overlays (item)
"Insert ITEM at point and update prefix/priority number overlays."
(todos-item-start)
- (insert item "\n")
+ ;; Insertion pushes item down but not its prefix overlay. When the
+ ;; overlay includes a mark, this would now mark the inserted ITEM,
+ ;; so move it to the pushed down item.
+ (let ((ov (todos-prefix-overlay))
+ (marked (todos-marked-item-p)))
+ (insert item "\n")
+ (when marked (move-overlay ov (point) (point))))
(todos-backward-item)
(todos-prefix-overlays))
-(defun todos-prefix-overlays () ;FIXME: this is a category function
- "Put before-string overlay in front of this category's items.
+(defun todos-prefix-overlays ()
+ "Update the prefix overlays of the current category's items.
The overlay's value is the string `todos-prefix' or with non-nil
`todos-number-priorities' an integer in the sequence from 1 to
the number of todo or done items in the category indicating the
item's priority. Todo and done items are numbered independently
of each other."
- (when (or todos-number-priorities
- (not (string-match "^[[:space:]]*$" todos-prefix)))
- (let ((prefix (propertize (concat todos-prefix " ")
- 'face 'todos-prefix-string))
- (num 0)
- (cat-tp (or (cdr (assoc-string (todos-current-category)
- (nth 2 (assoc-string todos-current-todos-file
- todos-priorities-rules))))
- todos-show-priorities))
- done)
- (save-excursion
- (goto-char (point-min))
- (while (not (eobp))
- (when (or (todos-date-string-matcher (line-end-position))
- (todos-done-string-matcher (line-end-position)))
- (goto-char (match-beginning 0))
- (when todos-number-priorities
- (setq num (1+ num))
- ;; Reset number to 1 for first done item.
- (when (and (looking-at todos-done-string-start)
- (looking-back (concat "^"
- (regexp-quote todos-category-done)
- "\n")))
- (setq num 1
- done t))
- (setq prefix (propertize (concat (number-to-string num) " ")
- 'face
- ;; Numbers of top priorities have
- ;; a distinct face in Todos mode.
- (if (and (not done) (<= num cat-tp)
- (eq major-mode 'todos-mode))
- 'todos-top-priority
- 'todos-prefix-string))))
- (let ((ovs (overlays-in (point) (point)))
- marked ov-pref)
- (if ovs
- (dolist (ov ovs)
- (let ((val (overlay-get ov 'before-string)))
- (if (equal val "*")
- (setq marked t)
- (setq ov-pref val)))))
- ;; Omitting this condition doesn't appear to slow
- ;; redisplay down, while having it prevents updating
- ;; display after changing number of top priorities.
- ;; (unless (equal ov-pref prefix)
- ;; Why doesn't this work?
- ;; (remove-overlays (point) (point) 'before-string)
- (remove-overlays (point) (point))
- (overlay-put (make-overlay (point) (point))
- 'before-string prefix)
- (and marked (overlay-put (make-overlay (point) (point))
- 'before-string todos-item-mark))));)
- (forward-line))))))
+ (let ((prefix (propertize (concat todos-prefix " ")
+ 'face 'todos-prefix-string))
+ (num 0)
+ (cat-tp (or (cdr (assoc-string
+ (todos-current-category)
+ (nth 2 (assoc-string todos-current-todos-file
+ todos-priorities-rules))))
+ todos-show-priorities))
+ done)
+ (save-excursion
+ (goto-char (point-min))
+ (while (not (eobp))
+ (when (or (todos-date-string-matcher (line-end-position))
+ (todos-done-string-matcher (line-end-position)))
+ (goto-char (match-beginning 0))
+ (when todos-number-priorities
+ (setq num (1+ num))
+ ;; Reset number to 1 for first done item.
+ (when (and (looking-at todos-done-string-start)
+ (looking-back (concat "^"
+ (regexp-quote todos-category-done)
+ "\n")))
+ (setq num 1
+ done t))
+ (setq prefix (propertize (concat (number-to-string num) " ")
+ 'face
+ ;; Numbers of top priorities have
+ ;; a distinct face in Todos mode.
+ (if (and (not done) (<= num cat-tp)
+ (eq major-mode 'todos-mode))
+ 'todos-top-priority
+ 'todos-prefix-string))))
+ (let ((ov (todos-prefix-overlay))
+ (marked (todos-marked-item-p)))
+ (unless ov (setq ov (make-overlay (point) (point))))
+ (overlay-put ov 'before-string (if marked
+ (concat todos-item-mark prefix)
+ prefix))))
+ (forward-line)))))
;; ---------------------------------------------------------------------------
;;; Helper functions for user input with prompting and completion
number of the last the day of the month."
(let (year monthname month day
dayname) ; Needed by calendar-date-display-form.
- ;; FIXME: year can be omitted from Diary
(when (or (not arg) (eq arg 'year))
(while (if (natnump year) (< year 1) (not (eq year '*)))
(setq year (read-from-minibuffer
month (1+ (- (length mlist)
(length (or (member monthname mlist)
(member monthname mablist))))))
- ;; FIXME: We follow diary-insert-entry in using abbreviated
- ;; month name (and no day name) in date string. Should this
- ;; be customizable?
(setq monthname (aref mabarray (1- month)))))
(when (or (not arg) (eq arg 'day))
(let ((last (let ((mm (or month mo))
" \"%s\"") buffer-type fnames))))
(defun todos-find-item (str)
- ""
+ "Search for saved top priority item STR in its Todos file.
+Return the list (FOUND FILE CAT), where CAT and FILE are the
+item's category and file, and FOUND is a cons cell if the search
+succeeds, whose car is the start of the item in FILE and whose
+cdr is `done' if the item is now a done item, `changed' if its
+priority has changed or its text was truncated or augmented, and
+`same' otherwise."
(string-match (concat (if todos-filter-done-items
(concat "\\(?:" todos-done-string-start "\\|"
todos-date-string-start "\\)")
(regexp-quote todos-nondiary-end)) "?"
"\\(?4: \\[\\(?3:(archive) \\)?\\(?2:.*:\\)?"
"\\(?1:.*\\)\\]\\).*$") str)
- ;; FIXME: use cat and file to find priorities
(let ((cat (match-string 1 str))
(file (match-string 2 str))
(archive (string= (match-string 3 str) "(archive) "))
+ (filcat (match-string 4 str))
+ (tpriority 1)
found)
(setq str (replace-match "" nil nil str 4))
+ (save-excursion
+ (while (search-backward filcat nil t)
+ (setq tpriority (1+ tpriority))))
(setq file (if file
(concat todos-files-directory (substring file 0 -1)
(if archive ".toda" ".todo"))
(with-current-buffer (find-buffer-visiting file)
(widen)
(goto-char (point-min))
- (re-search-forward
- (concat "^" (regexp-quote (concat todos-category-beg cat)) "$") nil t)
- ;; FIXME: use todos-forward-item to find priority, and return it as well
- (setq found (search-forward str nil t)))
- (list found file cat)))
+ (let ((beg (re-search-forward
+ (concat "^" (regexp-quote (concat todos-category-beg cat)) "$")
+ nil t))
+ (done (save-excursion
+ (re-search-forward
+ (concat "^" (regexp-quote todos-category-done)) nil t)))
+ (end (save-excursion
+ (or (re-search-forward
+ (concat "^" (regexp-quote todos-category-beg))
+ nil t)
+ (point-max)))))
+ (setq found (when (search-forward str end t)
+ (goto-char (match-beginning 0))))
+ (when found
+ (setq found
+ (cons found (if (> (point) done)
+ 'done
+ (let ((cpriority 1))
+ (save-excursion
+ ;; Not top item in category.
+ (while (> (point) (1+ beg))
+ (let ((opoint (point)))
+ (todos-backward-item)
+ ;; Can't move backward beyond
+ ;; first item in file.
+ (unless (= (point) opoint)
+ (setq cpriority (1+ cpriority))))))
+ (if (and (= tpriority cpriority)
+ ;; Proper substring is not the same.
+ (string= (todos-item-string)
+ str))
+ 'same
+ 'changed))))))))
+ (list found file cat)))
(defun todos-check-top-priorities ()
- "Return a message saying whether top priorities file is up-to-date."
- (while (not (eobp))
- (let ((item (todos-item-string)))
- (unless (car (todos-find-item item))
- (error "Top priorities file is not up to date")))
- (todos-forward-item))
- (message "Top priorities file is up to date."))
-
-(defun todos-top-priorities-filename () ;FIXME: make part of t-s-t-p-b ?
+ "Return a message saying whether top priorities file is up to date."
+ ;; (catch 'old
+ (let ((count 0))
+ (while (not (eobp))
+ (let* ((item (todos-item-string))
+ (found (car (todos-find-item item))))
+ (unless (eq (cdr found) 'same)
+ (save-excursion
+ (overlay-put (make-overlay (todos-item-start) (todos-item-end))
+ 'face 'todos-search))
+ (setq count (1+ count))))
+ ;; (throw 'old (message "The marked item is not up to date.")))
+ (todos-forward-item))
+ (if (zerop count)
+ (message "Top priorities file is up to date.")
+ (message (concat "The highlighted item" (if (= count 1) " is " "s are ")
+ "not up to date."
+ ;; "\nType <return> on item for details."
+ )))))
+
+(defun todos-top-priorities-filename ()
""
(let ((bufname (buffer-name)))
(string-match "\"\\([^\"]+\\)\"" bufname)
(let ((archive (member todos-current-todos-file todos-archives))
buffer-read-only)
(erase-buffer)
- ;; FIXME: add usage tips?
(insert (format (concat "Category counts for Todos "
(if archive "archive" "file")
" \"%s\".")
"-\\_>" ""
(replace-regexp-in-string
"-+" "-"
- ;; FIXME: "todos-insert-item-"
(concat "todos-item-insert-"
(mapconcat (lambda (e) (if e (symbol-name e))) arglist "-")))))
todos-insertion-commands-args)
"List of names of Todos insertion commands.")
-;; FIXME: prefix argument ARG is nil
(defmacro todos-define-insertion-command (&rest args)
(let ((name (intern (todos-insertion-command-name args)))
(arg0 (nth 0 args))
(interactive (list current-prefix-arg))
(todos-insert-item arg ',arg0 ',arg1 ',arg2 ',arg3 ',arg4))))
-;; FIXME: exclude todos-insert-item (or rather from
-;; todos-insertion-key-bindings?), otherwise its doc string won't be
-;; found with C-h k (but it will with M-x todos-insert-item)
(defvar todos-insertion-commands
(mapcar (lambda (c)
(eval `(todos-define-insertion-command ,@c)))
map)
"Todos mode keymap.")
-;; FIXME
(easy-menu-define
todos-menu todos-mode-map "Todos Menu"
'("Todos"
'todos-reset-and-enable-done-separator nil t)
(add-hook 'kill-buffer-hook 'todos-reset-global-current-todos-file nil t))
-(defun todos-unload-hook ()
- ""
- (remove-hook 'pre-command-hook 'todos-show-current-file t)
- (remove-hook 'post-command-hook 'todos-update-buffer-list t)
- (remove-hook 'find-file-hook 'todos-display-as-todos-file t)
- (remove-hook 'find-file-hook 'todos-add-to-buffer-list t)
- (remove-hook 'window-configuration-change-hook
- 'todos-reset-and-enable-done-separator t)
- (remove-hook 'kill-buffer-hook 'todos-reset-global-current-todos-file t))
-
(put 'todos-archive-mode 'mode-class 'special)
;; If todos-mode is parent, all todos-mode key bindings appear to be
;; invocation of `todos-show', since there is then
;; no buffer visiting the current file.
(find-file-noselect todos-current-todos-file 'nowarn)
- todos-categories)))
+ (or todos-categories
+ ;; In Todos Edit mode todos-categories is now nil
+ ;; since it uses same buffer as Todos mode but
+ ;; doesn't have the latter's local variables.
+ (save-excursion
+ (goto-char (point-min))
+ (read (buffer-substring-no-properties
+ (line-beginning-position)
+ (line-end-position))))))))
(set (make-local-variable 'todos-categories) cats)))
(define-derived-mode todos-edit-mode text-mode "Todos-Ed"
\\{todos-edit-mode-map}"
(todos-modes-set-1)
- (todos-mode-external-set))
+ (todos-mode-external-set)
+ (setq buffer-read-only nil))
(put 'todos-categories-mode 'mode-class 'special)
\\{todos-categories-mode-map}"
(todos-mode-external-set))
-(put 'todos-filter-mode 'mode-class 'special)
+(put 'todos-filtered-items-mode 'mode-class 'special)
(define-derived-mode todos-filtered-items-mode special-mode "Todos-Fltr"
"Mode for displaying and reprioritizing top priority Todos.
;; called again from todos-display-categories.
(let ((todos-current-todos-file file))
(cond ((eq todos-show-first 'table)
- ;; FIXME: what if there are no categories yet?
(todos-display-categories))
((eq todos-show-first 'top)
(let* ((shortf (todos-short-file-name file))
(let* ((str (todos-item-string))
(buf (current-buffer))
(res (todos-find-item str))
+ (found (nth 0 res))
(file (nth 1 res))
- (cat (nth 2 res))
- beg)
- (if (not (car res))
- (message "Item not found")
- (setq beg (match-beginning 0))
+ (cat (nth 2 res)))
+ (if (not found)
+ (message "Category %s does not contain this item." cat)
(kill-buffer buf)
(set-window-buffer (selected-window)
(set-buffer (find-buffer-visiting file)))
(setq todos-current-todos-file file)
(setq todos-category-number (todos-category-number cat))
- (let ((todos-show-with-done (if todos-filter-done-items
+ (let ((todos-show-with-done (if (or todos-filter-done-items
+ (eq (cdr found) 'done))
t
todos-show-with-done)))
(todos-category-select))
- (goto-char beg))))
+ (goto-char (car found)))))
(defun todos-forward-item (&optional count)
"Move point down to start of item with next lower priority.
With positive numerical prefix COUNT, move point COUNT items
-downward."
+downward.
+
+If the category's done items are hidden, this command also moves
+point to the empty line below the last todo item from any higher
+item in the category, i.e., when invoked with or without a prefix
+argument. If the category's done items are visible, this command
+called with a prefix argument only moves point to a lower item,
+e.g., with point on the last todo item and called with prefix 1,
+it moves point to the first done item; but if called with point
+on the last todo item without a prefix argument, it moves point
+the the empty line above the done items separator."
(interactive "P")
;; It's not worth the trouble to allow prefix arg value < 1, since we have
;; the corresponding command.
;; space above todos-done-separator, since that is a legitimate place to
;; insert an item. But skip this space if count > 1, since that should
;; only stop on an item.
- (when (and not-done (todos-done-item-p))
- (if (or (not count) (= count 1))
- (re-search-backward "^$" start t))))))
+ (when (and not-done (todos-done-item-p) (not count))
+ ;; (if (or (not count) (= count 1))
+ (re-search-backward "^$" start t)))));)
;; FIXME: The preceding sexp is insufficient when buffer is not narrowed,
;; since there could be no done items in this category, so the search puts
;; us on first todo item of next category. Does this ever happen? If so:
(defun todos-backward-item (&optional count)
"Move point up to start of item with next higher priority.
With positive numerical prefix COUNT, move point COUNT items
-upward."
+upward.
+
+If the category's done items are visible, this command called
+with a prefix argument only moves point to a higher item, e.g.,
+with point on the first done item and called with prefix 1, it
+moves to the last todo item; but if called with point on the
+first done item without a prefix argument, it moves point the the
+empty line above the done items separator."
(interactive "P")
;; Avoid moving to bob if on the first item but not at bob.
(when (> (line-number-at-pos) 1)
;; todos-done-separator, since that is a legitimate place to insert an
;; item. But skip this space if count > 1, since that should only
;; stop on an item.
- (when (and done (not (todos-done-item-p)) (or (not count) (= count 1))
+ (when (and done (not (todos-done-item-p)) (not count)
+ ;(or (not count) (= count 1))
(not (equal (buffer-name) todos-regexp-items-buffer)))
(re-search-forward (concat "^" (regexp-quote todos-category-done))
nil t)
;; Align with beginning of category label.
(forward-char (+ 4 (length todos-categories-number-separator)))))
-;; FIXME: (i) Extend search to other Todos files. (ii) Allow navigating among
-;; hits. (But these features are effectively available with
-;; todos-regexp-items-multifile, so maybe it's not worth the trouble here.)
(defun todos-search ()
"Search for a regular expression in this Todos file.
The search runs through the whole file and encompasses all and
(interactive)
(if (zerop (todos-get-count 'done (todos-current-category)))
(message "There are no done items in this category.")
- (save-excursion
+ (let ((opoint (point)))
(goto-char (point-min))
- (let ((todos-show-with-done (not (re-search-forward
- todos-done-string-start nil t))))
- (todos-category-select)))))
+ (let* ((shown (re-search-forward todos-done-string-start nil t))
+ (todos-show-with-done (not shown)))
+ (todos-category-select)
+ (goto-char opoint)
+ ;; If start of done items sections is below the bottom of the
+ ;; window, make it visible.
+ (unless shown
+ (setq shown (progn
+ (goto-char (point-min))
+ (re-search-forward todos-done-string-start nil t)))
+ (if (not (pos-visible-in-window-p shown))
+ (recenter)
+ (goto-char opoint)))))))
(defun todos-show-done-only ()
"Switch between displaying only done or only todo items."
(overlay-put ov 'display "")))
(todos-forward-item)))))))
-(defun todos-mark-unmark-item (&optional n all)
- "Mark item at point if unmarked, or unmark it if marked.
-
+(defun todos-mark-unmark-item (&optional n)
+ "Mark item with `todos-item-mark' if unmarked, otherwise unmark it.
With a positive numerical prefix argument N, change the
-markedness of the next N items. With non-nil argument ALL, mark
-all visible items in the category (depending on visibility, all
-todo and done items, or just todo or just done items).
-
-The mark is the character \"*\" inserted in front of the item's
-priority number or the `todos-prefix' string; if `todos-prefix'
-is \"*\", then the mark is \"@\"."
+marking of the next N items."
(interactive "p")
- (if all (goto-char (point-min)))
- (unless (> n 0) (setq n 1))
- (let ((i 0))
- (while (or (and all (not (eobp)))
- (< i n))
- (let* ((cat (todos-current-category))
- (ov (todos-marked-item-p))
- (marked (assoc cat todos-categories-with-marks)))
- (if (and ov (not all))
- (progn
- (delete-overlay ov)
- (if (= (cdr marked) 1) ; Deleted last mark in this category.
- (setq todos-categories-with-marks
- (assq-delete-all cat todos-categories-with-marks))
- (setcdr marked (1- (cdr marked)))))
- (when (todos-item-start)
- (unless (and all (todos-marked-item-p))
- (setq ov (make-overlay (point) (point)))
- (overlay-put ov 'before-string todos-item-mark)
- (if marked
- (setcdr marked (1+ (cdr marked)))
- (push (cons cat 1) todos-categories-with-marks))))))
- (todos-forward-item)
- (setq i (1+ i)))))
+ (unless (> n 1) (setq n 1))
+ (dotimes (i n)
+ (let* ((cat (todos-current-category))
+ (marks (assoc cat todos-categories-with-marks))
+ (ov (todos-prefix-overlay))
+ (pref (overlay-get ov 'before-string)))
+ (if (todos-marked-item-p)
+ (progn
+ (overlay-put ov 'before-string (substring pref 1))
+ (if (= (cdr marks) 1) ; Deleted last mark in this category.
+ (setq todos-categories-with-marks
+ (assq-delete-all cat todos-categories-with-marks))
+ (setcdr marks (1- (cdr marks)))))
+ (overlay-put ov 'before-string (concat todos-item-mark pref))
+ (if marks
+ (setcdr marks (1+ (cdr marks)))
+ (push (cons cat 1) todos-categories-with-marks))))
+ (todos-forward-item)))
(defun todos-mark-category ()
- "Put the \"*\" mark on all items in this category.
-\(If `todos-prefix' is \"*\", then the mark is \"@\".)"
+ "Mark all visiblw items in this category with `todos-item-mark'."
(interactive)
- (todos-mark-unmark-item 0 t))
+ (save-excursion
+ (goto-char (point-min))
+ (while (not (eobp))
+ (let* ((cat (todos-current-category))
+ (marks (assoc cat todos-categories-with-marks))
+ (ov (todos-prefix-overlay))
+ (pref (overlay-get ov 'before-string)))
+ (unless (todos-marked-item-p)
+ (overlay-put ov 'before-string (concat todos-item-mark pref))
+ (if marks
+ (setcdr marks (1+ (cdr marks)))
+ (push (cons cat 1) todos-categories-with-marks))))
+ (todos-forward-item))))
(defun todos-unmark-category ()
- "Remove the \"*\" mark from all items in this category.
-\(If `todos-prefix' is \"*\", then the mark is \"@\".)"
+ "Remove `todos-item-mark' from all visible items in this category."
(interactive)
- (remove-overlays (point-min) (point-max) 'before-string todos-item-mark)
- (setq todos-categories-with-marks
- (delq (assoc (todos-current-category) todos-categories-with-marks)
- todos-categories-with-marks)))
+ (save-excursion
+ (goto-char (point-min))
+ (while (not (eobp))
+ (let* ((cat (todos-current-category))
+ (marks (assoc cat todos-categories-with-marks))
+ (ov (todos-prefix-overlay))
+ (pref (overlay-get ov 'before-string)))
+ (when (todos-marked-item-p)
+ (overlay-put ov 'before-string (substring pref 1))
+ (setq todos-categories-with-marks
+ (delq (assoc (todos-current-category)
+ todos-categories-with-marks)
+ todos-categories-with-marks))))
+ (todos-forward-item))))
;; ---------------------------------------------------------------------------
;;; Item filtering commands
file0 (if (called-interactively-p 'any)
(cdr catfil)
file)))
- (find-file file0) ;FIXME:? find-file-noselect, set-buffer etc.
+ (find-file file0)
(let ((counts (make-vector 4 0)) ; [todo diary done archived]
(num (1+ (length todos-categories)))
(buffer-read-only nil))
(setq todos-categories
(append todos-categories (list (cons new counts))))
(todos-update-categories-sexp)
- ;; If archive was just created, save it to avoid "File <xyz> no
- ;; longer exists!" message on invoking
- ;; `todos-view-archived-items'. FIXME: maybe better to save
- ;; unconditionally?
+ ;; If archive was just created, save it to avoid "File
+ ;; <xyz> no longer exists!" message on invoking
+ ;; `todos-view-archived-items'.
(unless (file-exists-p (buffer-file-name))
(save-buffer))
(todos-category-number (or new cat))
;; ---------------------------------------------------------------------------
;;; Item editing commands
-;; FIXME: make insertion options customizable per category?
;;;###autoload
(defun todos-insert-item (&optional arg diary nonmarking date-type time
region-or-here)
The argument REGION-OR-HERE determines the source and location of
the new item:
- If the REGION-OR-HERE is the symbol `here', prompt for the text
- of the new item and insert it directly above the todo item at
+ of the new item and, if the command was invoked in the current
+ category, insert it directly above the todo item at
point (hence lowering the priority of the remaining items), or
if point is on the empty line below the last todo item, insert
- the new item there. An error is signalled if
- `todos-insert-item' is invoked with `here' outside of the
- current category.
+ the new item there. If the command with `here' is invoked
+ outside of the current category, jump to the chosen category
+ and insert the new item as the first item in the category.
- If REGION-OR-HERE is the symbol `region', use the region of the
current buffer as the text of the new item, depending on the
value of user option `todos-use-only-highlighted-region': if
(unless (and todos-use-only-highlighted-region (use-region-p))
(error "There is no active region"))))
(let* ((buf (current-buffer))
+ (ocat (todos-current-category))
+ (todos-mm (eq major-mode 'todos-mode))
(cat+file (cond ((equal arg '(4))
(todos-read-category "Insert in category: "))
((equal arg '(16))
(setq todos-date-from-calendar date-type)
(todos-set-date-from-calendar))
(t
- ;; FIXME: We follow diary-insert-entry in
- ;; hardcoding abbreviated month name and no
- ;; day name in date string. Should this be
- ;; customizable?
(calendar-date-string (calendar-current-date) t t))))
(time-string (or (and time (todos-read-time))
(and todos-always-add-time-string
(substring (current-time-string) 11 16)))))
(setq todos-date-from-calendar nil)
(find-file-noselect file 'nowarn)
- (setq todos-current-todos-file file)
(set-window-buffer (selected-window)
;; If current category was nil till now, on
;; entering Todos mode here it will be set to
;; file's first category.
(set-buffer (find-buffer-visiting file)))
+ (setq todos-current-todos-file file)
(unless todos-global-current-todos-file
(setq todos-global-current-todos-file todos-current-todos-file))
;; These are not needed here, since they are called in
;; todos-set-item-priority.
;; (todos-category-number cat)
;; (todos-category-select)
- (let (buffer-read-only)
+ (let ((buffer-read-only nil)
+ done-only item-added)
(setq new-item
;; Add date, time and diary marking as required.
(concat (if (not (and diary (not todos-include-in-diary)))
"\\(\n\\)[^[:blank:]]"
(concat "\n" (make-string todos-indent-to-here 32))
new-item nil nil 1))
- ;; FIXME: after jumping to another category due to `C-u i h',
- ;; item is inserted as first item -- ok?
(if here
- (cond ((not (eq major-mode 'todos-mode))
- (error "Cannot insert a todo item here outside of Todos mode"))
- ((not (eq buf (current-buffer)))
- (error "Cannot insert an item here after changing buffer"))
- ((or (todos-done-item-p)
- ;; Point on last blank line.
- (save-excursion (forward-line -1) (todos-done-item-p)))
- (error "Cannot insert a new item in the done item section"))
- (t
- (todos-insert-with-overlays new-item)))
- ;; (todos-set-item-priority new-item (todos-current-category) t))
- (todos-set-item-priority new-item cat t)
- ;; If item is inserted at end of category, make sure the
- ;; items above it are displayed in the window.
- (recenter))
+ (if (or (todos-done-item-p) (todos-done-item-section-p))
+ (error "Cannot insert item in done items section")
+ (unless (and todos-mm (equal cat ocat))
+ (todos-category-number cat)
+ (todos-category-select)
+ (goto-char (point-min)))
+ (todos-insert-with-overlays new-item))
+ (unwind-protect
+ (progn
+ ;; If only done items are displayed in category,
+ ;; toggle to todo items.
+ (when (and (goto-char (point-min))
+ (looking-at todos-done-string-start))
+ (setq done-only t)
+ (todos-show-done-only))
+ (todos-set-item-priority new-item cat t)
+ (setq item-added t))
+ ;; If user cancels before setting priority, restore
+ ;; display.
+ (unless item-added
+ (and done-only (todos-show-done-only)))
+ ;; If todos section is not visible when insertion
+ ;; command is called (either because only done items
+ ;; were shown or because category was not in current
+ ;; buffer), then if item is inserted at end of category,
+ ;; point is at eob and eob at window-start, so that that
+ ;; higher priority todo items are out of view. So we
+ ;; recenter to make sure the todo items are displayed in
+ ;; the window.
+ (when item-added (recenter))))
(todos-update-count 'todo 1)
(if (or diary todos-include-in-diary) (todos-update-count 'diary 1))
(todos-update-categories-sexp))))))
(calendar-exit)
(exit-recursive-edit))))
(message "Put cursor on a date and type <return> to set it.")
- ;; FIXME: is there a better way than recursive-edit?
(recursive-edit)
(unwind-protect
(when (equal (buffer-name) calendar-buffer)
(let* ((cat (todos-current-category))
(marked (assoc cat todos-categories-with-marks))
(item (unless marked (todos-item-string)))
- ;; FIXME: make confirmation an option?
(answer (if marked
(y-or-n-p "Permanently delete all marked items? ")
(when item
(save-excursion (todos-item-end))))
(overlay-put ov 'face 'todos-search)
(y-or-n-p (concat "Permanently delete this item? ")))))
- (opoint (point))
buffer-read-only)
(when answer
(and marked (goto-char (point-min)))
(throw 'done (setq item nil))))
(todos-forward-item))))
(when marked
- (remove-overlays (point-min) (point-max)
- 'before-string todos-item-mark)
(setq todos-categories-with-marks
- (assq-delete-all cat todos-categories-with-marks))
- (goto-char opoint))
+ (assq-delete-all cat todos-categories-with-marks)))
(todos-update-categories-sexp)
(todos-prefix-overlays)))
(if ov (delete-overlay ov)))))
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.
+ ;; Ensure lines following hard newlines are indented.
(setq new (replace-regexp-in-string
"\\(\n\\)[^[:blank:]]"
(concat "\n" (make-string todos-indent-to-here 32)) new
(todos-insert-with-overlays new)
(move-to-column item-beg))))))
+;; (defun todos-edit-multiline-item ()
+;; "Edit current Todo item in Todos Edit mode.
+;; Use of newlines invokes `todos-indent' to insure compliance with
+;; the format of Diary entries."
+;; (interactive)
+;; (todos-edit-multiline t))
+
+;; (defun todos-edit-multiline (&optional item) ;FIXME: not item editing command
+;; "" ;FIXME
+;; (interactive)
+;; (let ((buffer-name todos-edit-buffer))
+;; (set-window-buffer
+;; (selected-window)
+;; (set-buffer (make-indirect-buffer
+;; (file-name-nondirectory todos-current-todos-file)
+;; buffer-name)))
+;; (if item
+;; (narrow-to-region (todos-item-start) (todos-item-end))
+;; (widen))
+;; (todos-edit-mode)
+;; (message "%s" (substitute-command-keys
+;; (concat "Type \\[todos-edit-quit] to check file format "
+;; "validity and return to Todos mode.\n")))))
+
+;; (defun todos-edit-quit ()
+;; "Return from Todos Edit mode to Todos mode.
+;; If the item contains hard line breaks, make sure the following
+;; lines are indented by `todos-indent-to-here' to conform to diary
+;; format.
+
+;; If the whole file was in Todos Edit mode, check before returning
+;; whether the file is still a valid Todos file and if so, also
+;; recalculate the Todos categories sexp, in case changes were made
+;; in the number or names of categories."
+;; (interactive)
+;; (if (eq (buffer-size) (- (point-max) (point-min)))
+;; (when (todos-check-format)
+;; (todos-repair-categories-sexp))
+;; ;; Ensure lines following hard newlines are indented.
+;; (let ((item (replace-regexp-in-string
+;; "\\(\n\\)[^[:blank:]]"
+;; (concat "\n" (make-string todos-indent-to-here 32))
+;; (buffer-string) nil nil 1)))
+;; (delete-region (point-min) (point-max))
+;; (insert item)))
+;; (kill-buffer)
+;; ;; In case next buffer is not the one holding todos-current-todos-file.
+;; (todos-show))
+
(defun todos-edit-multiline-item ()
"Edit current Todo item in Todos Edit mode.
Use of newlines invokes `todos-indent' to insure compliance with
the format of Diary entries."
(interactive)
- (todos-edit-multiline t))
-
-(defun todos-edit-multiline (&optional item)
- ""
+ (narrow-to-region (todos-item-start) (todos-item-end))
+ (rename-buffer todos-edit-buffer)
+ (todos-edit-mode)
+ (message "%s" (substitute-command-keys
+ (concat "Type \\[todos-edit-quit] "
+ "to return to Todos mode.\n"))))
+
+(defun todos-edit-multiline (&optional item) ;FIXME: not item editing command
+ "" ;FIXME
(interactive)
- ;; FIXME: should there be only one live Todos Edit buffer?
- ;; (let ((buffer-name todos-edit-buffer))
- (let ((buffer-name (generate-new-buffer-name todos-edit-buffer)))
- (set-window-buffer
- (selected-window)
- (set-buffer (make-indirect-buffer
- (file-name-nondirectory todos-current-todos-file)
- buffer-name)))
- (if item
- (narrow-to-region (todos-item-start) (todos-item-end))
- (widen))
- (todos-edit-mode)
- (message "%s" (substitute-command-keys
- (concat "Type \\[todos-edit-quit] to check file format "
- "validity and return to Todos mode.\n")))))
+ (widen)
+ (rename-buffer todos-edit-buffer)
+ (todos-edit-mode)
+ (remove-overlays) ; nil nil 'before-string)
+ (message "%s" (substitute-command-keys
+ (concat "Type \\[todos-edit-quit] to check file format "
+ "validity and return to Todos mode.\n"))))
(defun todos-edit-quit ()
"Return from Todos Edit mode to Todos mode.
+If the item contains hard line breaks, make sure the following
+lines are indented by `todos-indent-to-here' to conform to diary
+format.
If the whole file was in Todos Edit mode, check before returning
whether the file is still a valid Todos file and if so, also
recalculate the Todos categories sexp, in case changes were made
in the number or names of categories."
(interactive)
- ;; FIXME: Should do todos-check-format only if file was actually changed --
- ;; but how to tell?
- (when (eq (buffer-size) (- (point-max) (point-min)))
- (when (todos-check-format) (todos-repair-categories-sexp)))
- (kill-buffer)
- ;; In case next buffer is not the one holding todos-current-todos-file.
- (todos-show))
+ (if (eq (buffer-size) (- (point-max) (point-min)))
+ (when (todos-check-format)
+ ;; FIXME: separate out sexp check?
+ ;; If manual editing makes e.g. item counts change, have to
+ ;; call this to update todos-categories, but it restores
+ ;; category order to list order.
+ ;; (todos-repair-categories-sexp)
+ ;; Compare (todos-make-categories-list t) with sexp and if
+ ;; different ask (todos-update-categories-sexp) ?
+ (todos-mode)
+ (todos-category-select))
+ ;; Ensure lines following hard newlines are indented.
+ (let ((beg (save-excursion (todos-item-start)))
+ (item (replace-regexp-in-string
+ "\\(\n\\)[^[:blank:]]"
+ (concat "\n" (make-string todos-indent-to-here 32))
+ (buffer-string) nil nil 1)))
+ (delete-region (point-min) (point-max))
+ (insert item)
+ (todos-mode)
+ (todos-category-select)
+ (goto-char (point-min))
+ (goto-char beg)
+ (recenter))))
(defun todos-edit-item-header-1 (what &optional inc)
- "Underlying function to edit items' date/time headers.
+ "Function underlying commands to edit item date/time header.
The argument WHAT (passed by invoking commands) specifies what
part of the header to edit; possible values are these symbols:
(todos-read-date 'year))
((string= oyear "*")
(error "Cannot increment *"))
- (t ; FIXME: handle negative years
+ (t
(number-to-string (+ yy inc))))))
((eq what 'month)
(setf day oday
(insert diary-nonmarking-symbol))))
(todos-forward-item)))))))
-;; FIXME: Make NOP if point isn't on a todo item (cf. todos-copy-item,
-;; todos-move-item
(defun todos-set-item-priority (&optional item cat new arg)
- "Set todo ITEM's priority in CATegory and move item accordingly.
+ "Prompt for and set ITEM's priority in CATegory.
-Interactively, ITEM defaults to the item at point, CAT to the
-current category in Todos mode, and the priority is a number
-between 1 and the number of items in the category.
-Non-interactively, non-nil NEW means ITEM is a new item and the
-lowest priority is one more than the number of items in CAT.
+Interactively, ITEM is the todo item at point, CAT is the current
+category, and the priority is a number between 1 and the number
+of items in the category. Non-interactively, non-nil NEW means
+ITEM is a new item and the lowest priority is one more than the
+number of items in CAT.
The new priority is set either interactively by prompt or by a
numerical prefix argument, or noninteractively by argument ARG,
whose value can be either of the symbols `raise' or `lower',
meaning to raise or lower the item's priority by one."
- (interactive) ; Prefix arg?
- (let* ((item (or item (todos-item-string)))
- (marked (todos-marked-item-p))
- (cat (or cat (cond ((eq major-mode 'todos-mode)
- (todos-current-category))
- ((eq major-mode 'todos-filtered-items-mode)
- (let* ((regexp1
- (concat todos-date-string-start
- todos-date-pattern
- "\\( " diary-time-regexp "\\)?"
- (regexp-quote todos-nondiary-end)
- "?\\(?1: \\[\\(.+:\\)?.+\\]\\)")))
- (save-excursion
- (re-search-forward regexp1 nil t)
- (match-string-no-properties 1)))))))
- curnum
- (todo (cond ((or (eq arg 'raise) (eq arg 'lower)
- (eq major-mode 'todos-filtered-items-mode))
- (save-excursion
- (let ((curstart (todos-item-start))
- (count 0))
- (goto-char (point-min))
- (while (looking-at todos-item-start)
- (setq count (1+ count))
- (when (= (point) curstart) (setq curnum count))
- (todos-forward-item))
- count)))
- ((eq major-mode 'todos-mode)
- (todos-get-count 'todo cat))))
- (maxnum (if new (1+ todo) todo))
- (prompt (format "Set item priority (1-%d): " maxnum))
- (priority (cond ((numberp current-prefix-arg)
- current-prefix-arg)
- ((and (eq arg 'raise) (>= curnum 1))
- (1- curnum))
- ((and (eq arg 'lower) (<= curnum maxnum))
- (1+ curnum))))
- candidate
- buffer-read-only)
- (unless (and priority
- (or (and (eq arg 'raise) (zerop priority))
- (and (eq arg 'lower) (> priority maxnum))))
- ;; When moving item to another category, show the category before
- ;; prompting for its priority.
- (unless (or arg (called-interactively-p t))
- (todos-category-number cat)
- (todos-category-select))
- ;; Prompt for priority only when the category has at least one todo item.
- (when (> maxnum 1)
- (while (not priority)
- (setq candidate (read-number prompt))
- (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))))
- ;; In Top Priorities buffer, an item's priority can be changed
- ;; wrt items in another category, but not wrt items in the same
- ;; category.
- (when (eq major-mode 'todos-filtered-items-mode)
- (let* ((regexp2 (concat todos-date-string-start todos-date-pattern
- "\\( " diary-time-regexp "\\)?"
- (regexp-quote todos-nondiary-end)
- "?\\(?1:" (regexp-quote cat) "\\)"))
- (end (cond ((< curnum priority)
- (save-excursion (todos-item-end)))
- ((> curnum priority)
- (save-excursion (todos-item-start)))))
- (match (save-excursion
- (cond ((< curnum priority)
- (todos-forward-item (1+ (- priority curnum)))
- (when (re-search-backward regexp2 end t)
- (match-string-no-properties 1)))
- ((> curnum priority)
- (todos-backward-item (- curnum priority))
- (when (re-search-forward regexp2 end t)
- (match-string-no-properties 1)))))))
- (when match
- (error (concat "Cannot reprioritize items from the same "
- "category in this mode, only in Todos mode")))))
- ;; Interactively or with non-nil ARG, relocate the item within its
- ;; category.
- (when (or arg (called-interactively-p))
- (todos-remove-item))
- (goto-char (point-min))
- (when priority
- (unless (= priority 1)
- (todos-forward-item (1- priority))))
- (todos-insert-with-overlays item)
- ;; If item was marked, restore the mark.
- (and marked (overlay-put (make-overlay (point) (point))
- 'before-string todos-item-mark)))))
+ (interactive) ;FIXME: Prefix arg?
+ (unless (and (called-interactively-p 'any)
+ (or (todos-done-item-p) (looking-at "^$")))
+ (let* ((item (or item (todos-item-string)))
+ (marked (todos-marked-item-p))
+ (cat (or cat (cond ((eq major-mode 'todos-mode)
+ (todos-current-category))
+ ((eq major-mode 'todos-filtered-items-mode)
+ (let* ((regexp1
+ (concat todos-date-string-start
+ todos-date-pattern
+ "\\( " diary-time-regexp "\\)?"
+ (regexp-quote todos-nondiary-end)
+ "?\\(?1: \\[\\(.+:\\)?.+\\]\\)")))
+ (save-excursion
+ (re-search-forward regexp1 nil t)
+ (match-string-no-properties 1)))))))
+ curnum
+ (todo (cond ((or (eq arg 'raise) (eq arg 'lower)
+ (eq major-mode 'todos-filtered-items-mode))
+ (save-excursion
+ (let ((curstart (todos-item-start))
+ (count 0))
+ (goto-char (point-min))
+ (while (looking-at todos-item-start)
+ (setq count (1+ count))
+ (when (= (point) curstart) (setq curnum count))
+ (todos-forward-item))
+ count)))
+ ((eq major-mode 'todos-mode)
+ (todos-get-count 'todo cat))))
+ (maxnum (if new (1+ todo) todo))
+ (prompt (format "Set item priority (1-%d): " maxnum))
+ (priority (cond ((numberp current-prefix-arg)
+ current-prefix-arg)
+ ((and (eq arg 'raise) (>= curnum 1))
+ (1- curnum))
+ ((and (eq arg 'lower) (<= curnum maxnum))
+ (1+ curnum))))
+ candidate
+ buffer-read-only)
+ (unless (and priority
+ (or (and (eq arg 'raise) (zerop priority))
+ (and (eq arg 'lower) (> priority maxnum))))
+ ;; When moving item to another category, show the category before
+ ;; prompting for its priority.
+ (unless (or arg (called-interactively-p 'any))
+ (todos-category-number cat)
+ ;; If done items in category are visible, keep them visible.
+ (let ((done todos-show-with-done))
+ (when (> (buffer-size) (- (point-max) (point-min)))
+ (save-excursion
+ (goto-char (point-min))
+ (setq done (re-search-forward todos-done-string-start nil t))))
+ (let ((todos-show-with-done done))
+ (todos-category-select)))))
+ ;; Prompt for priority only when the category has at least one todo item.
+ (when (> maxnum 1)
+ (while (not priority)
+ (setq candidate (read-number prompt))
+ (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))))
+ ;; In Top Priorities buffer, an item's priority can be changed
+ ;; wrt items in another category, but not wrt items in the same
+ ;; category.
+ (when (eq major-mode 'todos-filtered-items-mode)
+ (let* ((regexp2 (concat todos-date-string-start todos-date-pattern
+ "\\( " diary-time-regexp "\\)?"
+ (regexp-quote todos-nondiary-end)
+ "?\\(?1:" (regexp-quote cat) "\\)"))
+ (end (cond ((< curnum priority)
+ (save-excursion (todos-item-end)))
+ ((> curnum priority)
+ (save-excursion (todos-item-start)))))
+ (match (save-excursion
+ (cond ((< curnum priority)
+ (todos-forward-item (1+ (- priority curnum)))
+ (when (re-search-backward regexp2 end t)
+ (match-string-no-properties 1)))
+ ((> curnum priority)
+ (todos-backward-item (- curnum priority))
+ (when (re-search-forward regexp2 end t)
+ (match-string-no-properties 1)))))))
+ (when match
+ (error (concat "Cannot reprioritize items from the same "
+ "category in this mode, only in Todos mode")))))
+ ;; Interactively or with non-nil ARG, relocate the item within its
+ ;; category.
+ (when (or arg (called-interactively-p 'any))
+ (todos-remove-item))
+ (goto-char (point-min))
+ (when priority
+ (unless (= priority 1)
+ (todos-forward-item (1- priority))
+ ;; When called from todos-item-undo and the highest priority
+ ;; is chosen, this advances point to the first done item, so
+ ;; move it up to the empty line above the done items
+ ;; separator.
+ (when (looking-back (concat "^"
+ (regexp-quote todos-category-done) "\n"))
+ (todos-backward-item))))
+ (todos-insert-with-overlays item)
+ ;; If item was marked, restore the mark.
+ (and marked
+ (let* ((ov (todos-prefix-overlay))
+ (pref (overlay-get ov 'before-string)))
+ (overlay-put ov 'before-string (concat todos-item-mark pref)))))))
(defun todos-raise-item-priority ()
"Raise priority of current item by moving it up by one item."
(if (todos-marked-item-p)
(todos-remove-item)
(todos-forward-item)))
- ;; FIXME: does this work?
- (remove-overlays (point-min) (point-max)
- 'before-string todos-item-mark)
(setq todos-categories-with-marks
(assq-delete-all cat1 todos-categories-with-marks)))
(if ov (delete-overlay ov))
(todos-category-select)
(goto-char omark))))))))
-;; (defun todos-move-item-to-diary ()
-;; "Move one or more items in current category to the diary file.
-;;
-;; If there are marked items, move all of these; otherwise, move
-;; the item at point."
-;; (interactive)
-;; ;; FIXME
-;; )
-
-;; FIXME: make adding date customizable, and make this and time customization
-;; overridable via double prefix arg ??
(defun todos-item-done (&optional arg)
- "Tag at least one item in this category as done and hide it.
+ "Tag a todo item in this category as done and relocate it.
With prefix argument ARG prompt for a comment and append it to
the done item; this is only possible if there are no marked
`todos-done-string' plus the current date and, if
`todos-always-add-time-string' is non-nil, the current time;
otherwise, just tag the item at point. Items tagged as done are
-relocated to the category's (by default hidden) done section."
+relocated to the category's (by default hidden) done section. If
+done items are visible on invoking this command, they remain
+visible."
(interactive "P")
(let* ((cat (todos-current-category))
(marked (assoc cat todos-categories-with-marks)))
(comment (and arg (not marked) (read-string "Enter a comment: ")))
(item-count 0)
(diary-count 0)
+ (show-done (save-excursion
+ (goto-char (point-min))
+ (re-search-forward todos-done-string-start nil t)))
item done-item
(buffer-read-only))
(and marked (goto-char (point-min)))
(catch 'done
- (while (not (eobp))
+ ;; Stop looping when we hit the empty line below the last
+ ;; todo item (this is eobp if only done items are hidden).
+ (while (not (looking-at "^$")) ;(not (eobp))
(if (or (not marked) (and marked (todos-marked-item-p)))
(progn
(setq item (todos-item-string))
(when marked
;; Chop off last newline of done item string.
(setq done-item (substring done-item 0 -1))
- (remove-overlays (point-min) (point-max) 'before-string todos-item-mark)
(setq todos-categories-with-marks
(assq-delete-all cat todos-categories-with-marks)))
(save-excursion
(todos-update-count 'done item-count)
(todos-update-count 'diary (- diary-count))
(todos-update-categories-sexp)
- (save-excursion (todos-category-select))))))
+ (let ((todos-show-with-done show-done))
+ (todos-category-select))))))
(defun todos-done-item-add-edit-or-delete-comment (&optional arg)
"Add a comment to this done item or edit an existing comment.
(interactive "P")
(when (todos-done-item-p)
(let ((item (todos-item-string))
+ (opoint (point))
(end (save-excursion (todos-item-end)))
comment buffer-read-only)
(save-excursion
(cons (match-string 1) 1)))
(replace-match comment nil nil nil 1))
(setq comment (read-string "Enter a comment: "))
+ ;; If user moved point during editing, make sure it moves back.
+ (goto-char opoint)
(todos-item-end)
(insert " [" todos-comment-string ": " comment "]"))))))
(todos-forward-item))))
(if marked
(progn
- ;; (remove-overlays (point-min) (point-max)
- ;; 'before-string todos-item-mark)
(setq todos-categories-with-marks
(assq-delete-all cat todos-categories-with-marks))
;; Insert undone items that were marked at end of todo item list.
(todos-update-count 'done (- count))
(todos-update-count 'archived count)))))
(when marked
- (remove-overlays (point-min) (point-max)
- 'before-string todos-item-mark)
(setq todos-categories-with-marks
(assq-delete-all cat todos-categories-with-marks)))
(todos-update-categories-sexp)