2 files changed, 367 insertions, 352 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 0bcb61c3712..fc8bbbac000 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,68 @@
+2012-09-14  Stephen Berman  <stephen.berman@gmx.net>
+
+        * calendar/todos.el Remove lots of commented out code; add various
+        comments; further code rearrangement.
+        (todos-insert-item-here-ask-date-time)
+        (todos-insert-item-ask-date-time)
+        (todos-insert-item-ask-dayname-time)
+        (todos-insert-item-for-diary)
+        (todos-insert-item-for-diary-ask-date-time)
+        (todos-make-categories-alist, todos-categories-alist): Remove.
+        (todos-categories-list): Comment out.
+        (todos-make-categories-list): New function replacing
+        todos-make-categories-alist, using category plists to get item
+        counts and taking archive into account.
+        (todos-current-todos-file): New variable.
+        (todos-mode-map): Update key bindings.
+        (todos-save): Add as comment code to make sure todos-categories
+        sexp is current on saving.
+        (todos-quit): Call todos-show on quitting Todos archive buffer.
+        (todos-show): If todos-current-todos-file is not set to Todos
+        file, set it as a new file; set todos-categories from
+        todos-make-categories-alist.
+        (todos-display-categories): Use a different display format for
+        archive file; put point initially on the first button.
+        (todos-toggle-view-done-items): Check the category's `done'
+        property to determine if there are done items.
+        (todos-view-archive): Set todos-current-todos-file to the archive
+        file; jump from the Todos file to the same category in the
+        archive, if it exists, else jump to the first category; use
+        message instead of error.
+        (todos-add-category): Intern a special symbol for the new category
+        and set its property list to holds counts of the numbers of todo,
+        done and archived items in the category; assign the new category
+        the current highest category number.
+        (todos-rename-category): Don't use todos-categories-alist.
+        (todos-delete-category): Check the category's `todo' and `done'
+        properties to determine if it is empty; ensure that the end of the
+        last category is found; after deleting the category, empty its
+        plist and unintern its special symbol.
+        (todos-insert-item-here): Fix argument list of todos-insert-item.
+        (todos-delete-item, todos-raise-item, todos-lower-item):
+        Use message instead of error.
+        (todos-move-item): If the category to be moved to does not exist,
+        add it as a new category.
+        (todos-item-done, todos-reset-separator):
+        Use todos-category-select instead of todos-show.
+        (todos-archive-done-items): Make buffer writeable; conditionalize
+        search for end of category; save after adding to archive in case
+        the file is new, so it can be found.
+        (todos-category-select): Wrap search in if instead of or+and;
+        don't hide done items in an archive.
+        (todos-set-item-priority): Check the category's `todo'
+        property to determine if there are not done todo items.
+        (todos-jump-to-category-noninteractively): Just switch to buffer
+        visiting todos-current-todos-file, since this can be either a
+        Todos file or an archive.
+        (todos-item-counts): Use category's plist instead of an alist.
+        (todos-longest-category-name-length): Argument is now a list of
+        category names, not an alist, so just test each element, not each
+        element's the car.
+        (todos-padded-string): Use todos-categories instead of
+        todos-categories-alist.
+        (todos-insert-category-name): Use category plist to get item
+        counts; take archived items into account.
+
 2012-09-13  Stephen Berman  <stephen.berman@gmx.net>
 
         * calendar/todos.el: Numerous spelling and comment fixes, doc
