Function: todo-filter-items-1

todo-filter-items-1 is a byte-compiled function defined in todo-mode.el.gz.

Signature

(todo-filter-items-1 FILTER FILE-LIST)

Documentation

Build a list of items by applying FILTER to FILE-LIST.

Internal subroutine called by todo-filter-items, which passes the values of FILTER and FILE-LIST.

Source Code

;; Defined in /usr/src/emacs/lisp/calendar/todo-mode.el.gz
(defun todo-filter-items-1 (filter file-list)
  "Build a list of items by applying FILTER to FILE-LIST.
Internal subroutine called by `todo-filter-items', which passes
the values of FILTER and FILE-LIST."
  (let ((num (if (consp filter) (cdr filter) todo-top-priorities))
	(buf (get-buffer-create todo-filtered-items-buffer))
	(multifile (> (length file-list) 1))
	regexp fname bufstr cat beg end done)
    (if (null file-list)
	(user-error "No files have been chosen for filtering")
      (with-current-buffer buf
	(erase-buffer)
	(kill-all-local-variables)
	(todo-filtered-items-mode))
      (when (eq filter 'regexp)
	(setq regexp (read-string "Enter a regular expression: ")))
      (save-current-buffer
	(dolist (f file-list)
	  ;; Before inserting file contents into temp buffer, save a modified
	  ;; buffer visiting it.
	  (let ((bf (find-buffer-visiting f)))
	    (when (buffer-modified-p bf)
	      (with-current-buffer bf (save-buffer))))
	  (setq fname (todo-short-file-name f))
	  (with-temp-buffer
	    (when (and todo-filter-done-items (eq filter 'regexp))
	      ;; If there is a corresponding archive file for the
	      ;; todo file, insert it first and add identifiers for
	      ;; todo-go-to-source-item.
	      (let ((arch (concat (file-name-sans-extension f) ".toda")))
		(when (file-exists-p arch)
		  (insert-file-contents arch)
		  ;; Delete todo archive file's categories sexp.
		  (delete-region (line-beginning-position)
				 (1+ (line-end-position)))
		  (save-excursion
		    (while (not (eobp))
		      (when (re-search-forward
			     (concat (if todo-filter-done-items
					 (concat "\\(?:" todo-done-string-start
						 "\\|" todo-date-string-start
						 "\\)")
				       todo-date-string-start)
				     todo-date-pattern "\\(?: "
				     diary-time-regexp "\\)?"
				     (if todo-filter-done-items
					 "\\]"
				       (regexp-quote todo-nondiary-end)) "?")
			     nil t)
			(insert "(archive) "))
		      (forward-line))))))
	    (insert-file-contents f)
	    ;; Delete todo file's categories sexp.
	    (delete-region (line-beginning-position) (1+ (line-end-position)))
	    (let (fnum)
	      ;; Unless the number of top priorities to show was
	      ;; passed by the caller, the file-wide value from
	      ;; `todo-top-priorities-overrides', if non-nil, overrides
	      ;; `todo-top-priorities'.
	      (unless (consp filter)
		(setq fnum (or (nth 1 (assoc f todo-top-priorities-overrides))
			       todo-top-priorities)))
	      (while (re-search-forward
		      (concat "^" (regexp-quote todo-category-beg)
			      "\\(.+\\)\n")
                      nil t)
		(setq cat (match-string 1))
		(let (cnum)
		  ;; Unless the number of top priorities to show was
		  ;; passed by the caller, the category-wide value
		  ;; from `todo-top-priorities-overrides', if non-nil,
		  ;; overrides a non-nil file-wide value from
		  ;; `todo-top-priorities-overrides' as well as
		  ;; `todo-top-priorities'.
		  (unless (consp filter)
		    (let ((cats (nth 2 (assoc f todo-top-priorities-overrides))))
		      (setq cnum (or (cdr (assoc cat cats)) fnum))))
		  (delete-region (match-beginning 0) (match-end 0))
		  (setq beg (point))	; First item in the current category.
		  (setq end (if (re-search-forward
				 (concat "^" (regexp-quote todo-category-beg))
				 nil t)
				(match-beginning 0)
			      (point-max)))
		  (goto-char beg)
		  (setq done
			(if (re-search-forward
			     (concat "\n" (regexp-quote todo-category-done))
			     end t)
			    (match-beginning 0)
			  end))
		  (unless (and todo-filter-done-items (eq filter 'regexp))
		    ;; Leave done items.
		    (delete-region done end)
		    (setq end done))
		  (narrow-to-region beg end)	; Process only current category.
		  (goto-char (point-min))
		  ;; Apply the filter.
		  (cond ((eq filter 'diary)
			 (while (not (eobp))
			   (if (looking-at (regexp-quote todo-nondiary-start))
			       (todo-remove-item)
			     (todo-forward-item))))
			((eq filter 'regexp)
			 (while (not (eobp))
			   (if (looking-at todo-item-start)
			       (if (string-match regexp (todo-item-string))
				   (todo-forward-item)
				 (todo-remove-item))
			     ;; Kill lines that aren't part of a todo or done
			     ;; item (empty or todo-category-done).
			     (delete-region (line-beginning-position)
					    (1+ (line-end-position))))
			   ;; If last todo item in file matches regexp and
			   ;; there are no following done items,
			   ;; todo-category-done string is left dangling,
			   ;; because todo-forward-item jumps over it.
			   (if (and (eobp)
				    (looking-back
				     (concat (regexp-quote todo-done-string)
					     "\n")
                                     (line-beginning-position 0)))
			       (delete-region (point) (progn
							(forward-line -2)
							(point))))))
			(t ; Filter top priority items.
			 (setq num (or cnum fnum num))
			 (unless (zerop num)
			   (todo-forward-item num))))
		  (setq beg (point))
		  ;; Delete non-top-priority items.
		  (unless (member filter '(diary regexp))
		    (delete-region beg end))
		  (goto-char (point-min))
		  ;; Add file (if using multiple files) and category tags to
		  ;; item.
		  (while (not (eobp))
		    (when (re-search-forward
			   (concat (if todo-filter-done-items
				       (concat "\\(?:" todo-done-string-start
					       "\\|" todo-date-string-start
					       "\\)")
				     todo-date-string-start)
				   todo-date-pattern "\\(?: " diary-time-regexp
				   "\\)?" (if todo-filter-done-items
					      "\\]"
					    (regexp-quote todo-nondiary-end))
				   "?")
			   nil t)
		      (insert " [")
		      (when (looking-at "(archive) ") (goto-char (match-end 0)))
		      (insert (if multifile (concat fname ":") "") cat "]"))
		    (forward-line))
		  (widen)))
		(setq bufstr (buffer-string))
		(with-current-buffer buf
		  (let (buffer-read-only)
		    (insert bufstr)))))))
      (set-window-buffer (selected-window) (set-buffer buf))
      (todo-prefix-overlays)
      (goto-char (point-min)))))