emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Emacs-diffs] Changes to emacs/lisp/mh-e/mh-utils.el [gnus-5_10-branch]


From: Miles Bader
Subject: [Emacs-diffs] Changes to emacs/lisp/mh-e/mh-utils.el [gnus-5_10-branch]
Date: Sat, 04 Sep 2004 08:31:19 -0400

Index: emacs/lisp/mh-e/mh-utils.el
diff -c /dev/null emacs/lisp/mh-e/mh-utils.el:1.6.2.1
*** /dev/null   Sat Sep  4 12:02:02 2004
--- emacs/lisp/mh-e/mh-utils.el Sat Sep  4 12:01:04 2004
***************
*** 0 ****
--- 1,2595 ----
+ ;;; mh-utils.el --- MH-E code needed for both sending and reading
+ 
+ ;; Copyright (C) 1993, 95, 1997,
+ ;;  2000, 01, 02, 03, 2004 Free Software Foundation, Inc.
+ 
+ ;; Author: Bill Wohler <address@hidden>
+ ;; Maintainer: Bill Wohler <address@hidden>
+ ;; 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., 59 Temple Place - Suite 330,
+ ;; Boston, MA 02111-1307, USA.
+ 
+ ;;; Commentary:
+ 
+ ;; Internal support for MH-E package.
+ 
+ ;;; Change Log:
+ 
+ ;;; Code:
+ 
+ (defvar recursive-load-depth-limit)
+ (eval-and-compile
+   (if (and (boundp 'recursive-load-depth-limit)
+            (integerp recursive-load-depth-limit)
+            (> 50 recursive-load-depth-limit))
+       (setq recursive-load-depth-limit 50)))
+ 
+ (eval-when-compile (require 'mh-acros))
+ (mh-require-cl)
+ (require 'gnus-util)
+ (require 'font-lock)
+ (require 'mouse)
+ (load "tool-bar" t t)
+ (require 'mh-loaddefs)
+ (require 'mh-customize)
+ (require 'mh-inc)
+ 
+ (load "mm-decode" t t)                  ; Non-fatal dependency
+ (load "mm-view" t t)                    ; Non-fatal dependency
+ (load "vcard" t t)                      ; Non-fatal dependency
+ (load "hl-line" t t)                    ; Non-fatal dependency
+ (load "executable" t t)                 ; Non-fatal dependency on
+                                         ; executable-find
+ 
+ ;; Shush the byte-compiler
+ (defvar font-lock-auto-fontify)
+ (defvar font-lock-defaults)
+ (defvar mark-active)
+ 
+ ;;; Autoloads
+ (autoload 'gnus-article-highlight-citation "gnus-cite")
+ (autoload 'message-fetch-field "message")
+ (autoload 'message-tokenize-header "message")
+ (require 'sendmail)
+ (unless (fboundp 'make-hash-table)
+   (autoload 'make-hash-table "cl"))
+ 
+ ;;; CL Replacements
+ (defun mh-search-from-end (char string)
+   "Return the position of last occurrence of CHAR in STRING.
+ If CHAR is not present in STRING then return nil. The function is used in lieu
+ of `search' in the CL package."
+   (loop for index from (1- (length string)) downto 0
+         when (equal (aref string index) char) return index
+         finally return nil))
+ 
+ ;;; Additional header fields that might someday be added:
+ ;;; "Sender: " "Reply-to: "
+ 
+ 
+ ;;; Scan Line Formats
+ 
+ (defvar mh-scan-msg-number-regexp "^ *\\([0-9]+\\)"
+   "This regexp is used to extract the message number from a scan line.
+ Note that the message number must be placed in a parenthesized expression as
+ in the default of \"^ *\\\\([0-9]+\\\\)\".")
+ 
+ (defvar mh-scan-msg-overflow-regexp "^[?0-9][0-9]"
+   "This regexp matches scan lines in which the message number overflowed.")
+ 
+ (defvar mh-scan-msg-format-regexp "%\\([0-9]*\\)(msg)"
+   "This regexp is used to find the message number width in a scan format.
+ Note that the message number must be placed in a parenthesized expression as
+ in the default of \"%\\\\([0-9]*\\\\)(msg)\".")
+ 
+ (defvar mh-scan-msg-format-string "%d"
+   "This is a format string for width of the message number in a scan format.
+ Use `0%d' for zero-filled message numbers.")
+ 
+ (defvar mh-scan-msg-search-regexp "^[^0-9]*%d[^0-9]"
+   "This format string regexp matches the scan line for a particular message.
+ Use `%d' to represent the location of the message number within the
+ expression as in the default of \"^[^0-9]*%d[^0-9]\".")
+ 
+ (defvar mh-cmd-note 4
+   "This is the number of characters to skip over before inserting notation.
+ This variable should be set with the function `mh-set-cmd-note'. This variable
+ may be updated dynamically if `mh-adaptive-cmd-note-flag' is non-nil and
+ `mh-scan-format-file' is t.")
+ (make-variable-buffer-local 'mh-cmd-note)
+ 
+ (defvar mh-note-seq ?%
+   "Messages in a user-defined sequence are marked by this character.
+ Messages in the `search' sequence are marked by this character as well.")
+ 
+ 
+ 
+ (defvar mh-show-buffer-mode-line-buffer-id "    {show-%s} %d"
+   "Format string to produce `mode-line-buffer-identification' for show 
buffers.
+ First argument is folder name.  Second is message number.")
+ 
+ 
+ 
+ (defvar mh-mail-header-separator "--------"
+   "*Line used by MH to separate headers from text in messages being composed.
+ This variable should not be used directly in programs. Programs should use
+ `mail-header-separator' instead. `mail-header-separator' is initialized to
+ `mh-mail-header-separator' in `mh-letter-mode'; in other contexts, you may
+ have to perform this initialization yourself.
+ 
+ Do not make this a regexp as it may be the argument to `insert' and it is
+ passed through `regexp-quote' before being used by functions like
+ `re-search-forward'.")
+ 
+ (defvar mh-signature-separator-regexp "^-- $"
+   "Regexp used to find signature separator.
+ See `mh-signature-separator'.")
+ 
+ (defvar mh-signature-separator "-- \n"
+   "Text of a signature separator.
+ A signature separator is used to separate the body of a message from the
+ signature. This can be used by user agents such as MH-E to render the
+ signature differently or to suppress the inclusion of the signature in a
+ reply.
+ Use `mh-signature-separator-regexp' when searching for a separator.")
+ 
+ (defun mh-signature-separator-p ()
+   "Return non-nil if buffer includes \"^-- $\"."
+   (save-excursion
+     (goto-char (point-min))
+     (re-search-forward mh-signature-separator-regexp nil t)))
+ 
+ ;; Variables for MIME display
+ 
+ ;; Structure to keep track of MIME handles on a per buffer basis.
+ (mh-defstruct (mh-buffer-data (:conc-name mh-mime-)
+                               (:constructor mh-make-buffer-data))
+   (handles ())                          ; List of MIME handles
+   (handles-cache (make-hash-table))     ; Cache to avoid multiple decodes of
+                                         ; nested messages
+   (parts-count 0)                       ; The button number is generated from
+                                         ; this number
+   (part-index-hash (make-hash-table)))  ; Avoid incrementing the part number
+                                         ; for nested messages
+ ;;; This has to be a macro, since we do: (setf (mh-buffer-data) ...)
+ (defmacro mh-buffer-data ()
+   "Convenience macro to get the MIME data structures of the current buffer."
+   `(gethash (current-buffer) mh-globals-hash))
+ 
+ (defvar mh-globals-hash (make-hash-table)
+   "Keeps track of MIME data on a per buffer basis.")
+ 
+ (defvar mh-gnus-pgp-support-flag (not (not (locate-library "mml2015")))
+   "Non-nil means installed Gnus has PGP support.")
+ 
+ (defvar mh-mm-inline-media-tests
+   `(("image/jpeg"
+      mm-inline-image
+      (lambda (handle)
+        (mm-valid-and-fit-image-p 'jpeg handle)))
+     ("image/png"
+      mm-inline-image
+      (lambda (handle)
+        (mm-valid-and-fit-image-p 'png handle)))
+     ("image/gif"
+      mm-inline-image
+      (lambda (handle)
+        (mm-valid-and-fit-image-p 'gif handle)))
+     ("image/tiff"
+      mm-inline-image
+      (lambda (handle)
+        (mm-valid-and-fit-image-p 'tiff handle)) )
+     ("image/xbm"
+      mm-inline-image
+      (lambda (handle)
+        (mm-valid-and-fit-image-p 'xbm handle)))
+     ("image/x-xbitmap"
+      mm-inline-image
+      (lambda (handle)
+        (mm-valid-and-fit-image-p 'xbm handle)))
+     ("image/xpm"
+      mm-inline-image
+      (lambda (handle)
+        (mm-valid-and-fit-image-p 'xpm handle)))
+     ("image/x-pixmap"
+      mm-inline-image
+      (lambda (handle)
+        (mm-valid-and-fit-image-p 'xpm handle)))
+     ("image/bmp"
+      mm-inline-image
+      (lambda (handle)
+        (mm-valid-and-fit-image-p 'bmp handle)))
+     ("image/x-portable-bitmap"
+      mm-inline-image
+      (lambda (handle)
+        (mm-valid-and-fit-image-p 'pbm handle)))
+     ("text/plain" mm-inline-text identity)
+     ("text/enriched" mm-inline-text identity)
+     ("text/richtext" mm-inline-text identity)
+     ("text/x-patch" mm-display-patch-inline
+      (lambda (handle)
+        (locate-library "diff-mode")))
+     ("application/emacs-lisp" mm-display-elisp-inline identity)
+     ("application/x-emacs-lisp" mm-display-elisp-inline identity)
+     ("text/html"
+      ,(if (fboundp 'mm-inline-text-html) 'mm-inline-text-html 'mm-inline-text)
+      (lambda (handle)
+        (or (and (boundp 'mm-inline-text-html-renderer)
+                 mm-inline-text-html-renderer)
+            (and (boundp 'mm-text-html-renderer) mm-text-html-renderer))))
+     ("text/x-vcard"
+      mm-inline-text-vcard
+      (lambda (handle)
+        (or (featurep 'vcard)
+            (locate-library "vcard"))))
+     ("message/delivery-status" mm-inline-text identity)
+     ("message/rfc822" mh-mm-inline-message identity)
+     ;;("message/partial" mm-inline-partial identity)
+     ;;("message/external-body" mm-inline-external-body identity)
+     ("text/.*" mm-inline-text identity)
+     ("audio/wav" mm-inline-audio
+      (lambda (handle)
+        (and (or (featurep 'nas-sound) (featurep 'native-sound))
+             (device-sound-enabled-p))))
+     ("audio/au"
+      mm-inline-audio
+      (lambda (handle)
+        (and (or (featurep 'nas-sound) (featurep 'native-sound))
+             (device-sound-enabled-p))))
+     ("application/pgp-signature" ignore identity)
+     ("application/x-pkcs7-signature" ignore identity)
+     ("application/pkcs7-signature" ignore identity)
+     ("application/x-pkcs7-mime" ignore identity)
+     ("application/pkcs7-mime" ignore identity)
+     ("multipart/alternative" ignore identity)
+     ("multipart/mixed" ignore identity)
+     ("multipart/related" ignore identity)
+     ;; Disable audio and image
+     ("audio/.*" ignore ignore)
+     ("image/.*" ignore ignore)
+     ;; Default to displaying as text
+     (".*" mm-inline-text mm-readable-p))
+   "Alist of media types/tests saying whether types can be displayed inline.")
+ 
+ ;; Copy of `goto-address-mail-regexp'
+ (defvar mh-address-mail-regexp
+   "address@hidden([-a-zA-z0-9_]+\\.\\)+[a-zA-Z0-9]+"
+   "A regular expression probably matching an e-mail address.")
+ 
+ ;; From goto-addr.el, which we don't want to force-load on users.
+ 
+ (defun mh-goto-address-find-address-at-point ()
+   "Find e-mail address around or before point.
+ Then search backwards to beginning of line for the start of an e-mail
+ address.  If no e-mail address found, return nil."
+   (re-search-backward "address@hidden" (line-beginning-position) 'lim)
+   (if (or (looking-at mh-address-mail-regexp) ; already at start
+         (and (re-search-forward mh-address-mail-regexp
+                                 (line-end-position) 'lim)
+              (goto-char (match-beginning 0))))
+       (match-string-no-properties 0)))
+ 
+ (defun mh-mail-header-end ()
+   "Substitute for `mail-header-end' that doesn't widen the buffer.
+ In MH-E we frequently need to find the end of headers in nested messages, 
where
+ the buffer has been narrowed. This function works in this situation."
+   (save-excursion
+     ;; XXX: The following replaces a call to rfc822-goto-eoh. Occasionally,
+     ;; mail headers that MH-E has to read contains lines of the form:
+     ;;    From address@hidden Mon May 10 11:48:07 2004
+     ;; In this situation, rfc822-goto-eoh doesn't go to the end of the
+     ;; header. The replacement allows From_ lines in the mail header.
+     (goto-char (point-min))
+     (loop for p = (re-search-forward
+                    "^\\([:\n]\\|[^: \t\n]+[ \t\n]\\)" nil 'move)
+           do (cond ((null p) (return))
+                    (t (goto-char (match-beginning 0))
+                       (unless (looking-at "From ") (return))
+                       (goto-char p))))
+     (point)))
+ 
+ (defun mh-in-header-p ()
+   "Return non-nil if the point is in the header of a draft message."
+   (< (point) (mh-mail-header-end)))
+ 
+ (defun mh-header-field-beginning ()
+   "Move to the beginning of the current header field.
+ Handles RFC 822 continuation lines."
+   (beginning-of-line)
+   (while (looking-at "^[ \t]")
+     (forward-line -1)))
+ 
+ (defun mh-header-field-end ()
+   "Move to the end of the current header field.
+ Handles RFC 822 continuation lines."
+   (forward-line 1)
+   (while (looking-at "^[ \t]")
+     (forward-line 1))
+   (backward-char 1))                    ;to end of previous line
+ 
+ (defun mh-letter-header-font-lock (limit)
+   "Return the entire mail header to font-lock.
+ Argument LIMIT limits search."
+   (if (= (point) limit)
+       nil
+     (let* ((mail-header-end (save-match-data (mh-mail-header-end)))
+            (lesser-limit (if (< mail-header-end limit) mail-header-end 
limit)))
+       (when (mh-in-header-p)
+         (set-match-data (list 1 lesser-limit))
+         (goto-char lesser-limit)
+         t))))
+ 
+ (defun mh-header-field-font-lock (field limit)
+   "Return the value of a header field FIELD to font-lock.
+ Argument LIMIT limits search."
+   (if (= (point) limit)
+       nil
+     (let* ((mail-header-end (mh-mail-header-end))
+            (lesser-limit (if (< mail-header-end limit) mail-header-end limit))
+            (case-fold-search t))
+       (when (and (< (point) mail-header-end) ;Only within header
+                  (re-search-forward (format "^%s" field) lesser-limit t))
+         (let ((match-one-b (match-beginning 0))
+               (match-one-e (match-end 0)))
+           (mh-header-field-end)
+           (if (> (point) limit)         ;Don't search for end beyond limit
+               (goto-char limit))
+           (set-match-data (list match-one-b match-one-e
+                                 (1+ match-one-e) (point)))
+           t)))))
+ 
+ (defun mh-header-to-font-lock (limit)
+   "Return the value of a header field To to font-lock.
+ Argument LIMIT limits search."
+   (mh-header-field-font-lock "To:" limit))
+ 
+ (defun mh-header-cc-font-lock (limit)
+   "Return the value of a header field cc to font-lock.
+ Argument LIMIT limits search."
+   (mh-header-field-font-lock "cc:" limit))
+ 
+ (defun mh-header-subject-font-lock (limit)
+   "Return the value of a header field Subject to font-lock.
+ Argument LIMIT limits search."
+   (mh-header-field-font-lock "Subject:" limit))
+ 
+ (eval-and-compile
+   ;; Otherwise byte-compilation fails on 
`mh-show-font-lock-keywords-with-cite'
+   (defvar mh-show-font-lock-keywords
+     '(("^\\(From:\\|Sender:\\)\\(.*\\)"  (1 'default) (2 mh-show-from-face))
+       (mh-header-to-font-lock            (0 'default) (1 mh-show-to-face))
+       (mh-header-cc-font-lock            (0 'default) (1 mh-show-cc-face))
+       ("^\\(Reply-To:\\|Return-Path:\\)\\(.*\\)$"
+        (1 'default) (2 mh-show-from-face))
+       (mh-header-subject-font-lock       (0 'default) (1 
mh-show-subject-face))
+       ("^\\(Apparently-To:\\|Newsgroups:\\)\\(.*\\)"
+        (1 'default) (2 mh-show-cc-face))
+       ("^\\(In-reply-to\\|Date\\):\\(.*\\)$"
+        (1 'default) (2 mh-show-date-face))
+       (mh-letter-header-font-lock        (0 mh-show-header-face append t)))
+     "Additional expressions to highlight in MH-show mode."))
+ 
+ (defvar mh-show-font-lock-keywords-with-cite
+   (eval-when-compile
+     (let* ((cite-chars "[>|}]")
+            (cite-prefix "A-Za-z")
+            (cite-suffix (concat cite-prefix "address@hidden'\"")))
+       (append
+        mh-show-font-lock-keywords
+        (list
+         ;; Use MATCH-ANCHORED to effectively anchor the regexp left side.
+         `(,cite-chars
+           (,(concat "\\=[ \t]*"
+                     "\\(\\([" cite-prefix "]+[" cite-suffix "]*\\)?"
+                     "\\(" cite-chars "[ \t]*\\)\\)+"
+                     "\\(.*\\)")
+            (beginning-of-line) (end-of-line)
+            (2 font-lock-constant-face nil t)
+            (4 font-lock-comment-face nil t)))))))
+   "Additional expressions to highlight in MH-show mode.")
+ 
+ (defvar mh-letter-font-lock-keywords
+   `(,@mh-show-font-lock-keywords-with-cite
+     (mh-font-lock-field-data (1 'mh-letter-header-field-face prepend t))))
+ 
+ (defun mh-show-font-lock-fontify-region (beg end loudly)
+   "Limit font-lock in `mh-show-mode' to the header.
+ Used when `mh-highlight-citation-p' is set to gnus, leaving the body to be
+ dealt with by gnus highlighting. The region between BEG and END is
+ given over to be fontified and LOUDLY controls if a user sees a
+ message about the fontification operation."
+   (let ((header-end (mh-mail-header-end)))
+     (cond
+      ((and (< beg header-end)(< end header-end))
+       (font-lock-default-fontify-region beg end loudly))
+      ((and (< beg header-end)(>= end header-end))
+       (font-lock-default-fontify-region beg header-end loudly))
+      (t
+       nil))))
+ 
+ ;; Needed to help shush the byte-compiler.
+ (if mh-xemacs-flag
+     (progn
+       (eval-and-compile
+         (require 'gnus)
+         (require 'gnus-art)
+         (require 'gnus-cite))))
+ 
+ (defun mh-gnus-article-highlight-citation ()
+   "Highlight cited text in current buffer using gnus."
+   (interactive)
+   ;; Requiring gnus-cite should have been sufficient. However for Emacs21.1,
+   ;; recursive-load-depth-limit is only 10, so an error occurs. Also it may be
+   ;; better to have an autoload at top-level (though that won't work because
+   ;; of recursive-load-depth-limit). That gets rid of a compiler warning as
+   ;; well.
+   (unless mh-xemacs-flag
+     (require 'gnus-art)
+     (require 'gnus-cite))
+   ;; Don't allow Gnus to create buttons while highlighting, maybe this is bad
+   ;; style?
+   (flet ((gnus-article-add-button (&rest args) nil))
+     (let* ((modified (buffer-modified-p))
+            (gnus-article-buffer (buffer-name))
+            (gnus-cite-face-list `(,@(cdr gnus-cite-face-list)
+                                     ,(car gnus-cite-face-list))))
+       (gnus-article-highlight-citation t)
+       (set-buffer-modified-p modified))))
+ 
+ ;;; Internal bookkeeping variables:
+ 
+ ;; Cached value of the `Path:' component in the user's MH profile.
+ ;; User's mail folder directory.
+ (defvar mh-user-path nil)
+ 
+ ;; An mh-draft-folder of nil means do not use a draft folder.
+ ;; Cached value of the `Draft-Folder:' component in the user's MH profile.
+ ;; Name of folder containing draft messages.
+ (defvar mh-draft-folder nil)
+ 
+ ;; Cached value of the `Unseen-Sequence:' component in the user's MH profile.
+ ;; Name of the Unseen sequence.
+ (defvar mh-unseen-seq nil)
+ 
+ ;; Cached value of the `Previous-Sequence:' component in the user's MH
+ ;; profile.
+ ;; Name of the Previous sequence.
+ (defvar mh-previous-seq nil)
+ 
+ ;; Cached value of the `Inbox:' component in the user's MH profile,
+ ;; or "+inbox" if no such component.
+ ;; Name of the Inbox folder.
+ (defvar mh-inbox nil)
+ 
+ ;; The names of ephemeral buffers have a " *mh-" prefix (so that they are
+ ;; hidden and can be programmatically removed in mh-quit), and the variable
+ ;; names have the form mh-temp-.*-buffer.
+ (defconst mh-temp-buffer " *mh-temp*")  ;scratch
+ (defconst mh-temp-fetch-buffer " *mh-fetch*")  ;wget/curl/fetch output
+ 
+ ;; The names of MH-E buffers that are not ephemeral and can be used by the
+ ;; user (and deleted by the user when no longer needed) have a "*MH-E " prefix
+ ;; (so they can be programmatically removed in mh-quit), and the variable
+ ;; names have the form mh-.*-buffer.
+ (defconst mh-aliases-buffer "*MH-E Aliases*") ;alias lookups
+ (defconst mh-folders-buffer "*MH-E Folders*") ;folder list
+ (defconst mh-help-buffer "*MH-E Help*") ;quick help
+ (defconst mh-info-buffer "*MH-E Info*") ;version information buffer
+ (defconst mh-log-buffer "*MH-E Log*") ;output of MH commands and so on
+ (defconst mh-mail-delivery-buffer "*MH-E Mail Delivery*") ;mail delivery log
+ (defconst mh-recipients-buffer "*MH-E Recipients*") ;killed when draft sent
+ (defconst mh-sequences-buffer "*MH-E Sequences*") ;sequences list
+ 
+ ;; Number of lines to keep in mh-log-buffer.
+ (defvar mh-log-buffer-lines 100)
+ 
+ ;; Window configuration before MH-E command.
+ (defvar mh-previous-window-config nil)
+ 
+ ;;Non-nil means next SPC or whatever goes to next undeleted message.
+ (defvar mh-page-to-next-msg-flag nil)
+ 
+ ;;; Internal variables local to a folder.
+ 
+ ;; Name of current folder, a string.
+ (defvar mh-current-folder nil)
+ 
+ ;; Buffer that displays message for this folder.
+ (defvar mh-show-buffer nil)
+ 
+ ;; Full path of directory for this folder.
+ (defvar mh-folder-filename nil)
+ 
+ ;;Number of msgs in buffer.
+ (defvar mh-msg-count nil)
+ 
+ ;; If non-nil, show the message in a separate window.
+ (defvar mh-showing-mode nil)
+ 
+ (defvar mh-show-mode-map (make-sparse-keymap)
+   "Keymap used by the show buffer.")
+ 
+ (defvar mh-show-folder-buffer nil
+   "Keeps track of folder whose message is being displayed.")
+ 
+ (defvar mh-logo-cache nil)
+ 
+ (defun mh-logo-display ()
+   "Modify mode line to display MH-E logo."
+   (mh-do-in-gnu-emacs
+    (add-text-properties
+     0 2
+     `(display ,(or mh-logo-cache
+                    (setq mh-logo-cache
+                          (mh-funcall-if-exists
+                           find-image '((:type xpm :ascent center
+                                               :file "mh-logo.xpm"))))))
+     (car mode-line-buffer-identification)))
+   (mh-do-in-xemacs
+    (setq modeline-buffer-identification
+          (list
+           (if mh-modeline-glyph
+               (cons modeline-buffer-id-left-extent mh-modeline-glyph)
+             (cons modeline-buffer-id-left-extent "XEmacs%N:"))
+           (cons modeline-buffer-id-right-extent " %17b")))))
+ 
+ ;;; This holds a documentation string used by describe-mode.
+ (defun mh-showing-mode (&optional arg)
+   "Change whether messages should be displayed.
+ With arg, display messages iff ARG is positive."
+   (setq mh-showing-mode
+         (if (null arg)
+             (not mh-showing-mode)
+           (> (prefix-numeric-value arg) 0))))
+ 
+ ;; The sequences of this folder.  An alist of (seq . msgs).
+ (defvar mh-seq-list nil)
+ 
+ ;; List of displayed messages to be removed from the Unseen sequence.
+ (defvar mh-seen-list nil)
+ 
+ ;; If non-nil, show buffer contains message with all headers.
+ ;; If nil, show buffer contains message processed normally.
+ ;; Showing message with headers or normally.
+ (defvar mh-showing-with-headers nil)
+ 
+ ;;; MH-E macros
+ 
+ (defmacro with-mh-folder-updating (save-modification-flag &rest body)
+   "Format is (with-mh-folder-updating (SAVE-MODIFICATION-FLAG) &body BODY).
+ Execute BODY, which can modify the folder buffer without having to
+ worry about file locking or the read-only flag, and return its result.
+ If SAVE-MODIFICATION-FLAG is non-nil, the buffer's modification
+ flag is unchanged, otherwise it is cleared."
+   (setq save-modification-flag (car save-modification-flag)) ; CL style
+   `(prog1
+        (let ((mh-folder-updating-mod-flag (buffer-modified-p))
+              (buffer-read-only nil)
+              (buffer-file-name nil))    ;don't let the buffer get locked
+          (prog1
+              (progn
+                ,@body)
+            (mh-set-folder-modified-p mh-folder-updating-mod-flag)))
+      ,@(if (not save-modification-flag)
+            '((mh-set-folder-modified-p nil)))))
+ 
+ (put 'with-mh-folder-updating 'lisp-indent-hook 'defun)
+ 
+ (defmacro mh-in-show-buffer (show-buffer &rest body)
+   "Format is (mh-in-show-buffer (SHOW-BUFFER) &body BODY).
+ Display buffer SHOW-BUFFER in other window and execute BODY in it.
+ Stronger than `save-excursion', weaker than `save-window-excursion'."
+   (setq show-buffer (car show-buffer))  ; CL style
+   `(let ((mh-in-show-buffer-saved-window (selected-window)))
+      (switch-to-buffer-other-window ,show-buffer)
+      (if mh-bury-show-buffer-flag (bury-buffer (current-buffer)))
+      (unwind-protect
+          (progn
+            ,@body)
+        (select-window mh-in-show-buffer-saved-window))))
+ 
+ (put 'mh-in-show-buffer 'lisp-indent-hook 'defun)
+ 
+ (defmacro mh-do-at-event-location (event &rest body)
+   "Switch to the location of EVENT and execute BODY.
+ After BODY has been executed return to original window. The modification flag
+ of the buffer in the event window is preserved."
+   (let ((event-window (make-symbol "event-window"))
+         (event-position (make-symbol "event-position"))
+         (original-window (make-symbol "original-window"))
+         (original-position (make-symbol "original-position"))
+         (modified-flag (make-symbol "modified-flag")))
+     `(save-excursion
+        (let* ((,event-window
+                (or (mh-funcall-if-exists posn-window (event-start ,event))
+                    (mh-funcall-if-exists event-window ,event)))
+               (,event-position
+                (or (mh-funcall-if-exists posn-point (event-start ,event))
+                    (mh-funcall-if-exists event-closest-point ,event)))
+               (,original-window (selected-window))
+               (,original-position (progn
+                                    (set-buffer (window-buffer ,event-window))
+                                    (set-marker (make-marker) (point))))
+               (,modified-flag (buffer-modified-p))
+               (buffer-read-only nil))
+          (unwind-protect (progn
+                            (select-window ,event-window)
+                            (goto-char ,event-position)
+                            ,@body)
+            (set-buffer-modified-p ,modified-flag)
+            (goto-char ,original-position)
+            (set-marker ,original-position nil)
+            (select-window ,original-window))))))
+ 
+ (put 'mh-do-at-event-location 'lisp-indent-hook 'defun)
+ 
+ (defmacro mh-make-seq (name msgs)
+   "Create sequence NAME with the given MSGS."
+   (list 'cons name msgs))
+ 
+ (defmacro mh-seq-name (sequence)
+   "Extract sequence name from the given SEQUENCE."
+   (list 'car sequence))
+ 
+ (defmacro mh-seq-msgs (sequence)
+   "Extract messages from the given SEQUENCE."
+   (list 'cdr sequence))
+ 
+ (defun mh-recenter (arg)
+   "Like recenter but with three improvements:
+ - At the end of the buffer it tries to show fewer empty lines.
+ - operates only if the current buffer is in the selected window.
+   (Commands like `save-some-buffers' can make this false.)
+ - nil ARG means recenter as if prefix argument had been given."
+   (cond ((not (eq (get-buffer-window (current-buffer)) (selected-window)))
+          nil)
+         ((= (point-max) (save-excursion
+                           (forward-line (- (/ (window-height) 2) 2))
+                           (point)))
+          (let ((lines-from-end 2))
+            (save-excursion
+              (while (> (point-max) (progn (forward-line) (point)))
+                (incf lines-from-end)))
+            (recenter (- lines-from-end))))
+         ;; '(4) is the same as C-u prefix argument.
+         (t (recenter (or arg '(4))))))
+ 
+ (defun mh-start-of-uncleaned-message ()
+   "Position uninteresting headers off the top of the window."
+   (let ((case-fold-search t))
+     (re-search-forward
+      "^To:\\|^Cc:\\|^From:\\|^Subject:\\|^Date:" nil t)
+     (beginning-of-line)
+     (mh-recenter 0)))
+ 
+ (defun mh-invalidate-show-buffer ()
+   "Invalidate the show buffer so we must update it to use it."
+   (if (get-buffer mh-show-buffer)
+       (save-excursion
+         (set-buffer mh-show-buffer)
+         (mh-unvisit-file))))
+ 
+ (defun mh-unvisit-file ()
+   "Separate current buffer from the message file it was visiting."
+   (or (not (buffer-modified-p))
+       (null buffer-file-name)           ;we've been here before
+       (yes-or-no-p (format "Message %s modified; flush changes? "
+                            (file-name-nondirectory buffer-file-name)))
+       (error "Flushing changes not confirmed"))
+   (clear-visited-file-modtime)
+   (unlock-buffer)
+   (setq buffer-file-name nil))
+ 
+ 
+ (defun mh-get-msg-num (error-if-no-message)
+   "Return the message number of the displayed message.
+ If the argument ERROR-IF-NO-MESSAGE is non-nil, then complain if the cursor is
+ not pointing to a message."
+   (save-excursion
+     (beginning-of-line)
+     (cond ((looking-at mh-scan-msg-number-regexp)
+            (string-to-int (buffer-substring (match-beginning 1)
+                                             (match-end 1))))
+           (error-if-no-message
+            (error "Cursor not pointing to message"))
+           (t nil))))
+ 
+ (defun mh-folder-name-p (name)
+   "Return non-nil if NAME is the name of a folder.
+ A name (a string or symbol) can be a folder name if it begins with \"+\"."
+   (if (symbolp name)
+       (eq (aref (symbol-name name) 0) ?+)
+     (and (> (length name) 0)
+          (eq (aref name 0) ?+))))
+ 
+ 
+ (defun mh-expand-file-name (filename &optional default)
+   "Expand FILENAME like `expand-file-name', but also handle MH folder names.
+ Any filename that starts with '+' is treated as a folder name.
+ See `expand-file-name' for description of DEFAULT."
+   (if (mh-folder-name-p filename)
+       (expand-file-name (substring filename 1) mh-user-path)
+     (expand-file-name filename default)))
+ 
+ 
+ (defun mh-msg-filename (msg &optional folder)
+   "Return the file name of MSG in FOLDER (default current folder)."
+   (expand-file-name (int-to-string msg)
+                     (if folder
+                         (mh-expand-file-name folder)
+                       mh-folder-filename)))
+ 
+ ;;; Infrastructure to generate show-buffer functions from folder functions
+ ;;; XEmacs does not have deactivate-mark? What is the equivalent of
+ ;;; transient-mark-mode for XEmacs? Should we be restoring the mark in the
+ ;;; folder buffer after the operation has been carried out.
+ (defmacro mh-defun-show-buffer (function original-function
+                                          &optional dont-return)
+   "Define FUNCTION to run ORIGINAL-FUNCTION in folder buffer.
+ If the buffer we start in is still visible and DONT-RETURN is nil then switch
+ to it after that."
+   `(defun ,function ()
+      ,(format "Calls %s from the message's folder.\n%s\nSee `%s' for more 
info.\n"
+               original-function
+               (if dont-return ""
+                 "When function completes, returns to the show buffer if it is
+ still visible.\n")
+               original-function)
+      (interactive)
+      (when (buffer-live-p (get-buffer mh-show-folder-buffer))
+        (let ((config (current-window-configuration))
+              (folder-buffer mh-show-folder-buffer)
+              (normal-exit nil)
+              ,@(if dont-return () '((cur-buffer-name (buffer-name)))))
+          (pop-to-buffer mh-show-folder-buffer nil)
+          (unless (equal (buffer-name
+                          (window-buffer (frame-first-window 
(selected-frame))))
+                         folder-buffer)
+            (delete-other-windows))
+          (mh-goto-cur-msg t)
+          (mh-funcall-if-exists deactivate-mark)
+          (unwind-protect
+              (prog1 (call-interactively (function ,original-function))
+                (setq normal-exit t))
+            (mh-funcall-if-exists deactivate-mark)
+            (when (eq major-mode 'mh-folder-mode)
+              (mh-funcall-if-exists hl-line-highlight))
+            (cond ((not normal-exit)
+                   (set-window-configuration config))
+                  ,(if dont-return
+                       `(t (setq mh-previous-window-config config))
+                     `((and (get-buffer cur-buffer-name)
+                            (window-live-p (get-buffer-window
+                                            (get-buffer cur-buffer-name))))
+                       (pop-to-buffer (get-buffer cur-buffer-name) nil)))))))))
+ 
+ ;;; Generate interactive functions for the show buffer from the corresponding
+ ;;; folder functions.
+ (mh-defun-show-buffer mh-show-previous-undeleted-msg
+                       mh-previous-undeleted-msg)
+ (mh-defun-show-buffer mh-show-next-undeleted-msg
+                       mh-next-undeleted-msg)
+ (mh-defun-show-buffer mh-show-quit mh-quit)
+ (mh-defun-show-buffer mh-show-delete-msg mh-delete-msg)
+ (mh-defun-show-buffer mh-show-refile-msg mh-refile-msg)
+ (mh-defun-show-buffer mh-show-undo mh-undo)
+ (mh-defun-show-buffer mh-show-execute-commands mh-execute-commands)
+ (mh-defun-show-buffer mh-show-reply mh-reply t)
+ (mh-defun-show-buffer mh-show-redistribute mh-redistribute)
+ (mh-defun-show-buffer mh-show-forward mh-forward t)
+ (mh-defun-show-buffer mh-show-header-display mh-header-display)
+ (mh-defun-show-buffer mh-show-refile-or-write-again
+                       mh-refile-or-write-again)
+ (mh-defun-show-buffer mh-show-show mh-show)
+ (mh-defun-show-buffer mh-show-write-message-to-file
+                       mh-write-msg-to-file)
+ (mh-defun-show-buffer mh-show-extract-rejected-mail
+                       mh-extract-rejected-mail t)
+ (mh-defun-show-buffer mh-show-delete-msg-no-motion
+                       mh-delete-msg-no-motion)
+ (mh-defun-show-buffer mh-show-first-msg mh-first-msg)
+ (mh-defun-show-buffer mh-show-last-msg mh-last-msg)
+ (mh-defun-show-buffer mh-show-copy-msg mh-copy-msg)
+ (mh-defun-show-buffer mh-show-edit-again mh-edit-again t)
+ (mh-defun-show-buffer mh-show-goto-msg mh-goto-msg)
+ (mh-defun-show-buffer mh-show-inc-folder mh-inc-folder)
+ (mh-defun-show-buffer mh-show-delete-subject-or-thread
+                       mh-delete-subject-or-thread)
+ (mh-defun-show-buffer mh-show-delete-subject mh-delete-subject)
+ (mh-defun-show-buffer mh-show-print-msg mh-print-msg)
+ (mh-defun-show-buffer mh-show-send mh-send t)
+ (mh-defun-show-buffer mh-show-toggle-showing mh-toggle-showing t)
+ (mh-defun-show-buffer mh-show-pipe-msg mh-pipe-msg t)
+ (mh-defun-show-buffer mh-show-sort-folder mh-sort-folder)
+ (mh-defun-show-buffer mh-show-visit-folder mh-visit-folder t)
+ (mh-defun-show-buffer mh-show-rescan-folder mh-rescan-folder)
+ (mh-defun-show-buffer mh-show-pack-folder mh-pack-folder)
+ (mh-defun-show-buffer mh-show-kill-folder mh-kill-folder t)
+ (mh-defun-show-buffer mh-show-list-folders mh-list-folders t)
+ (mh-defun-show-buffer mh-show-search-folder mh-search-folder t)
+ (mh-defun-show-buffer mh-show-undo-folder mh-undo-folder)
+ (mh-defun-show-buffer mh-show-delete-msg-from-seq
+                       mh-delete-msg-from-seq)
+ (mh-defun-show-buffer mh-show-delete-seq mh-delete-seq)
+ (mh-defun-show-buffer mh-show-list-sequences mh-list-sequences)
+ (mh-defun-show-buffer mh-show-narrow-to-seq mh-narrow-to-seq)
+ (mh-defun-show-buffer mh-show-put-msg-in-seq mh-put-msg-in-seq)
+ (mh-defun-show-buffer mh-show-msg-is-in-seq mh-msg-is-in-seq)
+ (mh-defun-show-buffer mh-show-widen mh-widen)
+ (mh-defun-show-buffer mh-show-narrow-to-subject mh-narrow-to-subject)
+ (mh-defun-show-buffer mh-show-narrow-to-from mh-narrow-to-from)
+ (mh-defun-show-buffer mh-show-narrow-to-cc mh-narrow-to-cc)
+ (mh-defun-show-buffer mh-show-narrow-to-range mh-narrow-to-range)
+ (mh-defun-show-buffer mh-show-narrow-to-to mh-narrow-to-to)
+ (mh-defun-show-buffer mh-show-store-msg mh-store-msg)
+ (mh-defun-show-buffer mh-show-page-digest mh-page-digest)
+ (mh-defun-show-buffer mh-show-page-digest-backwards
+                       mh-page-digest-backwards)
+ (mh-defun-show-buffer mh-show-burst-digest mh-burst-digest)
+ (mh-defun-show-buffer mh-show-page-msg mh-page-msg)
+ (mh-defun-show-buffer mh-show-previous-page mh-previous-page)
+ (mh-defun-show-buffer mh-show-modify mh-modify t)
+ (mh-defun-show-buffer mh-show-next-button mh-next-button)
+ (mh-defun-show-buffer mh-show-prev-button mh-prev-button)
+ (mh-defun-show-buffer mh-show-toggle-mime-part mh-folder-toggle-mime-part)
+ (mh-defun-show-buffer mh-show-save-mime-part mh-folder-save-mime-part)
+ (mh-defun-show-buffer mh-show-inline-mime-part mh-folder-inline-mime-part)
+ (mh-defun-show-buffer mh-show-toggle-threads mh-toggle-threads)
+ (mh-defun-show-buffer mh-show-thread-delete mh-thread-delete)
+ (mh-defun-show-buffer mh-show-thread-refile mh-thread-refile)
+ (mh-defun-show-buffer mh-show-update-sequences mh-update-sequences)
+ (mh-defun-show-buffer mh-show-next-unread-msg mh-next-unread-msg)
+ (mh-defun-show-buffer mh-show-previous-unread-msg mh-previous-unread-msg)
+ (mh-defun-show-buffer mh-show-thread-ancestor mh-thread-ancestor)
+ (mh-defun-show-buffer mh-show-thread-next-sibling mh-thread-next-sibling)
+ (mh-defun-show-buffer mh-show-thread-previous-sibling
+                       mh-thread-previous-sibling)
+ (mh-defun-show-buffer mh-show-index-visit-folder mh-index-visit-folder t)
+ (mh-defun-show-buffer mh-show-toggle-tick mh-toggle-tick)
+ (mh-defun-show-buffer mh-show-narrow-to-tick mh-narrow-to-tick)
+ (mh-defun-show-buffer mh-show-junk-blacklist mh-junk-blacklist)
+ (mh-defun-show-buffer mh-show-junk-whitelist mh-junk-whitelist)
+ (mh-defun-show-buffer mh-show-index-new-messages mh-index-new-messages)
+ (mh-defun-show-buffer mh-show-index-ticked-messages mh-index-ticked-messages)
+ (mh-defun-show-buffer mh-show-index-sequenced-messages
+                       mh-index-sequenced-messages)
+ (mh-defun-show-buffer mh-show-catchup mh-catchup)
+ (mh-defun-show-buffer mh-show-ps-print-toggle-mime mh-ps-print-toggle-mime)
+ (mh-defun-show-buffer mh-show-ps-print-toggle-color mh-ps-print-toggle-color)
+ (mh-defun-show-buffer mh-show-ps-print-toggle-faces mh-ps-print-toggle-faces)
+ (mh-defun-show-buffer mh-show-ps-print-msg-file mh-ps-print-msg-file)
+ (mh-defun-show-buffer mh-show-ps-print-msg mh-ps-print-msg)
+ (mh-defun-show-buffer mh-show-ps-print-msg-show mh-ps-print-msg-show)
+ (mh-defun-show-buffer mh-show-toggle-mime-buttons mh-toggle-mime-buttons)
+ (mh-defun-show-buffer mh-show-display-with-external-viewer
+                       mh-display-with-external-viewer)
+ 
+ ;;; Populate mh-show-mode-map
+ (gnus-define-keys mh-show-mode-map
+   " "    mh-show-page-msg
+   "!"    mh-show-refile-or-write-again
+   "'"    mh-show-toggle-tick
+   ","    mh-show-header-display
+   "."    mh-show-show
+   ">"    mh-show-write-message-to-file
+   "?"    mh-help
+   "E"    mh-show-extract-rejected-mail
+   "M"    mh-show-modify
+   "\177" mh-show-previous-page
+   "\C-d" mh-show-delete-msg-no-motion
+   "\t"   mh-show-next-button
+   [backtab] mh-show-prev-button
+   "\M-\t" mh-show-prev-button
+   "\ed"  mh-show-redistribute
+   "^"    mh-show-refile-msg
+   "c"    mh-show-copy-msg
+   "d"    mh-show-delete-msg
+   "e"    mh-show-edit-again
+   "f"    mh-show-forward
+   "g"    mh-show-goto-msg
+   "i"    mh-show-inc-folder
+   "k"    mh-show-delete-subject-or-thread
+   "m"    mh-show-send
+   "n"    mh-show-next-undeleted-msg
+   "\M-n" mh-show-next-unread-msg
+   "o"    mh-show-refile-msg
+   "p"    mh-show-previous-undeleted-msg
+   "\M-p" mh-show-previous-unread-msg
+   "q"    mh-show-quit
+   "r"    mh-show-reply
+   "s"    mh-show-send
+   "t"    mh-show-toggle-showing
+   "u"    mh-show-undo
+   "x"    mh-show-execute-commands
+   "v"    mh-show-index-visit-folder
+   "|"    mh-show-pipe-msg)
+ 
+ (gnus-define-keys (mh-show-folder-map "F" mh-show-mode-map)
+   "?"    mh-prefix-help
+   "'"    mh-index-ticked-messages
+   "S"    mh-show-sort-folder
+   "c"    mh-show-catchup
+   "f"    mh-show-visit-folder
+   "i"    mh-index-search
+   "k"    mh-show-kill-folder
+   "l"    mh-show-list-folders
+   "n"    mh-index-new-messages
+   "o"    mh-show-visit-folder
+   "q"    mh-show-index-sequenced-messages
+   "r"    mh-show-rescan-folder
+   "s"    mh-show-search-folder
+   "t"    mh-show-toggle-threads
+   "u"    mh-show-undo-folder
+   "v"    mh-show-visit-folder)
+ 
+ (gnus-define-keys (mh-show-sequence-map "S" mh-show-mode-map)
+   "'"    mh-show-narrow-to-tick
+   "?"    mh-prefix-help
+   "d"    mh-show-delete-msg-from-seq
+   "k"    mh-show-delete-seq
+   "l"    mh-show-list-sequences
+   "n"    mh-show-narrow-to-seq
+   "p"    mh-show-put-msg-in-seq
+   "s"    mh-show-msg-is-in-seq
+   "w"    mh-show-widen)
+ 
+ (define-key mh-show-mode-map "I" mh-inc-spool-map)
+ 
+ (gnus-define-keys (mh-show-junk-map "J" mh-show-mode-map)
+   "?"    mh-prefix-help
+   "b"    mh-show-junk-blacklist
+   "w"    mh-show-junk-whitelist)
+ 
+ (gnus-define-keys (mh-show-ps-print-map "P" mh-show-mode-map)
+   "?" mh-prefix-help
+   "A" mh-show-ps-print-toggle-mime
+   "C" mh-show-ps-print-toggle-color
+   "F" mh-show-ps-print-toggle-faces
+   "M" mh-show-ps-print-toggle-mime
+   "f" mh-show-ps-print-msg-file
+   "l"   mh-show-print-msg
+   "p" mh-show-ps-print-msg
+   "s" mh-show-ps-print-msg-show)
+ 
+ (gnus-define-keys (mh-show-thread-map "T" mh-show-mode-map)
+   "?"    mh-prefix-help
+   "u"    mh-show-thread-ancestor
+   "p"    mh-show-thread-previous-sibling
+   "n"    mh-show-thread-next-sibling
+   "t"    mh-show-toggle-threads
+   "d"    mh-show-thread-delete
+   "o"    mh-show-thread-refile)
+ 
+ (gnus-define-keys (mh-show-limit-map "/" mh-show-mode-map)
+   "'"    mh-show-narrow-to-tick
+   "?"    mh-prefix-help
+   "c"    mh-show-narrow-to-cc
+   "f"    mh-show-narrow-to-from
+   "r"    mh-show-narrow-to-range
+   "s"    mh-show-narrow-to-subject
+   "t"    mh-show-narrow-to-to
+   "w"    mh-show-widen)
+ 
+ (gnus-define-keys (mh-show-extract-map "X" mh-show-mode-map)
+   "?"    mh-prefix-help
+   "s"    mh-show-store-msg
+   "u"    mh-show-store-msg)
+ 
+ ;; Untested...
+ (gnus-define-keys (mh-show-digest-map "D" mh-show-mode-map)
+   "?"    mh-prefix-help
+   " "    mh-show-page-digest
+   "\177" mh-show-page-digest-backwards
+   "b"    mh-show-burst-digest)
+ 
+ (gnus-define-keys (mh-show-mime-map "K" mh-show-mode-map)
+   "?"           mh-prefix-help
+   "a"           mh-mime-save-parts
+   "e"           mh-show-display-with-external-viewer
+   "v"           mh-show-toggle-mime-part
+   "o"           mh-show-save-mime-part
+   "i"           mh-show-inline-mime-part
+   "t"           mh-show-toggle-mime-buttons
+   "\t"          mh-show-next-button
+   [backtab]     mh-show-prev-button
+   "\M-\t"       mh-show-prev-button)
+ 
+ (easy-menu-define
+   mh-show-sequence-menu mh-show-mode-map "Menu for MH-E folder-sequence."
+   '("Sequence"
+     ["Add Message to Sequence..."       mh-show-put-msg-in-seq t]
+     ["List Sequences for Message"       mh-show-msg-is-in-seq t]
+     ["Delete Message from Sequence..."  mh-show-delete-msg-from-seq t]
+     ["List Sequences in Folder..."      mh-show-list-sequences t]
+     ["Delete Sequence..."               mh-show-delete-seq t]
+     ["Narrow to Sequence..."            mh-show-narrow-to-seq t]
+     ["Widen from Sequence"              mh-show-widen t]
+     "--"
+     ["Narrow to Subject Sequence"       mh-show-narrow-to-subject t]
+     ["Narrow to Tick Sequence"          mh-show-narrow-to-tick
+      (save-excursion
+        (set-buffer mh-show-folder-buffer)
+        (and mh-tick-seq (mh-seq-msgs (mh-find-seq mh-tick-seq))))]
+     ["Delete Rest of Same Subject"      mh-show-delete-subject t]
+     ["Toggle Tick Mark"                 mh-show-toggle-tick t]
+     "--"
+     ["Push State Out to MH"             mh-show-update-sequences t]))
+ 
+ (easy-menu-define
+   mh-show-message-menu mh-show-mode-map "Menu for MH-E folder-message."
+   '("Message"
+     ["Show Message"                     mh-show-show t]
+     ["Show Message with Header"         mh-show-header-display t]
+     ["Next Message"                     mh-show-next-undeleted-msg t]
+     ["Previous Message"                 mh-show-previous-undeleted-msg t]
+     ["Go to First Message"              mh-show-first-msg t]
+     ["Go to Last Message"               mh-show-last-msg t]
+     ["Go to Message by Number..."       mh-show-goto-msg t]
+     ["Modify Message"                   mh-show-modify t]
+     ["Delete Message"                   mh-show-delete-msg t]
+     ["Refile Message"                   mh-show-refile-msg t]
+     ["Undo Delete/Refile"               mh-show-undo t]
+     ["Process Delete/Refile"            mh-show-execute-commands t]
+     "--"
+     ["Compose a New Message"            mh-send t]
+     ["Reply to Message..."              mh-show-reply t]
+     ["Forward Message..."               mh-show-forward t]
+     ["Redistribute Message..."          mh-show-redistribute t]
+     ["Edit Message Again"               mh-show-edit-again t]
+     ["Re-edit a Bounced Message"        mh-show-extract-rejected-mail t]
+     "--"
+     ["Copy Message to Folder..."        mh-show-copy-msg t]
+     ["Print Message"                    mh-show-print-msg t]
+     ["Write Message to File..."         mh-show-write-msg-to-file t]
+     ["Pipe Message to Command..."       mh-show-pipe-msg t]
+     ["Unpack Uuencoded Message..."      mh-show-store-msg t]
+     ["Burst Digest Message"             mh-show-burst-digest t]))
+ 
+ (easy-menu-define
+   mh-show-folder-menu mh-show-mode-map  "Menu for MH-E folder."
+   '("Folder"
+     ["Incorporate New Mail"             mh-show-inc-folder t]
+     ["Toggle Show/Folder"               mh-show-toggle-showing t]
+     ["Execute Delete/Refile"            mh-show-execute-commands t]
+     ["Rescan Folder"                    mh-show-rescan-folder t]
+     ["Thread Folder"                    mh-show-toggle-threads t]
+     ["Pack Folder"                      mh-show-pack-folder t]
+     ["Sort Folder"                      mh-show-sort-folder t]
+     "--"
+     ["List Folders"                     mh-show-list-folders t]
+     ["Visit a Folder..."                mh-show-visit-folder t]
+     ["View New Messages"                mh-show-index-new-messages t]
+     ["Search a Folder..."               mh-show-search-folder t]
+     ["Indexed Search..."                mh-index-search t]
+     "--"
+     ["Quit MH-E"                        mh-quit t]))
+ 
+ 
+ ;;; Ensure new buffers won't get this mode if default-major-mode is nil.
+ (put 'mh-show-mode 'mode-class 'special)
+ 
+ ;; Avoid compiler warnings in XEmacs and Emacs 20
+ (eval-when-compile
+   (defvar tool-bar-mode)
+   (defvar tool-bar-map))
+ 
+ (define-derived-mode mh-show-mode text-mode "MH-Show"
+   "Major mode for showing messages in MH-E.\\<mh-show-mode-map>
+ The value of `mh-show-mode-hook' is a list of functions to
+ be called, with no arguments, upon entry to this mode.
+ See also `mh-folder-mode'.
+ 
+ \\{mh-show-mode-map}"
+   (set (make-local-variable 'mail-header-separator) mh-mail-header-separator)
+   (setq paragraph-start (default-value 'paragraph-start))
+   (mh-show-unquote-From)
+   (mh-show-xface)
+   (mh-show-addr)
+   (setq buffer-invisibility-spec '((vanish . t) t))
+   (set (make-local-variable 'line-move-ignore-invisible) t)
+   (make-local-variable 'font-lock-defaults)
+   ;;(set (make-local-variable 'font-lock-support-mode) nil)
+   (cond
+    ((equal mh-highlight-citation-p 'font-lock)
+     (setq font-lock-defaults '(mh-show-font-lock-keywords-with-cite t)))
+    ((equal mh-highlight-citation-p 'gnus)
+     (setq font-lock-defaults '((mh-show-font-lock-keywords)
+                                t nil nil nil
+                                (font-lock-fontify-region-function
+                                 . mh-show-font-lock-fontify-region)))
+     (mh-gnus-article-highlight-citation))
+    (t
+     (setq font-lock-defaults '(mh-show-font-lock-keywords t))))
+   (if (and mh-xemacs-flag
+            font-lock-auto-fontify)
+       (turn-on-font-lock))
+   (set (make-local-variable 'tool-bar-map) mh-show-tool-bar-map)
+   (mh-funcall-if-exists mh-toolbar-init :show)
+   (when mh-decode-mime-flag
+     (mh-make-local-hook 'kill-buffer-hook)
+     (add-hook 'kill-buffer-hook 'mh-mime-cleanup nil t))
+   (easy-menu-add mh-show-sequence-menu)
+   (easy-menu-add mh-show-message-menu)
+   (easy-menu-add mh-show-folder-menu)
+   (make-local-variable 'mh-show-folder-buffer)
+   (buffer-disable-undo)
+   (setq buffer-read-only t)
+   (use-local-map mh-show-mode-map)
+   (run-hooks 'mh-show-mode-hook))
+ 
+ (defun mh-show-addr ()
+   "Use `goto-address'."
+   (when mh-show-use-goto-addr-flag
+     (if (not (featurep 'goto-addr))
+         (load "goto-addr" t t))
+     (if (fboundp 'goto-address)
+         (goto-address))))
+ 
+ 
+ 
+ ;; X-Face and Face display
+ (defvar mh-show-xface-function
+   (cond ((and mh-xemacs-flag (locate-library "x-face") (not (featurep 
'xface)))
+          (load "x-face" t t)
+          #'mh-face-display-function)
+         ((>= emacs-major-version 21)
+          #'mh-face-display-function)
+         (t #'ignore))
+   "Determine at run time what function should be called to display X-Face.")
+ 
+ (defvar mh-uncompface-executable
+   (and (fboundp 'executable-find) (executable-find "uncompface")))
+ 
+ (defun mh-face-to-png (data)
+   "Convert base64 encoded DATA to png image."
+   (with-temp-buffer
+     (insert data)
+     (ignore-errors (base64-decode-region (point-min) (point-max)))
+     (buffer-string)))
+ 
+ (defun mh-uncompface (data)
+   "Run DATA through `uncompface' to generate bitmap."
+   (with-temp-buffer
+     (insert data)
+     (when (and mh-uncompface-executable
+                (equal (call-process-region (point-min) (point-max)
+                                            mh-uncompface-executable t '(t 
nil))
+                       0))
+       (mh-icontopbm)
+       (buffer-string))))
+ 
+ (defun mh-icontopbm ()
+   "Elisp substitute for `icontopbm'."
+   (goto-char (point-min))
+   (let ((end (point-max)))
+     (while (re-search-forward "0x\\(..\\)\\(..\\)," nil t)
+       (save-excursion
+         (goto-char (point-max))
+         (insert (string-to-number (match-string 1) 16))
+         (insert (string-to-number (match-string 2) 16))))
+     (delete-region (point-min) end)
+     (goto-char (point-min))
+     (insert "P4\n48 48\n")))
+ 
+ (mh-do-in-xemacs (defvar default-enable-multibyte-characters))
+ 
+ (defun mh-face-display-function ()
+   "Display a Face, X-Face, or X-Image-URL header field.
+ If more than one of these are present, then the first one found in this order
+ is used."
+   (save-restriction
+     (goto-char (point-min))
+     (re-search-forward "\n\n" (point-max) t)
+     (narrow-to-region (point-min) (point))
+     (let* ((case-fold-search t)
+            (default-enable-multibyte-characters nil)
+            (face (message-fetch-field "face" t))
+            (x-face (message-fetch-field "x-face" t))
+            (url (message-fetch-field "x-image-url" t))
+            raw type)
+       (cond (face (setq raw (mh-face-to-png face)
+                         type 'png))
+             (x-face (setq raw (mh-uncompface x-face)
+                           type 'pbm))
+             (url (setq type 'url))
+             (t (multiple-value-setq (type raw) (mh-picon-get-image))))
+       (when type
+         (goto-char (point-min))
+         (when (re-search-forward "^from:" (point-max) t)
+           ;; GNU Emacs
+           (mh-do-in-gnu-emacs
+             (if (eq type 'url)
+                 (mh-x-image-url-display url)
+               (mh-funcall-if-exists
+                insert-image (create-image
+                              raw type t
+                              :foreground (face-foreground 'mh-show-xface-face)
+                              :background (face-background 
'mh-show-xface-face))
+                             " ")))
+           ;; XEmacs
+           (mh-do-in-xemacs
+             (cond
+              ((eq type 'url)
+               (mh-x-image-url-display url))
+              ((eq type 'png)
+               (when (featurep 'png)
+                 (set-extent-begin-glyph
+                  (make-extent (point) (point))
+                  (make-glyph (vector 'png ':data (mh-face-to-png face))))))
+              ;; Try internal xface support if available...
+              ((and (eq type 'pbm) (featurep 'xface))
+               (set-glyph-face
+                (set-extent-begin-glyph
+                 (make-extent (point) (point))
+                 (make-glyph (vector 'xface ':data (concat "X-Face: " 
x-face))))
+                'mh-show-xface-face))
+              ;; Otherwise try external support with x-face...
+              ((and (eq type 'pbm)
+                    (fboundp 'x-face-xmas-wl-display-x-face)
+                    (fboundp 'executable-find) (executable-find "uncompface"))
+               (mh-funcall-if-exists x-face-xmas-wl-display-x-face))
+              ;; Picon display
+              ((and raw (member type '(xpm xbm gif)))
+               (when (featurep type)
+                 (set-extent-begin-glyph
+                  (make-extent (point) (point))
+                  (make-glyph (vector type ':data raw))))))
+             (when raw (insert " "))))))))
+ 
+ (defun mh-show-xface ()
+   "Display X-Face."
+   (when (and window-system mh-show-use-xface-flag
+              (or mh-decode-mime-flag mhl-formfile
+                  mh-clean-message-header-flag))
+     (funcall mh-show-xface-function)))
+ 
+ 
+ 
+ ;; Picon display
+ 
+ ;;; XXX: This should be customizable. As a side-effect of setting this
+ ;;;   variable, arrange to reset mh-picon-existing-directory-list to 'unset.
+ (defvar mh-picon-directory-list
+   '("~/.picons" "~/.picons/users" "~/.picons/usenix" "~/.picons/news"
+     "~/.picons/domains" "~/.picons/misc"
+     "/usr/share/picons/" "/usr/share/picons/users" "/usr/share/picons/usenix"
+     "/usr/share/picons/news" "/usr/share/picons/domains"
+     "/usr/share/picons/misc")
+   "List of directories where picons reside.
+ The directories are searched for in the order they appear in the list.")
+ 
+ (defvar mh-picon-existing-directory-list 'unset
+   "List of directories to search in.")
+ 
+ (defvar mh-picon-cache (make-hash-table :test #'equal))
+ 
+ (defvar mh-picon-image-types
+   (loop for type in '(xpm xbm gif)
+         when (or (mh-do-in-gnu-emacs
+                    (ignore-errors
+                      (mh-funcall-if-exists image-type-available-p type)))
+                  (mh-do-in-xemacs (featurep type)))
+         collect type))
+ 
+ (defun mh-picon-set-directory-list ()
+   "Update `mh-picon-existing-directory-list' if needed."
+   (when (eq mh-picon-existing-directory-list 'unset)
+     (setq mh-picon-existing-directory-list
+           (loop for x in mh-picon-directory-list
+                 when (file-directory-p x) collect x))))
+ 
+ (defun* mh-picon-get-image ()
+   "Find the best possible match and return contents."
+   (mh-picon-set-directory-list)
+   (save-restriction
+     (let* ((from-field (ignore-errors (car (message-tokenize-header
+                                             (mh-get-header-field "from:")))))
+            (from (car (ignore-errors
+                         (mh-funcall-if-exists ietf-drums-parse-address
+                                               from-field))))
+            (host (and from
+                       (string-match 
"\\([^+]*\\)\\(+.*\\)address@hidden(.*\\)" from)
+                       (downcase (match-string 3 from))))
+            (user (and host (downcase (match-string 1 from))))
+            (canonical-address (format "address@hidden" user host))
+            (cached-value (gethash canonical-address mh-picon-cache))
+            (host-list (and host (delete "" (split-string host "\\."))))
+            (match nil))
+       (cond (cached-value (return-from mh-picon-get-image cached-value))
+             ((not host-list) (return-from mh-picon-get-image nil)))
+       (setq match
+             (block 'loop
+               ;; address@hidden search
+               (loop for dir in mh-picon-existing-directory-list
+                     do (loop for type in mh-picon-image-types
+                              ;; address@hidden
+                              for file1 = (format "%s/%s.%s"
+                                                  dir canonical-address type)
+                              when (file-exists-p file1)
+                              do (return-from 'loop file1)
+                              ;; [path]user
+                              for file2 = (format "%s/%s.%s" dir user type)
+                              when (file-exists-p file2)
+                              do (return-from 'loop file2)
+                              ;; [path]host
+                              for file3 = (format "%s/%s.%s" dir host type)
+                              when (file-exists-p file3)
+                              do (return-from 'loop file3)))
+               ;; facedb search
+               ;; Search order for address@hidden:
+               ;;   [path]net/foo/user
+               ;;   [path]net/foo/user/face
+               ;;   [path]net/user
+               ;;   [path]net/user/face
+               ;;   [path]net/foo/unknown
+               ;;   [path]net/foo/unknown/face
+               ;;   [path]net/unknown
+               ;;   [path]net/unknown/face
+               (loop for u in (list user "unknown")
+                     do (loop for dir in mh-picon-existing-directory-list
+                              do (loop for x on host-list by #'cdr
+                                       for y = (mh-picon-generate-path x u dir)
+                                       do (loop for type in 
mh-picon-image-types
+                                                for z1 = (format "%s.%s" y 
type)
+                                                when (file-exists-p z1)
+                                                do (return-from 'loop z1)
+                                                for z2 = (format "%s/face.%s"
+                                                                 y type)
+                                                when (file-exists-p z2)
+                                                do (return-from 'loop z2)))))))
+       (setf (gethash canonical-address mh-picon-cache)
+             (mh-picon-file-contents match)))))
+ 
+ (defun mh-picon-file-contents (file)
+   "Return details about FILE.
+ A list of consisting of a symbol for the type of the file and the file
+ contents as a string is returned. If FILE is nil, then both elements of the
+ list are nil."
+   (if (stringp file)
+       (with-temp-buffer
+         (let ((type (and (string-match ".*\\.\\(...\\)$" file)
+                          (intern (match-string 1 file)))))
+           (insert-file-contents-literally file)
+           (values type (buffer-string))))
+     (values nil nil)))
+ 
+ (defun mh-picon-generate-path (host-list user directory)
+   "Generate the image file path.
+ HOST-LIST is the parsed host address of the email address, USER the username
+ and DIRECTORY is the directory relative to which the path is generated."
+   (loop with acc = ""
+         for elem in host-list
+         do (setq acc (format "%s/%s" elem acc))
+         finally return (format "%s/%s%s" directory acc user)))
+ 
+ 
+ 
+ ;; X-Image-URL display
+ 
+ (defvar mh-x-image-cache-directory nil
+   "Directory where X-Image-URL images are cached.")
+ (defvar mh-x-image-scaling-function
+   (cond ((executable-find "convert")
+          'mh-x-image-scale-with-convert)
+         ((and (executable-find "anytopnm") (executable-find "pnmscale")
+               (executable-find "pnmtopng"))
+          'mh-x-image-scale-with-pnm)
+         (t 'ignore))
+   "Function to use to scale image to proper size.")
+ (defvar mh-wget-executable nil)
+ (defvar mh-wget-choice
+   (or (and (setq mh-wget-executable (executable-find "wget")) 'wget)
+       (and (setq mh-wget-executable (executable-find "fetch")) 'fetch)
+       (and (setq mh-wget-executable (executable-find "curl")) 'curl)))
+ (defvar mh-wget-option
+   (cdr (assoc mh-wget-choice '((curl . "-o") (fetch . "-o") (wget . "-O")))))
+ (defvar mh-x-image-temp-file nil)
+ (defvar mh-x-image-url nil)
+ (defvar mh-x-image-marker nil)
+ (defvar mh-x-image-url-cache-file nil)
+ 
+ ;; Functions to scale image to proper size
+ (defun mh-x-image-scale-with-pnm (input output)
+   "Scale image in INPUT file and write to OUTPUT file using pnm tools."
+   (let ((res (shell-command-to-string
+               (format "anytopnm < %s | pnmscale -xysize 96 48 | pnmtopng > %s"
+                       input output))))
+     (unless (equal res "")
+       (delete-file output))))
+ 
+ (defun mh-x-image-scale-with-convert (input output)
+   "Scale image in INPUT file and write to OUTPUT file using ImageMagick."
+   (call-process "convert" nil nil nil "-geometry" "96x48" input output))
+ 
+ (defun mh-x-image-url-cache-canonicalize (url)
+   "Canonicalize URL.
+ Replace the ?/ character with a ?! character and append .png."
+    (format "%s/%s.png" mh-x-image-cache-directory
+            (with-temp-buffer
+              (insert url)
+              (mh-replace-string "/" "!")
+              (buffer-string))))
+ 
+ (defun mh-x-image-set-download-state (file data)
+   "Setup a symbolic link from FILE to DATA."
+   (if data
+       (make-symbolic-link (symbol-name data) file t)
+     (delete-file file)))
+ 
+ (defun mh-x-image-get-download-state (file)
+   "Check the state of FILE by following any symbolic links."
+   (unless (file-exists-p mh-x-image-cache-directory)
+     (call-process "mkdir" nil nil nil mh-x-image-cache-directory))
+   (cond ((file-symlink-p file)
+          (intern (file-name-nondirectory (file-chase-links file))))
+         ((not (file-exists-p file)) nil)
+         (t 'ok)))
+ 
+ (defun mh-x-image-url-fetch-image (url cache-file marker sentinel)
+   "Fetch and display the image specified by URL.
+ After the image is fetched, it is stored in CACHE-FILE. It will be displayed
+ in a buffer and position specified by MARKER. The actual display is carried
+ out by the SENTINEL function."
+   (if mh-wget-executable
+       (let ((buffer (get-buffer-create (generate-new-buffer-name
+                                         mh-temp-fetch-buffer)))
+             (filename (or (mh-funcall-if-exists make-temp-file "mhe-fetch")
+                           (expand-file-name (make-temp-name "~/mhe-fetch")))))
+         (save-excursion
+           (set-buffer buffer)
+           (set (make-local-variable 'mh-x-image-url-cache-file) cache-file)
+           (set (make-local-variable 'mh-x-image-marker) marker)
+           (set (make-local-variable 'mh-x-image-temp-file) filename))
+         (set-process-sentinel
+          (start-process "*mh-x-image-url-fetch*" buffer
+                         mh-wget-executable mh-wget-option filename url)
+          sentinel))
+     ;; Temporary failure
+     (mh-x-image-set-download-state cache-file 'try-again)))
+ 
+ (defun mh-x-image-display (image marker)
+   "Display IMAGE at MARKER."
+   (save-excursion
+     (set-buffer (marker-buffer marker))
+     (let ((buffer-read-only nil)
+           (default-enable-multibyte-characters nil)
+           (buffer-modified-flag (buffer-modified-p)))
+       (unwind-protect
+           (when (and (file-readable-p image) (not (file-symlink-p image))
+                      (eq marker mh-x-image-marker))
+             (goto-char marker)
+             (mh-do-in-gnu-emacs
+               (mh-funcall-if-exists insert-image (create-image image 'png)))
+             (mh-do-in-xemacs
+               (when (featurep 'png)
+                 (set-extent-begin-glyph
+                  (make-extent (point) (point))
+                  (make-glyph
+                   (vector 'png ':data (with-temp-buffer
+                                         (insert-file-contents-literally image)
+                                         (buffer-string))))))))
+         (set-buffer-modified-p buffer-modified-flag)))))
+ 
+ (defun mh-x-image-scale-and-display (process change)
+   "When the wget PROCESS terminates scale and display image.
+ The argument CHANGE is ignored."
+   (when (eq (process-status process) 'exit)
+     (let (marker temp-file cache-filename wget-buffer)
+       (save-excursion
+         (set-buffer (setq wget-buffer (process-buffer process)))
+         (setq marker mh-x-image-marker
+               cache-filename mh-x-image-url-cache-file
+               temp-file mh-x-image-temp-file))
+       (cond
+        ;; Check if we have `convert'
+        ((eq mh-x-image-scaling-function 'ignore)
+         (message "The `convert' program is needed to display X-Image-URL")
+         (mh-x-image-set-download-state cache-filename 'try-again))
+        ;; Scale fetched image
+        ((and (funcall mh-x-image-scaling-function temp-file cache-filename)
+              nil))
+        ;; Attempt to display image if we have it
+        ((file-exists-p cache-filename)
+         (mh-x-image-display cache-filename marker))
+        ;; We didn't find the image. Should we try to display it the next time?
+        (t (mh-x-image-set-download-state cache-filename 'try-again)))
+       (ignore-errors
+         (set-marker marker nil)
+         (delete-process process)
+         (kill-buffer wget-buffer)
+         (delete-file temp-file)))))
+ 
+ (defun mh-x-image-url-sane-p (url)
+   "Check if URL is something sensible."
+   (let ((len (length url)))
+     (cond ((< len 5) nil)
+           ((not (equal (substring url 0 5) "http:")) nil)
+           ((> len 100) nil)
+           (t t))))
+ 
+ (defun mh-x-image-url-display (url)
+   "Display image from location URL.
+ If the URL isn't present in the cache then it is fetched with wget."
+   (let* ((cache-filename (mh-x-image-url-cache-canonicalize url))
+          (state (mh-x-image-get-download-state cache-filename))
+          (marker (set-marker (make-marker) (point))))
+     (set (make-local-variable 'mh-x-image-marker) marker)
+     (cond ((not (mh-x-image-url-sane-p url)))
+           ((eq state 'ok)
+            (mh-x-image-display cache-filename marker))
+           ((or (not mh-wget-executable)
+                (eq mh-x-image-scaling-function 'ignore)))
+           ((eq state 'never))
+           ((not mh-fetch-x-image-url)
+            (set-marker marker nil))
+           ((eq state 'try-again)
+            (mh-x-image-set-download-state cache-filename nil)
+            (mh-x-image-url-fetch-image url cache-filename marker
+                                        'mh-x-image-scale-and-display))
+           ((and (eq mh-fetch-x-image-url 'ask)
+                 (not (y-or-n-p (format "Fetch %s? " url))))
+            (mh-x-image-set-download-state cache-filename 'never))
+           ((eq state nil)
+            (mh-x-image-url-fetch-image url cache-filename marker
+                                        'mh-x-image-scale-and-display)))))
+ 
+ 
+ 
+ (defun mh-maybe-show (&optional msg)
+   "Display message at cursor, but only if in show mode.
+ If optional arg MSG is non-nil, display that message instead."
+   (if mh-showing-mode (mh-show msg)))
+ 
+ (defun mh-show (&optional message redisplay-flag)
+   "Show message at cursor.
+ If optional argument MESSAGE is non-nil, display that message instead.
+ Force a two-window display with the folder window on top (size given by the
+ variable `mh-summary-height') and the show buffer below it.
+ If the message is already visible, display the start of the message.
+ 
+ If REDISPLAY-FLAG is non-nil, the default when called interactively, the
+ message is redisplayed even if the show buffer was already displaying the
+ correct message.
+ 
+ Display of the message is controlled by setting the variables
+ `mh-clean-message-header-flag' and `mhl-formfile'.  The default behavior is
+ to scroll uninteresting headers off the top of the window.
+ Type \"\\[mh-header-display]\" to see the message with all its headers."
+   (interactive (list nil t))
+   (when (or redisplay-flag
+             (and mh-showing-with-headers
+                  (or mhl-formfile mh-clean-message-header-flag)))
+     (mh-invalidate-show-buffer))
+   (mh-show-msg message))
+ 
+ (defun mh-show-mouse (event)
+   "Move point to mouse EVENT and show message."
+   (interactive "e")
+   (mouse-set-point event)
+   (mh-show))
+ 
+ (defun mh-summary-height ()
+   "Return ideal value for the variable `mh-summary-height'.
+ The current frame height is taken into consideration."
+   (or (and (fboundp 'frame-height)
+            (> (frame-height) 24)
+            (min 10 (/ (frame-height) 6)))
+       4))
+ 
+ (defun mh-show-msg (msg)
+   "Show MSG.
+ The value of `mh-show-hook' is a list of functions to be called, with no
+ arguments, after the message has been displayed."
+   (if (not msg)
+       (setq msg (mh-get-msg-num t)))
+   (mh-showing-mode t)
+   (setq mh-page-to-next-msg-flag nil)
+   (let ((folder mh-current-folder)
+         (folders (list mh-current-folder))
+         (clean-message-header mh-clean-message-header-flag)
+         (show-window (get-buffer-window mh-show-buffer))
+         (display-mime-buttons-flag mh-display-buttons-for-inline-parts-flag))
+     (if (not (eq (next-window (minibuffer-window)) (selected-window)))
+         (delete-other-windows))         ; force ourself to the top window
+     (mh-in-show-buffer (mh-show-buffer)
+       (setq mh-display-buttons-for-inline-parts-flag 
display-mime-buttons-flag)
+       (if (and show-window
+                (equal (mh-msg-filename msg folder) buffer-file-name))
+           (progn                        ;just back up to start
+             (goto-char (point-min))
+             (if (not clean-message-header)
+                 (mh-start-of-uncleaned-message)))
+         (mh-display-msg msg folder)))
+     (if (not (= (1+ (window-height)) (frame-height))) ;not horizontally split
+         (shrink-window (- (window-height) (or mh-summary-height
+                                               (mh-summary-height)))))
+     (mh-recenter nil)
+     ;; The following line is a nop which forces update of the scan line so
+     ;; that font-lock will update it (if needed)...
+     (mh-notate nil nil mh-cmd-note)
+     (if (not (memq msg mh-seen-list))
+         (setq mh-seen-list (cons msg mh-seen-list)))
+     (when mh-update-sequences-after-mh-show-flag
+       (mh-update-sequences)
+       (when mh-index-data
+         (setq folders
+               (append (mh-index-delete-from-sequence mh-unseen-seq (list msg))
+                       folders)))
+       (when (mh-speed-flists-active-p)
+         (apply #'mh-speed-flists t folders)))
+     (run-hooks 'mh-show-hook)))
+ 
+ (defun mh-modify (&optional message)
+   "Edit message at cursor.
+ If optional argument MESSAGE is non-nil, edit that message instead.
+ Force a two-window display with the folder window on top (size given by the
+ value of the variable `mh-summary-height') and the message editing buffer 
below
+ it.
+ 
+ The message is displayed in raw form."
+   (interactive)
+   (let* ((message (or message (mh-get-msg-num t)))
+          (msg-filename (mh-msg-filename message))
+          edit-buffer)
+     (when (not (file-exists-p msg-filename))
+       (error "Message %d does not exist" message))
+ 
+     ;; Invalidate the show buffer if it is showing the same message that is
+     ;; to be edited.
+     (when (and (buffer-live-p (get-buffer mh-show-buffer))
+                (equal (save-excursion (set-buffer mh-show-buffer)
+                                       buffer-file-name)
+                       msg-filename))
+       (mh-invalidate-show-buffer))
+ 
+     ;; Edit message
+     (find-file msg-filename)
+     (setq edit-buffer (current-buffer))
+ 
+     ;; Set buffer properties
+     (mh-letter-mode)
+     (use-local-map text-mode-map)
+ 
+     ;; Just show the edit buffer...
+     (delete-other-windows)
+     (switch-to-buffer edit-buffer)))
+ 
+ (defun mh-show-unquote-From ()
+   "Decode >From at beginning of lines for `mh-show-mode'."
+   (save-excursion
+     (let ((modified (buffer-modified-p))
+           (case-fold-search nil))
+       (goto-char (mh-mail-header-end))
+       (while (re-search-forward "^>From" nil t)
+         (replace-match "From"))
+       (set-buffer-modified-p modified))))
+ 
+ (defun mh-msg-folder (folder-name)
+   "Return the name of the buffer for FOLDER-NAME."
+   folder-name)
+ 
+ (defun mh-display-msg (msg-num folder-name)
+   "Display MSG-NUM of FOLDER-NAME.
+ Sets the current buffer to the show buffer."
+   (let ((folder (mh-msg-folder folder-name)))
+     (set-buffer folder)
+     ;; When Gnus uses external displayers it has to keep handles longer. So
+     ;; we will delete these handles when mh-quit is called on the folder. It
+     ;; would be nicer if there are weak pointers in emacs lisp, then we could
+     ;; get the garbage collector to do this for us.
+     (unless (mh-buffer-data)
+       (setf (mh-buffer-data) (mh-make-buffer-data)))
+     ;; Bind variables in folder buffer in case they are local
+     (let ((formfile mhl-formfile)
+           (clean-message-header mh-clean-message-header-flag)
+           (invisible-headers mh-invisible-header-fields-compiled)
+           (visible-headers nil)
+           (msg-filename (mh-msg-filename msg-num folder-name))
+           (show-buffer mh-show-buffer)
+           (mm-inline-media-tests mh-mm-inline-media-tests))
+       (if (not (file-exists-p msg-filename))
+           (error "Message %d does not exist" msg-num))
+       (if (and (> mh-show-maximum-size 0)
+                (> (elt (file-attributes msg-filename) 7)
+                   mh-show-maximum-size)
+                (not (y-or-n-p
+                      (format
+                       "Message %d (%d bytes) exceeds %d bytes. Display it? "
+                       msg-num (elt (file-attributes msg-filename) 7)
+                       mh-show-maximum-size))))
+           (error "Message %d not displayed" msg-num))
+       (set-buffer show-buffer)
+       (cond ((not (equal msg-filename buffer-file-name))
+              (mh-unvisit-file)
+              (setq buffer-read-only nil)
+              (erase-buffer)
+              ;; Changing contents, so this hook needs to be reinitialized.
+              ;; pgp.el uses this.
+              (if (boundp 'write-contents-hooks) ;Emacs 19
+                  (kill-local-variable 'write-contents-hooks))
+              (if formfile
+                  (mh-exec-lib-cmd-output "mhl" "-nobell" "-noclear"
+                                          (if (stringp formfile)
+                                              (list "-form" formfile))
+                                          msg-filename)
+                (insert-file-contents-literally msg-filename))
+              ;; Cleanup old mime handles
+              (mh-mime-cleanup)
+              ;; Use mm to display buffer
+              (when (and mh-decode-mime-flag (not formfile))
+                (mh-add-missing-mime-version-header)
+                (setf (mh-buffer-data) (mh-make-buffer-data))
+                (mh-mime-display))
+              (mh-show-mode)
+              ;; Header cleanup
+              (goto-char (point-min))
+              (cond (clean-message-header
+                     (mh-clean-msg-header (point-min)
+                                          invisible-headers
+                                          visible-headers)
+                     (goto-char (point-min)))
+                    (t
+                     (mh-start-of-uncleaned-message)))
+              (mh-decode-message-header)
+              ;; the parts of visiting we want to do (no locking)
+              (or (eq buffer-undo-list t) ;don't save undo info for prev msgs
+                  (setq buffer-undo-list nil))
+              (set-buffer-auto-saved)
+              ;; the parts of set-visited-file-name we want to do (no locking)
+              (setq buffer-file-name msg-filename)
+              (setq buffer-backed-up nil)
+              (auto-save-mode 1)
+              (set-mark nil)
+              (unwind-protect
+                  (when (and mh-decode-mime-flag (not formfile))
+                    (setq buffer-read-only nil)
+                    (mh-display-smileys)
+                    (mh-display-emphasis))
+                (setq buffer-read-only t))
+              (set-buffer-modified-p nil)
+              (setq mh-show-folder-buffer folder)
+              (setq mode-line-buffer-identification
+                    (list (format mh-show-buffer-mode-line-buffer-id
+                                  folder-name msg-num)))
+              (mh-logo-display)
+              (set-buffer folder)
+              (setq mh-showing-with-headers nil))))))
+ 
+ (defun mh-clean-msg-header (start invisible-headers visible-headers)
+   "Flush extraneous lines in message header.
+ Header is cleaned from START to the end of the message header.
+ INVISIBLE-HEADERS contains a regular expression specifying lines to delete
+ from the header. VISIBLE-HEADERS contains a regular expression specifying the
+ lines to display. INVISIBLE-HEADERS is ignored if VISIBLE-HEADERS is non-nil.
+ 
+ Note that MH-E no longer supports the `mh-visible-headers' variable, so
+ this function could be trimmed of this feature too."
+   (let ((case-fold-search t)
+         (buffer-read-only nil)
+         (after-change-functions nil))   ;Work around emacs-20 font-lock bug
+                                         ;causing an endless loop.
+     (save-restriction
+       (goto-char start)
+       (if (search-forward "\n\n" nil 'move)
+           (backward-char 1))
+       (narrow-to-region start (point))
+       (goto-char (point-min))
+       (if visible-headers
+           (while (< (point) (point-max))
+             (cond ((looking-at visible-headers)
+                    (forward-line 1)
+                    (while (looking-at "[ \t]") (forward-line 1)))
+                   (t
+                    (mh-delete-line 1)
+                    (while (looking-at "[ \t]")
+                      (mh-delete-line 1)))))
+         (while (re-search-forward invisible-headers nil t)
+           (beginning-of-line)
+           (mh-delete-line 1)
+           (while (looking-at "[ \t]")
+             (mh-delete-line 1)))))
+     (let ((mh-compose-skipped-header-fields ()))
+       (mh-letter-hide-all-skipped-fields))
+     (unlock-buffer)))
+ 
+ (defun mh-delete-line (lines)
+   "Delete the next LINES lines."
+   (delete-region (point) (progn (forward-line lines) (point))))
+ 
+ (defun mh-notate (msg notation offset)
+   "Mark MSG with the character NOTATION at position OFFSET.
+ Null MSG means the message at cursor.
+ If NOTATION is nil then no change in the buffer occurs."
+   (save-excursion
+     (if (or (null msg)
+             (mh-goto-msg msg t t))
+         (with-mh-folder-updating (t)
+           (beginning-of-line)
+           (forward-char offset)
+           (let* ((change-stack-flag (and (equal offset (1+ mh-cmd-note))
+                                          (not (eq notation mh-note-seq))))
+                  (msg (and change-stack-flag (or msg (mh-get-msg-num nil))))
+                  (stack (and msg (gethash msg mh-sequence-notation-history)))
+                  (notation (or notation (char-after))))
+             (if stack
+                 ;; The presence of the stack tells us that we don't need to
+                 ;; notate the message, since the notation would be replaced
+                 ;; by a sequence notation. So we will just put the notation
+                 ;; at the bottom of the stack. If the sequence is deleted,
+                 ;; the correct notation will be shown.
+                 (setf (gethash msg mh-sequence-notation-history)
+                       (reverse (cons notation (cdr (reverse stack)))))
+               ;; Since we don't have any sequence notations in the way, just
+               ;; notate the scan line.
+               (delete-char 1)
+               (insert notation))
+             (when change-stack-flag
+               (mh-thread-update-scan-line-map msg notation offset)))))))
+ 
+ (defun mh-goto-msg (number &optional no-error-if-no-message dont-show)
+   "Position the cursor at message NUMBER.
+ Optional non-nil second argument NO-ERROR-IF-NO-MESSAGE means return nil
+ instead of signaling an error if message does not exist; in this case, the
+ cursor is positioned near where the message would have been.
+ Non-nil third argument DONT-SHOW means not to show the message."
+   (interactive "NGo to message: ")
+   (setq number (prefix-numeric-value number))
+   (let ((point (point))
+         (return-value t))
+     (goto-char (point-min))
+     (unless (re-search-forward (format "^[ ]*%s[^0-9]+" number) nil t)
+       (goto-char point)
+       (unless no-error-if-no-message
+         (error "No message %d" number))
+       (setq return-value nil))
+     (beginning-of-line)
+     (or dont-show (not return-value) (mh-maybe-show number))
+     return-value))
+ 
+ (defun mh-get-profile-field (field)
+   "Find and return the value of FIELD in the current buffer.
+ Returns nil if the field is not in the buffer."
+   (let ((case-fold-search t))
+     (goto-char (point-min))
+     (cond ((not (re-search-forward (format "^%s" field) nil t)) nil)
+           ((looking-at "[\t ]*$") nil)
+           (t
+            (re-search-forward "[\t ]*\\([^\t \n].*\\)$" nil t)
+            (let ((start (match-beginning 1)))
+              (end-of-line)
+              (buffer-substring start (point)))))))
+ 
+ (defvar mh-find-path-run nil
+   "Non-nil if `mh-find-path' has been run already.")
+ 
+ (defun mh-find-path ()
+   "Set variables from user's MH profile.
+ Set `mh-user-path', `mh-draft-folder', `mh-unseen-seq', `mh-previous-seq',
+ `mh-inbox' from user's MH profile.
+ The value of `mh-find-path-hook' is a list of functions to be called, with no
+ arguments, after these variable have been set."
+   (mh-variants)
+   (unless mh-find-path-run
+     (setq mh-find-path-run t)
+     (save-excursion
+       ;; Be sure profile is fully expanded before switching buffers
+       (let ((profile (expand-file-name (or (getenv "MH") "~/.mh_profile"))))
+         (set-buffer (get-buffer-create mh-temp-buffer))
+         (setq buffer-offer-save nil)      ;for people who set default to t
+         (erase-buffer)
+         (condition-case err
+             (insert-file-contents profile)
+           (file-error
+            (mh-install profile err)))
+         (setq mh-user-path (mh-get-profile-field "Path:"))
+         (if (not mh-user-path)
+             (setq mh-user-path "Mail"))
+         (setq mh-user-path
+               (file-name-as-directory
+                (expand-file-name mh-user-path (expand-file-name "~"))))
+         (unless mh-x-image-cache-directory
+           (setq mh-x-image-cache-directory
+                 (expand-file-name ".mhe-x-image-cache" mh-user-path)))
+         (setq mh-draft-folder (mh-get-profile-field "Draft-Folder:"))
+         (if mh-draft-folder
+             (progn
+               (if (not (mh-folder-name-p mh-draft-folder))
+                   (setq mh-draft-folder (format "+%s" mh-draft-folder)))
+               (if (not (file-exists-p (mh-expand-file-name mh-draft-folder)))
+                   (error
+                    "Draft folder \"%s\" not found.  Create it and try again"
+                          (mh-expand-file-name mh-draft-folder)))))
+         (setq mh-inbox (mh-get-profile-field "Inbox:"))
+         (cond ((not mh-inbox)
+                (setq mh-inbox "+inbox"))
+               ((not (mh-folder-name-p mh-inbox))
+                (setq mh-inbox (format "+%s" mh-inbox))))
+         (setq mh-unseen-seq (mh-get-profile-field "Unseen-Sequence:"))
+         (if mh-unseen-seq
+             (setq mh-unseen-seq (intern mh-unseen-seq))
+           (setq mh-unseen-seq 'unseen))   ;old MH default?
+         (setq mh-previous-seq (mh-get-profile-field "Previous-Sequence:"))
+         (if mh-previous-seq
+             (setq mh-previous-seq (intern mh-previous-seq)))
+         (run-hooks 'mh-find-path-hook)
+         (mh-collect-folder-names)))))
+ 
+ (defun mh-file-command-p (file)
+   "Return t if file FILE is the name of a executable regular file."
+   (and (file-regular-p file) (file-executable-p file)))
+ 
+ (defvar mh-no-install nil)              ;do not run install-mh
+ 
+ (defun mh-install (profile error-val)
+   "Initialize the MH environment.
+ This is called if we fail to read the PROFILE file. ERROR-VAL is the error
+ that made this call necessary."
+   (if (or (getenv "MH")
+           (file-exists-p profile)
+           mh-no-install)
+       (signal (car error-val)
+               (list (format "Cannot read MH profile \"%s\"" profile)
+                     (car (cdr (cdr error-val))))))
+   ;; The "install-mh" command will output a short note which
+   ;; mh-exec-cmd will display to the user.
+   ;; The MH 5 version of install-mh might try prompt the user
+   ;; for information, which would fail here.
+   (mh-exec-cmd (expand-file-name "install-mh" mh-lib-progs) "-auto")
+   ;; now try again to read the profile file
+   (erase-buffer)
+   (condition-case err
+       (insert-file-contents profile)
+     (file-error
+      (signal (car err)                  ;re-signal with more specific msg
+              (list (format "Cannot read MH profile \"%s\"" profile)
+                    (car (cdr (cdr err))))))))
+ 
+ (defun mh-set-folder-modified-p (flag)
+   "Mark current folder as modified or unmodified according to FLAG."
+   (set-buffer-modified-p flag))
+ 
+ (defun mh-find-seq (name)
+   "Return sequence NAME."
+   (assoc name mh-seq-list))
+ 
+ (defun mh-seq-to-msgs (seq)
+   "Return a list of the messages in SEQ."
+   (mh-seq-msgs (mh-find-seq seq)))
+ 
+ (defun mh-update-scan-format (fmt width)
+   "Return a scan format with the (msg) width in the FMT replaced with WIDTH.
+ 
+ The message number width portion of the format is discovered using
+ `mh-scan-msg-format-regexp'. Its replacement is controlled with
+ `mh-scan-msg-format-string'."
+   (or (and
+        (string-match mh-scan-msg-format-regexp fmt)
+        (let ((begin (match-beginning 1))
+              (end (match-end 1)))
+          (concat (substring fmt 0 begin)
+                  (format mh-scan-msg-format-string width)
+                  (substring fmt end))))
+       fmt))
+ 
+ (defun mh-message-number-width (folder)
+   "Return the widest message number in this FOLDER."
+   (or mh-progs (mh-find-path))
+   (let ((tmp-buffer (get-buffer-create mh-temp-buffer))
+         (width 0))
+     (save-excursion
+       (set-buffer tmp-buffer)
+       (erase-buffer)
+       (apply 'call-process
+              (expand-file-name mh-scan-prog mh-progs) nil '(t nil) nil
+              (list folder "last" "-format" "%(msg)"))
+       (goto-char (point-min))
+       (if (re-search-forward mh-scan-msg-number-regexp nil 0 1)
+           (setq width (length (buffer-substring
+                                (match-beginning 1) (match-end 1))))))
+     width))
+ 
+ (defun mh-add-msgs-to-seq (msgs seq &optional internal-flag 
dont-annotate-flag)
+   "Add MSGS to SEQ.
+ Remove duplicates and keep sequence sorted. If optional INTERNAL-FLAG is
+ non-nil, do not mark the message in the scan listing or inform MH of the
+ addition.
+ 
+ If DONT-ANNOTATE-FLAG is non-nil then the annotations in the folder buffer are
+ not updated."
+   (let ((entry (mh-find-seq seq))
+         (internal-seq-flag (mh-internal-seq seq)))
+     (if (and msgs (atom msgs)) (setq msgs (list msgs)))
+     (if (null entry)
+         (setq mh-seq-list
+               (cons (mh-make-seq seq (mh-canonicalize-sequence msgs))
+                     mh-seq-list))
+       (if msgs (setcdr entry (mh-canonicalize-sequence
+                               (append msgs (mh-seq-msgs entry))))))
+     (unless internal-flag
+       (mh-add-to-sequence seq msgs)
+       (when (not dont-annotate-flag)
+         (mh-iterate-on-range msg msgs
+           (unless (memq msg (cdr entry))
+             (mh-add-sequence-notation msg internal-seq-flag)))))))
+ 
+ (defun mh-canonicalize-sequence (msgs)
+   "Sort MSGS in decreasing order and remove duplicates."
+   (let* ((sorted-msgs (sort (copy-sequence msgs) '>))
+          (head sorted-msgs))
+     (while (cdr head)
+       (if (= (car head) (cadr head))
+           (setcdr head (cddr head))
+         (setq head (cdr head))))
+     sorted-msgs))
+ 
+ (defvar mh-sub-folders-cache (make-hash-table :test #'equal))
+ (defvar mh-current-folder-name nil)
+ (defvar mh-flists-partial-line "")
+ (defvar mh-flists-process nil)
+ 
+ ;; Initialize mh-sub-folders-cache...
+ (defun mh-collect-folder-names ()
+   "Collect folder names by running `flists'."
+   (unless mh-flists-process
+     (setq mh-flists-process
+           (mh-exec-cmd-daemon "folders" 'mh-collect-folder-names-filter
+                               "-recurse" "-fast"))))
+ 
+ (defun mh-collect-folder-names-filter (process output)
+   "Read folder names.
+ PROCESS is the flists process that was run to collect folder names and the
+ function is called when OUTPUT is available."
+   (let ((position 0)
+       (prevailing-match-data (match-data))
+       line-end folder)
+     (unwind-protect
+       (while (setq line-end (string-match "\n" output position))
+         (setq folder (format "+%s%s"
+                                mh-flists-partial-line
+                                (substring output position line-end)))
+         (setq mh-flists-partial-line "")
+           (unless (equal (aref folder 1) ?.)
+             (mh-populate-sub-folders-cache folder))
+         (setq position (1+ line-end)))
+       (set-match-data prevailing-match-data))
+     (setq mh-flists-partial-line (substring output position))))
+ 
+ (defun mh-populate-sub-folders-cache (folder)
+   "Tell `mh-sub-folders-cache' about FOLDER."
+   (let* ((last-slash (mh-search-from-end ?/ folder))
+          (child1 (substring folder (1+ (or last-slash 0))))
+          (parent (and last-slash (substring folder 0 last-slash)))
+          (parent-slash (and parent (mh-search-from-end ?/ parent)))
+          (child2 (and parent (substring parent (1+ (or parent-slash 0)))))
+          (grand-parent (and parent-slash (substring parent 0 parent-slash)))
+          (cache-entry (gethash parent mh-sub-folders-cache)))
+     (unless (loop for x in cache-entry when (equal (car x) child1) return t
+                   finally return nil)
+       (push (list child1) cache-entry)
+       (setf (gethash parent mh-sub-folders-cache)
+             (sort cache-entry (lambda (x y) (string< (car x) (car y)))))
+       (when parent
+         (loop for x in (gethash grand-parent mh-sub-folders-cache)
+               when (equal (car x) child2)
+               do (progn (setf (cdr x) t) (return)))))))
+ 
+ (defun mh-normalize-folder-name (folder &optional empty-string-okay
+                                         dont-remove-trailing-slash)
+   "Normalizes FOLDER name.
+ Makes sure that two '/' characters never occur next to each other. Also all
+ occurrences of \"..\" and \".\" are suitably processed. So \"+inbox/../news\"
+ will be normalized to \"+news\".
+ 
+ If optional argument EMPTY-STRING-OKAY is nil then a '+' is added at the
+ front if FOLDER lacks one. If non-nil and FOLDER is the empty string then
+ nothing is added.
+ 
+ If optional argument DONT-REMOVE-TRAILING-SLASH is non-nil then a trailing '/'
+ if present is retained (if present), otherwise it is removed."
+   (when (stringp folder)
+     ;; Replace two or more consecutive '/' characters with a single '/'
+     (while (string-match "//" folder)
+       (setq folder (replace-match "/" nil t folder)))
+     (let* ((length (length folder))
+            (trailing-slash-present (and (> length 0)
+                                         (equal (aref folder (1- length)) ?/)))
+            (leading-slash-present (and (> length 0)
+                                        (equal (aref folder 0) ?/))))
+       (when (and (> length 0) (equal (aref folder 0) ?@)
+                  (stringp mh-current-folder-name))
+         (setq folder (format "%s/%s/" mh-current-folder-name
+                              (substring folder 1))))
+       ;; XXX: Purge empty strings from the list that split-string returns. In
+       ;;  XEmacs, (split-string "+foo/" "/") returns ("+foo" "") while in GNU
+       ;;  Emacs it returns ("+foo"). In the code it is assumed that the
+       ;; components list has no empty strings.
+       (let ((components (delete "" (split-string folder "/")))
+             (result ()))
+         ;; Remove .. and . from the pathname.
+         (dolist (component components)
+           (cond ((and (equal component "..") result)
+                  (pop result))
+                 ((equal component ".."))
+                 ((equal component "."))
+                 (t (push component result))))
+         (setq folder "")
+         (dolist (component result)
+           (setq folder (concat component "/" folder)))
+         ;; Remove trailing '/' if needed.
+         (unless (and trailing-slash-present dont-remove-trailing-slash)
+           (when (not (equal folder ""))
+             (setq folder (substring folder 0 (1- (length folder))))))
+         (when leading-slash-present
+           (setq folder (concat "/" folder)))))
+     (cond ((and empty-string-okay (equal folder "")))
+           ((equal folder "") (setq folder "+"))
+           ((not (equal (aref folder 0) ?+)) (setq folder (concat "+" 
folder)))))
+   folder)
+ 
+ (defun mh-sub-folders (folder &optional add-trailing-slash-flag)
+   "Find the subfolders of FOLDER.
+ The function avoids running folders unnecessarily by caching the results of
+ the actual folders call.
+ 
+ If optional argument ADD-TRAILING-SLASH-FLAG is non-nil then a slash is added
+ to each of the sub-folder names that may have nested folders within them."
+   (let* ((folder (mh-normalize-folder-name folder))
+          (match (gethash folder mh-sub-folders-cache 'no-result))
+          (sub-folders (cond ((eq match 'no-result)
+                              (setf (gethash folder mh-sub-folders-cache)
+                                    (mh-sub-folders-actual folder)))
+                             (t match))))
+     (if add-trailing-slash-flag
+         (mapcar #'(lambda (x)
+                     (if (cdr x) (cons (concat (car x) "/") (cdr x)) x))
+                 sub-folders)
+       sub-folders)))
+ 
+ (defun mh-sub-folders-actual (folder)
+   "Execute the command folders to return the sub-folders of FOLDER.
+ Filters out the folder names that start with \".\" so that directories that
+ aren't usually mail folders are hidden."
+   (let ((arg-list `(,(expand-file-name "folders" mh-progs)
+                     nil (t nil) nil "-noheader" "-norecurse" "-nototal"
+                     ,@(if (stringp folder) (list folder) ())))
+         (results ())
+         (current-folder (concat
+                          (with-temp-buffer
+                            (call-process (expand-file-name "folder" mh-progs)
+                                          nil '(t nil) nil "-fast")
+                            (buffer-substring (point-min) (1- (point-max))))
+                          "+")))
+     (with-temp-buffer
+       (apply #'call-process arg-list)
+       (goto-char (point-min))
+       (while (not (and (eolp) (bolp)))
+         (goto-char (line-end-position))
+         (let ((start-pos (line-beginning-position))
+               (has-pos (search-backward " has " (line-beginning-position) t)))
+           (when (integerp has-pos)
+             (while (equal (char-after has-pos) ? )
+               (decf has-pos))
+             (incf has-pos)
+             (while (equal (char-after start-pos) ? )
+               (incf start-pos))
+             (let* ((name (buffer-substring start-pos has-pos))
+                    (first-char (aref name 0))
+                    (last-char (aref name (1- (length name)))))
+               (unless (member first-char '(?. ?# ?,))
+                 (when (and (equal last-char ?+) (equal name current-folder))
+                   (setq name (substring name 0 (1- (length name)))))
+                 (push
+                  (cons name
+                        (search-forward "(others)" (line-end-position) t))
+                  results))))
+           (forward-line 1))))
+     (setq results (nreverse results))
+     (when (stringp folder)
+       (setq results (cdr results))
+       (let ((folder-name-len (length (format "%s/" (substring folder 1)))))
+         (setq results (mapcar (lambda (f)
+                                 (cons (substring (car f) folder-name-len)
+                                       (cdr f)))
+                               results))))
+     results))
+ 
+ (defun mh-remove-from-sub-folders-cache (folder)
+   "Remove FOLDER and its parent from `mh-sub-folders-cache'.
+ FOLDER should be unconditionally removed from the cache. Also the last 
ancestor
+ of FOLDER present in the cache must be removed as well.
+ 
+ To see why this is needed assume we have a folder +foo which has a single
+ sub-folder qux. Now we create the folder +foo/bar/baz. Here we will need to
+ invalidate the cached sub-folders of +foo, otherwise completion on +foo won't
+ tell us about the option +foo/bar!"
+   (remhash folder mh-sub-folders-cache)
+   (block ancestor-found
+     (let ((parent folder)
+           (one-ancestor-found nil)
+           last-slash)
+       (while (setq last-slash (mh-search-from-end ?/ parent))
+         (setq parent (substring parent 0 last-slash))
+         (unless (eq (gethash parent  mh-sub-folders-cache 'none) 'none)
+           (remhash parent mh-sub-folders-cache)
+           (if one-ancestor-found
+               (return-from ancestor-found)
+             (setq one-ancestor-found t))))
+       (remhash nil mh-sub-folders-cache))))
+ 
+ (defvar mh-folder-hist nil)
+ (defvar mh-speed-folder-map)
+ (defvar mh-speed-flists-cache)
+ 
+ (defvar mh-allow-root-folder-flag nil
+   "Non-nil means \"+\" is an acceptable folder name.
+ This variable is used to communicate with `mh-folder-completion-function'. 
That
+ function can have exactly three arguments so we bind this variable to t or 
nil.
+ 
+ This variable should never be set.")
+ 
+ (defvar mh-folder-completion-map (copy-keymap 
minibuffer-local-completion-map))
+ (define-key mh-folder-completion-map " " 'minibuffer-complete)
+ 
+ (defvar mh-speed-flists-inhibit-flag nil)
+ 
+ (defun mh-speed-flists-active-p ()
+   "Check if speedbar is running with message counts enabled."
+   (and (featurep 'mh-speed)
+        (not mh-speed-flists-inhibit-flag)
+        (> (hash-table-count mh-speed-flists-cache) 0)))
+ 
+ (defun mh-folder-completion-function (name predicate flag)
+   "Programmable completion for folder names.
+ NAME is the partial folder name that has been input. PREDICATE if non-nil is a
+ function that is used to filter the possible choices and FLAG determines
+ whether the completion is over."
+   (let* ((orig-name name)
+          (name (mh-normalize-folder-name name nil t))
+          (last-slash (mh-search-from-end ?/ name))
+          (last-complete (if last-slash (substring name 0 last-slash) nil))
+          (remainder (cond (last-complete (substring name (1+ last-slash)))
+                           ((and (> (length name) 0) (equal (aref name 0) ?+))
+                            (substring name 1))
+                           (t ""))))
+     (cond ((eq flag nil)
+            (let ((try-res (try-completion
+                            name
+                            (mapcar (lambda (x)
+                                      (cons (if (not last-complete)
+                                                (concat "+" (car x))
+                                              (concat last-complete "/" (car 
x)))
+                                            (cdr x)))
+                                    (mh-sub-folders last-complete t))
+                            predicate)))
+              (cond ((eq try-res nil) nil)
+                    ((and (eq try-res t) (equal name orig-name)) t)
+                    ((eq try-res t) name)
+                    (t try-res))))
+           ((eq flag t)
+            (all-completions
+             remainder (mh-sub-folders last-complete t) predicate))
+           ((eq flag 'lambda)
+            (let ((path (concat mh-user-path
+                                (substring (mh-normalize-folder-name name) 
1))))
+              (cond (mh-allow-root-folder-flag (file-exists-p path))
+                    ((equal path mh-user-path) nil)
+                    (t (file-exists-p path))))))))
+ 
+ (defun mh-folder-completing-read (prompt default allow-root-folder-flag)
+   "Read folder name with PROMPT and default result DEFAULT.
+ If ALLOW-ROOT-FOLDER-FLAG is non-nil then \"+\" is allowed to be a folder name
+ corresponding to `mh-user-path'."
+   (mh-normalize-folder-name
+    (let ((minibuffer-completing-file-name t)
+          (completion-root-regexp "^[+/]")
+          (minibuffer-local-completion-map mh-folder-completion-map)
+          (mh-allow-root-folder-flag allow-root-folder-flag))
+      (completing-read prompt 'mh-folder-completion-function nil nil nil
+                       'mh-folder-hist default))
+    t))
+ 
+ (defun mh-prompt-for-folder (prompt default can-create
+                              &optional default-string allow-root-folder-flag)
+   "Prompt for a folder name with PROMPT.
+ Returns the folder's name as a string. DEFAULT is used if the folder exists
+ and the user types return. If the CAN-CREATE flag is t, then a folder is
+ created if it doesn't already exist. If optional argument DEFAULT-STRING is
+ non-nil, use it in the prompt instead of DEFAULT. If ALLOW-ROOT-FOLDER-FLAG is
+ non-nil then the function will accept the folder +, which means all folders
+ when used in searching."
+   (if (null default)
+       (setq default ""))
+   (let* ((default-string (cond (default-string (format "[%s] " 
default-string))
+                                ((equal "" default) "")
+                                (t (format "[%s] " default))))
+          (prompt (format "%s folder: %s" prompt default-string))
+          (mh-current-folder-name mh-current-folder)
+          read-name folder-name)
+     (while (and (setq read-name (mh-folder-completing-read
+                                  prompt default allow-root-folder-flag))
+                 (equal read-name "")
+                 (equal default "")))
+     (cond ((or (equal read-name "")
+                (and (equal read-name "+") (not allow-root-folder-flag)))
+            (setq read-name default))
+           ((not (mh-folder-name-p read-name))
+            (setq read-name (format "+%s" read-name))))
+     (if (or (not read-name) (equal "" read-name))
+         (error "No folder specified"))
+     (setq folder-name read-name)
+     (cond ((and (> (length folder-name) 0)
+                 (eq (aref folder-name (1- (length folder-name))) ?/))
+            (setq folder-name (substring folder-name 0 -1))))
+     (let* ((last-slash (mh-search-from-end ?/ folder-name))
+            (parent (and last-slash (substring folder-name 0 last-slash)))
+            (child (if last-slash
+                       (substring folder-name (1+ last-slash))
+                     (substring folder-name 1))))
+       (unless (member child
+                       (mapcar #'car (gethash parent mh-sub-folders-cache)))
+         (mh-remove-from-sub-folders-cache folder-name)))
+     (let ((new-file-flag
+            (not (file-exists-p (mh-expand-file-name folder-name)))))
+       (cond ((and new-file-flag
+                   (y-or-n-p
+                    (format "Folder %s does not exist.  Create it? "
+                            folder-name)))
+              (message "Creating %s" folder-name)
+              (mh-exec-cmd-error nil "folder" folder-name)
+              (mh-remove-from-sub-folders-cache folder-name)
+              (when (boundp 'mh-speed-folder-map)
+                (mh-speed-add-folder folder-name))
+              (message "Creating %s...done" folder-name))
+             (new-file-flag
+              (error "Folder %s is not created" folder-name))
+             ((not (file-directory-p (mh-expand-file-name folder-name)))
+              (error "\"%s\" is not a directory"
+                     (mh-expand-file-name folder-name)))))
+     folder-name))
+ 
+ (defun mh-truncate-log-buffer ()
+   "If `mh-log-buffer' is too big then truncate it.
+ If the number of lines in `mh-log-buffer' exceeds `mh-log-buffer-lines' then
+ keep only the last `mh-log-buffer-lines'. As a side effect the point is set to
+ the end of the log buffer.
+ 
+ The function returns the size of the final size of the log buffer."
+   (with-current-buffer (get-buffer-create mh-log-buffer)
+     (goto-char (point-max))
+     (save-excursion
+       (when (equal (forward-line (- mh-log-buffer-lines)) 0)
+         (delete-region (point-min) (point))))
+     (unless (or (bobp)
+                 (save-excursion
+                   (and (equal (forward-line -1) 0) (equal (char-after) ?))))
+       (insert "\n\n"))
+     (buffer-size)))
+ 
+ ;;; Issue commands to MH.
+ 
+ (defun mh-exec-cmd (command &rest args)
+   "Execute mh-command COMMAND with ARGS.
+ The side effects are what is desired.
+ Any output is assumed to be an error and is shown to the user.
+ The output is not read or parsed by MH-E."
+   (save-excursion
+     (set-buffer (get-buffer-create mh-log-buffer))
+     (let* ((initial-size (mh-truncate-log-buffer))
+            (start (point))
+            (args (mh-list-to-string args)))
+       (apply 'call-process (expand-file-name command mh-progs) nil t nil args)
+       (when (> (buffer-size) initial-size)
+         (save-excursion
+           (goto-char start)
+           (insert "Errors when executing: " command)
+           (loop for arg in args do (insert " " arg))
+           (insert "\n"))
+         (save-window-excursion
+           (switch-to-buffer-other-window mh-log-buffer)
+           (sit-for 5))))))
+ 
+ (defun mh-exec-cmd-error (env command &rest args)
+   "In environment ENV, execute mh-command COMMAND with ARGS.
+ ENV is nil or a string of space-separated \"var=value\" elements.
+ Signals an error if process does not complete successfully."
+   (save-excursion
+     (set-buffer (get-buffer-create mh-temp-buffer))
+     (erase-buffer)
+     (let ((process-environment process-environment))
+       ;; XXX: We should purge the list that split-string returns of empty
+       ;;  strings. This can happen in XEmacs if leading or trailing spaces
+       ;;  are present.
+       (dolist (elem (if (stringp env) (split-string env " ") ()))
+         (push elem process-environment))
+       (mh-handle-process-error
+        command (apply #'call-process (expand-file-name command mh-progs)
+                       nil t nil (mh-list-to-string args))))))
+ 
+ (defun mh-exec-cmd-daemon (command filter &rest args)
+   "Execute MH command COMMAND in the background.
+ 
+ If FILTER is non-nil then it is used to process the output otherwise the
+ default filter `mh-process-daemon' is used. See `set-process-filter' for more
+ details of FILTER.
+ 
+ ARGS are passed to COMMAND as command line arguments."
+   (save-excursion
+     (set-buffer (get-buffer-create mh-log-buffer))
+     (mh-truncate-log-buffer))
+   (let* ((process-connection-type nil)
+          (process (apply 'start-process
+                          command nil
+                          (expand-file-name command mh-progs)
+                          (mh-list-to-string args))))
+     (set-process-filter process (or filter 'mh-process-daemon))
+     process))
+ 
+ (defun mh-exec-cmd-env-daemon (env command filter &rest args)
+   "In ennvironment ENV, execute mh-command COMMAND in the background.
+ 
+ ENV is nil or a string of space-separated \"var=value\" elements.
+ Signals an error if process does not complete successfully.
+ 
+ If FILTER is non-nil then it is used to process the output otherwise the
+ default filter `mh-process-daemon' is used. See `set-process-filter' for more
+ details of FILTER.
+ 
+ ARGS are passed to COMMAND as command line arguments."
+   (let ((process-environment process-environment))
+     (dolist (elem (if (stringp env) (split-string env " ") ()))
+       (push elem process-environment))
+     (apply #'mh-exec-cmd-daemon command filter args)))
+ 
+ (defun mh-process-daemon (process output)
+   "PROCESS daemon that puts OUTPUT into a temporary buffer.
+ Any output from the process is displayed in an asynchronous pop-up window."
+   (set-buffer (get-buffer-create mh-log-buffer))
+   (insert-before-markers output)
+   (display-buffer mh-log-buffer))
+ 
+ (defun mh-exec-cmd-quiet (raise-error command &rest args)
+   "Signal RAISE-ERROR if COMMAND with ARGS fails.
+ Execute MH command COMMAND with ARGS.  ARGS is a list of strings.
+ Return at start of mh-temp buffer, where output can be parsed and used.
+ Returns value of `call-process', which is 0 for success, unless RAISE-ERROR is
+ non-nil, in which case an error is signaled if `call-process' returns non-0."
+   (set-buffer (get-buffer-create mh-temp-buffer))
+   (erase-buffer)
+   (let ((value
+          (apply 'call-process
+                 (expand-file-name command mh-progs) nil t nil
+                 args)))
+     (goto-char (point-min))
+     (if raise-error
+         (mh-handle-process-error command value)
+       value)))
+ 
+ (defun mh-profile-component (component)
+   "Return COMPONENT value from mhparam, or nil if unset."
+   (save-excursion
+     (mh-exec-cmd-quiet nil "mhparam" "-components" component)
+     (mh-get-profile-field (concat component ":"))))
+ 
+ (defun mh-exchange-point-and-mark-preserving-active-mark ()
+   "Put the mark where point is now, and point where the mark is now.
+ This command works even when the mark is not active, and preserves whether the
+ mark is active or not."
+   (interactive nil)
+   (let ((is-active (and (boundp 'mark-active) mark-active)))
+     (let ((omark (mark t)))
+       (if (null omark)
+           (error "No mark set in this buffer"))
+       (set-mark (point))
+       (goto-char omark)
+       (if (boundp 'mark-active)
+           (setq mark-active is-active))
+       nil)))
+ 
+ (defun mh-exec-cmd-output (command display &rest args)
+   "Execute MH command COMMAND with DISPLAY flag and ARGS.
+ Put the output into buffer after point.  Set mark after inserted text.
+ Output is expected to be shown to user, not parsed by MH-E."
+   (push-mark (point) t)
+   (apply 'call-process
+          (expand-file-name command mh-progs) nil t display
+          (mh-list-to-string args))
+ 
+   ;; The following is used instead of 'exchange-point-and-mark because the
+   ;; latter activates the current region (between point and mark), which
+   ;; turns on highlighting.  So prior to this bug fix, doing "inc" would
+   ;; highlight a region containing the new messages, which is undesirable.
+   ;; The bug wasn't seen in emacs21 but still occurred in XEmacs21.4.
+   (mh-exchange-point-and-mark-preserving-active-mark))
+ 
+ (defun mh-exec-lib-cmd-output (command &rest args)
+   "Execute MH library command COMMAND with ARGS.
+ Put the output into buffer after point.  Set mark after inserted text."
+   (apply 'mh-exec-cmd-output (expand-file-name command mh-lib-progs) nil 
args))
+ 
+ (defun mh-handle-process-error (command status)
+   "Raise error if COMMAND returned non-zero STATUS, otherwise return STATUS."
+   (if (equal status 0)
+       status
+     (goto-char (point-min))
+     (insert (if (integerp status)
+                 (format "%s: exit code %d\n" command status)
+               (format "%s: %s\n" command status)))
+     (save-excursion
+       (let ((error-message (buffer-substring (point-min) (point-max))))
+         (set-buffer (get-buffer-create mh-log-buffer))
+         (mh-truncate-log-buffer)
+         (insert error-message)))
+     (error "%s failed, check %s buffer for error message"
+            command mh-log-buffer)))
+ 
+ (defun mh-list-to-string (l)
+   "Flatten the list L and make every element of the new list into a string."
+   (nreverse (mh-list-to-string-1 l)))
+ 
+ (defun mh-list-to-string-1 (l)
+   "Flatten the list L and make every element of the new list into a string."
+   (let ((new-list nil))
+     (while l
+       (cond ((null (car l)))
+             ((symbolp (car l))
+              (setq new-list (cons (symbol-name (car l)) new-list)))
+             ((numberp (car l))
+              (setq new-list (cons (int-to-string (car l)) new-list)))
+             ((equal (car l) ""))
+             ((stringp (car l)) (setq new-list (cons (car l) new-list)))
+             ((listp (car l))
+              (setq new-list (nconc (mh-list-to-string-1 (car l))
+                                    new-list)))
+             (t (error "Bad element in mh-list-to-string: %s" (car l))))
+       (setq l (cdr l)))
+     new-list))
+ 
+ (defun mh-replace-string (old new)
+   "Replace all occurrences of OLD with NEW in the current buffer."
+   (goto-char (point-min))
+   (let ((case-fold-search t))
+     (while (search-forward old nil t)
+       (replace-match new t t))))
+ 
+ (defun mh-replace-in-string (regexp newtext string)
+   "Replace REGEXP with NEWTEXT everywhere in STRING and return result.
+ NEWTEXT is taken literally---no \\DIGIT escapes will be recognized.
+ 
+ The function body was copied from `dired-replace-in-string' in dired.el.
+ Emacs21 has `replace-regexp-in-string' while XEmacs has `replace-in-string'.
+ Neither is present in Emacs20. The file gnus-util.el in Gnus 5.10.1 and above
+ has `gnus-replace-in-string'. We should use that when we decide to not support
+ older versions of Gnus."
+   (let ((result "") (start 0) mb me)
+     (while (string-match regexp string start)
+       (setq mb (match-beginning 0)
+             me (match-end 0)
+             result (concat result (substring string start mb) newtext)
+             start me))
+     (concat result (substring string start))))
+ 
+ (provide 'mh-utils)
+ 
+ ;;; Local Variables:
+ ;;; indent-tabs-mode: nil
+ ;;; sentence-end-double-space: nil
+ ;;; End:
+ 
+ ;;; arch-tag: 1af39fdf-f66f-4b06-9b48-18a7656c8e36
+ ;;; mh-utils.el ends here




reply via email to

[Prev in Thread] Current Thread [Next in Thread]