diff --git a/lisp/calendar/todos.el b/lisp/calendar/todos.el
index 7ec54e0f2e9..427056e6e26 100644
--- a/lisp/calendar/todos.el
+++ b/lisp/calendar/todos.el
@@ -481,6 +481,9 @@ Automatically generated when `todos-save-top-priorities' is non-nil."
 ;; ---------------------------------------------------------------------------
 ;;; Mode setup
 
+(defvar todos-current-todos-file nil
+  "")
+
 (defvar todos-categories nil
   "TODO categories.")
 
@@ -496,12 +499,14 @@ Automatically generated when `todos-save-top-priorities' is non-nil."
     (define-key map "S" 'todos-search)
     ;; display commands
     (define-key map "C" 'todos-display-categories)
+    ;; (define-key map "" 'todos-display-categories-alphabetically)
     (define-key map "h" 'todos-highlight-item)
     (define-key map "N" 'todos-toggle-item-numbering)
     ;; (define-key map "" 'todos-toggle-display-date-time)
     (define-key map "P" 'todos-print)
     (define-key map "q" 'todos-quit)
     (define-key map "s" 'todos-save)
+    (define-key map "V" 'todos-view-archive)
     (define-key map "v" 'todos-toggle-view-done-items)
     (define-key map "Y" 'todos-diary-items)
     ;; (define-key map "S" 'todos-save-top-priorities)
@@ -514,7 +519,6 @@ Automatically generated when `todos-save-top-priorities' is non-nil."
     (define-key map "e" 'todos-edit-item)
     (define-key map "E" 'todos-edit-multiline)
     ;; (define-key map "" 'todos-change-date)
-    ;; (define-key map "f" 'todos-file-item)
     (define-key map "ii" 'todos-insert-item)
     (define-key map "ih" 'todos-insert-item-here)
     (define-key map "ia" 'todos-insert-item-ask-date-time)
@@ -684,19 +688,27 @@ Automatically generated when `todos-save-top-priorities' is non-nil."
 (defun todos-save ()
   "Save the TODO list."
   (interactive)
-  (save-excursion
-    (save-restriction
-      (save-buffer)))
-  ;; (if todos-save-top-priorities-too (todos-save-top-priorities)))
-  )
+  (let (buffer-read-only)
+    (save-excursion
+      (save-restriction
+        ;; (widen)
+        ;; (goto-char (point-min))
+        ;; (unless (looking-at (concat "^" (regexp-quote todos-category-beg)))
+        ;;   (kill-line))
+        ;; (prin1 todos-categories (current-buffer))
+        (save-buffer)))
+    ;; (if todos-save-top-priorities-too (todos-save-top-priorities)))
+    ))
 
 (defun todos-quit ()
   "Done with TODO list for now."
   (interactive)
   (widen)
   (todos-save)
-  (message "")
-  (bury-buffer))
+  ;; (message "")
+  (if (eq major-mode 'todos-archive-mode)
+      (todos-show)
+    (bury-buffer)))
 
 ;; ---------------------------------------------------------------------------
 ;;; Commands
@@ -722,14 +734,14 @@ Automatically generated when `todos-save-top-priorities' is non-nil."
         (find-file todos-file-do)
       (todos-initial-setup))
     (unless (eq major-mode 'todos-mode) (todos-mode))
-    (unless todos-categories-alist
-      (setq todos-categories-alist (todos-make-categories-alist)))
+    (unless (string= todos-current-todos-file todos-file-do)
+      (setq todos-current-todos-file todos-file-do)
+      (setq todos-category-number 0)
+      (setq todos-categories nil))
     (unless todos-categories
-      (setq todos-categories (mapcar 'car todos-categories-alist)))
+      (setq todos-categories (todos-make-categories-list)))
     (save-excursion
-      (todos-category-select)
-      ;; (todos-show-paren-hack)
-      )))
+      (todos-category-select))))
 
 (defun todos-display-categories (&optional alpha)
   "Display a numbered list of the Todos category names.
@@ -755,9 +767,15 @@ the category in Todos mode."
         (insert "Press a button to display the corresponding category.\n\n")
         ;; FIXME: abstract format from here and todos-insert-category-name
         (insert (make-string 4 32) (todos-padded-string "Category")
-                (make-string 7 32) "Todos   Done\n\n")
+                (if (string= todos-current-todos-file todos-archive-file)
+                    (concat (make-string 6 32)
+                            (format "%s" "Archived"))
+                  (concat (make-string 7 32)
+                          (format "%-7s%-7s%s" "Todo" "Done" "Archived")))
+                "\n\n")
         (save-excursion
           (mapc '(lambda (cat) (todos-insert-category-name cat alpha)) categories)))
+      (goto-char (next-single-char-property-change (point) 'button))
       (todos-categories-mode))))
 
 (defun todos-display-categories-alphabetically ()
@@ -775,25 +793,41 @@ the category in Todos mode."
   (interactive)
   (save-excursion
     (goto-char (point-min))
-    (let ((todos-show-with-done
-           (if (re-search-forward (concat "\n\\(\\[" (regexp-quote todos-done-string)
-                                   "\\)") nil t)
-               nil
-             t)))
-      (todos-category-select))))
+    (let* ((todos-show-with-done
+            (if (re-search-forward (concat "\n\\(\\["
+                                           (regexp-quote todos-done-string)
+                                           "\\)") nil t)
+                nil
+              t))
+           (cat (todos-current-category))
+           (catsym (intern-soft (concat "todos-" cat))))
+      (todos-category-select)
+      (when (zerop (get catsym 'done))
+        (message "There are no done items in this category.")))))
 
 (defun todos-view-archive (&optional cat)
   ""
   (interactive)
   (if (file-exists-p todos-archive-file)
-      (progn
+      (progn ;let ((todos-show-with-done t))
         (find-file todos-archive-file)
+        (todos-archive-mode)
+        (unless (string= todos-current-todos-file todos-archive-file)
+          (setq todos-current-todos-file todos-archive-file)
+          (setq todos-categories nil))
+        (unless todos-categories
+          (setq todos-categories (todos-make-categories-list)))
         (if cat
-            (if (member cat (todos-categories-list (current-buffer)))
-                (todos-jump-to-category-noninteractively cat)
-              (error "No archived items from this category"))
+            (if (member cat (todos-categories))
+                (progn
+                  (setq todos-category-number
+                        (- (length todos-categories)
+                           (length (member cat todos-categories))))
+                  (todos-jump-to-category-noninteractively cat))
+              (message "No archived items from this category"))
+          (setq todos-category-number 0)
           (todos-category-select)))
-    (error "There is currently no Todos archive")))
+    (message "There is currently no Todos archive")))
 
 ;; FIXME: slow
 (defun todos-diary-items ()
@@ -806,7 +840,6 @@ the category in Todos mode."
         (widen)
         (copy-to-buffer bufname (point-min) (point-max))))
     (with-current-buffer bufname
-      ;; (todos-mode)
       (goto-char (point-min))
       (while (not (eobp))
         (setq opoint (point))
@@ -866,12 +899,10 @@ the category in Todos mode."
                                      "\\( " diary-time-regexp "\\)?\\]? ")
                                         ; FIXME: this space in header? ^
                              nil t)
+          ;; FIXME: wrong match data if search fails
           (setq ov (make-overlay (match-beginning 0) (match-end 0) nil t))
           (overlay-put ov 'display "")
-          (forward-line)))
-      ;; FIXME: need this?
-      ;; (todos-update-numbered-prefix)
-      )))
+          (forward-line))))))
       
 ;;;###autoload
 (defun todos-top-priorities (&optional nof-priorities category-pr-page show-done)
@@ -972,7 +1003,6 @@ With non-nil SHOW-DONE, include done items in the listing."
               (- (length todos-categories)
                  (length (member category todos-categories)))
             (todos-add-category category)))
-    ;; (todos-show)))
     (todos-category-select)))
 
 ;; FIXME ? todos-{backward,forward}-item skip over empty line between done and
@@ -1013,7 +1043,7 @@ With non-nil SHOW-DONE, include done items in the listing."
       (forward-line))
     (if found
         (progn
-          (setq found (match-beginning 0))
+          (setq found (match-beginning 0)) ;FIXME: ok if looking-at returns nil?
           (todos-item-start)
           (when (looking-at (concat "^\\[" (regexp-quote todos-done-string)))
             (setq in-done t))
@@ -1035,7 +1065,8 @@ With non-nil SHOW-DONE, include done items in the listing."
   "Add new category CAT to the TODO list."
   (interactive)
   (let ((buffer-read-only)
-        (buf (find-file-noselect todos-file-do t)))
+        (buf (find-file-noselect todos-file-do t))
+        catsym)
     (unless (zerop (buffer-size buf))
       (and (null todos-categories)
            (error "Error in %s: File is non-empty but contains no category"
@@ -1045,9 +1076,11 @@ With non-nil SHOW-DONE, include done items in the listing."
       (setq cat (todos-check-category-name cat))
       ;; initialize a newly created Todo buffer for Todo mode
       (unless (file-exists-p todos-file-do) (todos-mode))
-      (push cat todos-categories)
-      (push (list cat (cons 0 0)) todos-categories-alist)
+      (setq catsym (intern (concat "todos-" cat)))
+      (setplist catsym (list 'todo 0 'done 0 'archived 0))
+      (nconc todos-categories (list cat)) ;FIXME: is this TRTD?
       (widen)
+      ;; FIXME: make this (point-max)
       (goto-char (point-min))
       ;; make sure file does not begin with empty lines (shouldn't, but may be
       ;; added by mistake), otherwise new categories will contain them, so
@@ -1056,8 +1089,9 @@ With non-nil SHOW-DONE, include done items in the listing."
       (insert todos-category-beg cat "\n")
       (if (interactive-p)
           ;; properly display the newly added category
-          (progn (setq todos-category-number 0) (todos-show))
-        0))))
+          (progn (setq todos-category-number (1- (length todos-categories)))
+                 (todos-category-select))
+        (1- (length todos-categories))))))
 
 (defun todos-rename-category ()
   "Rename current Todos category."
@@ -1069,7 +1103,6 @@ With non-nil SHOW-DONE, include done items in the listing."
     (setq new (todos-check-category-name new))
     (aset vec todos-category-number new)
     (setq todos-categories (append vec nil))
-    (setcar (assoc cat todos-categories-alist) new)
     (save-excursion
       (widen)
       (re-search-backward (concat (regexp-quote todos-category-beg) "\\("
@@ -1085,28 +1118,31 @@ With ARG non-nil delete the category unconditionally,
 i.e. including all existing entries."
   (interactive "P")
   (let* ((cat (todos-current-category))
-         (not-done (car (todos-item-counts cat)))
-         (done (cdr (todos-item-counts cat)))
+         (catsym (intern-soft (concat "todos-" cat)))
+         (todo (get catsym 'todo))
+         (done (get catsym 'done))
          beg end)
     (if (and (null arg)
-             (or (> not-done 0) (> done 0)))
+             (or (> todo 0) (> done 0)))
         (message "To delete a non-empty category, type C-u D.")
       (when (y-or-n-p (concat "Permanently remove category \"" cat
                               "\"" (and arg " and all its entries") "? "))
         (let ((buffer-read-only))
           (widen)
           (setq beg (re-search-backward (concat "^" (regexp-quote todos-category-beg)
-                                                cat "\n") nil t)
-                end (progn
-                      (re-search-forward (concat "\n\\("
-                                                 (regexp-quote todos-category-beg)
-                                                 ".*\n\\)") nil t)
-                      (match-beginning 1)))
+                                                cat "\n") nil t))
+          (setq end (if (re-search-forward (concat "\n\\("
+                                                   (regexp-quote todos-category-beg)
+                                                   ".*\n\\)") nil t)
+                        (match-beginning 1)
+                      (point-max)))
           (remove-overlays beg end)
           (kill-region beg end)
           (setq todos-categories (delete cat todos-categories))
-          (setq todos-categories-alist
-                (delete (assoc cat todos-categories-alist) todos-categories-alist))
+          (setplist catsym nil)
+          (unintern catsym)
+          (setq todos-category-number
+                (mod todos-category-number (length todos-categories)))
           (todos-category-select)
           (message "Deleted category %s" cat))))))
 
@@ -1180,7 +1216,7 @@ there."
   (interactive "P")
   (unless (or (todos-done-item-p)
               (save-excursion (forward-line -1) (todos-done-item-p)))
-    (if (not (derived-mode-p 'todos-mode)) (todos-show))
+    (when (not (derived-mode-p 'todos-mode)) (todos-show))
     (let* ((buffer-read-only)
            (date-string (cond
                          ((eq date-type 'ask-date)
@@ -1192,7 +1228,7 @@ there."
                           (with-current-buffer "*Calendar*"
                             (calendar-date-string (calendar-cursor-to-date t) t t)))
                          (t (calendar-date-string (calendar-current-date) t t))))
-           (time-string (cond ((eq time 'omit) nil)
+           (time-string (cond ((eq time 'omit) nil) ;FIXME: delete
                               ((eq time 'ask-time)
                                (todos-read-time))
                               (todos-always-add-time-string
@@ -1208,88 +1244,55 @@ there."
                       "\\(\n\\)[^[:blank:]]"
                       (concat "\n" (make-string todos-indent-to-here 32)) new-item
                       nil nil 1))
-      ;; (if here
-      ;;          (todos-insert-with-overlays new-item)
-      ;;        (todos-add-item-non-interactively new-item cat))
       (unless here (todos-set-item-priority new-item cat))
       (todos-insert-with-overlays new-item)
       (todos-item-counts cat 'insert))))
 
 ;; FIXME: make insertion options customizable per category
-;; date-type: d n (c) - time - diary - here
-;; idd            inn            itt  iyy ih
-;; idtt  idyy idh intt  inyy inh ityy iyh 
-;; idtyy idyh     intyy inyh     ityh 
-;; idtyh          intyh 
-;; idth           inth  
-
-;; todos-insert-item
-;; todos-insert-item-ask-date
-;; todos-insert-item-ask-date-time
-;; todos-insert-item-ask-dayname
-;; todos-insert-item-ask-dayname-time
-;; todos-insert-item-ask-time
-;; todos-insert-item-for-diary
-;; todos-insert-item-for-diary-ask-date
-;; todos-insert-item-for-diary-ask-date-time
-;; todos-insert-item-for-diary-ask-dayname
-;; todos-insert-item-for-diary-ask-dayname-time
-;; todos-insert-item-for-diary-ask-time
-;; todos-insert-item-here
-;; todos-insert-item-here-ask-date
-;; todos-insert-item-here-ask-date-time
-;; todos-insert-item-here-ask-dayname
-;; todos-insert-item-here-ask-dayname-time
-;; todos-insert-item-here-ask-time
-;; todos-insert-item-here-ask-time-diary
-;; todos-insert-item-here-for-diary
-;; todos-insert-item-here-for-diary-ask-date-time
-;; todos-insert-item-here-for-diary-ask-time
-;; todos-insert-item-here-for-diary-ask-dayname-time
 
-(defun todos-insert-item-here ()
-  ""
-  (interactive)
-  (todos-insert-item nil nil nil t))
-
-(defun todos-insert-item-here-ask-date-time ()
-  ""
-  (interactive)
-  (todos-insert-item nil 'ask-date 'ask-time t))
+;; current date ~ current day ~ ask date ~ ask day
+;; current time ~ ask time ~ no time
+;; for diary ~ not for diary
+;; here ~ ask priority
 
-;; (defun todos-insert-item-no-time ()
-;;   ""
-;;   (interactive)
-;;   (todos-insert-item nil nil 'omit t))
+;; date-type: d n (c) - time - diary - here
 
-(defun todos-insert-item-ask-date-time (&optional arg)
-  ""
-  (interactive "P")
-  (todos-insert-item arg 'ask-date 'ask-time))
+;; ii     todos-insert-item
+;; idd    todos-insert-item-ask-date
+;; idtt   todos-insert-item-ask-date-time
+;; idtyy  todos-insert-item-ask-date-time-for-diary
+;; idtyh  todos-insert-item-ask-date-time-for-diary-here
+;; idth   todos-insert-item-ask-date-time-here
+;; idyy   todos-insert-item-ask-date-for-diary
+;; idyh   todos-insert-item-ask-date-for-diary-here
+;; idh    todos-insert-item-ask-date-here
+;; inn    todos-insert-item-ask-dayname
+;; intt   todos-insert-item-ask-dayname-time
+;; intyy  todos-insert-item-ask-dayname-time-for-diary
+;; intyh  todos-insert-item-ask-dayname-time-for-diary-here
+;; inth   todos-insert-item-ask-dayname-time-here
+;; inyy   todos-insert-item-ask-dayname-for-diary
+;; inyh   todos-insert-item-ask-dayname-for-diary-here
+;; inh    todos-insert-item-ask-dayname-here
+;; itt    todos-insert-item-time
+;; ityy   todos-insert-item-time-for-diary
+;; ityh   todos-insert-item-time-for-diary-here
+;; ith    todos-insert-item-time-here
+;; iyy    todos-insert-item-for-diary
+;; iyh    todos-insert-item-for-diary-here
+;; ih     todos-insert-item-here
 
-(defun todos-insert-item-ask-dayname-time (&optional arg)
+(defun todos-insert-item-here ()
   ""
   (interactive)
-  (todos-insert-item arg 'ask-dayname 'ask-time))
-
-(defun todos-insert-item-for-diary (&optional arg)
-  ""
-  (interactive "P")
-  (let ((todos-include-in-diary t))
-    (todos-insert-item arg)))
-
-(defun todos-insert-item-for-diary-ask-date-time (&optional arg)
-  ""
-  (interactive "P")
-  (let ((todos-include-in-diary t))
-    (todos-insert-item arg 'ask-dayname 'ask-time)))
+  (todos-insert-item nil nil nil nil t))
 
 ;; FIXME: autoload when key-binding is defined in calendar.el
 (defun todos-insert-item-from-calendar ()
   ""
   (interactive)
   (pop-to-buffer (file-name-nondirectory todos-file-do))
-  (todos-show)
+  (todos-show)                          ;FIXME: todos-category-select ? 
   (todos-insert-item t 'calendar))
 
 ;; FIXME: calendar is loaded before todos
@@ -1312,12 +1315,8 @@ there."
                      (< (point-min) (point-max)))
             (todos-backward-item))
           (todos-item-counts (todos-current-category) 'delete)
-          ;; FIXME: is todos-prefix-overlays part of if-sexp, and is it needed
-          ;; at all?
-          ;; (if todos-number-prefix
-          ;;     (todos-update-numbered-prefix)
-          (todos-prefix-overlays)));)
-    (error "No TODO list entry to delete")))
+          (todos-prefix-overlays)))
+    (message "No TODO list entry to delete"))) ;FIXME: better message
 
 (defun todos-edit-item ()
   "Edit current TODO list entry."
@@ -1382,23 +1381,14 @@ there."
             (todos-remove-item)
             (todos-backward-item)
             (todos-insert-with-overlays item))
-        (error "No TODO list entry to raise")))))
+        (message "No TODO list entry to raise"))))) ;FIXME: better message
 
 (defun todos-lower-item ()
   "Lower priority of current entry."
   (interactive)
   (unless (or (todos-done-item-p)
               (looking-at "^$"))        ; between done and not done items
-    (let* ((buffer-read-only)
-           ;; (end (save-excursion (todos-forward-item) (point)))
-           ;; (done (save-excursion
-           ;;      (if (re-search-forward (concat "\n\n\\\["
-           ;;                                     (regexp-quote todos-done-string))
-           ;;                             nil t)
-           ;;          (match-beginning 0)
-           ;;        (point-max))))
-           )
-      ;; (if (> (count-lines (point) done) 1)
+    (let* ((buffer-read-only))
       (if (save-excursion
             ;; can only lower non-final unfinished item
             (todos-forward-item)
@@ -1410,7 +1400,7 @@ there."
             (todos-forward-item)
             (when (todos-done-item-p) (forward-line -1))
             (todos-insert-with-overlays item))
-        (error "No TODO list entry to lower"))))) ;FIXME: better message
+        (message "No TODO list entry to lower"))))) ;FIXME: better message
 
 (defun todos-move-item ()
   "Move the current todo item to another, interactively named, category.
@@ -1429,12 +1419,10 @@ it is created and the item becomes the first entry in that category."
           (orig-mrk (progn (todos-item-start) (point-marker)))
           moved)
       (todos-remove-item)
-      ;; numbered prefix isn't cached (see todos-remove-item) so have to update
-      ;; (if todos-number-prefix (todos-update-numbered-prefix))
       (unwind-protect
           (progn
-            ;; (todos-add-item-non-interactively item newcat)
-            (todos-set-item-priority item newcat)
+            (unless (member newcat todos-categories) (todos-add-category newcat))
+            (todos-set-item-priority item newcat)       
             (todos-insert-with-overlays item)
             (setq moved t)
             (todos-item-counts oldcat 'delete)
@@ -1444,8 +1432,6 @@ it is created and the item becomes the first entry in that category."
           (goto-char orig-mrk)
           (todos-insert-with-overlays item)
           (setq todos-category-number oldnum)
-          ;; (todos-item-counts oldcat 'move-failed)
-          ;; (todos-item-counts newcat 'move-failed)
           (todos-category-select)
           ;; FIXME: does this work?
           (goto-char opoint))
@@ -1484,19 +1470,22 @@ it is created and the item becomes the first entry in that category."
           (newline))
         (todos-insert-with-overlays done-item)))
     (todos-item-counts (todos-current-category) 'done)
-    (todos-show)))
+    (todos-category-select)))
 
 (defun todos-archive-done-items ()
   "Archive the done items in the current category."
   (interactive)
   (let ((archive (find-file-noselect todos-archive-file t))
         (cat (todos-current-category))
+        (buffer-read-only)
         beg end)
     (save-excursion
       (save-restriction
         (widen)
-        (re-search-forward (concat "^" (regexp-quote todos-category-beg)) nil t)
-        (setq end (or (match-beginning 0) (point-max)))
+        (setq end (if (re-search-forward
+                       (concat "^" (regexp-quote todos-category-beg)) nil t)
+                      (match-beginning 0)
+                    (point-max)))
         (re-search-backward (concat "^" (regexp-quote todos-category-beg)
                                     (regexp-quote cat))
                             nil t)
@@ -1512,7 +1501,8 @@ it is created and the item becomes the first entry in that category."
                                    nil t)
                 (forward-char)
               (insert todos-category-beg cat "\n"))
-            (insert done))
+            (insert done)
+            (save-buffer))
           (delete-region beg end)
           (remove-overlays beg end)
           (kill-line -1)
@@ -1532,10 +1522,8 @@ it is created and the item becomes the first entry in that category."
            (item (buffer-substring start (todos-item-end)))
            undone)
       (todos-remove-item)
-      ;; (if todos-number-prefix (todos-update-numbered-prefix))
       (unwind-protect
           (progn
-            ;; (todos-add-item-non-interactively item cat)
             (todos-set-item-priority item cat)
             (todos-insert-with-overlays item)
             (setq undone t)
@@ -1544,7 +1532,6 @@ it is created and the item becomes the first entry in that category."
           (widen)
           (goto-char orig-mrk)
           (todos-insert-with-overlays done-item)
-          ;; (todos-item-counts cat 'done)
           (let ((todos-show-with-done t))
             (todos-category-select)
             (goto-char opoint)))
@@ -1679,7 +1666,6 @@ Number of entries for each category is given by `todos-print-priorities'."
   (make-local-variable 'word-wrap)
   (setq word-wrap t)
   (make-local-variable 'wrap-prefix)
-  ;; (setq wrap-prefix (make-string (+ 5 (length todos-prefix)) 32))
   (setq wrap-prefix (make-string todos-indent-to-here 32))
   (unless (member '(continuation) fringe-indicator-alist)
     (push '(continuation) fringe-indicator-alist)))
@@ -1688,53 +1674,6 @@ Number of entries for each category is given by `todos-print-priorities'."
   ""
   (indent-to todos-indent-to-here todos-indent-to-here))
 
-(defun todos-reset-prefix (symbol value)
-  "Set SYMBOL's value to VALUE, and ."  ; FIXME
-  (let ((oldvalue (symbol-value symbol)))
-    (custom-set-default symbol value)
-    (when (not (equal value oldvalue))
-      (save-window-excursion
-        (todos-show)
-        (save-excursion
-          (widen)
-          (goto-char (point-min))
-          (while (not (eobp))
-            (remove-overlays (point) (point)); 'before-string prefix)
-            (forward-line)))
-        ;; activate the prefix setting (save-restriction does not help)
-        ;; (todos-show)
-        (todos-category-select)
-        ))))
-
-;; FIXME: ??? with todos-lower-item leaves overlay of lower item if this is
-;; the third or greater item number -- but not in edebug
-;; (defun todos-update-numbered-prefix ()
-;;   "Update consecutive item numbering in the current category."
-;;   (save-excursion
-;;     (goto-char (point-min))
-;;     (while (not (eobp))
-;;       (let ((ov (car (overlays-in (point) (point))))
-;;           val)
-;;      (when ov
-;;        (setq val (overlay-get ov 'before-string))
-;;        (remove-overlays (point) (point) 'before-string val)))
-;;       (todos-forward-item))
-;;     (todos-show)))
-
-;; (defun todos-update-numbered-prefix ()
-;;   "Update consecutive item numbering in the current category."
-;;   (save-excursion
-;;     (goto-char (point-min))
-;;     (while (not (eobp))
-;;       (remove-overlays (point) (point))
-;;       (todos-forward-item))
-;;     ;; FIXME: is todos-prefix-overlays enough?
-;;     (todos-show)))
-
-;; (defvar todos-item-start-overlays nil "")
-
-;; (defvar todos-done-overlays nil "")
-
 (defun todos-prefix-overlays ()
   ""
   (when (or todos-number-prefix
@@ -1750,31 +1689,16 @@ Number of entries for each category is given by `todos-print-priorities'."
             (when todos-number-prefix
               (setq num (1+ num))
               ;; reset number for done items
-              (when ;; (or
-                   ;; ;; FIXME: really need this?
-                   ;; (looking-at (concat "\n\\[" (regexp-quote todos-done-string)))
+              (when
+                  ;; FIXME: really need this?
                   ;; if last not done item is multiline, then
                   ;; todos-done-string-match skips empty line, so have
                   ;; to look back.
                   (and (looking-at (concat "^\\[" (regexp-quote todos-done-string)))
-                       (looking-back "\n\n"));)
-                  (setq num 1))
+                       (looking-back "\n\n"))
+                (setq num 1))
               (setq prefix (propertize (concat (number-to-string num) " ")
                                        'face 'todos-prefix-string)))
-            ;; (let ((ovs (overlays-in (point) (point))))
-            ;;   (or (and (setq ov-pref (car ovs))
-            ;;         ;; when done-separator overlay is in front of prefix overlay
-            ;;         (if (and (> (length ovs) 1)
-            ;;                  (not (equal (overlay-get ov-pref 'before-string)
-            ;;                              prefix)))
-            ;;             (setq ov-pref (cadr ovs))
-            ;;           t)
-            ;;         (equal (overlay-get ov-pref 'before-string) prefix))
-            ;;    ;; non-numerical prefix
-            ;;    (and (setq ov-pref (pop todos-item-start-overlays))
-            ;;         (move-overlay ov-pref (point) (point)))
-            ;;    (and (setq ov-pref (make-overlay (point) (point)))
-            ;;         (overlay-put ov-pref 'before-string prefix))))
             (let* ((ovs (overlays-in (point) (point)))
                    (ov-pref (car ovs))
                    (val (when ov-pref (overlay-get ov-pref 'before-string))))
@@ -1782,17 +1706,32 @@ Number of entries for each category is given by `todos-print-priorities'."
                          (not (equal val prefix)))
                 (setq ov-pref (cadr ovs)))
               (when (not (equal val prefix))
-                ;; (delete-overlay ov-pref)
-                (remove-overlays (point) (point)); 'before-string val)
+                ;; (delete-overlay ov-pref) ; why doesn't this work ???
+                (remove-overlays (point) (point)); 'before-string val) ; or this ???
                 (setq ov-pref (make-overlay (point) (point)))
                 (overlay-put ov-pref 'before-string prefix))))
         (forward-line))))))
 
+(defun todos-reset-prefix (symbol value)
+  "Set SYMBOL's value to VALUE, and ."  ; FIXME
+  (let ((oldvalue (symbol-value symbol)))
+    (custom-set-default symbol value)
+    (when (not (equal value oldvalue))
+      (save-window-excursion
+        (todos-show)
+        (save-excursion
+          (widen)
+          (goto-char (point-min))
+          (while (not (eobp))
+            (remove-overlays (point) (point)); 'before-string prefix)
+            (forward-line)))
+        ;; activate the prefix setting (save-restriction does not help)
+        (todos-category-select)))))
+
 (defun todos-reset-separator (symbol value)
   "Set SYMBOL's value to VALUE, and ."  ; FIXME
   (let ((oldvalue (symbol-value symbol)))
     (custom-set-default symbol value)
-    ;; (setq todos-done-overlays nil)
     (when (not (equal value oldvalue))
       (save-window-excursion
         (todos-show)
@@ -1802,7 +1741,7 @@ Number of entries for each category is given by `todos-print-priorities'."
                                    nil t)
             (remove-overlays (point) (point))))
         ;; activate the prefix setting (save-restriction does not help)
-        (todos-show)))))
+        (todos-category-select)))))
 
 ;; FIXME: should be defsubst?
 (defun todos-category-number (cat)
@@ -1823,75 +1762,50 @@ Number of entries for each category is given by `todos-print-priorities'."
      (concat "^" (regexp-quote (concat todos-category-beg name))
              "$"))
     (let ((begin (1+ (line-end-position)))
-          (end (or (and (re-search-forward (concat "^" todos-category-beg) nil t)
-                        (match-beginning 0))
-                   (point-max))))
+          (end (if (re-search-forward (concat "^" todos-category-beg) nil t)
+                   (match-beginning 0)
+                 (point-max))))
       (narrow-to-region begin end)
       (goto-char (point-min))))
   (todos-prefix-overlays)
-  ;; display or hide done items as per todos-show-with-done
-  (save-excursion
-    (when (re-search-forward (concat "\n\\(\\[" (regexp-quote todos-done-string)
-                                     "\\)") nil t)
-      (let (done end done-sep prefix ov-pref ov-done)
-        (setq done (match-beginning 1)
-              end  (match-beginning 0))
-        (if todos-show-with-done
-            (progn
-              (setq done-sep todos-done-separator)
-              (unless (string-match "^[[:space:]]*$" todos-done-separator)
-                (setq done-sep (propertize (concat todos-done-separator "\n")
-                                           'face 'todos-done-sep))
-                (setq prefix (propertize
-                              (concat (if todos-number-prefix "1" todos-prefix) " ")
-                              'face 'todos-prefix-string))
-                ;; FIXME? Just deleting done-sep overlay results in bad
-                ;; display (except when stepping though in edebug)
-                (remove-overlays done done)
-                ;; must make separator overlay after making prefix overlay to get
-                ;; the order separator before prefix
-                (setq ov-pref (make-overlay done done)
-                      ov-done (make-overlay done done))
-                (overlay-put ov-pref 'before-string prefix)
-                (overlay-put ov-done 'before-string done-sep)))
-          (narrow-to-region (point-min) end))))))
-
-;; FIXME: why autoload?
-;;;###autoload
-;; (defun todos-add-item-non-interactively (item category)
-;;   "Insert item ITEM into category CATEGORY and set its priority."
-;;   (todos-category-number category)
-;;   (todos-show)                       ; now at point-min
-;;   (unless (or (eq (point-min) (point-max)) ; no unfinished items
-;;            (when (re-search-forward (concat "^\\["
-;;                                             (regexp-quote todos-done-string))
-;;                                     nil t)
-;;              (forward-line -1)
-;;              (bobp))) ; there are done items but no unfinished items
-;;     (let* ((maxnum (1+ (car (todos-item-counts category))))
-;;         priority candidate prompt)
-;;       (while (null priority)
-;;      (setq candidate
-;;            (string-to-number (read-from-minibuffer
-;;                               (concat prompt
-;;                                       (format "Set item priority (1-%d): "
-;;                                               maxnum)))))
-;;      (setq prompt
-;;            (when (or (< candidate 1) (> candidate maxnum))
-;;              (format "Priority must be an integer between 1 and %d.\n" maxnum)))
-;;      (unless prompt (setq priority candidate)))
-;;       (goto-char (point-min))
-;;       (unless (= priority 1) (todos-forward-item (1- priority)))))
-;;   (todos-insert-with-overlays item))
+  (unless (eq major-mode 'todos-archive-mode)
+    ;; display or hide done items as per todos-show-with-done
+    (save-excursion
+      (when (re-search-forward (concat "\n\\(\\[" (regexp-quote todos-done-string)
+                                       "\\)") nil t)
+        (let (done end done-sep prefix ov-pref ov-done)
+          (setq done (match-beginning 1)
+                end  (match-beginning 0))
+          (if todos-show-with-done
+              (progn
+                (setq done-sep todos-done-separator)
+                (unless (string-match "^[[:space:]]*$" todos-done-separator)
+                  (setq done-sep (propertize (concat todos-done-separator "\n")
+                                             'face 'todos-done-sep))
+                  (setq prefix (propertize (concat (if todos-number-prefix
+                                                       "1"
+                                                     todos-prefix) " ")
+                                           'face 'todos-prefix-string))
+                  ;; FIXME? Just deleting done-sep overlay results in bad
+                  ;; display (except when stepping though in edebug)
+                  (remove-overlays done done)
+                  ;; must make separator overlay after making prefix overlay to get
+                  ;; the order separator before prefix
+                  (setq ov-pref (make-overlay done done)
+                        ov-done (make-overlay done done))
+                  (overlay-put ov-pref 'before-string prefix)
+                  (overlay-put ov-done 'before-string done-sep)))
+            (narrow-to-region (point-min) end)))))))
 
 (defun todos-set-item-priority (item cat)
   "Set the priority of unfinished item ITEM in category CAT."
   (todos-category-number cat)
   (todos-category-select)
-  (let* ((not-done (car (todos-item-counts cat)))
-         (maxnum (1+ not-done))
+  (let* ((catsym (intern-soft (concat "todos-" cat)))
+         (todo (get catsym 'todo))
+         (maxnum (1+ todo))
          priority candidate prompt)
-    (unless (zerop not-done)
+    (unless (zerop todo)
       (while (null priority)
         (setq candidate
               (string-to-number (read-from-minibuffer
@@ -1907,13 +1821,14 @@ Number of entries for each category is given by `todos-print-priorities'."
 
 (defun todos-jump-to-category-noninteractively (cat)
   ""
-  (let ((bufname (buffer-name)))
-    (cond ((string= bufname todos-categories-buffer)
-           (switch-to-buffer (file-name-nondirectory todos-file-do)))
-          ((string= bufname todos-archived-categories-buffer)
-           ;; FIXME: is pop-to-buffer better for this case?
-           (switch-to-buffer (file-name-nondirectory todos-archive-file))))
-    (kill-buffer bufname))
+  ;; (let ((bufname (buffer-name)))
+  ;;   (cond ((string= bufname todos-categories-buffer)
+  ;;       (switch-to-buffer (file-name-nondirectory todos-file-do)))
+  ;;      ((string= bufname todos-archived-categories-buffer)
+  ;;       ;; FIXME: is pop-to-buffer better for this case?
+  ;;       (switch-to-buffer (file-name-nondirectory todos-archive-file))))
+  ;;   (kill-buffer bufname))
+  (switch-to-buffer (file-name-nondirectory todos-current-todos-file))
   (widen)
   (goto-char (point-min))
   (todos-category-number cat)
@@ -1924,9 +1839,7 @@ Number of entries for each category is given by `todos-print-priorities'."
   (todos-item-start)
   (insert item "\n")
   (todos-backward-item)
-  ;; (if todos-number-prefix
-  ;;     (todos-update-numbered-prefix)
-    (todos-prefix-overlays));)
+  (todos-prefix-overlays))
 
 (defun todos-item-string-start ()
   "Return the start of this TODO list entry as a string."
@@ -1966,10 +1879,6 @@ Number of entries for each category is given by `todos-print-priorities'."
          (end (progn (todos-item-end) (1+ (point))))
          (ov-start (car (overlays-in beg beg))))
     (when ov-start
-      ;; ;; don't cache numbers, since they can be popped out of order in
-      ;; ;; todos-prefix-overlays
-      ;; (unless todos-number-prefix
-      ;;        (push ov-start todos-item-start-overlays))
       (delete-overlay ov-start))
     (delete-region beg end)))
 
@@ -1983,65 +1892,79 @@ Number of entries for each category is given by `todos-print-priorities'."
     (todos-item-start)
     (looking-at (concat "^\\[" (regexp-quote todos-done-string)))))
 
-
-(defvar todos-categories-alist nil
-  "Variable for storing the result of todos-make-categories-alist.")
-(defun todos-make-categories-alist ()
-  "Return an alist of categories and some of their properties.
-The properties are at least the numbers of the unfinished and
-done items in the category."
-  (let (todos-categories-alist)
+(defun todos-make-categories-list ()
+  "Return a list of Todos categories and set their property lists.
+The properties are at least the category number and the numbers
+of todo items, done items and archived items in the category."
+  (let (catlist)
     (save-excursion
       (save-restriction
         (widen)
         (goto-char (point-min))
-        (let ((not-done 0)
-              (done 0)
-              category beg end)
+        (let ((num 0)
+              cat catsym archive-check)
           (while (not (eobp))
             (cond ((looking-at (concat (regexp-quote todos-category-beg)
                                        "\\(.*\\)\n"))
-                   (setq not-done 0 done 0)
-                   (push (list (match-string-no-properties 1) (cons not-done done))
-                         todos-categories-alist))
+                   (setq cat (match-string-no-properties 1))
+                   (setq num (1+ num))
+                   (setq archive-check nil)
+                   ;; FIXME: ok to intern in global obarray?
+                   (setq catsym (intern (concat "todos-" cat)))
+                   (setplist catsym (list 'catnum num 'todo 0 'done 0 'archived 0))
+                   (push cat catlist))
                   ((looking-at (concat "^\\[" (regexp-quote todos-done-string)))
-                   (setq done (1+ done))
-                   (setcdr (cadr (car todos-categories-alist)) done))
+                   (put catsym 'done (1+ (get catsym 'done))))
                   ((looking-at (concat "^\\[?" todos-date-pattern))
-                   (setq not-done (1+ not-done))
-                   (setcar (cadr (car todos-categories-alist)) not-done)))
+                   (put catsym 'todo (1+ (get catsym 'todo)))))
+            (unless (or archive-check
+                        (string= (buffer-file-name)
+                                 (expand-file-name todos-archive-file)))
+              (let ((archive (find-file-noselect todos-archive-file)))
+                (with-current-buffer archive
+                  (goto-char (point-min))
+                  (when (re-search-forward
+                         (concat (regexp-quote todos-category-beg) cat)
+                         (point-max) t)
+                    (forward-line)
+                    (while (not (or (looking-at
+                                     (concat (regexp-quote todos-category-beg)
+                                             "\\(.*\\)\n"))
+                                    (eobp)))
+                      (when (looking-at
+                             (concat "^\\[" (regexp-quote todos-done-string)))
+                        (put catsym 'archived (1+ (get catsym 'archived))))
+                      (forward-line)))))
+              (setq archive-check t))
             (forward-line)))))
-    todos-categories-alist))
+    catlist))
 
 (defun todos-item-counts (cat &optional how)
   ""
-  (let* ((counts (cadr (assoc cat todos-categories-alist)))
-         (not-done (car counts))
-         (done (cdr counts)))
+  (let ((catsym (intern-soft (concat "todos-" cat))))
+    ;; FIXME: need this?
+    ;; (when catsym
     (cond ((eq how 'insert)
-           (setcar counts (1+ not-done)))
+           (put catsym 'todo (1+ (get catsym 'todo))))
           ((eq how 'delete)
            (if (todos-done-item-p)      ;FIXME: fails if last done item was deleted
-               (setcdr counts (1- done))
-             (setcar counts (1- not-done))))
-          ;; ((eq how 'move-failed)
-          ;;  (setcar counts not-done))
+               (put catsym 'done (1- (get catsym 'done)))
+             (put catsym 'todo (1- (get catsym 'todo)))))
           ((eq how 'done)
-           (setcar counts (1- not-done))
-           (setcdr counts (1+ done)))
+           (put catsym 'todo (1- (get catsym 'todo)))
+           (put catsym 'done (1+ (get catsym 'done))))
           ((eq how 'undo)
-           (setcar counts (1+ not-done))
-           (setcdr counts (1- done)))
+           (put catsym 'todo (1+ (get catsym 'todo)))
+           (put catsym 'done (1- (get catsym 'done))))
           ((eq how 'archive)
-           (setcdr counts 0))
-          (t
-           (cons not-done done)))))
+           (put catsym 'archived (+ (get catsym 'done) (get catsym 'archived)))
+           (put catsym 'done 0)))))
 
 (defun todos-longest-category-name-length (categories)
   ""
   (let ((longest 0))
     (dolist (c categories longest)
-      (setq longest (max longest (length (car c)))))))
+      (setq longest (max longest (length c))))))
 
 (defun todos-string-count-lines (string)
   "Return the number of lines STRING spans."
@@ -2052,7 +1975,7 @@ done items in the category."
   (> (todos-string-count-lines string) 1))
 
 (defun todos-read-category ()
-  "Return an existing category name, with tab completion."
+  "Return a category name (existing names with tab completion)."
   ;; allow SPC to insert spaces, for adding new category names with
   ;; todos-move-item
   (let ((map minibuffer-local-completion-map))
@@ -2076,7 +1999,8 @@ done items in the category."
     (while (and (cond ((string= "" cat)
                        (setq prompt "Enter a non-empty category name: "))
                       ((string-match "\\`\\s-+\\'" cat)
-                       (setq prompt "Enter a category name that is not only white space: "))
+                       (setq prompt
+                             "Enter a category name that is not only white space: "))
                       ((member cat todos-categories)
                        (setq prompt "Enter a non-existing category name: ")))
                 (setq cat (read-from-minibuffer prompt)))))
@@ -2120,28 +2044,28 @@ done items in the category."
   (let (valid answer)
     (while (not valid)
       (setq answer (read-from-minibuffer
-                    "Enter a clock time: "))
+                    "Enter a clock time (or return for none): "))
       (when (or (string= "" answer)
                 (string-match diary-time-regexp answer))
         (setq valid t)))
     answer))
 
-(defun todos-categories-list (buf)
-  "Return a list of the Todo mode categories in buffer BUF."
-  (let (categories)
-    (with-current-buffer buf
-      (save-excursion
-        (save-restriction
-          (widen)
-          (goto-char (point-max))
-          (while (re-search-backward (concat "^" (regexp-quote todos-category-beg)
-                                             "\\(.*\\)\n") nil t)
-            (push (match-string-no-properties 1) categories)))))
-    categories))
+;; (defun todos-categories-list (buf)
+;;   "Return a list of the Todo mode categories in buffer BUF."
+;;   (let (categories)
+;;     (with-current-buffer buf
+;;       (save-excursion
+;;      (save-restriction
+;;        (widen)
+;;        (goto-char (point-max))
+;;        (while (re-search-backward (concat "^" (regexp-quote todos-category-beg)
+;;                                           "\\(.*\\)\n") nil t)
+;;          (push (match-string-no-properties 1) categories)))))
+;;     categories))
 
 (defun todos-padded-string (str)
   ""
-  (let* ((len (todos-longest-category-name-length todos-categories-alist))
+  (let* ((len (todos-longest-category-name-length todos-categories))
          (strlen (length str))
          (strlen-odd (eq (logand strlen 1) 1)) ; oddp from cl.el
          (padding (/ (- len strlen) 2)))
@@ -2150,9 +2074,8 @@ done items in the category."
 
 (defun todos-insert-category-name (cat &optional nonum)
   ""
-  (let* ((buf (get-buffer (file-name-nondirectory todos-file-do)))
-         (cat-alist todos-categories-alist)
-         (counts (todos-item-counts cat)))
+  (let ((catsym (intern-soft (concat "todos-" cat)))
+        (archive (string= todos-current-todos-file todos-archive-file)))
     ;; num is declared in caller
     (setq num (1+ num))
     (if nonum
@@ -2163,11 +2086,17 @@ done items in the category."
                    'action
                    `(lambda (button)
                       (todos-jump-to-category-noninteractively ,cat)))
-    (insert (make-string 8 32)
-            (format "%2d" (car counts))
-            (make-string 5 32)
-            (format "%2d" (cdr counts)))
-    (newline)))
+    (insert (concat (make-string 8 32)
+                    (unless archive
+                      (concat
+                       (format "%2d" (get catsym 'todo))
+                       (make-string 5 32)))
+                    (format "%2d" (get catsym 'done))
+                    (unless archive
+                      (concat
+                       (make-string 5 32)
+                       (format "%2d" (get catsym 'archived))))
+                    "\n"))))
 
 (defun todos-initial-setup ()
   "Set up things to work properly in TODO mode."
@@ -2178,4 +2107,25 @@ done items in the category."
 
 (provide 'todos)
 
+;;; UI
+;; - display
+;;   - show todos in cat
+;;   - show done in cat
+;;   - show catlist
+;;   - show top priorities in all cats
+;;   - show archived
+;; - navigation
+;;   - 
+;; - editing
+;;
+;;; Internals
+;; - cat props: name, number, todos, done, archived
+;; - item props: priority, date-time, status?
+;; - file format
+;;   - cat begin
+;;   - todo items 0...n
+;;   - empty line
+;;   - done-separator
+;;   - done item 0...n
+
 ;;; todos.el ends here