Re: gnus crashes on threads deeper than 333 articles

[Chong Yidong <cyd@stupidchicken.com>]

> How about this patch?  Instead of adding a new defcustom, we use the
> safe recursive sorter by default, and try again with the non-recursive
> sorter if an error is signalled.  The patch also regenerates
> gnus-thread-indent-array if it becomes too small to handle a thread.

Oops, a couple typos in that patch.  I meant this:

*** gnus-sum.el.~1.93.~	2006-11-24 14:49:06.000000000 -0500
--- gnus-sum.el	2006-12-05 11:58:31.000000000 -0500
***************
*** 3343,3358 ****
        t
      (not (cdr (gnus-data-find-list article)))))
  
! (defun gnus-make-thread-indent-array ()
!   (let ((n 200))
!     (unless (and gnus-thread-indent-array
! 		 (= gnus-thread-indent-level gnus-thread-indent-array-level))
!       (setq gnus-thread-indent-array (make-vector 201 "")
! 	    gnus-thread-indent-array-level gnus-thread-indent-level)
!       (while (>= n 0)
! 	(aset gnus-thread-indent-array n
! 	      (make-string (* n gnus-thread-indent-level) ? ))
! 	(setq n (1- n))))))
  
  (defun gnus-update-summary-mark-positions ()
    "Compute where the summary marks are to go."
--- 3343,3358 ----
        t
      (not (cdr (gnus-data-find-list article)))))
  
! (defun gnus-make-thread-indent-array (&optional n)
!   (if (null n) (setq n 200))
!   (unless (and gnus-thread-indent-array
! 	       (= gnus-thread-indent-level gnus-thread-indent-array-level))
!     (setq gnus-thread-indent-array (make-vector 201 "")
! 	  gnus-thread-indent-array-level gnus-thread-indent-level)
!     (while (>= n 0)
!       (aset gnus-thread-indent-array n
! 	    (make-string (* n gnus-thread-indent-level) ? ))
!       (setq n (1- n)))))
  
  (defun gnus-update-summary-mark-positions ()
    "Compute where the summary marks are to go."
***************
*** 3451,3456 ****
--- 3451,3459 ----
  				 gnus-tmp-expirable gnus-tmp-subject-or-nil
  				 &optional gnus-tmp-dummy gnus-tmp-score
  				 gnus-tmp-process)
+   (if (> gnus-tmp-level (length gnus-thread-indent-array))
+       (gnus-make-thread-indent-array (max (* 2 (length gnus-thread-indent-array))
+ 					  gnus-tmp-level)))
    (let* ((gnus-tmp-indentation (aref gnus-thread-indent-array gnus-tmp-level))
  	 (gnus-tmp-lines (mail-header-lines gnus-tmp-header))
  	 (gnus-tmp-score (or gnus-tmp-score gnus-summary-default-score 0))
***************
*** 4549,4571 ****
  	      (1+ (gnus-point-at-eol))
  	    (gnus-delete-line)))))))
  
! (defun gnus-sort-threads-1 (threads func)
    (sort (mapcar (lambda (thread)
  		  (cons (car thread)
  			(and (cdr thread)
! 			     (gnus-sort-threads-1 (cdr thread) func))))
  		threads) func))
  
  (defun gnus-sort-threads (threads)
    "Sort THREADS."
    (if (not gnus-thread-sort-functions)
        threads
      (gnus-message 8 "Sorting threads...")
!     (let ((max-lisp-eval-depth 5000))
!       (prog1 (gnus-sort-threads-1
! 	 threads
! 	 (gnus-make-sort-function gnus-thread-sort-functions))
!         (gnus-message 8 "Sorting threads...done")))))
  
  (defun gnus-sort-articles (articles)
    "Sort ARTICLES."
--- 4552,4597 ----
  	      (1+ (gnus-point-at-eol))
  	    (gnus-delete-line)))))))
  
! (defun gnus-sort-threads-recursive (threads func)
    (sort (mapcar (lambda (thread)
  		  (cons (car thread)
  			(and (cdr thread)
! 			     (gnus-sort-threads-recursive (cdr thread) func))))
  		threads) func))
  
+ (defun gnus-sort-threads-loop (threads func)
+   (let* ((superthread (cons nil threads))
+   	 (stack (list (cons superthread threads)))
+   	 remaining-threads thread)
+     (while stack
+       (setq remaining-threads (cdr (car stack)))
+       (if remaining-threads
+   	  (progn (setq thread (car remaining-threads))
+   		 (setcdr (car stack) (cdr remaining-threads))
+   		 (if (cdr thread)
+   		     (push (cons thread (cdr thread)) stack)))
+   	(setq thread (caar stack))
+   	(setcdr thread (sort (cdr thread) func))
+   	(pop stack)))
+     (cdr superthread)))
+ 
  (defun gnus-sort-threads (threads)
    "Sort THREADS."
    (if (not gnus-thread-sort-functions)
        threads
      (gnus-message 8 "Sorting threads...")
!     (prog1
! 	(condition-case nil
! 	    (let ((max-lisp-eval-depth (max max-lisp-eval-depth 5000)))
! 	      (gnus-sort-threads-recursive
! 	       threads (gnus-make-sort-function gnus-thread-sort-functions)))
! 	  ;; Even after binding max-lisp-eval-depth, the recursive
! 	  ;; sorter might fail for very long threads.  In that case,
! 	  ;; fall back on a (less well-tested) non-recursive sorter.
! 	  (error (gnus-sort-threads-loop
! 		  threads (gnus-make-sort-function
! 			   gnus-thread-sort-functions))))
!       (gnus-message 8 "Sorting threads...done"))))
  
  (defun gnus-sort-articles (articles)
    "Sort ARTICLES."
***************
*** 4990,4995 ****
--- 5016,5025 ----
  		      gnus-tmp-closing-bracket ?\>)
  	      (setq gnus-tmp-opening-bracket ?\[
  		    gnus-tmp-closing-bracket ?\]))
+ 	    (if (> gnus-tmp-level (length gnus-thread-indent-array))
+ 		(gnus-make-thread-indent-array
+ 		 (max (* 2 (length gnus-thread-indent-array))
+ 		      gnus-tmp-level)))
  	    (setq
  	     gnus-tmp-indentation
  	     (aref gnus-thread-indent-array gnus-tmp-level)
***************
*** 8165,8171 ****
    ;; will really go down to a leaf article first, before slowly
    ;; working its way up towards the root.
    (when thread
!     (let* ((max-lisp-eval-depth 5000)
  	   (children
  	   (if (cdr thread)
  	       (apply '+ (mapcar 'gnus-summary-limit-children
--- 8195,8201 ----
    ;; will really go down to a leaf article first, before slowly
    ;; working its way up towards the root.
    (when thread
!     (let* ((max-lisp-eval-depth (max 5000 max-lisp-eval-depth))
  	   (children
  	   (if (cdr thread)
  	       (apply '+ (mapcar 'gnus-summary-limit-children