[Orgmode] BUG: Infinite loop finding stuck projects

[Bernt Hansen]

Hi Carsten,

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

------------------------------------------------------------------------
commit 1fbe1f7f503e473e6a3a14f44451c4e6e5f043a4
Author: Carsten Dominik <address@hidden>
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-window)) (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)
------------------------------------------------------------------------