The Great Cleanup

Remove circular dependencies.
mh-e.el now includes few require statements and stands alone. Other
files should need to require mh-e.el, which requires mh-loaddefs.el,
plus variable-only files such as mh-scan.el.
Remove unneeded require statements.
Remove unneeded load statements, or replace them with non-fatal
require statements.
Break out components into their own files that were often spread
between many files. As a result, many functions that are now only used
within a single file no longer need to be autoloaded.
Rearrange and provide consistent headings.
Untabify.

* mh-acros.el: Update commentary to reflect current usage. Add
autoload cookies to all macros.
(mh-require-cl): Merge docstring and comment.
(mh-do-in-xemacs): Fix typo in docstring.
(assoc-string): Move to new file mh-compat.el.
(with-mh-folder-updating, mh-in-show-buffer)
(mh-do-at-event-location, mh-seq-msgs): Move here from mh-utils.el.
(mh-iterate-on-messages-in-region, mh-iterate-on-range): Move here
from mh-seq.el.

* mh-alias.el (mh-address-mail-regexp)
(mh-goto-address-find-address-at-point): Move here from mh-utils.el.
(mh-folder-line-matches-show-buffer-p): Move here from mh-e.el.

* mh-buffers.el: Update descriptive text.

* mh-comp.el (mh-note-repl, mh-note-forw, mh-note-dist): Move to new
file mh-scan.el.
(mh-yank-hooks, mh-to-field-choices, mh-position-on-field)
(mh-letter-menu, mh-letter-mode-help-messages)
(mh-letter-buttons-init-flag, mh-letter-mode)
(mh-font-lock-field-data, mh-letter-header-end)
(mh-auto-fill-for-letter, mh-to-field, mh-to-fcc)
(mh-file-is-vcard-p, mh-insert-signature, mh-check-whom)
(mh-insert-letter, mh-extract-from-attribution, mh-yank-cur-msg)
(mh-filter-out-non-text, mh-insert-prefix-string)
(mh-current-fill-prefix, mh-open-line, mh-complete-word)
(mh-folder-expand-at-point, mh-letter-complete-function-alist)
(mh-letter-complete, mh-letter-complete-or-space)
(mh-letter-confirm-address, mh-letter-header-field-at-point)
(mh-letter-next-header-field-or-indent)
(mh-letter-next-header-field, mh-letter-previous-header-field)
(mh-letter-skipped-header-field-p)
(mh-letter-skip-leading-whitespace-in-header-field)
(mh-hidden-header-keymap)
(mh-letter-toggle-header-field-display-button)
(mh-letter-toggle-header-field-display)
(mh-letter-truncate-header-field, mh-letter-mode-map): Move to new
file mh-letter.el.
(mh-letter-mode-map, mh-sent-from-folder, mh-send-args)
(mh-pgp-support-flag, mh-x-mailer-string)
(mh-letter-header-field-regexp): Move to mh-e.el.
(mh-goto-header-field, mh-goto-header-end)
(mh-extract-from-header-value, mh-beginning-of-word): Move to
mh-utils.el.
(mh-insert-header-separator): Move to mh-comp.el.
(mh-display-completion-list-compat): Move to new file mh-compat.el.

* mh-compat.el: New file.
(assoc-string): Move here from mh-acros.el.
(mh-display-completion-list): Move here from mh-comp.el.

* mh-customize.el: Move content into mh-e.el and remove.

