Mercurial > hg > xemacs-beta

comparison lisp/gnus/gnus-sum.el @ 124:9b50b4588a93 r20-1b15

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b15
author cvs
date Mon, 13 Aug 2007 09:26:39 +0200
parents d2f30a177268
children b980b6286996
comparison
equal deleted inserted replaced
123:c77884c6318d 124:9b50b4588a93
2757 (setq threads (cdr threads))) 2757 (setq threads (cdr threads)))
2758 result)) 2758 result))
2759 2759
2760 (defun gnus-thread-loop-p (root thread) 2760 (defun gnus-thread-loop-p (root thread)
2761 "Say whether ROOT is in THREAD." 2761 "Say whether ROOT is in THREAD."
2762 (let ((th (cdr thread))) 2762 (let ((stack (list thread))
2763 (while (and th 2763 (infloop 0)
2764 (not (eq (caar th) root))) 2764 th)
2765 (pop th)) 2765 (while (setq thread (pop stack))
2766 (if th 2766 (setq th (cdr thread))
2767 ;; We have found a loop. 2767 (while (and th
2768 (let (ref-dep) 2768 (not (eq (caar th) root)))
2769 (setcdr thread (delq (car th) (cdr thread))) 2769 (pop th))
2770 (if (boundp (setq ref-dep (intern "none" 2770 (if th
2771 gnus-newsgroup-dependencies))) 2771 ;; We have found a loop.
2772 (setcdr (symbol-value ref-dep) 2772 (let (ref-dep)
2773 (nconc (cdr (symbol-value ref-dep)) 2773 (setcdr thread (delq (car th) (cdr thread)))
2774 (list (car th)))) 2774 (if (boundp (setq ref-dep (intern "none"
2775 (set ref-dep (list nil (car th)))) 2775 gnus-newsgroup-dependencies)))
2776 1) 2776 (setcdr (symbol-value ref-dep)
2777 ;; Recurse down into the sub-threads and look for loops. 2777 (nconc (cdr (symbol-value ref-dep))
2778 (apply '+ 2778 (list (car th))))
2779 (mapcar 2779 (set ref-dep (list nil (car th))))
2780 (lambda (thread) (gnus-thread-loop-p root thread)) 2780 (setq infloop 1
2781 (cdr thread)))))) 2781 stack nil))
2782 ;; Push all the subthreads onto the stack.
2783 (push (cdr thread) stack)))
2784 infloop))
2782 2785
2783 (defun gnus-make-threads () 2786 (defun gnus-make-threads ()
2784 "Go through the dependency hashtb and find the roots. Return all threads." 2787 "Go through the dependency hashtb and find the roots. Return all threads."
2785 (let (threads) 2788 (let (threads)
2786 (while (catch 'infloop 2789 (while (catch 'infloop
2948 (cadr 2951 (cadr
2949 (gnus-data-find-list 2952 (gnus-data-find-list
2950 article 2953 article
2951 (gnus-data-list t))))) 2954 (gnus-data-list t)))))
2952 ;; Error on the side of excessive subjects. 2955 ;; Error on the side of excessive subjects.
2953 (error (mail-header-subject header))) 2956 (error ""))
2954 (mail-header-subject header)) 2957 (mail-header-subject header))
2955 (mail-header-subject header) 2958 ""
2956 "") 2959 (mail-header-subject header))
2957 nil (cdr (assq article gnus-newsgroup-scored)) 2960 nil (cdr (assq article gnus-newsgroup-scored))
2958 (memq article gnus-newsgroup-processable)) 2961 (memq article gnus-newsgroup-processable))
2959 (when length 2962 (when length
2960 (gnus-data-update-list 2963 (gnus-data-update-list
2961 (cdr datal) (- length (- (gnus-data-pos data) (point)))))))) 2964 (cdr datal) (- length (- (gnus-data-pos data) (point))))))))
3815 (setq articles (symbol-value var)) 3818 (setq articles (symbol-value var))
3816 3819
3817 ;; All articles have to be subsets of the active articles. 3820 ;; All articles have to be subsets of the active articles.
3818 (cond 3821 (cond
3819 ;; Adjust "simple" lists. 3822 ;; Adjust "simple" lists.
3820 ((memq mark '(tick dormant expirable reply save)) 3823 ((memq mark '(tick dormant expire reply save))
3821 (while articles 3824 (while articles
3822 (when (or (< (setq article (pop articles)) min) (> article max)) 3825 (when (or (< (setq article (pop articles)) min) (> article max))
3823 (set var (delq article (symbol-value var)))))) 3826 (set var (delq article (symbol-value var))))))
3824 ;; Adjust assocs. 3827 ;; Adjust assocs.
3825 ((memq mark uncompressed) 3828 ((memq mark uncompressed)
4865 ;; Make all changes in this group permanent. 4868 ;; Make all changes in this group permanent.
4866 (unless quit-config 4869 (unless quit-config
4867 (run-hooks 'gnus-exit-group-hook) 4870 (run-hooks 'gnus-exit-group-hook)
4868 (gnus-summary-update-info)) 4871 (gnus-summary-update-info))
4869 (gnus-close-group group) 4872 (gnus-close-group group)
4870 ;; Make sure where I was, and go to next newsgroup. 4873 ;; Make sure where we were, and go to next newsgroup.
4871 (set-buffer gnus-group-buffer) 4874 (set-buffer gnus-group-buffer)
4872 (unless quit-config 4875 (unless quit-config
4873 (gnus-group-jump-to-group group)) 4876 (gnus-group-jump-to-group group))
4874 (run-hooks 'gnus-summary-exit-hook) 4877 (run-hooks 'gnus-summary-exit-hook)
4875 (unless quit-config 4878 (unless quit-config