Function: mh-thread-generate
mh-thread-generate is an autoloaded and byte-compiled function defined
in mh-thread.el.gz.
Signature
(mh-thread-generate FOLDER MSG-LIST)
Documentation
Scan FOLDER to get info for threading.
Only information about messages in MSG-LIST are added to the tree.
Source Code
;; Defined in /usr/src/emacs/lisp/mh-e/mh-thread.el.gz
;;;###mh-autoload
(defun mh-thread-generate (folder msg-list)
"Scan FOLDER to get info for threading.
Only information about messages in MSG-LIST are added to the tree."
(with-temp-buffer
(mh-thread-set-tables folder)
(when msg-list
(apply
#'call-process (expand-file-name mh-scan-prog mh-progs) nil '(t nil) nil
"-width" "10000" "-format"
"%(msg)\n%{message-id}\n%{references}\n%{in-reply-to}\n%{subject}\n"
folder (mapcar (lambda (x) (format "%s" x)) msg-list)))
(goto-char (point-min))
(let ((roots ())
(case-fold-search t))
(cl-block nil
(while (not (eobp))
(cl-block process-message
(let* ((index-line
(prog1 (buffer-substring (point) (mh-line-end-position))
(forward-line)))
(index (string-to-number index-line))
(id (prog1 (buffer-substring (point) (mh-line-end-position))
(forward-line)))
(refs (prog1
(buffer-substring (point) (mh-line-end-position))
(forward-line)))
(in-reply-to (prog1 (buffer-substring (point)
(mh-line-end-position))
(forward-line)))
(subject (prog1
(buffer-substring
(point) (mh-line-end-position))
(forward-line)))
(subject-re-p nil))
(unless (gethash index mh-thread-scan-line-map)
(cl-return-from process-message))
(unless (integerp index) (cl-return)) ;Error message here
(cl-multiple-value-setq (subject subject-re-p)
(cl-values-list (mh-thread-prune-subject subject)))
(setq in-reply-to (mh-thread-process-in-reply-to in-reply-to))
(setq refs
(cl-loop for x in (append (split-string refs) in-reply-to)
when (string-match mh-message-id-regexp x)
collect x))
(setq id (mh-thread-canonicalize-id id))
(mh-thread-update-id-index-maps id index)
(setq refs (mapcar #'mh-thread-canonicalize-id refs))
(mh-thread-get-message id subject-re-p subject refs)
(cl-do ((ancestors refs (cdr ancestors)))
((null (cdr ancestors))
(when (car ancestors)
(mh-thread-remove-parent-link id)
(mh-thread-add-link (car ancestors) id)))
(mh-thread-add-link (car ancestors) (cadr ancestors)))))))
(maphash (lambda (_k v)
(when (null (mh-container-parent v))
(push v roots)))
mh-thread-id-table)
(setq roots (mh-thread-prune-containers roots))
(prog1 (setq roots (mh-thread-group-by-subject roots))
(let ((history mh-thread-history))
(set-buffer folder)
(setq mh-thread-history history))))))