* mh-e.el (mh-folder-mode-map, mh-folder-seq-tool-bar-map)
(mh-folder-tool-bar-map, mh-inc-spool-map, mh-letter-mode-map)
(mh-letter-tool-bar-map, mh-search-mode-map, mh-show-mode-map)
(mh-show-seq-tool-bar-map, mh-show-tool-bar-map): All maps now
declared here so that they can be used in docstrings.
(mh-sent-from-folder, mh-sent-from-msg)
(mh-letter-header-field-regexp, mh-pgp-support-flag)
(mh-x-mailer-string): Move here from mh-comp.el.
(mh-folder-line-matches-show-buffer-p): Move to mh-alias.el.
(mh-thread-scan-line-map, mh-thread-scan-line-map-stack): Move here
from mh-seq.el.
(mh-draft-folder, mh-inbox, mh-user-path, mh-current-folder)
(mh-previous-window-config, mh-seen-list, mh-seq-list)
(mh-show-buffer, mh-showing-mode, mh-globals-hash)
(mh-show-folder-buffer, mh-mail-header-separator)
(mh-unseen-seq, mh-previous-seq, mh-page-to-next-msg-flag)
(mh-signature-separator, mh-signature-separator-regexp)
(mh-list-to-string, mh-list-to-string-1): Move here from mh-utils.el.
(mh-index-max-cmdline-args, mh-xargs, mh-quote-for-shell)
(mh-exec-cmd, mh-exec-cmd-error, mh-exec-cmd-daemon)
(mh-exec-cmd-env-daemon, mh-process-daemon, mh-exec-cmd-quiet)
(mh-exec-cmd-output)
(mh-exchange-point-and-mark-preserving-active-mark)
(mh-exec-lib-cmd-output, mh-handle-process-error): Move here from
deprecated file mh-exec.el.
(mh-path): Move here from deprecated file mh-customize.el.
(mh-sys-path, mh-variants, mh-variant-in-use, mh-progs, mh-lib)
(mh-flists-present-flag, mh-variants, mh-variant-mh-info)
(mh-variant-mu-mh-info, mh-variant-nmh-info, mh-file-command-p)
(mh-variant-set-variant, mh-variant-p, mh-profile-component)
(mh-profile-component-value, mh-defface-compat): Move here from
deprecated file mh-init.el.
(mh-goto-next-button, mh-folder-mime-action)
(mh-folder-toggle-mime-part, mh-folder-inline-mime-part)
(mh-folder-save-mime-part, mh-toggle-mime-buttons): Move to to
mh-mime.el.
(mh-scan-format-mh, mh-scan-format-nmh, mh-note-deleted)
(mh-note-refiled, mh-note-cur, mh-scan-good-msg-regexp)
(mh-scan-deleted-msg-regexp, mh-scan-refiled-msg-regexp)
(mh-scan-valid-regexp, mh-scan-cur-msg-number-regexp)
(mh-scan-date-regexp, mh-scan-rcpt-regexp, mh-scan-body-regexp)
(mh-scan-subject-regexp, mh-scan-sent-to-me-sender-regexp)
(mh-scan-cmd-note-width, mh-scan-destination-width)
(mh-scan-date-width, mh-scan-date-flag-width)
(mh-scan-from-mbox-width, mh-scan-from-mbox-sep-width)
(mh-scan-field-destination-offset)
(mh-scan-field-from-start-offset, mh-scan-field-from-end-offset)
(mh-scan-field-subject-start-offset, mh-scan-format)
(mh-msg-num-width-to-column, mh-set-cmd-note): Move to new file
mh-scan.el.
(mh-partial-folder-mode-line-annotation)
(mh-folder-font-lock-keywords, mh-folder-font-lock-subject)
(mh-generate-sequence-font-lock, mh-last-destination)
(mh-last-destination-write, mh-first-msg-num, mh-last-msg-num)
(mh-rmail, mh-nmail, mh-delete-msg, mh-delete-msg-no-motion)
(mh-execute-commands, mh-first-msg, mh-header-display)
(mh-inc-folder, mh-last-msg, mh-next-undeleted-msg)
(mh-folder-from-address, mh-prompt-for-refile-folder)
(mh-refile-msg, mh-refile-or-write-again, mh-quit, mh-page-msg)
(mh-previous-page, mh-previous-undeleted-msg)
(mh-previous-unread-msg, mh-next-button, mh-prev-button)
(mh-reset-threads-and-narrowing, mh-rescan-folder)
(mh-write-msg-to-file, mh-toggle-showing, mh-undo)
(mh-visit-folder, mh-update-sequences, mh-delete-a-msg)
(mh-refile-a-msg, mh-next-msg, mh-next-unread-msg)
(mh-set-scan-mode, mh-undo-msg, mh-make-folder)
(mh-folder-sequence-menu, mh-folder-message-menu)
(mh-folder-folder-menu, mh-remove-xemacs-horizontal-scrollbar)
(mh-write-file-functions-compat, mh-folder-mode)
(mh-restore-desktop-buffer, mh-scan-folder)
(mh-regenerate-headers, mh-generate-new-cmd-note)
(mh-get-new-mail, mh-make-folder-mode-line, mh-goto-cur-msg)
(mh-process-or-undo-commands, mh-process-commands)
(mh-update-unseen, mh-delete-scan-msgs)
(mh-outstanding-commands-p): Move to new file mh-folder.el.
(mh-mapc, mh-colors-available-p, mh-colors-in-use-p)
(mh-make-local-vars, mh-coalesce-msg-list, mh-greaterp)
(mh-lessp): Move to mh-utils.el.
(mh-parse-flist-output-line, mh-folder-size-folder)
(mh-folder-size-flist, mh-folder-size, mh-add-sequence-notation)
(mh-remove-sequence-notation, mh-remove-cur-notation)
(mh-remove-all-notation, mh-delete-seq-locally)
(mh-read-folder-sequences, mh-read-msg-list)
(mh-notate-user-sequences, mh-internal-seqs, mh-internal-seq)
(mh-valid-seq-p, mh-delete-msg-from-seq, mh-catchup)
(mh-delete-a-msg-from-seq, mh-undefine-sequence)
(mh-define-sequence, mh-seq-containing-msg): Move to mh-seq.el.
(mh-xemacs-flag)
(mh-customize, mh-e, mh-alias, mh-folder, mh-folder-selection)
(mh-identity, mh-inc, mh-junk, mh-letter, mh-ranges)
(mh-scan-line-formats, mh-search, mh-sending-mail, mh-sequences)
(mh-show, mh-speedbar, mh-thread, mh-tool-bar, mh-hooks)
(mh-faces, mh-alias-completion-ignore-case-flag)
(mh-alias-expand-aliases-flag, mh-alias-flash-on-comma)
(mh-alias-insert-file, mh-alias-insertion-location)
(mh-alias-local-users, mh-alias-local-users-prefix)
(mh-alias-passwd-gecos-comma-separator-flag)
(mh-new-messages-folders, mh-ticked-messages-folders)
(mh-large-folder, mh-recenter-summary-flag)
(mh-recursive-folders-flag, mh-sortm-args)
(mh-default-folder-for-message-function, mh-default-folder-list)
(mh-default-folder-must-exist-flag, mh-default-folder-prefix)
(mh-identity-list, mh-auto-fields-list)
(mh-auto-fields-prompt-flag, mh-identity-default)
(mh-identity-handlers, mh-inc-prog, mh-inc-spool-list)
(mh-junk-choice, mh-junk-function-alist, mh-junk-choose)
(mh-junk-background, mh-junk-disposition, mh-junk-program)
(mh-compose-insertion, mh-compose-skipped-header-fields)
(mh-compose-space-does-completion-flag)
(mh-delete-yanked-msg-window-flag)
(mh-extract-from-attribution-verb, mh-ins-buf-prefix)
(mh-letter-complete-function, mh-letter-fill-column)
(mh-mml-method-default, mh-signature-file-name)
(mh-signature-separator-flag, mh-x-face-file, mh-yank-behavior)
(mh-interpret-number-as-range-flag, mh-adaptive-cmd-note-flag)
(mh-scan-format-file-check, mh-scan-format-file)
(mh-adaptive-cmd-note-flag-check, mh-scan-prog)
(mh-search-program, mh-compose-forward-as-mime-flag)
(mh-compose-letter-function, mh-compose-prompt-flag)
(mh-forward-subject-format, mh-insert-x-mailer-flag)
(mh-redist-full-contents-flag, mh-reply-default-reply-to)
(mh-reply-show-message-flag, mh-refile-preserves-sequences-flag)
(mh-tick-seq, mh-update-sequences-after-mh-show-flag)
(mh-bury-show-buffer-flag, mh-clean-message-header-flag)
(mh-decode-mime-flag, mh-display-buttons-for-alternatives-flag)
(mh-display-buttons-for-inline-parts-flag)
(mh-do-not-confirm-flag, mh-fetch-x-image-url)
(mh-graphical-smileys-flag, mh-graphical-emphasis-flag)
(mh-highlight-citation-style)
(mh-invisible-header-fields-internal)
(mh-delay-invisible-header-generation-flag)
(mh-invisible-header-fields, mh-invisible-header-fields-default)
(mh-invisible-header-fields-compiled, mh-invisible-headers)
(mh-lpr-command-format, mh-max-inline-image-height)
(mh-max-inline-image-width, mh-mhl-format-file)
(mh-mime-save-parts-default-directory, mh-print-background-flag)
(mh-show-maximum-size, mh-show-use-goto-addr-flag)
(mh-show-use-xface-flag, mh-store-default-directory)
(mh-summary-height, mh-speed-update-interval)
(mh-show-threads-flag, mh-tool-bar-search-function)
(mh-after-commands-processed-hook, mh-alias-reloaded-hook)
(mh-before-commands-processed-hook, mh-before-quit-hook)
(mh-before-send-letter-hook, mh-delete-msg-hook)
(mh-find-path-hook, mh-folder-mode-hook, mh-forward-hook)
(mh-inc-folder-hook, mh-insert-signature-hook)
(mh-kill-folder-suppress-prompt-hooks, mh-letter-mode-hook)
(mh-mh-to-mime-hook, mh-search-mode-hook, mh-quit-hook)
(mh-refile-msg-hook, mh-show-hook, mh-show-mode-hook)
(mh-unseen-updated-hook, mh-min-colors-defined-flag)
(mh-folder-address, mh-folder-body)
(mh-folder-cur-msg-number, mh-folder-date, mh-folder-deleted)
(mh-folder-followup, mh-folder-msg-number, mh-folder-refiled)
(mh-folder-sent-to-me-hint, mh-folder-sent-to-me-sender)
(mh-folder-subject, mh-folder-tick, mh-folder-to)
(mh-search-folder, mh-letter-header-field, mh-show-cc)
(mh-show-date, mh-show-from, mh-show-header, mh-show-pgg-bad)
(mh-show-pgg-good, mh-show-pgg-unknown, mh-show-signature)
(mh-show-subject, mh-show-to, mh-show-xface, mh-speedbar-folder)
(mh-speedbar-folder-with-unseen-messages)
(mh-speedbar-selected-folder)
(mh-speedbar-selected-folder-with-unseen-messages): Move here from
deprecated file mh-customize.el.

* mh-exec.el: Move content into mh-e.el and remove.

* mh-folder.el: New file. Contains mh-folder-mode from mh-e.el

* mh-funcs.el (mh-note-copied, mh-note-printed): Move to new file
mh-scan.el.
(mh-ephem-message, mh-help, mh-prefix-help): Move to mh-utils.el.

* mh-gnus.el (mm-uu-dissect-text-parts): Add.
(mh-mail-abbrev-make-syntax-table): Move to mh-utils.el and rename to
mail-abbrev-make-syntax-table.

