BUG: Infinite loop finding stuck projects

[Bernt Hansen <bernt@norang.ca>]

Hi Carsten,

The following commit breaks finding stuck projects for me.  It looks
like an infinite loop.

------------------------------------------------------------------------
commit 1fbe1f7f503e473e6a3a14f44451c4e6e5f043a4
Author: Carsten Dominik <carsten.dominik@gmail.com>
Date:   Thu Apr 2 18:16:35 2009 +0200

    Tags scan: Also find the first line in a buffer

------------------------------------------------------------------------

My org-stuck-projects setup is:

org-stuck-projects is a variable defined in `org-agenda.el'.
Its value is 
("/PROJECT" nil
 ("NEXT")
 "")

Let me know if you need additional information.

Backtrace from C-g from commit 3d8e835 follows.  I interrupted C-C a #
and generated the following backtrace (in case that's useful)

-Bernt

------------------------------------------------------------------------
Debugger entered--Lisp error: (quit)
  (if tags (progn (setq tags ... tags-alist ...)))
  (when tags (setq tags (org-split-string tags ":") tags-alist (cons ... tags-alist)))
  (catch :skip (setq todo (if ... ...) tags (if ... ...)) (goto-char (setq lspos ...)) (setq level (org-reduced-level ...) category (org-get-category)) (setq i llast llast level) (while (>= i level) (when ... ...) (setq i ...)) (when tags (setq tags ... tags-alist ...)) (setq tags-list (if org-use-tag-inheritance ... tags) org-scanner-tags tags-list) (when org-use-tag-inheritance (setcdr ... ...)) (when (and tags org-use-tag-inheritance ...) (setcdr ... ...)) (when (and ... ... ...) (unless ... ...) (cond ... ... ... ...) (or org-tags-match-list-sublevels ...)))
  (while (re-search-forward re nil t) (catch :skip (setq todo ... tags ...) (goto-char ...) (setq level ... category ...) (setq i llast llast level) (while ... ... ...) (when tags ...) (setq tags-list ... org-scanner-tags tags-list) (when org-use-tag-inheritance ...) (when ... ...) (when ... ... ... ...)))
  (save-excursion (goto-char (point-min)) (when (eq action ...) (org-overview) (org-remove-occur-highlights)) (while (re-search-forward re nil t) (catch :skip ... ... ... ... ... ... ... ... ... ...)))
  (let* ((re ...) (props ...) (case-fold-search nil) lspos tags tags-list (tags-alist ...) (llast 0) rtn rtn1 level category i txt todo marker entry priority) (when (not ...) (setq action ...)) (save-excursion (goto-char ...) (when ... ... ...) (while ... ...)) (when (and ... ...) (org-hide-archived-subtrees ... ...)) (nreverse rtn))
  org-scan-tags(agenda (and t (equal todo "PROJECT")) nil)
  (setq rtn (org-scan-tags (quote agenda) matcher todo-only))
  (save-restriction (if org-agenda-restrict (narrow-to-region org-agenda-restrict-begin org-agenda-restrict-end) (widen)) (setq rtn (org-scan-tags ... matcher todo-only)) (setq rtnall (append rtnall rtn)))
  (save-excursion (save-restriction (if org-agenda-restrict ... ...) (setq rtn ...) (setq rtnall ...)))
  (save-current-buffer (set-buffer buffer) (unless (org-mode-p) (error "Agenda file %s is not in `org-mode'" file)) (save-excursion (save-restriction ... ... ...)))
  (with-current-buffer buffer (unless (org-mode-p) (error "Agenda file %s is not in `org-mode'" file)) (save-excursion (save-restriction ... ... ...)))
  (if (not buffer) (setq rtn (list ...) rtnall (append rtnall rtn)) (with-current-buffer buffer (unless ... ...) (save-excursion ...)))
  (catch (quote nextfile) (org-check-agenda-file file) (setq buffer (if ... ... ...)) (if (not buffer) (setq rtn ... rtnall ...) (with-current-buffer buffer ... ...)))
  (while (setq file (pop files)) (catch (quote nextfile) (org-check-agenda-file file) (setq buffer ...) (if ... ... ...)))
  (let* ((org-tags-match-list-sublevels ...) (completion-ignore-case t) rtn rtnall files file pos matcher buffer) (setq matcher (org-make-tags-matcher match) match (car matcher) matcher (cdr matcher)) (org-prepare-agenda (concat "TAGS " match)) (setq org-agenda-query-string match) (setq org-agenda-redo-command (list ... ... ...)) (setq files (org-agenda-files nil ...) rtnall nil) (while (setq file ...) (catch ... ... ... ...)) (if org-agenda-overriding-header (insert ... "\n") (insert "Headlines with TAGS match: ") (add-text-properties ... ... ...) (setq pos ...) (insert match "\n") (add-text-properties pos ... ...) (setq pos ...) (unless org-agenda-multi ...) (add-text-properties pos ... ...)) (when rtnall (insert ... "\n")) (goto-char (point-min)) (or org-agenda-multi (org-fit-agenda-win
 dow)) (add-text-properties (point-min) (point-max) (quote ...)) (org-finalize-agenda) (setq buffer-read-only t))
  org-tags-view(nil "/PROJECT")
  (let* ((org-agenda-skip-function ...) (org-agenda-overriding-header "List of stuck projects: ") (matcher ...) (todo ...) (todo-wds ...) (todo-re ...) (tags ...) (tags-re ...) (gen-re ...) (re-list ...)) (setq org-agenda-skip-regexp (if re-list ... ...)) (org-tags-view nil matcher) (with-current-buffer org-agenda-buffer-name (setq org-agenda-redo-command ...)))
  org-agenda-list-stuck-projects()
  call-interactively(org-agenda-list-stuck-projects)
  (cond ((setq entry ...) (if ... ... ...)) ((equal keys "C") (setq org-agenda-custom-commands org-agenda-custom-commands-orig) (customize-variable ...)) ((equal keys "a") (call-interactively ...)) ((equal keys "s") (call-interactively ...)) ((equal keys "t") (call-interactively ...)) ((equal keys "T") (org-call-with-arg ... ...)) ((equal keys "m") (call-interactively ...)) ((equal keys "M") (org-call-with-arg ... ...)) ((equal keys "e") (call-interactively ...)) ((equal keys "L") (unless ... ...) (unless restriction ... ...)) ((equal keys "#") (call-interactively ...)) ((equal keys "/") (call-interactively ...)) ((equal keys "!") (customize-variable ...)) (t (error "Invalid agenda key")))
  (let* ((prefix-descriptions nil) (org-agenda-custom-commands-orig org-agenda-custom-commands) (org-agenda-custom-commands ...) (buf ...) (bfn ...) entry key type match lprops ans) (unless org-agenda-overriding-restriction (put ... ... nil) (setq org-agenda-restrict nil) (move-marker org-agenda-restrict-begin nil) (move-marker org-agenda-restrict-end nil)) (put (quote org-agenda-redo-command) (quote org-lprops) nil) (setq org-agenda-last-dispatch-buffer (current-buffer)) (unless keys (setq ans ... keys ... restriction ...)) (when (and ... restriction) (put ... ... ...) (cond ... ...)) (require (quote calendar)) (cond (... ...) (... ... ...) (... ...) (... ...) (... ...) (... ...) (... ...) (... ...) (... ...) (... ... ...) (... ...) (... ...) (... ...) (t ...)))
  (catch (quote exit) (let* (... ... ... ... ... entry key type match lprops ans) (unless org-agenda-overriding-restriction ... ... ... ...) (put ... ... nil) (setq org-agenda-last-dispatch-buffer ...) (unless keys ...) (when ... ... ...) (require ...) (cond ... ... ... ... ... ... ... ... ... ... ... ... ... ...)))
  org-agenda(nil)
  call-interactively(org-agenda)
------------------------------------------------------------------------