Function: gnus-summary-prepare-threads
gnus-summary-prepare-threads is a byte-compiled function defined in
gnus-sum.el.gz.
Signature
(gnus-summary-prepare-threads THREADS)
Documentation
Prepare summary buffer from THREADS and indentation LEVEL.
THREADS is either a list of (PARENT [(CHILD1 [(GRANDCHILD ...]...) ...])
or a straight list of headers.
Source Code
;; Defined in /usr/src/emacs/lisp/gnus/gnus-sum.el.gz
(defun gnus-summary-prepare-threads (threads)
"Prepare summary buffer from THREADS and indentation LEVEL.
THREADS is either a list of `(PARENT [(CHILD1 [(GRANDCHILD ...]...) ...])'
or a straight list of headers."
(gnus-message 7 "Generating summary...")
(setq gnus-newsgroup-threads threads)
(beginning-of-line)
(let ((gnus-tmp-level 0)
(default-score (or gnus-summary-default-score 0))
(gnus-visual-p (gnus-visual-p 'summary-highlight 'highlight))
(building-line-count gnus-summary-display-while-building)
(building-count (integerp gnus-summary-display-while-building))
thread number subject stack state gnus-tmp-gathered beg-match
new-roots gnus-tmp-new-adopts thread-end simp-subject
gnus-tmp-header gnus-tmp-unread gnus-tmp-downloaded
gnus-tmp-replied gnus-tmp-subject-or-nil
gnus-tmp-dummy gnus-tmp-indentation gnus-tmp-lines gnus-tmp-score
gnus-tmp-score-char gnus-tmp-from gnus-tmp-name gnus-tmp-thread
gnus-tmp-number gnus-tmp-opening-bracket gnus-tmp-closing-bracket
tree-stack)
(setq gnus-tmp-prev-subject nil
gnus-tmp-thread-tree-header-string "")
(if (vectorp (car threads))
;; If this is a straight (sic) list of headers, then a
;; threaded summary display isn't required, so we just create
;; an unthreaded one.
(gnus-summary-prepare-unthreaded threads)
;; Do the threaded display.
(if gnus-summary-display-while-building
(switch-to-buffer (buffer-name)))
(while (or threads stack gnus-tmp-new-adopts new-roots)
(if (and (= gnus-tmp-level 0)
(or (not stack)
(= (caar stack) 0))
(not gnus-tmp-false-parent)
(or gnus-tmp-new-adopts new-roots))
(if gnus-tmp-new-adopts
(setq gnus-tmp-level (if gnus-tmp-root-expunged 0 1)
thread (list (car gnus-tmp-new-adopts))
gnus-tmp-header (caar thread)
gnus-tmp-new-adopts (cdr gnus-tmp-new-adopts))
(when new-roots
(setq thread (list (car new-roots))
gnus-tmp-header (caar thread)
new-roots (cdr new-roots))))
(if threads
;; If there are some threads, we do them before the
;; threads on the stack.
(setq thread threads
gnus-tmp-header (caar thread))
;; There were no current threads, so we pop something off
;; the stack.
(setq state (car stack)
gnus-tmp-level (car state)
tree-stack (cadr state)
thread (caddr state)
stack (cdr stack)
gnus-tmp-header (caar thread))))
(setq gnus-tmp-false-parent nil)
(setq gnus-tmp-root-expunged nil)
(setq thread-end nil)
(if (stringp gnus-tmp-header)
;; The header is a dummy root.
(cond
((eq gnus-summary-make-false-root 'adopt)
;; We let the first article adopt the rest.
(setq gnus-tmp-new-adopts (nconc gnus-tmp-new-adopts
(cddar thread)))
(setq gnus-tmp-gathered
(nconc (mapcar
(lambda (h) (mail-header-number (car h)))
(cddar thread))
gnus-tmp-gathered))
(setq thread (cons (list (caar thread)
(cadar thread))
(cdr thread)))
(setq gnus-tmp-level -1
gnus-tmp-false-parent t))
((eq gnus-summary-make-false-root 'empty)
;; We print adopted articles with empty subject fields.
(setq gnus-tmp-gathered
(nconc (mapcar
(lambda (h) (mail-header-number (car h)))
(cddar thread))
gnus-tmp-gathered))
(setq gnus-tmp-level -1))
((eq gnus-summary-make-false-root 'dummy)
;; We remember that we probably want to output a dummy
;; root.
(setq gnus-tmp-dummy-line gnus-tmp-header)
(setq gnus-tmp-prev-subject
(gnus-simplify-subject-fully gnus-tmp-header)))
(t
;; We do not make a root for the gathered
;; sub-threads at all.
(setq gnus-tmp-level -1)))
(setq number (mail-header-number gnus-tmp-header)
subject (mail-header-subject gnus-tmp-header)
simp-subject (gnus-simplify-subject-fully subject))
(cond
;; If the thread has changed subject, we might want to make
;; this subthread into a root.
((and (null gnus-thread-ignore-subject)
(not (zerop gnus-tmp-level))
gnus-tmp-prev-subject
(not (string= gnus-tmp-prev-subject simp-subject)))
(setq new-roots (nconc new-roots (list (car thread)))
thread-end t
gnus-tmp-header nil))
;; If the article lies outside the current limit,
;; then we do not display it.
((not (memq number gnus-newsgroup-limit))
(setq gnus-tmp-gathered
(nconc (mapcar
(lambda (h) (mail-header-number (car h)))
(cdar thread))
gnus-tmp-gathered))
(setq gnus-tmp-new-adopts (if (cdar thread)
(append gnus-tmp-new-adopts
(cdar thread))
gnus-tmp-new-adopts)
thread-end t
gnus-tmp-header nil)
(when (zerop gnus-tmp-level)
(setq gnus-tmp-root-expunged t)))
;; Perhaps this article is to be marked as read?
((and gnus-summary-mark-below
(< (or (cdr (assq number gnus-newsgroup-scored))
default-score)
gnus-summary-mark-below)
;; Don't touch sparse articles.
(not (gnus-summary-article-sparse-p number))
(not (gnus-summary-article-ancient-p number)))
(setq gnus-newsgroup-unreads
(delq number gnus-newsgroup-unreads))
(if gnus-newsgroup-auto-expire
(setq gnus-newsgroup-expirable
(gnus-add-to-sorted-list
gnus-newsgroup-expirable number))
(push (cons number gnus-low-score-mark)
gnus-newsgroup-reads))))
(when gnus-tmp-header
;; We may have an old dummy line to output before this
;; article.
(when (and gnus-tmp-dummy-line
(gnus-subject-equal
gnus-tmp-dummy-line
(mail-header-subject gnus-tmp-header)))
(gnus-summary-insert-dummy-line
gnus-tmp-dummy-line (mail-header-number gnus-tmp-header))
(setq gnus-tmp-dummy-line nil))
;; Compute the mark.
(setq gnus-tmp-unread (gnus-article-mark number))
(push (gnus-data-make number gnus-tmp-unread (1+ (point))
gnus-tmp-header gnus-tmp-level)
gnus-newsgroup-data)
;; Actually insert the line.
(setq
gnus-tmp-subject-or-nil
(cond
((and gnus-thread-ignore-subject
gnus-tmp-prev-subject
(not (string= gnus-tmp-prev-subject simp-subject)))
subject)
((zerop gnus-tmp-level)
(if (and (eq gnus-summary-make-false-root 'empty)
(memq number gnus-tmp-gathered)
gnus-tmp-prev-subject
(string= gnus-tmp-prev-subject simp-subject))
gnus-summary-same-subject
subject))
(t gnus-summary-same-subject)))
(if (and (eq gnus-summary-make-false-root 'adopt)
(= gnus-tmp-level 1)
(memq number gnus-tmp-gathered))
(setq gnus-tmp-opening-bracket gnus-sum-opening-bracket-adopted
gnus-tmp-closing-bracket gnus-sum-closing-bracket-adopted)
(setq gnus-tmp-opening-bracket gnus-sum-opening-bracket
gnus-tmp-closing-bracket gnus-sum-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)
gnus-tmp-lines (mail-header-lines gnus-tmp-header)
gnus-tmp-score (or (cdr (assq number gnus-newsgroup-scored))
gnus-summary-default-score 0)
gnus-tmp-score-char
(if (or (null gnus-summary-default-score)
(<= (abs (- gnus-tmp-score gnus-summary-default-score))
gnus-summary-zcore-fuzz))
? ;Whitespace
(if (< gnus-tmp-score gnus-summary-default-score)
gnus-score-below-mark gnus-score-over-mark))
gnus-tmp-replied
(cond ((memq number gnus-newsgroup-processable)
gnus-process-mark)
((memq number gnus-newsgroup-cached)
gnus-cached-mark)
((memq number gnus-newsgroup-replied)
gnus-replied-mark)
((memq number gnus-newsgroup-forwarded)
gnus-forwarded-mark)
((memq number gnus-newsgroup-saved)
gnus-saved-mark)
((memq number gnus-newsgroup-unseen)
gnus-unseen-mark)
(t gnus-no-mark))
gnus-tmp-downloaded
(cond ((memq number gnus-newsgroup-undownloaded)
gnus-undownloaded-mark)
(gnus-newsgroup-agentized
gnus-downloaded-mark)
(t
gnus-no-mark))
gnus-tmp-from (mail-header-from gnus-tmp-header)
gnus-tmp-name
(cond
((string-match "<[^>]+> *$" gnus-tmp-from)
(setq beg-match (match-beginning 0))
(or (and (string-match "^\".+\"" gnus-tmp-from)
(substring gnus-tmp-from 1 (1- (match-end 0))))
(substring gnus-tmp-from 0 beg-match)))
((string-match "(.+)" gnus-tmp-from)
(substring gnus-tmp-from
(1+ (match-beginning 0)) (1- (match-end 0))))
(t gnus-tmp-from))
;; Do the %B string
gnus-tmp-thread-tree-header-string
(cond
((not gnus-show-threads) "")
((zerop gnus-tmp-level)
(cond ((cdar thread)
(or gnus-sum-thread-tree-root subject))
(gnus-tmp-new-adopts
(or gnus-sum-thread-tree-false-root subject))
(t
(or gnus-sum-thread-tree-single-indent subject))))
(t
(concat (apply #'concat
(mapcar (lambda (item)
(if (= item 1)
gnus-sum-thread-tree-vertical
gnus-sum-thread-tree-indent))
(cdr (reverse tree-stack))))
(if (nth 1 thread)
gnus-sum-thread-tree-leaf-with-other
gnus-sum-thread-tree-single-leaf)))))
(when (string= gnus-tmp-name "")
(setq gnus-tmp-name gnus-tmp-from))
(unless (numberp gnus-tmp-lines)
(setq gnus-tmp-lines -1))
(setq gnus-tmp-lines (if (= gnus-tmp-lines -1)
"?"
(number-to-string gnus-tmp-lines)))
(setq gnus-tmp-thread thread)
(put-text-property
(point)
(progn (eval gnus-summary-line-format-spec t) (point))
'gnus-number number)
(when gnus-visual-p
(forward-line -1)
(gnus-summary-highlight-line)
(when gnus-summary-update-hook
(gnus-run-hooks 'gnus-summary-update-hook))
(forward-line 1))
(setq gnus-tmp-prev-subject simp-subject)))
(when (nth 1 thread)
(push (list (max 0 gnus-tmp-level)
(copy-sequence tree-stack)
(nthcdr 1 thread))
stack))
(push (if (nth 1 thread) 1 0) tree-stack)
(cl-incf gnus-tmp-level)
(setq threads (if thread-end nil (cdar thread)))
(if gnus-summary-display-while-building
(if building-count
(progn
;; use a set frequency
(setq building-line-count (1- building-line-count))
(when (= building-line-count 0)
(sit-for 0)
(setq building-line-count
gnus-summary-display-while-building)))
;; always
(sit-for 0)))
(unless threads
(setq gnus-tmp-level 0)))))
(gnus-message 7 "Generating summary...done"))