* mh-identity.el (mh-identity-menu): New variable for existing menu.
(mh-identity-make-menu-no-autoload): New alias for
mh-identity-make-menu which can be called from mh-e.el.
(mh-identity-list-set): Move to mh-e.el.
(mh-identity-add-menu): New function
(mh-insert-identity): Add optional argument maybe-insert so that local
variable mh-identity-local does not have to be visible.
(mh-identity-handler-default):

* mh-inc.el (mh-inc-spool-map): Move declaration to mh-e.el (with rest
of keymaps). Update key binding for ? to call mh-help with help
messages in new argument.
(mh-inc-spool-make-no-autoload): New alias for mh-inc-spool-make which
can be called from mh-e.el.
(mh-inc-spool-list-set): Simplify update of mh-inc-spool-map-help.

* mh-init.el: Move content into mh-e.el and remove.

* mh-junk.el: Update requires, untabify, and add mh-autoload cookies.

* mh-letter.el: New file. Contains mh-letter-mode from mh-comp.el.

* mh-limit.el: New file. Contains display limit commands from
mh-mime.el.

* mh-mime.el: Rearrange for consistency with other files.
(mh-buffer-data, mh-mm-inline-media-tests): Move here from
mh-utils.el.
(mh-folder-inline-mime-part, mh-folder-save-mime-part)
(mh-folder-toggle-mime-part, mh-toggle-mime-buttons)
(mh-goto-next-button): Move here from mh-e.el.

* mh-print.el: Rearrange for consistency with other files.

* mh-scan.el: New file. Contains scan line constants and utilities
from XXX, mh-funcs, mh-utils.el.

* mh-search.el: Rearrange for consistency with other files.
(mh-search-mode-map): Drop C-c C-f {dr} bindings since these fields
which don't exist in the saved header. Replace C-c C-f f with C-c C-f
m per mail-mode consistency.
(mh-search-mode): Use mh-set-help instead of setting mh-help-messages.

* mh-seq.el (mh-thread-message, mh-thread-container)
(mh-thread-id-hash, mh-thread-subject-hash, mh-thread-id-table)
(mh-thread-id-index-map, mh-thread-index-id-map)
(mh-thread-scan-line-map, mh-thread-scan-line-map-stack)
(mh-thread-subject-container-hash, mh-thread-duplicates)
(mh-thread-history, mh-thread-body-width)
(mh-thread-find-msg-subject mh-thread-initialize-hash)
(mh-thread-initialize, mh-thread-id-container)
(mh-thread-remove-parent-link, mh-thread-add-link)
(mh-thread-ancestor-p, mh-thread-get-message-container)
(mh-thread-get-message, mh-thread-canonicalize-id)
(mh-thread-prune-subject, mh-thread-container-subject)
(mh-thread-rewind-pruning, mh-thread-prune-containers)
(mh-thread-sort-containers, mh-thread-group-by-subject)
(mh-thread-process-in-reply-to, mh-thread-set-tables)
(mh-thread-update-id-index-maps, mh-thread-generate)
(mh-thread-inc, mh-thread-generate-scan-lines)
(mh-thread-parse-scan-line, mh-thread-update-scan-line-map)
(mh-thread-add-spaces, mh-thread-print-scan-lines)
(mh-thread-folder, mh-toggle-threads, mh-thread-forget-message)
(mh-thread-current-indentation-level, mh-thread-next-sibling)
(mh-thread-previous-sibling, mh-thread-immediate-ancestor)
(mh-thread-ancestor, mh-thread-find-children)
(mh-message-id-regexp, mh-thread-delete, mh-thread-refile): Move to
new file mh-thread.el.
(mh-subject-to-sequence, mh-subject-to-sequence-unthreaded)
(mh-subject-to-sequence-threaded, mh-edit-pick-expr)
(mh-pick-args-list, mh-narrow-to-subject, mh-narrow-to-from)
(mh-narrow-to-cc, mh-narrow-to-to, mh-narrow-to-header-field)
(mh-current-message-header-field, mh-narrow-to-range)
(mh-delete-subject, mh-delete-subject-or-thread): Move to new file
mh-limit.el.
(mh-iterate-on-messages-in-region, mh-iterate-on-range): Move to
mh-acros.el.
(mh-internal-seqs, mh-catchup, mh-delete-msg-from-seq)
(mh-internal-seq, mh-valid-seq-p, mh-seq-containing-msg)
(mh-define-sequence, mh-undefine-sequence)
(mh-delete-a-msg-from-seq, mh-delete-seq-locally)
(mh-folder-size, mh-folder-size-flist, mh-folder-size-folder)
(mh-parse-flist-output-line, mh-read-folder-sequences)
(mh-read-msg-list, mh-notate-user-sequences)
(mh-remove-cur-notation, mh-add-sequence-notation)
(mh-remove-sequence-notation, mh-remove-all-notation): Move here from
mh-e.el.
(mh-make-seq, mh-seq-name, mh-find-seq, mh-seq-to-msgs)
(mh-add-msgs-to-seq, mh-notate): Move here from mh-utils.el.

* mh-show.el: New file. Contains mh-show-mode from mh-utils.el.

* mh-speed.el: Rearrange for consistency with other files.

* mh-thread.el: New file. Contains threading code from mh-seq.el.

* mh-tool-bar.el: New file. Contains tool bar creation code from
deprecated file mh-customize.el.

* mh-utils.el (recursive-load-depth-limit): Remove setting. No longer
needed.
(mh-scan-msg-number-regexp, mh-scan-msg-overflow-regexp)
(mh-scan-msg-format-regexp, mh-scan-msg-format-string)
(mh-scan-msg-search-regexp, mh-cmd-note, mh-note-seq)
(mh-update-scan-format, mh-msg-num-width): Move to new file
mh-scan.el.
(mh-show-buffer-mode-line-buffer-id, mh-letter-header-font-lock)
(mh-header-field-font-lock, mh-header-to-font-lock)
(mh-header-cc-font-lock, mh-header-subject-font-lock)
(mh-show-font-lock-keywords)
(mh-show-font-lock-keywords-with-cite)
(mh-show-font-lock-fontify-region)
(mh-gnus-article-highlight-citation, mh-showing-with-headers)
(mh-start-of-uncleaned-message, mh-invalidate-show-buffer)
(mh-unvisit-file, mh-defun-show-buffer, mh-show-mode-map)
(mh-show-sequence-menu, mh-show-message-menu)
(mh-show-folder-menu, mh-show-mode, mh-show-addr)
(mh-maybe-show, mh-show, mh-show-msg, mh-show-unquote-From)
(mh-msg-folder, mh-display-msg, mh-clean-msg-header): Move to new file
mh-show.el.
(mh-mail-header-separator, mh-signature-separator-regexp)
(mh-signature-separator, mh-globals-hash, mh-user-path)
(mh-draft-folder, mh-unseen-seq, mh-previous-seq, mh-inbox)
(mh-previous-window-config, mh-current-folder mh-show-buffer)
(mh-showing-mode, mh-show-mode-map, mh-show-folder-buffer)
(mh-showing-mode, mh-seq-list, mh-seen-list, mh-summary-height)
(mh-list-to-string, mh-list-to-string-1): Move to mh-e.el.
(mh-buffer-data, mh-mm-inline-media-tests): Move to mh-mime.el.
(mh-address-mail-regexp, mh-goto-address-find-address-at-point): Move
to mh-alias.el.
(mh-letter-font-lock-keywords): Move to new file mh-letter.el.
(mh-folder-filename, mh-msg-count, mh-recenter, mh-msg-filename)
(mh-show-mouse, mh-modify, mh-goto-msg, mh-set-folder-modified-p):
Move to new file mh-folder.el.
(with-mh-folder-updating, mh-in-show-buffer)
(mh-do-at-event-location, mh-seq-msgs): Moved to mh-acros.el.
(mh-make-seq, mh-seq-name, mh-notate, mh-find-seq)
(mh-seq-to-msgs, mh-add-msgs-to-seq, mh-canonicalize-sequence): Moved
to mh-seq.el.
(mh-show-xface-function, mh-uncompface-executable, mh-face-to-png)
(mh-uncompface, mh-icontopbm, mh-face-foreground-compat)
(mh-face-background-compat, mh-face-display-function)
(mh-show-xface, mh-picon-directory-list)
(mh-picon-existing-directory-list)
(mh-picon-cache, mh-picon-image-types)
(mh-picon-set-directory-list, mh-picon-get-image)
(mh-picon-file-contents, mh-picon-generate-path)
(mh-x-image-cache-directory, mh-x-image-scaling-function)
(mh-wget-executable, mh-wget-choice, mh-wget-option)
(mh-x-image-temp-file, mh-x-image-url, mh-x-image-marker)
(mh-x-image-url-cache-file, mh-x-image-scale-with-pnm)
(mh-x-image-scale-with-convert)
(url-unreserved-chars, url-hexify-string)
(mh-x-image-url-cache-canonicalize)
(mh-x-image-set-download-state, mh-x-image-get-download-state)
(mh-x-image-url-fetch-image, mh-x-image-display)
(mh-x-image-scale-and-display, mh-x-image-url-sane-p)
(mh-x-image-url-display): Move to new file mh-xface.el.
(mh-logo-display): Call mh-image-load-path.
(mh-find-path-run, mh-find-path): Move here from deprecated file
mh-init.el.
(mh-help-messages): Now an alist of modes to an alist of messages.
(mh-set-help): New function used to set mh-help-messages
(mh-help): Adjust for new format of mh-help-messages. Add
help-messages argument.
(mh-prefix-help): Refactor to use mh-help.
(mh-coalesce-msg-list, mh-greaterp, mh-lessp): Move here from mh-e.el.
(mh-clear-sub-folders-cache): New function added to avoid exposing
mh-sub-folders-cache variable.

