Function: todo-archive-done-item

todo-archive-done-item is an interactive and byte-compiled function defined in todo-mode.el.gz.

Signature

(todo-archive-done-item &optional ALL)

Documentation

Archive at least one done item in this category.

With prefix argument ALL, prompt whether to archive all done items in this category and on confirmation archive them. Otherwise, if there are marked done items (and no marked todo items), archive all of these; otherwise, archive the done item at point.

If the archive of this file does not exist, it is created. If this category does not exist in the archive, it is created.

Key Bindings

Source Code

;; Defined in /usr/src/emacs/lisp/calendar/todo-mode.el.gz
(defun todo-archive-done-item (&optional all)
  "Archive at least one done item in this category.

With prefix argument ALL, prompt whether to archive all done
items in this category and on confirmation archive them.
Otherwise, if there are marked done items (and no marked todo
items), archive all of these; otherwise, archive the done item at
point.

If the archive of this file does not exist, it is created.  If
this category does not exist in the archive, it is created."
  (interactive "P")
  (when (eq major-mode 'todo-mode)
    (if (and all (zerop (todo-get-count 'done)))
	(message "No done items in this category")
      (catch 'end
	(let* ((cat (todo-current-category))
	       (tbuf (current-buffer))
	       (marked (assoc cat todo-categories-with-marks))
	       (afile (concat (file-name-sans-extension
			       todo-current-todo-file) ".toda"))
	       (archive (find-file-noselect afile t))
	       (item (and (not marked) (todo-done-item-p)
			  (concat (todo-item-string) "\n")))
	       (count 0)
	       (opoint (unless (todo-done-item-p) (point)))
	       marked-items beg end all-done)
	  (cond
	   (all
	    (if (todo-y-or-n-p "Archive all done items in this category? ")
		(save-excursion
		  (save-restriction
		    (goto-char (point-min))
		    (widen)
		    (setq beg (progn
				(re-search-forward todo-done-string-start
						   nil t)
				(match-beginning 0))
			  end (if (re-search-forward
				   (concat "^"
					   (regexp-quote todo-category-beg))
				   nil t)
				  (match-beginning 0)
				(point-max))
			  all-done (buffer-substring-no-properties beg end)
			  count (todo-get-count 'done))
		    ;; Restore starting point, unless it was on a done
		    ;; item, since they will all be deleted.
		    (when opoint (goto-char opoint))))
	      (throw 'end nil)))
	   (marked
	    (save-excursion
	      (goto-char (point-min))
	      (while (not (eobp))
		(when (todo-marked-item-p)
		  (if (not (todo-done-item-p))
		      (throw 'end (message "Only done items can be archived"))
		    (setq marked-items
			  (concat marked-items (todo-item-string) "\n"))
		    (setq count (1+ count))))
		(todo-forward-item)))))
	  (if (not (or marked all item))
	      (throw 'end (message "Only done items can be archived"))
	    (with-current-buffer archive
	      (unless (derived-mode-p 'todo-archive-mode) (todo-archive-mode))
	      (let ((headers-hidden todo--item-headers-hidden)
                    buffer-read-only)
                (if headers-hidden (todo-toggle-item-header))
		(widen)
		(goto-char (point-min))
		(if (and (re-search-forward
			  (concat "^" (regexp-quote
				       (concat todo-category-beg cat)) "$")
			  nil t)
			 (re-search-forward (regexp-quote todo-category-done)
					    nil t))
		    ;; Start of done items section in existing category.
		    (forward-char)
		  (todo-add-category nil cat)
		  ;; Start of done items section in new category.
		  (goto-char (point-max)))
		(insert (cond (marked marked-items)
			      (all all-done)
			      (item)))
		(todo-update-count 'done (if (or marked all) count 1) cat)
		(todo-update-categories-sexp)
		;; If archive is new, save to file now (with
		;; write-region to avoid prompt for file to save to)
		;; to update todo-archives, and set the mode for
		;; visiting the archive below.
		(unless (nth 7 (file-attributes afile))
		  (write-region nil nil afile t t)
		  (setq todo-archives (funcall todo-files-function t))
		  (todo-archive-mode))
                (if headers-hidden (todo-toggle-item-header))))
	    (with-current-buffer tbuf
	      (let ((buffer-read-only nil))
		(cond
		 (all
		  (save-excursion
		    (save-restriction
		      ;; Make sure done items are accessible.
		      (widen)
		      (remove-overlays beg end)
		      (delete-region beg end)
		      (todo-update-count 'done (- count))
		      (todo-update-count 'archived count))))
		 ((or marked
		      ;; If we're archiving all done items, can't
		      ;; first archive item point was on, since
		      ;; that will short-circuit the rest.
		      (and item (not all)))
		  (and marked (goto-char (point-min)))
		  (catch 'done
		    (while (not (eobp))
		      (if (or (and marked (todo-marked-item-p)) item)
			  (progn
			    (todo-remove-item)
			    (todo-update-count 'done -1)
			    (todo-update-count 'archived 1)
			    ;; Don't leave point below last item.
			    (and (or marked item) (bolp) (eolp)
				 (< (point-min) (point-max))
				 (todo-backward-item))
			    (when item
			      (throw 'done (setq item nil))))
			(todo-forward-item)))))))
	      (when marked
		(setq todo-categories-with-marks
		      (assq-delete-all cat todo-categories-with-marks)))
	      (todo-update-categories-sexp)
	      (todo-prefix-overlays)))
	  (find-file afile)
	  (todo-category-number cat)
	  (todo-category-select)
	  (split-window-below)
	  (set-window-buffer (selected-window) tbuf)
	  ;; Make todo file current to select category.
	  (find-file (buffer-file-name tbuf))
	  ;; Make sure done item separator is hidden (if done items
	  ;; were initially visible).
	  (let (todo-show-with-done) (todo-category-select)))))))