comparison lisp/mh-e/mh-utils.el @ 67758:6b063593fdad

Follow Emacs coding conventions. Use default setting of emacs-lisp-docstring-fill-column which is 65.

67757:488b4dbc7482

;;; 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:

;;; Scan Line Formats

(defvar mh-scan-msg-number-regexp "^ *\\([0-9]+\\)"
  "This regular expression extracts the message number.
It must match from the beginning of the 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 regular expression matches overflowed message numbers.")

(defvar mh-scan-msg-format-regexp "%\\([0-9]*\\)(msg)"
  "This regular expression finds 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)\". This variable is only consulted
if `mh-scan-format-file' is set to \"Use MH-E scan Format\".")

(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. This variable is only consulted if
`mh-scan-format-file' is set to \"Use MH-E scan Format\".")

(defvar mh-scan-msg-search-regexp "^[^0-9]*%d[^0-9]"
  "This regular expression matches a particular message.
It is a format string; 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
  "Column for notations.
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 on.

Note that columns in Emacs start with 0.")
(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 regular expression 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 "^-- $"
  "This regular expression matches the 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))

;; 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 "[^-_A-z0-9.@]" (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 xxx@yyy Mon May 10 11:48:07 2004
    ;; In this situation, rfc822-goto-eoh doesn't go to the end of the

    (mh-font-lock-field-data (1 'mh-letter-header-field prepend t))))

(defun mh-show-font-lock-fontify-region (beg end loudly)
  "Limit font-lock in `mh-show-mode' to the header.

Used when the option `mh-highlight-citation-style' 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))



;;; 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-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

(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

(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")))

  "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))

  (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-number (buffer-substring (match-beginning 1)
                                               (match-end 1))))

           (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) ?+))))

;; 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

(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)

      (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)))

        ((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")))))

  (if mh-showing-mode (mh-show msg)))

(defun mh-show (&optional message redisplay-flag)
  "Display message\\<mh-folder-mode-map>.

If the message under the cursor is already displayed, this command scrolls to
the beginning of the message. MH-E normally hides a lot of the superfluous
header fields that mailers add to a message, but if you wish to see all of
them, use the command \\[mh-header-display].

From a program, optional argument MESSAGE can be used to display an
alternative message. The optional argument REDISPLAY-FLAG forces the redisplay
of the message even if the show buffer was already displaying the correct
message.

See the \"mh-show\" customization group for a litany of options that control
what displayed messages look like."
  (interactive (list nil t))
  (when (or redisplay-flag
            (and mh-showing-with-headers
                 (or mh-mhl-format-file mh-clean-message-header-flag)))
    (mh-invalidate-show-buffer))

    (run-hooks 'mh-show-hook)))

(defun mh-modify (&optional message)
  "Edit message.

There are times when you need to edit a message. For example, you may need to
fix a broken Content-Type header field. You can do this with this command. It
displays the raw message in an editable buffer. When you are done editing,
save and kill the buffer as you would any other.

From a program, edit MESSAGE instead if it is non-nil."
  (interactive)
  (let* ((message (or message (mh-get-msg-num t)))
         (msg-filename (mh-msg-filename message))

             (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

  "Go to a message\\<mh-folder-mode-map>.

You can enter the message NUMBER either before or after typing
\\[mh-goto-msg]. In the latter case, Emacs prompts you.

In a program, 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))

  "Set variables from user's MH profile.

This function sets `mh-user-path' from your \"Path:\" MH profile
component (but defaults to \"Mail\" if one isn't present),
`mh-draft-folder' from \"Draft-Folder:\", `mh-unseen-seq' from
\"Unseen-Sequence:\", `mh-previous-seq' from \"Previous-Sequence:\",
and `mh-inbox' from \"Inbox:\" (defaults to \"+inbox\").

The hook `mh-find-path-hook' is run after these variables have been
set. This hook can be used the change the value of these variables if
you need to run with different values between MH and MH-E."
  (mh-variants)
  (unless mh-find-path-run
    (setq mh-find-path-run t)
    (save-excursion
      ;; Be sure profile is fully expanded before switching buffers

(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)

  (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)

                               (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

          (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))

              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))

          ((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)))

                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

                              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)

(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)

       (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)))

                   ((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))

   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 " (default %s)" default-string))
                               ((equal "" default) "")
                               (t (format " (default %s)" default))))

                    (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

;;; 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)))

                      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))

  "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

    (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"))

          (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 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)

(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)

67758:6b063593fdad

;;; 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:

;;; Scan Line Formats

(defvar mh-scan-msg-number-regexp "^ *\\([0-9]+\\)"
  "This regular expression extracts the message number.

It must match from the beginning of the 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 regular expression matches overflowed message numbers.")

(defvar mh-scan-msg-format-regexp "%\\([0-9]*\\)(msg)"
  "This regular expression finds 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)\". This
variable is only consulted if `mh-scan-format-file' is set to
\"Use MH-E scan Format\".")

(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. This variable is only
consulted if `mh-scan-format-file' is set to \"Use MH-E scan
Format\".")

(defvar mh-scan-msg-search-regexp "^[^0-9]*%d[^0-9]"
  "This regular expression matches a particular message.

It is a format string; 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
  "Column for notations.

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 on.

Note that columns in Emacs start with 0.")
(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 regular expression 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 "^-- $"
  "This regular expression matches the 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))

;; 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 "[^-_A-z0-9.@]" (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 xxx@yyy Mon May 10 11:48:07 2004
    ;; In this situation, rfc822-goto-eoh doesn't go to the end of the

    (mh-font-lock-field-data (1 'mh-letter-header-field prepend t))))

(defun mh-show-font-lock-fontify-region (beg end loudly)
  "Limit font-lock in `mh-show-mode' to the header.

Used when the option `mh-highlight-citation-style' 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))



;;; Internal bookkeeping variables:

(defvar mh-user-path nil
  "Cached value of the \"Path:\" MH profile component.
User's mail folder directory.")

(defvar mh-draft-folder nil
  "Cached value of the \"Draft-Folder:\" MH profile component.
Name of folder containing draft messages.
Nil means do not use a draft folder.")

(defvar mh-unseen-seq nil
  "Cached value of the \"Unseen-Sequence:\" MH profile component.
Name of the Unseen sequence.")

(defvar mh-previous-seq nil
  "Cached value of the \"Previous-Sequence:\" MH profile component.
Name of the Previous sequence.")

(defvar mh-inbox nil
  "Cached value of the \"Inbox:\" MH profile component.
Set to \"+inbox\" if no such component.
Name of the Inbox folder.")

;; 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-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

(defvar mh-log-buffer-lines 100
  "Number of lines to keep in `mh-log-buffer'.")

(defvar mh-previous-window-config nil
  "Window configuration before MH-E command.")

(defvar mh-page-to-next-msg-flag nil
  "Non-nil means next SPC or whatever goes to next undeleted message.")



;;; Internal variables local to a folder.

(defvar mh-current-folder nil
  "Name of current folder, a string.")

(defvar mh-show-buffer nil
  "Buffer that displays message for this folder.")

(defvar mh-folder-filename nil
  "Full path of directory for this folder.")

(defvar mh-msg-count nil
  "Number of msgs in buffer.")

(defvar mh-showing-mode nil
  "If non-nil, show the message in a separate window.")

(defvar mh-show-mode-map (make-sparse-keymap)
  "Keymap used by the show buffer.")

(defvar mh-show-folder-buffer nil

(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

(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")))

  "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))

  (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-number (buffer-substring (match-beginning 1)
                                               (match-end 1))))

           (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) ?+))))

;; 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

(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)

      (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)))

        ((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")))))

  (if mh-showing-mode (mh-show msg)))

(defun mh-show (&optional message redisplay-flag)
  "Display message\\<mh-folder-mode-map>.

If the message under the cursor is already displayed, this command
scrolls to the beginning of the message. MH-E normally hides a lot of
the superfluous header fields that mailers add to a message, but if
you wish to see all of them, use the command \\[mh-header-display].

From a program, optional argument MESSAGE can be used to display an
alternative message. The optional argument REDISPLAY-FLAG forces the
redisplay of the message even if the show buffer was already
displaying the correct message.

See the \"mh-show\" customization group for a litany of options that
control what displayed messages look like."
  (interactive (list nil t))
  (when (or redisplay-flag
            (and mh-showing-with-headers
                 (or mh-mhl-format-file mh-clean-message-header-flag)))
    (mh-invalidate-show-buffer))

    (run-hooks 'mh-show-hook)))

(defun mh-modify (&optional message)
  "Edit message.

There are times when you need to edit a message. For example, you
may need to fix a broken Content-Type header field. You can do
this with this command. It displays the raw message in an
editable buffer. When you are done editing, save and kill the
buffer as you would any other.

From a program, edit MESSAGE instead if it is non-nil."
  (interactive)
  (let* ((message (or message (mh-get-msg-num t)))
         (msg-filename (mh-msg-filename message))

             (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."
  ;; XXX 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

  "Go to a message\\<mh-folder-mode-map>.

You can enter the message NUMBER either before or after typing
\\[mh-goto-msg]. In the latter case, Emacs prompts you.

In a program, 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))

  "Set variables from user's MH profile.

This function sets `mh-user-path' from your \"Path:\" MH profile
component (but defaults to \"Mail\" if one isn't present),
`mh-draft-folder' from \"Draft-Folder:\", `mh-unseen-seq' from
\"Unseen-Sequence:\", `mh-previous-seq' from
\"Previous-Sequence:\", and `mh-inbox' from \"Inbox:\" (defaults
to \"+inbox\").

The hook `mh-find-path-hook' is run after these variables have
been set. This hook can be used the change the value of these
variables if you need to run with different values between MH and
MH-E."
  (mh-variants)
  (unless mh-find-path-run
    (setq mh-find-path-run t)
    (save-excursion
      ;; Be sure profile is fully expanded before switching buffers

(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)

  (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)

                               (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

          (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))

              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))

          ((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)))

                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

                              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)

(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)

       (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)))

                   ((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))

   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 " (default %s)" default-string))
                               ((equal "" default) "")
                               (t (format " (default %s)" default))))

                    (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

;;; 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)))

                      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))

  "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

    (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"))

          (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 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)

(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)