* mh-xface.el: New file. Contains X-Face and Face header field display
routines from mh-utils.el.

1 files changed, 883 insertions, 0 deletions

diff --git a/lisp/mh-e/mh-thread.el b/lisp/mh-e/mh-thread.el
new file mode 100644
index 00000000000..3b477177e05
--- /dev/null
+++ b/lisp/mh-e/mh-thread.el
@@ -0,0 +1,883 @@
+;;; mh-thread.el --- MH-E threading support
+
+;; Copyright (C) 2002, 2003, 2004, 2006 Free Software Foundation, Inc.
+
+;; Author: Satyaki Das <satyaki@theforce.stanford.edu>
+;; Maintainer: Bill Wohler <wohler@newt.com>
+;; Keywords: mail
+;; See: mh-e.el
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Commentary:
+
+;; The threading portion of this files tries to implement the
+;; algorithm described at:
+;;   http://www.jwz.org/doc/threading.html
+;; It also begins to implement the IMAP Threading extension RFC. The
+;; implementation lacks the reference and subject canonicalization of
+;; the RFC.
+
+;; In the presentation buffer, children messages are shown indented
+;; with either [ ] or < > around them. Square brackets ([ ]) denote
+;; that the algorithm can point out some headers which when taken
+;; together implies that the unindented message is an ancestor of the
+;; indented message. If no such proof exists then angles (< >) are
+;; used.
+
+;; If threading is slow on your machine, compile this file. Of all the
+;; files in MH-E, this one really benefits from compilation.
+
+;; Some issues and problems are as follows:
+
+;;  (1) Scan truncates the fields at length 512. So longer
+;;      references: headers get mutilated. The same kind of MH
+;;      format string works when composing messages. Is there a way
+;;      to avoid this? My scan command is as follows:
+;;        scan +folder -width 10000 \
+;;             -format "%(msg)\n%{message-id}\n%{references}\n%{subject}\n"
+;;      I would really appreciate it if someone would help me with this.
+
+;;  (2) Implement heuristics to recognize message identifiers in
+;;      In-Reply-To: header. Right now it just assumes that the last
+;;      text between angles (< and >) is the message identifier.
+;;      There is the chance that this will incorrectly use an email
+;;      address like a message identifier.
+
+;;  (3) Error checking of found message identifiers should be done.
+
+;;  (4) Since this breaks the assumption that message indices
+;;      increase as one goes down the buffer, the binary search
+;;      based mh-goto-msg doesn't work. I have a simpler replacement
+;;      which may be less efficient.
+
+;;  (5) Better canonicalizing for message identifier and subject
+;;      strings.
+
+;;; Change Log:
+
+;;; Code:
+
+(require 'mh-e)
+(require 'mh-scan)
+
+(mh-defstruct (mh-thread-message (:conc-name mh-message-)
+                                 (:constructor mh-thread-make-message))
+  (id nil)
+  (references ())
+  (subject "")
+  (subject-re-p nil))
+
+(mh-defstruct (mh-thread-container (:conc-name mh-container-)
+                                   (:constructor mh-thread-make-container))
+  message parent children
+  (real-child-p t))
+
+(defvar mh-thread-id-hash nil
+  "Hashtable used to canonicalize message identifiers.")
+(make-variable-buffer-local 'mh-thread-id-hash)
+
+(defvar mh-thread-subject-hash nil
+  "Hashtable used to canonicalize subject strings.")
+(make-variable-buffer-local 'mh-thread-subject-hash)
+
+(defvar mh-thread-id-table nil
+  "Thread ID table maps from message identifiers to message containers.")
+(make-variable-buffer-local 'mh-thread-id-table)
+
+(defvar mh-thread-index-id-map nil
+  "Table to look up message identifier from message index.")
+(make-variable-buffer-local 'mh-thread-index-id-map)
+
+(defvar mh-thread-id-index-map nil
+  "Table to look up message index number from message identifier.")
+(make-variable-buffer-local 'mh-thread-id-index-map)
+
+(defvar mh-thread-subject-container-hash nil
+  "Hashtable used to group messages by subject.")
+(make-variable-buffer-local 'mh-thread-subject-container-hash)
+
+(defvar mh-thread-duplicates nil
+  "Hashtable used to associate messages with the same message identifier.")
+(make-variable-buffer-local 'mh-thread-duplicates)
+
+(defvar mh-thread-history ()
+  "Variable to remember the transformations to the thread tree.
+When new messages are added, these transformations are rewound,
+then the links are added from the newly seen messages. Finally
+the transformations are redone to get the new thread tree. This
+makes incremental threading easier.")
+(make-variable-buffer-local 'mh-thread-history)
+
+(defvar mh-thread-body-width nil
+  "Width of scan substring that contains subject and body of message.")
+
+
+
+;;; MH-Folder Commands
+
+;;;###mh-autoload
+(defun mh-thread-ancestor (&optional thread-root-flag)
+  "Display ancestor of current message.
+
+If you do not care for the way a particular thread has turned,
+you can move up the chain of messages with this command. This
+command can also take a prefix argument THREAD-ROOT-FLAG to jump
+to the message that started everything."
+  (interactive "P")
+  (beginning-of-line)
+  (cond ((not (memq 'unthread mh-view-ops))
+         (error "Folder isn't threaded"))
+        ((eobp)
+         (error "No message at point")))
+  (let ((current-level (mh-thread-current-indentation-level)))
+    (cond (thread-root-flag
+           (while (mh-thread-immediate-ancestor))
+           (mh-maybe-show))
+          ((equal current-level 1)
+           (message "Message has no ancestor"))
+          (t (mh-thread-immediate-ancestor)
+             (mh-maybe-show)))))
+
+;;;###mh-autoload
+(defun mh-thread-delete ()
+  "Delete thread."
+  (interactive)
+  (cond ((not (memq 'unthread mh-view-ops))
+         (error "Folder isn't threaded"))
+        ((eobp)
+         (error "No message at point"))
+        (t (let ((region (mh-thread-find-children)))
+             (mh-iterate-on-messages-in-region () (car region) (cadr region)
+               (mh-delete-a-msg nil))
+             (mh-next-msg)))))
+
+;;;###mh-autoload
+(defun mh-thread-next-sibling (&optional previous-flag)
+  "Display next sibling.
+
+With non-nil optional argument PREVIOUS-FLAG jump to the previous
+sibling."
+  (interactive)
+  (cond ((not (memq 'unthread mh-view-ops))
+         (error "Folder isn't threaded"))
+        ((eobp)
+         (error "No message at point")))
+  (beginning-of-line)
+  (let ((point (point))
+        (done nil)
+        (my-level (mh-thread-current-indentation-level)))
+    (while (and (not done)
+                (equal (forward-line (if previous-flag -1 1)) 0)
+                (not (eobp)))
+      (let ((level (mh-thread-current-indentation-level)))
+        (cond ((equal level my-level)
+               (setq done 'success))
+              ((< level my-level)
+               (message "No %s sibling" (if previous-flag "previous" "next"))
+               (setq done 'failure)))))
+    (cond ((eq done 'success) (mh-maybe-show))
+          ((eq done 'failure) (goto-char point))
+          (t (message "No %s sibling" (if previous-flag "previous" "next"))
+             (goto-char point)))))
+
+;;;###mh-autoload
+(defun mh-thread-previous-sibling ()
+  "Display previous sibling."
+  (interactive)
+  (mh-thread-next-sibling t))
+
+;;;###mh-autoload
+(defun mh-thread-refile (folder)
+  "Refile (output) thread into FOLDER."
+  (interactive (list (intern (mh-prompt-for-refile-folder))))
+  (cond ((not (memq 'unthread mh-view-ops))
+         (error "Folder isn't threaded"))
+        ((eobp)
+         (error "No message at point"))
+        (t (let ((region (mh-thread-find-children)))
+             (mh-iterate-on-messages-in-region () (car region) (cadr region)
+               (mh-refile-a-msg nil folder))
+             (mh-next-msg)))))
+
+;;;###mh-autoload
+(defun mh-toggle-threads ()
+  "Toggle threaded view of folder."
+  (interactive)
+  (let ((msg-at-point (mh-get-msg-num nil))
+        (old-buffer-modified-flag (buffer-modified-p))
+        (buffer-read-only nil))
+    (cond ((memq 'unthread mh-view-ops)
+           (unless (mh-valid-view-change-operation-p 'unthread)
+             (error "Can't unthread folder"))
+           (let ((msg-list ()))
+             (goto-char (point-min))
+             (while (not (eobp))
+               (let ((index (mh-get-msg-num nil)))
+                 (when index
+                   (push index msg-list)))
+               (forward-line))
+             (mh-scan-folder mh-current-folder
+                             (mapcar #'(lambda (x) (format "%s" x))
+                                     (mh-coalesce-msg-list msg-list))
+                             t))
+           (when mh-index-data
+             (mh-index-insert-folder-headers)
+             (mh-notate-cur)))
+          (t (mh-thread-folder)
+             (push 'unthread mh-view-ops)))
+    (when msg-at-point (mh-goto-msg msg-at-point t t))
+    (set-buffer-modified-p old-buffer-modified-flag)
+    (mh-recenter nil)))
+
+
+
+;;; Support Routines
+
+(defun mh-thread-current-indentation-level ()
+  "Find the number of spaces by which current message is indented."
+  (save-excursion
+    (let ((address-start-offset (+ mh-cmd-note mh-scan-date-flag-width
+                                   mh-scan-date-width 1))
+          (level 0))
+      (beginning-of-line)
+      (forward-char address-start-offset)
+      (while (char-equal (char-after) ? )
+        (incf level)
+        (forward-char))
+      level)))
+
+(defun mh-thread-immediate-ancestor ()
+  "Jump to immediate ancestor in thread tree."
+  (beginning-of-line)
+  (let ((point (point))
+        (ancestor-level (- (mh-thread-current-indentation-level) 2))
+        (done nil))
+    (if (< ancestor-level 0)
+        nil
+      (while (and (not done) (equal (forward-line -1) 0))
+        (when (equal ancestor-level (mh-thread-current-indentation-level))
+          (setq done t)))
+      (unless done
+        (goto-char point))
+      done)))
+
+(defun mh-thread-find-children ()
+  "Return a region containing the current message and its children.
+The result is returned as a list of two elements. The first is
+the point at the start of the region and the second is the point
+at the end."
+  (beginning-of-line)
+  (if (eobp)
+      nil
+    (let ((address-start-offset (+ mh-cmd-note mh-scan-date-flag-width
+                                   mh-scan-date-width 1))
+          (level (mh-thread-current-indentation-level))
+          spaces begin)
+      (setq begin (point))
+      (setq spaces (format (format "%%%ss" (1+ level)) ""))
+      (forward-line)
+      (block nil
+        (while (not (eobp))
+          (forward-char address-start-offset)
+          (unless (equal (string-match spaces (buffer-substring-no-properties
+                                               (point) (line-end-position)))
+                         0)
+            (beginning-of-line)
+            (backward-char)
+            (return))
+          (forward-line)))
+      (list begin (point)))))
+
+
+
+;;; Thread Creation
+
+(defun mh-thread-folder ()
+  "Generate thread view of folder."
+  (message "Threading %s..." (buffer-name))
+  (mh-thread-initialize)
+  (goto-char (point-min))
+  (mh-remove-all-notation)
+  (let ((msg-list ()))
+    (mh-iterate-on-range msg (cons (point-min) (point-max))
+      (setf (gethash msg mh-thread-scan-line-map) (mh-thread-parse-scan-line))
+      (push msg msg-list))
+    (let* ((range (mh-coalesce-msg-list msg-list))
+           (thread-tree (mh-thread-generate (buffer-name) range)))
+      (delete-region (point-min) (point-max))
+      (mh-thread-print-scan-lines thread-tree)
+      (mh-notate-user-sequences)
+      (mh-notate-deleted-and-refiled)
+      (mh-notate-cur)
+      (message "Threading %s...done" (buffer-name)))))
+
+;;;###mh-autoload
+(defun mh-thread-inc (folder start-point)
+  "Update thread tree for FOLDER.
+All messages after START-POINT are added to the thread tree."
+  (mh-thread-rewind-pruning)
+  (mh-remove-all-notation)
+  (goto-char start-point)
+  (let ((msg-list ()))
+    (while (not (eobp))
+      (let ((index (mh-get-msg-num nil)))
+        (when (numberp index)
+          (push index msg-list)
+          (setf (gethash index mh-thread-scan-line-map)
+                (mh-thread-parse-scan-line)))
+        (forward-line)))
+    (let ((thread-tree (mh-thread-generate folder msg-list))
+          (buffer-read-only nil)
+          (old-buffer-modified-flag (buffer-modified-p)))
+      (delete-region (point-min) (point-max))
+      (mh-thread-print-scan-lines thread-tree)
+      (mh-notate-user-sequences)
+      (mh-notate-deleted-and-refiled)
+      (mh-notate-cur)
+      (set-buffer-modified-p old-buffer-modified-flag))))
+
+(defmacro mh-thread-initialize-hash (var test)
+  "Initialize the hash table in VAR.
+TEST is the test to use when creating a new hash table."
+  (unless (symbolp var) (error "Expected a symbol: %s" var))
+  `(if ,var (clrhash ,var) (setq ,var (make-hash-table :test ,test))))
+
+(defun mh-thread-initialize ()
+  "Make new hash tables, or clear them if already present."
+  (mh-thread-initialize-hash mh-thread-id-hash #'equal)
+  (mh-thread-initialize-hash mh-thread-subject-hash #'equal)
+  (mh-thread-initialize-hash mh-thread-id-table #'eq)
+  (mh-thread-initialize-hash mh-thread-id-index-map #'eq)
+  (mh-thread-initialize-hash mh-thread-index-id-map #'eql)
+  (mh-thread-initialize-hash mh-thread-scan-line-map #'eql)
+  (mh-thread-initialize-hash mh-thread-subject-container-hash #'eq)
+  (mh-thread-initialize-hash mh-thread-duplicates #'eq)
+  (setq mh-thread-history ()))
+
+(defsubst mh-thread-id-container (id)
+  "Given ID, return the corresponding container in `mh-thread-id-table'.
+If no container exists then a suitable container is created and
+the id-table is updated."
+  (when (not id)
+    (error "1"))
+  (or (gethash id mh-thread-id-table)
+      (setf (gethash id mh-thread-id-table)
+            (let ((message (mh-thread-make-message :id id)))
+              (mh-thread-make-container :message message)))))
+
+(defsubst mh-thread-remove-parent-link (child)
+  "Remove parent link of CHILD if it exists."
+  (let* ((child-container (if (mh-thread-container-p child)
+                              child (mh-thread-id-container child)))
+         (parent-container (mh-container-parent child-container)))
+    (when parent-container
+      (setf (mh-container-children parent-container)
+            (loop for elem in (mh-container-children parent-container)
+                  unless (eq child-container elem) collect elem))
+      (setf (mh-container-parent child-container) nil))))
+
+(defsubst mh-thread-add-link (parent child &optional at-end-p)
+  "Add links so that PARENT becomes a parent of CHILD.
+Doesn't make any changes if CHILD is already an ancestor of
+PARENT. If optional argument AT-END-P is non-nil, the CHILD is
+added to the end of the children list of PARENT."
+  (let ((parent-container (cond ((null parent) nil)
+                                ((mh-thread-container-p parent) parent)
+                                (t (mh-thread-id-container parent))))
+        (child-container (if (mh-thread-container-p child)
+                             child (mh-thread-id-container child))))
+    (when (and parent-container
+               (not (mh-thread-ancestor-p child-container parent-container))
+               (not (mh-thread-ancestor-p parent-container child-container)))
+      (mh-thread-remove-parent-link child-container)
+      (cond ((not at-end-p)
+             (push child-container (mh-container-children parent-container)))
+            ((null (mh-container-children parent-container))
+             (push child-container (mh-container-children parent-container)))
+            (t (let ((last-child (mh-container-children parent-container)))
+                 (while (cdr last-child)
+                   (setq last-child (cdr last-child)))
+                 (setcdr last-child (cons child-container nil)))))
+      (setf (mh-container-parent child-container) parent-container))
+    (unless parent-container
+      (mh-thread-remove-parent-link child-container))))
+
+(defun mh-thread-rewind-pruning ()
+  "Restore the thread tree to its state before pruning."
+  (while mh-thread-history
+    (let ((action (pop mh-thread-history)))
+      (cond ((eq (car action) 'DROP)
+             (mh-thread-remove-parent-link (cadr action))
+             (mh-thread-add-link (caddr action) (cadr action)))
+            ((eq (car action) 'PROMOTE)
+             (let ((node (cadr action))
+                   (parent (caddr action))
+                   (children (cdddr action)))
+               (dolist (child children)
+                 (mh-thread-remove-parent-link child)
+                 (mh-thread-add-link node child))
+               (mh-thread-add-link parent node)))
+            ((eq (car action) 'SUBJECT)
+             (let ((node (cadr action)))
+               (mh-thread-remove-parent-link node)
+               (setf (mh-container-real-child-p node) t)))))))
+
+(defun mh-thread-ancestor-p (ancestor successor)
+  "Return t if ANCESTOR is really an ancestor of SUCCESSOR and nil otherwise.
+In the limit, the function returns t if ANCESTOR and SUCCESSOR
+are the same containers."
+  (block nil
+    (while successor
+      (when (eq ancestor successor) (return t))
+      (setq successor (mh-container-parent successor)))
+    nil))
+
+;; Another and may be better approach would be to generate all the info from
+;; the scan which generates the threading info. For now this will have to do.
+;;;###mh-autoload
+(defun mh-thread-parse-scan-line (&optional string)
+  "Parse a scan line.
+If optional argument STRING is given then that is assumed to be
+the scan line. Otherwise uses the line at point as the scan line
+to parse."
+  (let* ((string (or string
+                     (buffer-substring-no-properties (line-beginning-position)
+                                                     (line-end-position))))
+         (address-start (+ mh-cmd-note mh-scan-field-from-start-offset))
+         (body-start (+ mh-cmd-note mh-scan-field-from-end-offset))
+         (first-string (substring string 0 address-start)))
+    (list first-string
+          (substring string address-start (- body-start 2))
+          (substring string body-start)
+          string)))
+
+(defsubst mh-thread-canonicalize-id (id)
+  "Produce canonical string representation for ID.
+This allows cheap string comparison with EQ."
+  (or (and (equal id "") (copy-sequence ""))
+      (gethash id mh-thread-id-hash)
+      (setf (gethash id mh-thread-id-hash) id)))
+
+(defsubst mh-thread-prune-subject (subject)
+  "Prune leading Re:'s, Fwd:'s etc. and trailing (fwd)'s from SUBJECT.
+If the result after pruning is not the empty string then it is
+canonicalized so that subjects can be tested for equality with
+eq. This is done so that all the messages without a subject are
+not put into a single thread."
+  (let ((case-fold-search t)
+        (subject-pruned-flag nil))
+    ;; Prune subject leader
+    (while (or (string-match "^[ \t]*\\(re\\|fwd?\\)\\(\\[[0-9]*\\]\\)?:[ \t]*"
+                             subject)
+               (string-match "^[ \t]*\\[[^\\]][ \t]*" subject))
+      (setq subject-pruned-flag t)
+      (setq subject (substring subject (match-end 0))))
+    ;; Prune subject trailer
+    (while (or (string-match "(fwd)$" subject)
+               (string-match "[ \t]+$" subject))
+      (setq subject-pruned-flag t)
+      (setq subject (substring subject 0 (match-beginning 0))))
+    ;; Canonicalize subject only if it is non-empty
+    (cond ((equal subject "") (values subject subject-pruned-flag))
+          (t (values
+              (or (gethash subject mh-thread-subject-hash)
+                  (setf (gethash subject mh-thread-subject-hash) subject))
+              subject-pruned-flag)))))
+
+(defsubst mh-thread-group-by-subject (roots)
+  "Group the set of message containers, ROOTS based on subject.
+Bug: Check for and make sure that something without Re: is made
+the parent in preference to something that has it."
+  (clrhash mh-thread-subject-container-hash)
+  (let ((results ()))
+    (dolist (root roots)
+      (let* ((subject (mh-thread-container-subject root))
+             (parent (gethash subject mh-thread-subject-container-hash)))
+        (cond (parent (mh-thread-remove-parent-link root)
+                      (mh-thread-add-link parent root t)
+                      (setf (mh-container-real-child-p root) nil)
+                      (push `(SUBJECT ,root) mh-thread-history))
+              (t
+               (setf (gethash subject mh-thread-subject-container-hash) root)
+               (push root results)))))
+    (nreverse results)))
+
+(defun mh-thread-container-subject (container)
+  "Return the subject of CONTAINER.
+If CONTAINER is empty return the subject info of one of its
+children."
+  (cond ((and (mh-container-message container)
+              (mh-message-id (mh-container-message container)))
+         (mh-message-subject (mh-container-message container)))
+        (t (block nil
+             (dolist (kid (mh-container-children container))
+               (when (and (mh-container-message kid)
+                          (mh-message-id (mh-container-message kid)))
+                 (let ((kid-message (mh-container-message kid)))
+                   (return (mh-message-subject kid-message)))))
+             (error "This can't happen")))))
+
+(defsubst mh-thread-update-id-index-maps (id index)
+  "Message with id, ID is the message in INDEX.
+The function also checks for duplicate messages (that is multiple
+messages with the same ID). These messages are put in the
+`mh-thread-duplicates' hash table."
+  (let ((old-index (gethash id mh-thread-id-index-map)))
+    (when old-index (push old-index (gethash id mh-thread-duplicates)))
+    (setf (gethash id mh-thread-id-index-map) index)
+    (setf (gethash index mh-thread-index-id-map) id)))
+
+(defsubst mh-thread-get-message-container (message)
+  "Return container which has MESSAGE in it.
+If there is no container present then a new container is
+allocated."
+  (let* ((id (mh-message-id message))
+         (container (gethash id mh-thread-id-table)))
+    (cond (container (setf (mh-container-message container) message)
+                     container)
+          (t (setf (gethash id mh-thread-id-table)
+                   (mh-thread-make-container :message message))))))
+
+(defsubst mh-thread-get-message (id subject-re-p subject refs)
+  "Return appropriate message.
+Otherwise update message already present to have the proper ID,
+SUBJECT-RE-P, SUBJECT and REFS fields."
+  (let* ((container (gethash id mh-thread-id-table))
+         (message (if container (mh-container-message container) nil)))
+    (cond (message
+           (setf (mh-message-subject-re-p message) subject-re-p)
+           (setf (mh-message-subject message) subject)
+           (setf (mh-message-id message) id)
+           (setf (mh-message-references message) refs)
+           message)
+          (container
+           (setf (mh-container-message container)
+                 (mh-thread-make-message :id id :references refs
+                                         :subject subject
+                                         :subject-re-p subject-re-p)))
+          (t (let ((message (mh-thread-make-message :id id :references refs
+                                                    :subject-re-p subject-re-p
+                                                    :subject subject)))
+               (prog1 message
+                 (mh-thread-get-message-container message)))))))
+
+(defvar mh-message-id-regexp "^<.*@.*>$"
+  "Regexp to recognize whether a string is a message identifier.")
+
+;;;###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))
+      (block nil
+        (while (not (eobp))
+          (block process-message
+            (let* ((index-line
+                    (prog1 (buffer-substring (point) (line-end-position))
+                      (forward-line)))
+                   (index (string-to-number index-line))
+                   (id (prog1 (buffer-substring (point) (line-end-position))
+                         (forward-line)))
+                   (refs (prog1 (buffer-substring (point) (line-end-position))
+                           (forward-line)))
+                   (in-reply-to (prog1 (buffer-substring (point)
+                                                         (line-end-position))
+                                  (forward-line)))
+                   (subject (prog1
+                                (buffer-substring (point) (line-end-position))
+                              (forward-line)))
+                   (subject-re-p nil))
+              (unless (gethash index mh-thread-scan-line-map)
+                (return-from process-message))
+              (unless (integerp index) (return)) ;Error message here
+              (multiple-value-setq (subject subject-re-p)
+                (mh-thread-prune-subject subject))
+              (setq in-reply-to (mh-thread-process-in-reply-to in-reply-to))
+              (setq refs (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)
+              (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)
+                   (declare (ignore k))
+                   (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))))))
+
+(defun mh-thread-set-tables (folder)
+  "Use the tables of FOLDER in current buffer."
+  (flet ((mh-get-table (symbol)
+                       (save-excursion
+                         (set-buffer folder)
+                         (symbol-value symbol))))
+    (setq mh-thread-id-hash (mh-get-table 'mh-thread-id-hash))
+    (setq mh-thread-subject-hash (mh-get-table 'mh-thread-subject-hash))
+    (setq mh-thread-id-table (mh-get-table 'mh-thread-id-table))
+    (setq mh-thread-id-index-map (mh-get-table 'mh-thread-id-index-map))
+    (setq mh-thread-index-id-map (mh-get-table 'mh-thread-index-id-map))
+    (setq mh-thread-scan-line-map (mh-get-table 'mh-thread-scan-line-map))
+    (setq mh-thread-subject-container-hash
+          (mh-get-table 'mh-thread-subject-container-hash))
+    (setq mh-thread-duplicates (mh-get-table 'mh-thread-duplicates))
+    (setq mh-thread-history (mh-get-table 'mh-thread-history))))
+
+(defun mh-thread-process-in-reply-to (reply-to-header)
+  "Extract message id's from REPLY-TO-HEADER.
+Ideally this should have some regexp which will try to guess if a
+string between < and > is a message id and not an email address.
+For now it will take the last string inside angles."
+  (let ((end (mh-search-from-end ?> reply-to-header)))
+    (when (numberp end)
+      (let ((begin (mh-search-from-end ?< (substring reply-to-header 0 end))))
+        (when (numberp begin)
+          (list (substring reply-to-header begin (1+ end))))))))
+
+(defun mh-thread-prune-containers (roots)
+  "Prune empty containers in the containers ROOTS."
+  (let ((dfs-ordered-nodes ())
+        (work-list roots))
+    (while work-list
+      (let ((node (pop work-list)))
+        (dolist (child (mh-container-children node))
+          (push child work-list))
+        (push node dfs-ordered-nodes)))
+    (while dfs-ordered-nodes
+      (let ((node (pop dfs-ordered-nodes)))
+        (cond ((gethash (mh-message-id (mh-container-message node))
+                        mh-thread-id-index-map)
+               ;; Keep it
+               (setf (mh-container-children node)
+                     (mh-thread-sort-containers (mh-container-children node))))
+              ((and (mh-container-children node)
+                    (or (null (cdr (mh-container-children node)))
+                        (mh-container-parent node)))
+               ;; Promote kids
+               (let ((children ()))
+                 (dolist (kid (mh-container-children node))
+                   (mh-thread-remove-parent-link kid)
+                   (mh-thread-add-link (mh-container-parent node) kid)
+                   (push kid children))
+                 (push `(PROMOTE ,node ,(mh-container-parent node) ,@children)
+                       mh-thread-history)
+                 (mh-thread-remove-parent-link node)))
+              ((mh-container-children node)
+               ;; Promote the first orphan to parent and add the other kids as
+               ;; his children
+               (setf (mh-container-children node)
+                     (mh-thread-sort-containers (mh-container-children node)))
+               (let ((new-parent (car (mh-container-children node)))
+                     (other-kids (cdr (mh-container-children node))))
+                 (mh-thread-remove-parent-link new-parent)
+                 (dolist (kid other-kids)
+                   (mh-thread-remove-parent-link kid)
+                   (setf (mh-container-real-child-p kid) nil)
+                   (mh-thread-add-link new-parent kid t))
+                 (push `(PROMOTE ,node ,(mh-container-parent node)
+                                 ,new-parent ,@other-kids)
+                       mh-thread-history)
+                 (mh-thread-remove-parent-link node)))
+              (t
+               ;; Drop it
+               (push `(DROP ,node ,(mh-container-parent node))
+                     mh-thread-history)
+               (mh-thread-remove-parent-link node)))))
+    (let ((results ()))
+      (maphash #'(lambda (k v)
+                   (declare (ignore k))
+                   (when (and (null (mh-container-parent v))
+                              (gethash (mh-message-id (mh-container-message v))
+                                       mh-thread-id-index-map))
+                     (push v results)))
+               mh-thread-id-table)
+      (mh-thread-sort-containers results))))
+
+(defun mh-thread-sort-containers (containers)
+  "Sort a list of message CONTAINERS to be in ascending order wrt index."
+  (sort containers
+        #'(lambda (x y)
+            (when (and (mh-container-message x) (mh-container-message y))
+              (let* ((id-x (mh-message-id (mh-container-message x)))
+                     (id-y (mh-message-id (mh-container-message y)))
+                     (index-x (gethash id-x mh-thread-id-index-map))
+                     (index-y (gethash id-y mh-thread-id-index-map)))
+                (and (integerp index-x) (integerp index-y)
+                     (< index-x index-y)))))))
+
+(defvar mh-thread-last-ancestor)
+
+;;;###mh-autoload
+(defun mh-thread-print-scan-lines (thread-tree)
+  "Print scan lines in THREAD-TREE in threaded mode."
+  (let ((mh-thread-body-width (- (window-width) mh-cmd-note
+                                 (1- mh-scan-field-subject-start-offset)))
+        (mh-thread-last-ancestor nil))
+    (if (null mh-index-data)
+        (mh-thread-generate-scan-lines thread-tree -2)
+      (loop for x in (mh-index-group-by-folder)
+            do (let* ((old-map mh-thread-scan-line-map)
+                      (mh-thread-scan-line-map (make-hash-table)))
+                 (setq mh-thread-last-ancestor nil)
+                 (loop for msg in (cdr x)
+                       do (let ((v (gethash msg old-map)))
+                            (when v
+                              (setf (gethash msg mh-thread-scan-line-map) v))))
+                 (when (> (hash-table-count mh-thread-scan-line-map) 0)
+                   (insert (if (bobp) "" "\n") (car x) "\n")
+                   (mh-thread-generate-scan-lines thread-tree -2))))
+      (mh-index-create-imenu-index))))
+
+(defun mh-thread-generate-scan-lines (tree level)
+  "Generate scan lines.
+TREE is the hierarchical tree of messages, SCAN-LINE-MAP maps
+message indices to the corresponding scan lines and LEVEL used to
+determine indentation of the message."
+  (cond ((null tree) nil)
+        ((mh-thread-container-p tree)
+         (let* ((message (mh-container-message tree))
+                (id (mh-message-id message))
+                (index (gethash id mh-thread-id-index-map))
+                (duplicates (gethash id mh-thread-duplicates))
+                (new-level (+ level 2))
+                (dupl-flag t)
+                (force-angle-flag nil)
+                (increment-level-flag nil))
+           (dolist (scan-line (mapcar (lambda (x)
+                                        (gethash x mh-thread-scan-line-map))
+                                      (reverse (cons index duplicates))))
+             (when scan-line
+               (when (and dupl-flag (equal level 0)
+                          (mh-thread-ancestor-p mh-thread-last-ancestor tree))
+                 (setq level (+ level 2)
+                       new-level (+ new-level 2)
+                       force-angle-flag t))
+               (when (equal level 0)
+                 (setq mh-thread-last-ancestor tree)
+                 (while (mh-container-parent mh-thread-last-ancestor)
+                   (setq mh-thread-last-ancestor
+                         (mh-container-parent mh-thread-last-ancestor))))
+               (let* ((lev (if dupl-flag level new-level))
+                      (square-flag (or (and (mh-container-real-child-p tree)
+                                            (not force-angle-flag)
+                                            dupl-flag)
+                                       (equal lev 0))))
+                 (insert (car scan-line)
+                         (format (format "%%%ss" lev) "")
+                         (if square-flag "[" "<")
+                         (cadr scan-line)
+                         (if square-flag "]" ">")
+                         (truncate-string-to-width
+                          (caddr scan-line) (- mh-thread-body-width lev))
+                         "\n"))
+               (setq increment-level-flag t)
+               (setq dupl-flag nil)))
+           (unless increment-level-flag (setq new-level level))
+           (dolist (child (mh-container-children tree))
+             (mh-thread-generate-scan-lines child new-level))))
+        (t (let ((nlevel (+ level 2)))
+             (dolist (ch tree)
+               (mh-thread-generate-scan-lines ch nlevel))))))
+
+
+
+;;; Additional Utilities
+
+;;;###mh-autoload
+(defun mh-thread-update-scan-line-map (msg notation offset)
+  "In threaded view update `mh-thread-scan-line-map'.
+MSG is the message being notated with NOTATION at OFFSET."
+  (let* ((msg (or msg (mh-get-msg-num nil)))
+         (cur-scan-line (and mh-thread-scan-line-map
+                             (gethash msg mh-thread-scan-line-map)))
+         (old-scan-lines (loop for map in mh-thread-scan-line-map-stack
+                               collect (and map (gethash msg map)))))
+    (when cur-scan-line
+      (setf (aref (car cur-scan-line) offset) notation))
+    (dolist (line old-scan-lines)
+      (when line (setf (aref (car line) offset) notation)))))
+
+;;;###mh-autoload
+(defun mh-thread-find-msg-subject (msg)
+  "Find canonicalized subject of MSG.
+This function can only be used the folder is threaded."
+  (ignore-errors
+    (mh-message-subject
+     (mh-container-message (gethash (gethash msg mh-thread-index-id-map)
+                                    mh-thread-id-table)))))
+
+;;;###mh-autoload
+(defun mh-thread-add-spaces (count)
+  "Add COUNT spaces to each scan line in `mh-thread-scan-line-map'."
+  (let ((spaces (format (format "%%%ss" count) "")))
+    (while (not (eobp))
+      (let* ((msg-num (mh-get-msg-num nil))
+             (old-line (nth 3 (gethash msg-num mh-thread-scan-line-map))))
+        (when (numberp msg-num)
+          (setf (gethash msg-num mh-thread-scan-line-map)
+                (mh-thread-parse-scan-line (format "%s%s" spaces old-line)))))
+      (forward-line 1))))
+
+;;;###mh-autoload
+(defun mh-thread-forget-message (index)
+  "Forget the message INDEX from the threading tables."
+  (let* ((id (gethash index mh-thread-index-id-map))
+         (id-index (gethash id mh-thread-id-index-map))
+         (duplicates (gethash id mh-thread-duplicates)))
+    (remhash index mh-thread-index-id-map)
+    (remhash index mh-thread-scan-line-map)
+    (cond ((and (eql index id-index) (null duplicates))
+           (remhash id mh-thread-id-index-map))
+          ((eql index id-index)
+           (setf (gethash id mh-thread-id-index-map) (car duplicates))
+           (setf (gethash (car duplicates) mh-thread-index-id-map) id)
+           (setf (gethash id mh-thread-duplicates) (cdr duplicates)))
+          (t
+           (setf (gethash id mh-thread-duplicates)
+                 (remove index duplicates))))))
+
+(provide 'mh-thread)
+
+;; Local Variables:
+;; indent-tabs-mode: nil
+;; sentence-end-double-space: nil
+;; End:
+
+;;; mh-thread.el ends here