Re: BUG: Infinite loop finding stuck projects

[Carsten Dominik <dominik@science.uva.nl>]

I have reverted this commit, thanks.

In particular thanks for finding the commit.  Just saying "stuck  
projects"
would have sent me off in the wrong direction.

- Carsten

On Apr 3, 2009, at 3:53 PM, Bernt Hansen wrote:

> 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- 
> 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)
> ------------------------------------------------------------------------
>
>
> _______________________________________________
> Emacs-orgmode mailing list
> Remember: use `Reply All' to send replies to the list.
> Emacs-orgmode@gnu.org
> http://lists.gnu.org/mailman/listinfo/emacs-orgmode